/* This file:
 *   http://anggtwu.net/MAXIMA/step_by_step.mac.html
 *   http://anggtwu.net/MAXIMA/step_by_step.mac
 *          (find-angg "MAXIMA/step_by_step.mac")
 * From: (find-maximamsg "37871522 202307 16" "RDodier: step_by_step.mac")
 * See: (find-es "maxima" "step_by_step.mac")
 *
 * Copyright 2023 by Robert Dodier
 * I (RDodier) release this work under terms of the GNU General Public License
*/

/* disable built-in identities */
simp: false;

plusp  (e) := not atom(e) and op(e) = "+";
timesp (e) := not atom(e) and op(e) = "*";

partition_list (l, p) := [sublist (l, p),
                          sublist (l, lambda ([e], not p(e)))];

/* distribute times over plus */
matchdeclare (aa, lambda ([e], e # 1));
matchdeclare (pp, plusp);
defrule (r2a, aa*pp, map (lambda ([x], aa*x), pp));

/* distribute minus over plus */
matchdeclare (pp, plusp);
defrule (r2b, - pp, map (lambda ([x], - x), pp));

/* group integers in times expression */
matchdeclare (mm, lambda ([e],
    timesp (e) and length (sublist (args (e), integerp)) >= 2));
defrule (r3a, mm, block ([a, b],
    [a, b]: partition_list(args(mm), integerp),
    apply ("*", append ([apply ("*", a)], b))));

/* evaluate product of integers */
matchdeclare (mm, lambda ([e], timesp (e) and every (integerp, args (e))));
defrule (r3b, mm, apply ('?\*, args (mm)));

/* group integers in plus expression */
matchdeclare (pp, lambda ([e], plusp (e) and length (sublist (args (e),
integerp)) >= 2));
defrule (r4a, pp, block ([a, b], [a, b]: partition_list (args (pp),
integerp), apply ("+", append (b, [apply ("+", a)]))));

/* evaluate sum of integers */
matchdeclare (pp, lambda ([e], plusp (e) and every (integerp, args (e))));
defrule (r4b, pp, apply ('?\+, args (pp)));

/* (- integer) --> negative integer */
matchdeclare (nn, integerp);
defrule (r5a, - nn, ?\- (nn));

/* (- something) --> (-1) * something */
matchdeclare (aa, all);
defrule (r5b, - aa, (?\- (1))*aa);

/* partition terms in equation, x versus free of x */

/* case a: left-hand side contains terms free of x */
matchdeclare (pp, lambda ([e], plusp (e) and some (lambda ([e1], freeof (x,
e1)), args (e))));
matchdeclare (qq, plusp);
defrule (r6a, pp = qq, block ([p1, px, q1, qx], [p1, px]: partition (pp,
x), [q1, qx]: partition (qq, x), px - qx = - p1 + q1));

/* case b: right-hand side contains terms not free of x */
matchdeclare (pp, plusp);
matchdeclare (qq, lambda ([e], plusp (e) and some (lambda ([e1], not freeof
(x, e1)), args (e))));
defrule (r6b, pp = qq, block ([p1, px, q1, qx], [p1, px]: partition (pp,
x), [q1, qx]: partition (qq, x), px - qx = - p1 + q1));

/* flatten plus expressions (associativity) */
matchdeclare (pp, lambda ([e], plusp (e) and some (plusp, args (e))));
defrule (r7a, pp, apply ("+", flatten (map (lambda ([e1], if plusp (e1)
then args (e1) else e1), args (pp)))));

/* flatten times expressions (associativity) */
matchdeclare (mm, lambda ([e], timesp (e) and some (timesp, args (e))));
defrule (r7b, mm, apply ("*", flatten (map (lambda ([e1], if timesp (e1)
then args (e1) else e1), args (mm)))));

/* group x terms in plus expression */
matchdeclare (pp, lambda ([e], plusp (e) and length (sublist (args (e),
lambda ([e1], not freeof (x, e1)))) >= 2));
defrule (r8, pp, block ([a, b], [a, b]: partition_list (args (pp), lambda
([e1], not freeof (x, e1))), apply ("+", cons (apply ("+", a), b))));

/* factor out x */
matchdeclare (pp, lambda ([e], plusp (e) and every (lambda ([e1], not
freeof (x, e1)), args (e))));
defrule (r9, pp, map (lambda ([e], subtimes (e, lambda ([e1], freeof (x,
e1)))), pp) * x);
subtimes (e, p) := if not atom(e) then apply ("*", sublist (args (e), p))
else 1;

/* trivial multiplication identities */
defrule (r10, "*"(), 1);
/* r11 implements "*"(aa) --> aa
 * working around bug in defrule here ...
 */
matchdeclare (aa, all);
/*
:lisp (defun $r11 (e) (if (and (consp e) (eq (caar e) 'mtimes) (= (length
(cdr e)) 1)) (values (msetq $aa (cadr e)) t)))
*/

/* foo*x = bar --> x = bar/foo */
matchdeclare (mm, lambda ([e], not atom(e) and op(e) = "*" and length (e) >
1 and not freeof (x, e)));
matchdeclare (aa, freeof (x));
defrule (r12, mm = aa, block ([a, b], [a, b]: partition_list (args (mm),
lambda ([e1], freeof (x, e1))), apply ("*", b) = aa / apply ("*", a)));



/*
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
load("step_by_step.mac");
:lisp (defun $r11 (e) (if (and (consp e) (eq (caar e) 'mtimes) (= (length (cdr e)) 1)) (values (msetq $aa (cadr e)) t)))

3+4*(x-2) = 5+6*(3-x);
apply1(%,r2a,r2b);
apply1(%,r7a);
apply1(%,r5a);
apply1(%,r3b);
applyb1(%,r4a,r4b);
apply1(%,r6a,r6b);
apply1(%,r5b);
apply1(%,r7b);
applyb1(%,r3a);
applyb1(%,r3b);
apply1(%,r9);
apply1(%,r10,r11);
apply1(%,r4b);
apply1(%,r12);
apply1(%,r10,r11);

*/