add stackmaxima 2023060500

.gitlab-ci.yml

@@ -67,6 +67,9 @@ test_maxima:
   allow_failure: true
   parallel:
     matrix:
+      - TEST_VERSION: "2023060500"
+        QSTACK_VERSION: "v4.4.4"
+        MOODLE_BRANCH: "MOODLE_400_STABLE"
       - TEST_VERSION: "2023052400"
         QSTACK_VERSION: "v4.4.3"
         MOODLE_BRANCH: "MOODLE_39_STABLE"

README.md

@@ -86,6 +86,7 @@ What Stackmaxima version do I need?
 | -                   | `4.4.1`              | 2022082900          | 5.44.0                  |
 | -                   | `4.4.2`              | 2023010400          | 5.44.0                  |
 | -                   | `4.4.3`              | 2023052400          | 5.44.0                  |
+| -                   | `4.4.4`              | 2023060500          | 5.44.0                  |
 
 
 Environment Variables

docker-compose.yml

 version: "3.3"
 services:
   maxima:
-    image: mathinstitut/goemaxima:${STACKMAXIMA_VERSION:-2023052400}-latest
+    image: mathinstitut/goemaxima:${STACKMAXIMA_VERSION:-2023060500}-latest
     ports:
       - 0.0.0.0:8080:8080
     tmpfs:

stack/2023060500/maxima/elementary.mac

+/*  Author Chris Sangwin
+    University of Birmingham
+    Copyright (C) 2013 Chris Sangwin
+
+    This program is free software: you can redistribute it or modify
+    it under the terms of the GNU General Public License version two.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+    GNU General Public License for details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program. If not, see <http://www.gnu.org/licenses/>. */
+
+
+/* THIS IS EXPERIMENTAL CODE */
+/* Most of the code is now in noun_simp.mac.  This is the remainder. */
+
+
+/*******************************************/
+/* Control functions                       */
+/*******************************************/
+
+DIS_TRANS:["disAddMul"]$
+POW_TRANS:["powLaw"]$
+BUG_RULES:["buggyPow","buggyNegDistAdd"]$
+
+/* Is the rule applicable at the top level? */
+trans_topp(ex,rl):=apply(parse_string(sconcat(rl,"p")),[ex])$
+
+/* Is the rule applicable anywhere in the expression? */
+trans_anyp(ex, rl):=block(
+  if atom(ex) then return(trans_topp(ex,rl)),
+  if trans_topp(ex,rl) then return(true),
+  apply("or",maplist(lambda([ex2],trans_anyp(ex2,rl)),args(ex)))    
+)$
+
+/* Identify applicable rules at the top level */
+trans_top(ex):=sublist(ALL_TRANS, lambda([ex2],trans_topp(ex,ex2)))$
+
+/* Identify applicable rules */
+trans_any(ex):=sublist(ALL_TRANS, lambda([ex2],trans_anyp(ex,ex2)))$
+
+/*******************************************/
+/* Higher level control functions          */
+/*******************************************/
+ 
+/* Very inefficient! */
+/* Has the advantage that the whole expression is always visible at the top level */
+step_through(ex):=block([rls],
+ rls:trans_any(ex),
+ if emptyp(rls) then return(ex),
+ print(string(ex)),
+ print(rls),
+ step_through(transr(ex,first(rls)))
+)$
+
+/* This only looks at the top level for rules which apply.  If none, we look deeper. */
+/* This is much more efficient */
+step_through2(ex):=block([rls,rl,ex2],
+ if atom(ex) then return(ex),
+ rls:trans_top(ex),
+ if emptyp(rls) then return(block([ex2],  ex2:map(step_through2,ex), if ex=ex2 then ex else step_through2(ex2))),
+ rl:first(rls),
+ ex2:apply(parse_string(rl),[ex]), 
+ print([ex,rl,ex2]),
+ if ex=ex2 then ex else step_through2(ex2)  
+)$
+
+/* Assume some rules are just applied in the background */
+step_through3(ex):=block([rls],
+ rls:sublist(ALG_TRANS, lambda([ex2],trans_anyp(ex,ex2))),
+ if not(emptyp(rls)) then return(step_through3(transr(ex,first(rls)))),
+ rls:trans_any(ex),
+ if emptyp(rls) then return(ex),
+ print(string(ex)),
+ print(rls),
+ step_through3(transr(ex,first(rls)))
+)$
+
+/* removes elements of l1 from l2. */
+removeoncelist(l1,l2):=block(
+ if listp(l2)#true or emptyp(l2) then return([]),
+ if listp(l1)#true or emptyp(l1) then return(l2),
+ if element_listp(first(l1),l2) then return(removeoncelist(rest(l1),removeonce(first(l1),l2))),
+ removeoncelist(rest(l1),l2)
+)$
+
+/* A special function.
+   If a\in l1 is also in l2 then remove a and -a from l2.  
+   Used on negDef  */
+removeoncelist_negDef(l1,l2):=block(
+ if listp(l2)#true or emptyp(l2) then return([]),
+ if listp(l1)#true or emptyp(l1) then return(l2),
+ if element_listp(first(l1),l2) then return(removeoncelist_negDef(rest(l1),removeonce("-"(first(l1)),removeonce(first(l1),l2)))),
+ removeoncelist_negDef(rest(l1),l2)
+)$
+
+/*******************************************/
+/* Transformation rules  (not used)        */
+/*******************************************/
+
+/* -1*x -> -x */
+negMinusOnep(ex):=block(
+  if safe_op(ex)#"*" then return(false),
+  if is(first(args(ex))=negInt(-1)) then return(true) else return(false)
+)$
+
+negMinusOne(ex):=block(
+  if negMinusOnep(ex)#true then return(ex),
+  if length(args(ex))>2 then "-"(apply("*",rest(args(ex)))) else -second(args(ex))
+)$
+
+/* a-a -> 0 */
+/* This is a complex function.  If "a" and "-a" occur as arguments in the sum
+   then we remove the first occurance of each.  Then we add the remaining arguments.
+   Hence, this does not flatten arguments or re-order them, but does cope with nary-addition 
+*/
+negDefp(ex):=block([a0,a1,a2,a3],
+  if safe_op(ex)#"+" then return(false),
+  a1:maplist(first,sublist(args(ex), lambda([ex2],safe_op(ex2)="-"))),
+  a2:sublist(args(ex), lambda([ex2],safe_op(ex2)#"-")),
+  any_listp(lambda([ex2],element_listp(ex2,a2)),a1)
+)$
+
+negDef(ex):=block([a0,a1,a2,a3],
+  if negDefp(ex)#true then return(ex),
+  a0:args(ex),
+  a1:maplist(first,sublist(args(ex), lambda([ex2],safe_op(ex2)="-"))),
+  a2:sublist(args(ex), lambda([ex2],safe_op(ex2)#"-")),
+  a3:removeoncelist_negDef(a1,a0),  
+  if emptyp(a3) then 0 else apply("+",a3)
+)$
+
+/* Distributes "-" over addition */
+negDistAddp(ex):=block(
+  if safe_op(ex)#"-" then return(false),
+  if safe_op(part((ex),1))="+" then true else false 
+)$
+
+negDistAdd(ex):=block(
+  if negDistAddp(ex) then map("-",part((ex),1)) else ex
+)$
+
+
+
+/*******************************************/
+/* Division rules */
+
+/* a/a -> 1 */
+idDivp(ex):= if safe_op(ex)="/" and part(ex,1)=part(ex,2) and part(ex,2)#0 then true else false$
+idDiv(ex) := if idDivp(ex) then 1 else ex$
+
+/*******************************************/
+/* Distribution  rules                     */
+
+/* Write (a+b)*c as a*c+b*c */
+disAddMulp(ex):= if safe_op(ex)="*" then 
+   if safe_op(last(ex))="+" then true else false$
+
+disAddMul(ex):= block([S,P],
+  S:last(ex),
+  P:reverse(rest(reverse(args(ex)))),
+  P:if length(P)=1 then first(P) else apply("*", P),
+  S:map(lambda([ex], P*ex), S)
+)$
+
+/*******************************************/
+/* Power rules                             */
+
+/* Write a*a^n as a^(n+m) */
+powLawp(ex):= block([B],
+   if not(safe_op(ex)="*") then return(false),
+   B:sort(maplist(lambda([ex], if safe_op(ex)="^" then first(args(ex)) else ex), args(ex))),
+   if emptyp(powLawpduplicates(B)) then return(false) else return(true)
+)$
+
+powLawpduplicates(l):=block(
+    if length(l)<2 then return([]),
+    if first(l)=second(l) then return([first(l)]),
+    return(powLawpduplicates(rest(l)))
+)$
+
+powLaw(ex):= block([B,l1,l2],
+   B:sort(maplist(lambda([ex], if safe_op(ex)="^" then first(args(ex)) else ex), args(ex))),
+   B:first(powLawpduplicates(B)),
+   l1:sublist(args(ex), lambda([ex], is(ex=B) or (is(safe_op(ex)="^") and is(first(args(ex))=B)))),
+   l1:maplist(lambda([ex], if is(ex=B) then 1 else second(args(ex))), l1),
+   l2:sublist(args(ex), lambda([ex], not(is(ex=B) or (is(safe_op(ex)="^") and is(first(args(ex))=B))))),
+   if l2=[] then return(B^apply("+",l1)),
+   if length(l2)=1 then l2:first(l2) else l2:apply("*",l2),
+   return(B^apply("+",l1)*l2)
+);
+

stack/2023060500/maxima/errortostring.lisp

+;; Custom version of erromsg() to collect the error as 
+;; a string after it has been formatted
+;; Matti Harjula 2019
+
+(defmfun $errormsgtostring ()
+  "errormsgtostring() returns the maxima-error message as string."
+  (apply #'aformat nil (cadr $error) (caddr (process-error-argl (cddr $error))))
+)

stack/2023060500/maxima/expandfeedback.mac

+/*  Author Chris Sangwin
+    University of Birmingham
+    Copyright (C) 2006 Chris Sangwin
+
+    This program is free software: you can redistribute it or modify
+    it under the terms of the GNU General Public License version two.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+    GNU General Public License for details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program. If not, see <http://www.gnu.org/licenses/>. */
+
+
+/* Expand tutorial.                                                  */
+/* This file should take a product and expand out one level in steps */
+/* Chris Sangwin, 6/11/2006                                          */
+/* This is experimental code, but may be useful.                     */
+
+COLOR_LIST:["red", "Blue"  , "YellowOrange", "Bittersweet"  , "BlueViolet" , "Aquamarine", "BrickRed" , "Apricot" , "Brown" , "BurntOrange", "CadetBlue" , "CarnationPink" , "Cerulean" , "CornflowerBlue" , "CyanDandelion" , "DarkOrchid" , "Emerald" , "ForestGreen" , "Fuchsia", "Goldenrod" , "Gray" , "Green" , "JungleGreen", "Lavender" , "LimeGreen" , "Magenta" , "Mahogany" , "Maroon" , "Melon", "MidnightBlue" , "Mulberry" , "NavyBlue" , "OliveGreen" , "Orange", "OrangeRed" , "Orchid" , "Peach" , "Periwinkle" , "PineGreen" , "Plum", "ProcessBlue" , "Purple" , "RawSienna" , "Red" , "RedOrange" , "RedViolet" , "Rhodamine" , "RoyalBlue" , "RoyalPurple" , "RubineRed", "Salmon" , "SeaGreen" , "Sepia" , "SkyBlue" , "SpringGreen" , "Tan", "TealBlue" , "Thistle" , "Turquoise" , "Violet" , "VioletRed" ,"WildStrawberry" , "Yellow" , "YellowGreen" , "BlueGreen" ]$
+COLOR_LIST_LENGTH:length(COLOR_LIST)$
+
+
+/* We want a list of the summands, but you cannot apply args to an atom */
+make_args_sum(ex) := if atom(ex) then [ex] else 
+                         if op(ex)#"+" then [ex] else args(ex)$
+
+/* Adds up the elements of a list */
+sum_list(ex) :=     if listp(ex) then 
+                        if length(ex)=1 then ex[1] else apply("+",ex)
+                    else ex$
+/* Multiplies together the elements of a list */
+product_list(ex) := if listp(ex) then
+                        if length(ex)=1 then ex[1] else apply("*",ex)
+                    else ex$
+
+make_product(ex) := product_list(maplist(sum_list,ex))$
+
+/******************************************************************/
+/* A "step" is a list representing a row in a three column matrix */
+/* eg  [ [], [], [] ]                                             */
+
+/* display a single step, returning a string */
+display_step(ex) := block([ret,ex1,ex2,ex3],
+ ex1:" ", ex2:" = ", ex3:" ",
+ if []#ex[1] then ex1:StackDISP(ex[1][1],""),
+ if []=ex[2] then ex2:" " else 
+     if ex[2][1]#"=" then ex2:StackDISP(ex[2][1],""),
+ if []#ex[3] then ex3:StackDISP(ex[3][1],""),
+ apply(concat,[ex1," & ",ex2," & ",ex3," \\\\ "])
+)$
+
+/* Takes a list of steps in a problem, and returns a single LaTeX string */
+display_steps(ex) := block([ret],
+  if atom(ex) then return(StackDISP(ex,"")),
+  if listp(ex)#true then return(StackDISP(ex,"")),
+  /*  */
+  steps:map(display_step,ex),
+  ret:append(["\\begin{array}{rcl}"],flatten(steps),[" \\end{array}   "]),
+  ret:apply(concat,ret)
+ )$
+
+
+/******************************************************************/
+
+/* Tutorial expand.  This function expands out the expression ex */
+/* It returns a list of steps                                    */
+tut_expand_one_level(ex) := block([args_ex,args_ex1,cur_step,ret],
+  /* Make sure we apply this function to a product */
+  if atom(ex) then return([ [[ex],[],[]] ]),
+  if op(ex)#"*" then return([ [[ex],[],[]] ]),
+  /* Get a list of lists with the arguments of ex */
+  args_ex:args(ex),
+  args_ex:maplist(make_args_sum,args_ex),
+  /* colour the first summands */
+  cur_step:cons(zip_with(texcolor,COLOR_LIST,first(args_ex)),rest(args_ex)),
+  ret:[ [[ex],["="],[make_product(cur_step)]] ],
+  /*  */
+  ex1:args_ex[1],
+  ex2:args_ex[2],
+  ex3:rest(args_ex,2),
+  cur_step:maplist(lambda([x],x*sum_list(ex2)),ex1),
+  cur_step:cons(zip_with(texcolor,COLOR_LIST,cur_step),ex3),
+  ret:cons([[],["="],[make_product(cur_step)]],ret),
+  /*  */
+  cur_step:maplist(lambda([x],maplist(lambda([y],x*y),ex2)),ex1),
+  cur_step:maplist(sum_list,cur_step),
+  cur_step:zip_with(texcolor,COLOR_LIST,cur_step),
+  cur_step:make_product(cons(cur_step,ex3)),
+  ret:cons([[],["="],[cur_step]],ret),
+  /* */
+  cur_step:maplist(lambda([x],maplist(lambda([y],x*y),ex2)),ex1),
+  cur_step:maplist(sum_list,cur_step),
+  /* BUG: this should only be "one step" of simplification.  Currently it does everthing */
+  cur_step:ev(sum_list(cur_step),simp),
+  cur_step:if ex3=[] then cur_step else make_product(cons(cur_step,ex3)),
+  ret:cons([[],["="],[cur_step]],ret),
+  /* */
+  reverse(ret)
+)$
+
+/* Tutorial expand.  This function expands out the expression ex */
+tut_expand_all_levels(ex) := block([args_ex,first_ex],
+  if atom(ex) then return([ [[ex],[],[]] ]),
+  if op(ex)#"*" then return([ [[ex],[],[]] ]),
+  /* first step */
+  args_ex:args(ex),
+  first_ex:ev(expand(args_ex[1]*args_ex[2]),simp),
+  if length(args_ex)>2 then
+   append(tut_expand_one_level(ex), [ [["and"],[],[]] ], tut_expand_all_levels(product_list(cons(first_ex,rest(args_ex,2)))))
+  else
+   tut_expand_one_level(ex)
+)$
+
+tut_expand_full(ex) := block([ret,seps],
+  ret:tut_expand_all_levels(ex),
+  ret:append(ret,[ [["Hence"],[],[]], [[ex],["="],[ev(expand(ex),simp)]] ]),
+  display_steps(ret)
+)$
+

stack/2023060500/maxima/experimental.mac

+/*  Author Chris Sangwin
+    Lougborough University
+    Copyright (C) 2015 Chris Sangwin
+
+    This program is free software: you can redistribute it or modify
+    it under the terms of the GNU General Public License version two.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+    GNU General Public License for details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program. If not, see <http://www.gnu.org/licenses/>. */
+
+
+/* THIS IS EXPERIMENTAL CODE */
+/* Currently this is under development by CJS and is not connected to the main STACK codebase */
+/* It sits here because the long-term goal is to incorporate it */
+
+/* More general random function - recurses across the structure.
+   Notice the use of the dummy "protect()" function to stop further evaluation.
+   E.g.
+   rand_recurse((5+protect(2))*x^protect(2)+3*x+7);
+   rand_recurse(sin([x,y,z]));
+*/
+rand_recurse(ex) := block(
+    if (integerp(ex) or floatnump(ex) or matrixp(ex) or listp(ex)) then return(rand(ex)),
+    if atom(ex) then return(ex),
+    if op(ex)=protect then return(first(args(ex))),
+    apply(op(ex), maplist(rand_recurse, args(ex)))
+    );
+
+/* Truncates a polynomial to only terms of degree "d" or less - always expands out */
+poly_truncate(pa,d) := apply("+",maplist(lambda([ex],if hipow(ex,x)>d then 0 else ex), args(expand(pa))));
+
+/****************************************************************/
+/*  Square root functions for STACK                             */
+/*                                                              */
+/*  Chris Sangwin, <C.J.Sangwin@ed.ac.uk>                       */
+/*  V0.1 August 2015                                            */
+/*                                                              */
+/****************************************************************/
+
+/* With simp:false */
+
+/* Some examples:  
+p1: (2 + sqrt (2)) * sqrt (2);
+p2:distrib(p1);
+p3:sqrt(a)*sqrt(b)*sqrt(b)*sqrt(b)*sqrt(a)*1*sqrt(b)+1;
+*/
+
+naivesqrt(ex):=block([al],
+  if atom(ex) then return(ex),
+  al:args(ex),
+  if safe_op(ex)="*" then block([alp,alq],
+    alp:sort(sublist(args(ex), lambda([ex2],equal(safe_op(ex2),"sqrt")))),
+    alq:sublist(args(ex), lambda([ex2],not(equal(safe_op(ex2),"sqrt")))),
+    al:append(naivesqrthelper(alp),alq)
+    ),
+  if safe_op(ex)="*" and length(al)=1 then return(naivesqrt(first(al))),
+  apply(op(ex), map(naivesqrt, al))
+);
+
+naivesqrthelper(ex):=block(
+  if length(ex)<2 then return(ex),
+  if equal(first(ex), second(ex)) then return(append([first(args(first(ex)))], naivesqrthelper(rest(rest(ex))))),
+  append([first(ex)], naivesqrthelper(rest(ex)))
+);
+
+

stack/2023060500/maxima/fboundp.mac

+/* fboundp.mac -- detect different kinds of functions in Maxima
+ * copyright 2020 by Robert Dodier
+ * I release this work under terms of the GNU General Public License
+ *
+ * See https://github.com/maxima-project-on-github/maxima-packages/blob/master/robert-dodier/fboundp/fboundp.mac
+ *
+ * Examples:
+ *
+   /* Name of an operator: */
+   fboundp("+");
+   true;
+   fboundp_operator("+");
+   true;
+
+   infix("//") $
+   fboundp("//");
+   false;
+   fboundp_operator("//");
+   false;
+   x // y := y - x $
+   fboundp("//");
+   true;
+   fboundp_operator("//");
+   true;
+
+   /* Simplifying function defined in Lisp: */
+   fboundp(sin);
+   true;
+   fboundp_simplifying(sin);
+   true;
+
+   /* DEFUN (ordinary argument-evaluating) function defined in Lisp: */
+   fboundp(expand);
+   true;
+   fboundp_ordinary_lisp(expand);
+   true;
+
+   /* DEFMSPEC (argument-quoting) function defined in Lisp: */
+   fboundp(kill);
+   true;
+   fboundp_quoting(kill);
+   true;
+
+   /* Maxima ordinary function: */
+   (kill(foo),
+    foo(x) := x,
+    fboundp(foo));
+   true;
+   fboundp_ordinary_maxima(foo);
+   true;
+
+   /* Maxima array function: */
+   (kill(bar),
+    bar[x](y) := x*y,
+    fboundp(bar));
+   true;
+   fboundp_array_function(bar);
+   true;
+
+   /* Maxima macro: */
+   (kill(baz),
+    baz(x) ::= buildq([x], x),
+    fboundp(baz));
+   true;
+   fboundp_maxima_macro(baz);
+   true;
+ *
+ */
+
+fboundp(a) :=
+    fboundp_operator(a)
+ or fboundp_simplifying(a)
+ or fboundp_ordinary_lisp(a)
+ or fboundp_quoting(a)
+ or fboundp_ordinary_maxima(a)
+ or fboundp_array_function(a)
+ or fboundp_maxima_macro(a);
+
+fboundp_operator(a) :=
+  stringp(a) and fboundp (verbify (a));
+
+fboundp_simplifying(a) :=
+  symbolp(a) and ?get(a, ?operators) # false;
+
+fboundp_ordinary_lisp(a) :=
+  symbolp(a) and ?fboundp(a) # false;
+
+fboundp_quoting(a) :=
+  symbolp(a) and ?get(a, ?mfexpr\*) # false;
+
+fboundp_ordinary_maxima(a) :=
+  symbolp(a) and ?mget(a, ?mexpr) # false;
+
+fboundp_array_function(a) :=
+  symbolp(a) and ?mget(a, ?aexpr) # false;
+
+fboundp_maxima_macro(a) :=
+  symbolp(a) and ?mget(a, ?mmacro) # false;
+

stack/2023060500/maxima/inequalities.mac

+/*  Author Chris Sangwin
+    University of Edinburgh
+    Copyright (C) 2015 Chris Sangwin
+
+    This program is free software: you can redistribute it or modify
+    it under the terms of the GNU General Public License version two.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+    GNU General Public License for details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program. If not, see <http://www.gnu.org/licenses/>. */
+
+
+/********************************************************************/
+/*  A package for manipulating inequalities in Maxima.              */
+/*                                                                  */
+/*  This file relies on assessment.mac, but not on stackmaxima.mac. */
+/*  This makes it useable outside STACK.                            */
+/*                                                                  */
+/*  Chris Sangwin, <chris@sangwin.com>                              */
+/*  V0.1 May 2015                                                   */
+/*                                                                  */
+/********************************************************************/
+
+/* Reduces an inequality to either ? > 0 or ? >=0, which is monic in its variable. */
+ineqprepare(ex) := block([op2, ex2],
+    if mapatom(ex) then return(ex),
+    if safe_op(ex)="%not" then ex:not_ineq(first(args(ex))),
+    if mapatom(ex) then return(ex),
+    if op(ex)="="  then return(make_monic_eq(ev(part(ex,1) - part(ex,2), simp, trigreduce)) = 0),
+    if op(ex)=">"  then return(make_monic(ev(part(ex,1) - part(ex,2), simp, trigreduce)) > 0),
+    if op(ex)=">=" then return(make_monic(ev(part(ex,1) - part(ex,2), simp, trigreduce)) >= 0),
+    if op(ex)="<"  then return(make_monic(ev(part(ex,2) - part(ex,1), simp, trigreduce)) > 0),
+    if op(ex)="<=" then return(make_monic(ev(part(ex,2) - part(ex,1), simp, trigreduce)) >= 0),
+    ex2:args(ex),
+    ex2:map(ineqprepare, ex2),
+    return(apply(op(ex), ex2))
+)$
+
+/* Turn a single variable polynomial expression into a +1/-1 monic polynomial.
+   This is used with inequalities. */
+make_monic(ex) := block([v,vc,nc],
+    if mapatom(ex) then return(ex),
+    if not(polynomialpsimp(ex)) then return(ex),
+    ex:expand(ex),
+    v:listofvars(ex),
+    if v=[] then return(ex),
+    /* Divide by the numerical coefficient of the leading term, without losing the minus sign, where possible. */
+    nc:numerical_coeff(ex),
+    if not(is(nc=0)) then ex:ev(expand(ex/abs(nc)), simp),
+    /* Deal with one special case only here. */
+    if is(ex=first(v)-minf) then ex:first(v)+inf,
+    return(ex)
+)$
+
+/* Return the numerical coefficient of the leading term in expression. */
+numerical_coeff(ex):= block([v, vc],
+  v:listofvars(ex),
+  if v=[] then return(ex),
+  vc:ratcoef(ex, first(v), degree(ex, first(v))),
+  if listofvars(vc)=[] then return(vc),
+  numerical_coeff(vc)
+);
+
+/* This is used with equations. */
+make_monic_eq(ex) := block([v],
+    if mapatom(ex) then return(ex),
+    if not(polynomialpsimp(ex)) then return(ex),
+    ex:ev(factor(ex), simp),
+    ex:ev(expand(ex), simp),
+    /* Divide by the coefficient of the highest power. */
+    v:listofvars(ex),
+    if v=[] then return(ex),
+    poly_normalize(ex, v)
+)$
+
+/* Determines if we have a linear inequality in one variable.
+   This function prepares the inequality.                       */
+linear_inequalityp(ex) := block([ex2],
+    if atom(ex) then return(false),
+    if not(">"= op(ex) or "<"= op(ex) or ">="= op(ex) or "<="= op(ex)) then return(false),
+    ex2:ineqprepare(ex),
+    if not(is(length(listofvars(ex2))=1)) then return(false),
+    if not(polynomialp(lhs(ex2), listofvars(ex2))) then return(false),
+    if is(degree(lhs(ex2), first(listofvars(ex2)))=1) then return(true),
+    return(false)
+)$
+
+/* Reformat an interval inequality in an easier to read form, namely a<x or x<a: a syntactic transformation. */
+inequality_disp(ex) := block([ex2, v],
+    if not(linear_inequalityp(ex)) then return(ex),
+    ex2:ineqprepare(ex),
+    v:first(listofvars(ex2)),
+    if equal(coeff(lhs(ex2), v), 1) then return(rev_ineq(subst(op(ex2), "=", first(solve(lhs(ex2), v))))),
+    if equal(coeff(lhs(ex2), v), -1) then return(neg_ineq(subst(op(ex2), "=", first(solve(lhs(ex2), v))))),
+    return(ex)
+)$
+
+/* Reverses the inequality: purely syntactic. */
+rev_ineq(ex):=block(
+    if safe_op(ex) = "<" then return(rhs(ex) > lhs(ex)),
+    if safe_op(ex) = "<=" then return(rhs(ex) >= lhs(ex)),
+    if safe_op(ex) = ">" then return(rhs(ex) < lhs(ex)),
+    if safe_op(ex) = ">=" then return(rhs(ex) <= lhs(ex)),
+    return(ex)
+)$
+
+/* Reverses any > or >= inequalities: purely syntactic.
+   This is useful to ensure only <, or <= occur in an expression when we are testing
+   equivalence, without too much simplification.  EqualsComAss does not do this.  */
+make_less_ineq(ex):=block(
+  if atom(ex) then return(ex),
+  if op(ex)=">" then return(rhs(ex)<lhs(ex)),
+  if op(ex)=">=" then return(rhs(ex)<=lhs(ex)),
+  return(apply(op(ex), map(make_less_ineq, args(ex))))
+)$
+
+/* Used to checks if we have the wrong inequality. */
+neg_ineq(ex):=block(
+    if safe_op(ex) = "<" then return(lhs(ex) > rhs(ex)),
+    if safe_op(ex) = "<=" then return(lhs(ex) >= rhs(ex)),
+    if safe_op(ex) = ">" then return(lhs(ex) < rhs(ex)),
+    if safe_op(ex) = ">=" then return(lhs(ex) <= rhs(ex)),
+    return(ex)
+)$
+
+/* Negates an inequality. */
+not_ineq(ex):=block(
+    if atom(ex) then return(not(ex)),
+    if safe_op(ex) = "<" then return(lhs(ex) >= rhs(ex)),
+    if safe_op(ex) = "<=" then return(lhs(ex) > rhs(ex)),
+    if safe_op(ex) = ">" then return(lhs(ex) <= rhs(ex)),
+    if safe_op(ex) = ">=" then return(lhs(ex) < rhs(ex)),
+    return(ex)
+)$
+
+/* ex:  a list of inequalities
+   l: a list of index numbers,
+   Function negates each inequality as indexed by l. */
+neg_ineq_list(ex, l) := block([k],
+    if emptyp(l) then return(ex),
+    for k: 1 thru length(l) do ex[ev(l[k], simp)]:neg_ineq(ex[ev(l[k], simp)]),
+    ex
+)$
+
+/*******************************************************************************/
+/* This block of functions removes unessary inequalities from a collection.    */
+ineq_rem_redundant(ex) := block([exl,exn,exg,exo,exv, simp],
+    if atom(ex) then return(ex),
+    if not(safe_op(ex)="nounand" or safe_op(ex)="nounor" or safe_op(ex)="%and" or safe_op(ex)="%or" or safe_op(ex)="and") then
+        return(ex),
+    /* Recurse over the expression. */
+    ex:apply(op(ex), maplist(ineq_rem_redundant, args(ex))),
+
+    if (safe_op(ex)="nounand" or safe_op(ex)="%and" or safe_op(ex)="and") then exo:[max, min] else exo:[min, max],
+    exn:sublist(args(ex), lambda([ex2], not(linear_inequalityp(ex2)))),
+    exl:sublist(args(ex), linear_inequalityp),
+    /* Separate out expressions in a single variable. */
+    exv:listofvars(exl),
+    exl:maplist(lambda([ex],sublist(exl,lambda([ex2], is(listofvars(ex2)=[ex])))), exv),
+    /* At this point we have linear inequalities, in a single variable, separated out into lists for each individual variable. */
+    exl:maplist(lambda([ex], single_linear_ineq_reduce(ex, exo)), exl),
+    exl:flatten(exl),
+    exl:append(exn,exl),
+    if is(length(exl)=1) then return(first(exl)),
+    ex:apply(op(ex), exl)
+)$
+
+/* Take a list of linear inequalities the same single variable, and a list of operators, min/max.
+   Returns the equivalent inequalities.
+*/
+single_linear_ineq_reduce(ex, exo):=block([exg,exl],
+    ex:maplist(ineqprepare,ex),
+    /* Separate out into x>?, x>=? and x<?, x<=?. */
+    exg:sublist(ex, lambda([ex2], is(coeff(lhs(ex2), first(listofvars(ex2))) = 1))),
+    exl:sublist(ex, lambda([ex2], is(coeff(lhs(ex2), first(listofvars(ex2))) = -1))),
+    /* Separate into solution and operator. */
+    exg:single_linear_ineq_reduce_h(exg, first(exo), true),
+    exl:single_linear_ineq_reduce_h(exl, second(exo), false),
+    append(exg, exl)
+)$
+
+/* Take a list of linear inequalities of the same sign, in a single variable, and an operator, min/max.
+   Return the single equivalent inequality.
+*/
+single_linear_ineq_reduce_h(exl, exo, odr):=block([m1,m2,m3,exg],
+    if exl=[] then return([]),
+    if not(is(exo = max) or is(exo = min)) then error("single_linear_ineq_reduce_h expects second argument to be max or min."),
+    exg:maplist(lambda([ex2],[rhs(first(solve(lhs(ex2)))), op(ex2)]), exl),
+    m1:apply(exo, maplist(first,exg)),
+    m2:sublist(exg,lambda([ex2],is(m1=first(ex2)))),
+    /* Get list of operators.  Used to sort out >, >= etc. */
+    m3:sort(listify(setify(maplist(second, m2)))),
+    if (not(odr) and is(exo=max)) or (odr and is(exo = min)) then m3:reverse(m3),
+    [apply(first(m3), if odr then [first(listofvars(exl)), m1] else [m1, first(listofvars(exl))])]
+)$
+
+
+/*******************************************************************************/
+/* Solve pol a single inequality a standard form.                              */
+/* ex>0 or ex>=0.                                                              */
+ineqorder(ex) := ineq_rem_redundant(ev(ineqprepare(ex), simp))$
+
+
+/*******************************************************************************/
+/* Takes a real linear inequality in one variable and returns an interval. */
+linear_inequality_to_interval(ex) := block([ex2, v, p, Ans],
+    if not(linear_inequalityp(ex)) then return(ex),
+    ex2:ineqprepare(ex),
+    v:first(listofvars(ex2)),
+    /* Deal with edge cases involving infinity. */
+    if is(lhs(ex2)=v-inf) then return({}),
+    if is(ex2=(inf-v>0)) then return(all),
+    if is(ex2=(inf-v>=0)) then return(oc(minf,inf)),
+    if is(lhs(ex2)=v+minf) then return({}),
+    if is(ex2=(v+inf>0)) then return(all),
+    if is(ex2=(v+inf>=0)) then return(co(minf,inf)),  
+
+    /* We know this solution will exist. */
+    p:rhs(first(solve(lhs(ex2), v))),
+    /* But we can only create an interval if the value is real! */
+    if not(real_numberp(p)) then return({}),
+    Ans:ex,
+    if equal(coeff(lhs(ex2), v), 1) then
+        (
+        if op(ex2)=">" then Ans:oo(p, inf),
+        if op(ex2)=">=" then Ans:co(p, inf)
+        ),
+    if equal(coeff(lhs(ex2), v), -1) then
+        (
+        if op(ex2)=">" then Ans:oo(-inf, p),
+        if op(ex2)=">=" then Ans:oc(-inf, p)
+        ),
+    return(Ans)
+)$
+
+/*******************************************************************************/
+/* Solve a single inequality in a single variable by factoring,                */
+/* where possible expressing the result as irreducible inequalities.           */
+inequality_factor_solve(ex):=block([ex2, p],
+    if not(inequalityp(ex)) then return(ex),
+    if length(listofvars(ex))#1 then return(ex),
+    ex:ineqprepare(ex),
+
+    /* Don't try to solve inequalities with inf/minf etc. */
+    if not(freeof(inf, ex)) or not(freeof(minf,ex)) then return(ex),
+
+    if not(polynomialp(lhs(ex), listofvars(ex))) then return(ex),
+    exop:op(ex), /* This is for >, >= */
+
+    ex2:factor(lhs(ex)),
+    if atom(ex2) then return(ex),
+    /* Create a list of factors */
+    m:false,
+    if is(safe_op(ex2)="-") then block(
+        m:true,
+        ex2:first(args(ex2))
+        ),
+    if is(safe_op(ex2)="/") then ex2:num(ex2),
+
+    if safe_op(fl)="*" then fl:args(ex2) else fl:[ex2],
+    fl:flatten(maplist(factor_ineq, fl)),
+
+    /* This function returns "true" or "false" rather than all/none to better interact with %or and %and. */
+    if is(fl=[]) then return(not(m)),
+    /* Turn each inequality back into a list. */
+    ex2:maplist(lambda([ex],apply(exop,[ex,0])),fl),
+    if m then ex2[1]:neg_ineq(ex2[1]),
+    /* Create a list of all even permutations, from which we negate those in the list */
+    p:sublist(maplist(listify, listify(powerset(setify(makelist(n, n, length(ex2)))))), lambda([ex], evenp(length(ex)))),
+    ex3:maplist(lambda([l], neg_ineq_list(copylist(ex2), l)), p),
+    /* Tidy up the list */
+    ex3:maplist(lambda([ex], ineq_rem_redundant(apply("%and", ex))), ex3),
+    ex3:reverse(sort(ex3)),
+    if is(length(ex3)=1) then first(ex3) else apply("%or", ex3)
+)$
+
+/* Return factors of the expression over the reals, but with the parity of the multiplicity.  */
+factor_ineq(ex) := block([ex2, m],
+  if not(polynomialp(ex, listofvars(ex))) then return(ex),
+  if atom(ex) then [return(ex)],
+  ex2:ev(factor(ex), simp),
+  if atom(ex2) then [return(ex)],
+  /* Create a list of factors */
+  if is(op(ex2)="-") then m:true else m:false,
+  if is(op(ex2)="/") then ex2:num(ex2),
+  /* Even powers and odd powers matter here. */
+  if safe_op(ex) = "^" then
+    if oddp(second(args(ex))) then
+        return([first(args(ex))])
+    else
+        return([first(args(ex)),first(args(ex))]),
+  if safe_op(ex) = "*" then ex:args(ex) else ex:[ex],
+  /* At this point we need to solve irreducible quadratics, and other equations. */
+  ex:maplist(factor_ineq_helper, ex),
+  /* Remove any numbers. */
+  ex:sublist(ex, lambda([ex2], ev(not(is(listofvars(ex2)=[])), simp))),
+  /* Return a list. */
+  return(ex)
+ )$
+
+ /* Return the real factors of a polynomial, in factored form. */
+ factor_ineq_helper(ex):=block([v,ex2,p,simp],
+    v:listofvars(ex),
+    if not(is(length(v)=1)) then return(ex),
+    if safe_op(ex) = "^" then
+      if oddp(second(args(ex))) then
+         (p:false, ex:first(args(ex)))
+      else
+         (p:true, ex:first(args(ex))),
+    ex2:solve(ex, first(v)),
+    ex2:maplist(rhs, ex2),
+    ex2:sublist(ex2, real_numberp),
+    ex2:maplist(lambda([ex3], first(v)-ex3), ex2),
+    simp:false,
+    if p then
+       ex2:append(ex2,ex2),
+    return(flatten(ex2))
+ )$

stack/2023060500/maxima/local.mac

+/* Site-specific Maxima code can be put here. */

stack/2023060500/maxima/noun_arith.lisp

+;; Customize Maxima's tex() function.  
+;; Chris Sangwin 21 Oct 2005.
+;; Useful files: 
+;; \Maxima-5.9.0\share\maxima\5.9.0\share\utils\mactex-utilities.lisp
+;; \Maxima-5.9.0\share\maxima\5.9.0\src\mactex.lisp
+
+(defprop $nounadd tex-mplus tex)
+(defprop $nounadd ("+") texsym)
+(defprop $nounadd 100. tex-lbp)
+(defprop $nounadd 100. tex-rbp)
+
+(defprop $nounsub tex-prefix tex)
+(defprop $nounsub ("-") texsym)
+(defprop $nounsub 100. tex-rbp)
+(defprop $nounsub 100. tex-lbp)
+
+(defprop $nounmul tex-nary tex)
+(defprop $nounmul "\\," texsym)
+(defprop $nounmul 120. tex-lbp)
+(defprop $nounmul 120. tex-rbp)
+
+(defprop $noundiv tex-mquotient tex)
+(defprop $noundiv 122. tex-lbp) ;;dunno about this
+(defprop $noundiv 123. tex-rbp)
+
+(defprop $nounpow tex-mexpt tex)
+(defprop $nounpow 140. tex-lbp)
+(defprop $nounpow 139. tex-rbp)
+
+(defprop $nounand tex-nary tex)
+;;(defprop $nounand ("\\land ") texsym)
+(defprop $nounand ("\\,{\\mbox{ !AND! }}\\, ") texsym)
+(defprop $nounand 65. tex-lbp)
+(defprop $nounand 65. tex-rbp)
+;;(defprop mand ("\\land ") texsym)
+(defprop mand ("\\,{\\mbox{ !AND! }}\\, ")  texsym)
+
+(defprop $nounor tex-nary tex)
+;;(defprop $nounor ("\\lor ") texsym)
+(defprop $nounor ("\\,{\\mbox{ !OR! }}\\, ") texsym)
+(defprop $nounor 61. tex-lbp)
+(defprop $nounor 61. tex-rbp)
+;;(defprop mor ("\\lor ") texsym)
+(defprop mor ("\\,{\\mbox{ !OR! }}\\, ")  texsym)
+
+(defprop $nounnot tex-prefix tex)
+;;(defprop $nounnot ("\\neg ") texsym)
+(defprop $nounnot ("{\\rm !NOT!}") texsym)
+(defprop $nounnot 70. tex-lbp)
+(defprop $nounnot 70. tex-rbp)
+(defprop mnot tex-prefix tex)
+;;(defprop mnot ("\\neg ") texsym)
+(defprop mnot ("{\\rm !NOT!}") texsym)
\ No newline at end of file

stack/2023060500/maxima/rtest_assessment_simpfalse.mac

+scientific_notation(123.456);
+1.23456*10^2$
+
+factorp(x); 
+true$ 
+factorp(2); 
+true$ 
+factorp(4); 
+false$ 
+factorp(2^2); 
+true$ 
+factorp(2^2*x^3); 
+true$ 
+factorp(x^2); 
+true$ 
+factorp(y^2*x^2); 
+true$ 
+factorp((y*x)^2); 
+true$ 
+factorp((x-1)*(1+x)); 
+true$ 
+factorp((x-1)^2); 
+true$ 
+factorp((1-x)^2); 
+true$ 
+factorp(2*(x-1)); 
+true$ 
+factorp(2*x-1); 
+true$ 
+factorp(x^2-1); 
+false$ 
+factorp(1+x^2); 
+true$ 
+factorp((x-1)*(1+x)); 
+true$ 
+factorp((x-%i)*(%i+x)); 
+true$ 
+factorp(4*(x-1/2)^2); 
+false$ 
+
+commonfaclist([12,15]); 
+3$ 
+commonfaclist([12,15,60,9]); 
+3$ 
+commonfaclist([x^2-1,x^3-1]); 
+x-1$ 
+commonfaclist([x = 6,8]); 
+1$ 
+
+lowesttermsp(x); 
+true$ 
+lowesttermsp(0.5); 
+true$ 
+lowesttermsp(1/2); 
+true$ 
+lowesttermsp((-1)/2); 
+true$ 
+lowesttermsp(1/(-2)); 
+true$ 
+lowesttermsp((-3)/6); 
+false$ 
+lowesttermsp((-x)/x^2); 
+false$ 
+lowesttermsp(15/3); 
+false$ 
+lowesttermsp(3/15); 
+false$ 
+lowesttermsp((x-1)/(x^2-1)); 
+false$ 
+lowesttermsp(x/(x^2-1)); 
+true$ 
+lowesttermsp((2+x)/(x^2-1)); 
+true$ 
+
+all_lowest_termsex(x); 
+true$ 
+all_lowest_termsex(0.5); 
+true$ 
+all_lowest_termsex(1/2); 
+true$ 
+all_lowest_termsex(2/4); 
+false$ 
+all_lowest_termsex(15/3); 
+false$ 
+all_lowest_termsex(0.3*x^2+3/15); 
+false$ 
+all_lowest_termsex(x/(x^3+x)); 
+true$ 
+
+list_expression_numbers(0.3*x+1/2); 
+[1/2,0.3]$ 
+
+exdowncase(X-x); 
+x-x$ 
+
+StackDISP(-(x-1),""); 
+"-\\left(x-1\\right)"$ 
+
+buggy_pow( 3*(x+1)^2 );
+3*(x^2+1^2)$
+buggy_pow(x^(a+b)^2);
+x^(a^2+b^2)$
+buggy_pow(x^(a+b)^(1/2));
+x^(a^(1/2)+b^(1/2))$
+buggy_pow((x+1)^(a+b)^2);
+x^(a^2+b^2)+1^(a^2+b^2)$
+buggy_pow( 3*(x+1)^-1 );
+3*(x^-1+1^-1)$
+buggy_pow( 3*(x+1)^-2 );
+3*(x^-2+1^-2)$
+buggy_pow(sin(sqrt(a+b)));
+sin(sqrt(a)+sqrt(b))$
+
+mediant(1/2,2/3);
+(1+2)/(2+3)$
+
+safe_setp({1,2});
+true$
+safe_setp({});
+true$
+safe_setp(set(a,b));
+true$
+safe_setp(1);
+false$
+