(wx)Maxima: how to get consistent expressions using `args`?

user_5986783 0
Viewed 53

I'm trying to write a small script that will look at the first term of an expression and determine whether it is positive or negative, then print a + or - in front of that expression, accordingly; however, I'm having a bit of trouble writing it in such a way that it reliably extracts the first term of the expression.

I have been experimenting with part and args. I have been leaning towards args because I haven't found any way to determine the "depth" of parts for an arbitrary expression (i.e. I'm not sure how one can determine whether to use, e.g. part(expr,1) or part(expr,1,1) or part(expr, 1,1,1) etc.).

The issue with args is that, e.g.

declare(cos, posfun)$
args(-2*cos(x));
    > [2 cos(x)]

i.e. the negative is dropped, presumably due to the lisp representation of the expression (we get the same result from part(-2*cos(x),1); moreover, part(-2*cos(x),2) "falls off the end" -- it seems part simply can't see the -).

By contrast,

args(-2*cos(x)+x);
    > [x, -2cos(x) ]

as expected.

Regardless of whether or not this is the desired behaviour for these functions, I was hoping to find some way to get around it so that I can have a function that would have the following bevaiour:

addOp(x) > ["+", x]
addOp(-x) > ["-", x]

addOp(1+2*x+x^2) > ["+", 1+2*x+x^2]
addOp(-2+2*x+x^2) > ["-", 2+2*x+x^2] /* NB: only the first term is scaled by -1, not the entire expression */

addOp(cos(...)) > ["+", cos(...)]
addOp(-2x*cos(...)) > ["-", 2x*cos(x) ]

I also tried using the op function along with a known number; however, the internal representation of negative numbers means that something like op(1-3*cos(x)) returns +.

This one has had me stumped for a while, so any suggestions would be greatly appreciated.

wxmaxima maxima arguments
2 Answers

Here's my first try. It seems to mostly work the way you describe except for %o11 because the -2 gets moved from the beginning to the end.

(%i1) f(e):= if atom(e) then ["+", e]
 else if op(e) = "-" then ["-", -e]
 elseif op(e) = "+" then [f(first(e)), rest(e)]
 else ["+", e];
(%o1) f(e) := if atom(e) then ["+", e] else (if op(e) = "-" then ["-", - e]
                  elseif op(e) = "+" then [f(first(e)), rest(e)] else ["+", e])
(%i2) f(x);
(%o2)                               [+, x]
(%i3) f(-x);
(%o3)                               [-, x]
(%i4) f(-2*x);
(%o4)                              [-, 2 x]
(%i5) f(-2*cos(x));
(%o5)                            [-, 2 cos(x)]
(%i6) f(1-2*cos(x));
(%o6)                        [[+, 1], - 2 cos(x)]
(%i7) f(-1+2*cos(x));
(%o7)                        [[+, 2 cos(x)], - 1]
(%i8) f(-1-2*cos(x));
(%o8)                        [[-, 2 cos(x)], - 1]
(%i9) f(a*b+c*d-e*f*g);
(%o9)                       [[-, e f g], c d + a b]
(%i10) f(1+2*x+x^2);
                                    2
(%o10)                        [[+, x ], 2 x + 1]
(%i11) f(-2+2*x+x^2);
                                    2
(%o11)                        [[+, x ], 2 x - 2]
(%i12) f(cos(a*b-c));
(%o12)                         [+, cos(c - a b)]
(%i13) f(-2*cos(x-y*z));
(%o13)                        [-, 2 cos(y z - x)]
(%i14) f(-2*x*cos(b-c));
(%o14)                        [-, 2 cos(c - b) x]
(%i15) -2+2*x+x^2;
                                  2
(%o15)                           x  + 2 x - 2
(%i16) f(-2 + 2*x - x^2);
                                    2
(%o16)                        [[-, x ], 2 x - 2]
(%i17) -2 + 2*x - x^2;
                                   2
(%o17)                         (- x ) + 2 x - 2
(%i18) f(a-b);
(%o18)                           [[+, a], - b]
(%i19) f(b-a);
(%o19)                           [[+, b], - a]

The business about op(e) = "-" is that stuff like -2*cos(x) gets reorganized into -(2*cos(x)) before args works on it (although I think inpart disables that behavior or modifies it).

EDIT: Take 2. atom(-2) returns true, so -2 is caught by the first case in the previous definition. Here's another try, where negative numbers are distinguished from other atoms.

f(e):= 
if atom(e)
 then (if numberp(e) and e < 0 then ["-", -e] else ["+", e])
 else if op(e) = "-" then ["-", -e]
 elseif op(e) = "+" then [f(first(e)), rest(e)]
 else ["+", e];

I didn't try this code but maybe you can say whether it works.

user_8710960

Addenda to Robert's answer, in case it may be of use to others. The following are sample scripts for extracting the values and reassembling them (after some transformation).

NB instead of "+" and "-", for the purpose of reassembling, I redefined the function to return 1 or -1, instead.

Robert's Function (Modified):

f(e):=  
        if numberp(e) 
        then  if e >= 0
              then [1, e]
              else [-1, -e]
        else  if atom(e) 
              then [1, e]
              else  if op(e) = "-" 
                    then [-1, -e]
                    else  if op(e) = "+" 
                          then [f(first(e)), rest(e)]
                          else [1, e];

Extract the Sign

Takes an expression of the form [+/-1, e] or [ [+/-1, e], r] and returns the +/-1.

fExtSg(expr):=
  block([expr:expr],
  if listp(expr[1])
  then expr[1][1]
  else expr[1]);

Extract the Term

Takes an expression of the form [+/-1, e] or [ [+/-1, e], r] and returns e.

fExtTerm(expr):=
  block([expr:expr],
  if listp(expr[1])
  then expr[1][2]
  else expr[2]
  );

Extract Rest

Takes an expression of the form [+/-1, e] or [ [+/-1, e], r] and returns r or 0.

fExtRest(expr):=
  block([expr:expr],
  if listp(expr[1])
  then expr[2]
  else 0
  );

Example of breaking the expression apart & reassembling:

Test:[-1+c,c-1,-b,3,-7*sin(x)-10*cos(x), -7*sin(x)+10*cos(x), 7*sin(x)-10*cos(x)];

/* apply `f` to all terms of the test list */
fTest: makelist(f(Test[i]), i, length(Test));

/* collect the signs into a list */
First_Term_Signs: makelist(fExtSg(fTest[i]), i, length(Test));

/* collect the first terms */
First_Terms: makelist(fExtTerm(fTest[i]), i, length(Test));

/* collect the rest */
Rests: makelist(fExtRest(fTest[i]), i, length(Test));

/* recombine and compare to original list, to ensure proper functioning */
reassembled_test: makelist(First_Term_Signs[i]*First_Terms[i] + Rests[i], i, length(Test));

NB -1 + c and c - 1 will both be handled the same by Maxima, the resulting "reassembled" version will match the output returned by Maxima...

user_59867830
Related