defrule extraction of scalars from symbolic matrix trace

On 12/3/2010 12:00 PM, Richard Fateman wrote:
> Not everything has to be done with patterns.  In particular,
> defrule(r1, ....)
> simplify defines a function r1.
>
> Sometimes it is better to write functions yourself, rather than having
> defrule write them for you.  For a (probably more "advanced" than 
> necessary
> discussion of this issue, see 
> http://www.cs.berkeley.edu/~fateman/papers/partition.pdf )
>
> If the idea is to take tr( mu,   ..stuff..)  and change it to  
> A*tr(mu, ...B...)   where
> A=product of all scalar multiples of yada yada  and B is the stuff 
> with the scalars removed, then
> you could use the partition program in that paper, or something like 
> it. Perhaps simpler
> and special purpose, you can write a program like this....
>
> simptrace(X) :=   /*  call this only if X looks like tr(mu, ...) and 
> you want to extract scalars. */
> block([A:1, B: substinpart("[",rest(X),0)],
>   for i:1 thru length(B) do
>
> (  /* set A:  A*  the scalar part of B[i]  ,
>       set B[i] : the nonscalar part of B[i] */
> ),
> return (A* apply(tr,(cons(first(X),B) )  /* put back  tr(mu, ....    */
>
> ... if this is unclear, please ask.
>
> RJF
>
...........
Here is more program...

/* as defined in the paper referred to above...*/

partition_expression(operator,pred,init,combiner,action,res,E):=
     block([yes:init,no:init],
    if not atom(E) and inpart(E,0)=operator then
        (map(lambda([r], if apply(pred,[r])=false
               then  no:apply(combiner,[r,no])
               else yes:apply(combiner,[r,yes])),
             inargs(E) ),
        res :: apply(action, [yes,no]), /* result stored as requested */
        true))$

  inargs(z):=substinpart("[",z,0)$ /* utility like args, but avoids / or 
- */;

/* example of using this program... */


f(q):=block([answer:[1,q]],partition_expression("*",scalarp,1,"*","[",'answer,q),answer);

declare(k,scalar);

hh:  map(f,[3*k*bbb,4,3*aa*sin(1)]);

produces [[3*k,bbb],[1,4],[3*sin(1),aa]]

A: apply("*", map(first,hh))  produces   9*sin(1)*k

B:apply(tr, cons(mu, map(second,hh)))   produces tr(mu,bbb,4,aa)

so A*B

is 9*sin(1)*k * tr(mu,bbb,4,aa)

instead of tr(mu, 3*k*bbb,4,3*aa*sin(1))

............
can this be done via defrule? not without some help. Should defrule be 
fixed to allow
variable length arglists? Eh, as Robert Dodier points out, it is already 
done with
* and +, but to do it right there are lots of mechanisms that have to be 
made
available.  Mathematica's pattern matching does more of this; implementing
it in Maxima would be possible, but is certainly not necessary for this 
task.

RJF