add stackmaxima 2023102700

.gitlab-ci.yml

@@ -62,13 +62,16 @@ test_maxima:
   when: manual
   tags:
     - docker
-  # the tests do not work perfectly for now because of
-  # sbcl issues
+  # the tests do not work perfectly for older versions
+  # because of sbcl issues
   allow_failure: true
   parallel:
     matrix:
+      - TEST_VERSION: "2023102700"
+        QSTACK_VERSION: "v4.4.6"
+        MOODLE_BRANCH: "MOODLE_400_STABLE"
       - TEST_VERSION: "2023072101"
-        QSTACK_VERSION: "v4.4.4"
+        QSTACK_VERSION: "v4.4.5"
         MOODLE_BRANCH: "MOODLE_400_STABLE"
       - TEST_VERSION: "2023060500"
         QSTACK_VERSION: "v4.4.4"

README.md

@@ -70,7 +70,6 @@ What Stackmaxima version do I need?
 
 | Ilias Stack Version | Moodle Stack Version | Stackmaxima version | Included Maxima version |
 | ------------------- | -------------------- | ------------------- | ----------------------- |
-| `5.3`, `5.4`        | -                    | 2017121800          | 5.41.0                  |
 | -                   | `4.2.1`              | 2018080600          | 5.41.0                  |
 | `6`, `7`            | `4.2.2a`             | 2019090200          | 5.41.0                  |
 | -                   | `4.3.1`              | 2020042000          | 5.41.0                  |
@@ -88,6 +87,7 @@ What Stackmaxima version do I need?
 | -                   | `4.4.3`              | 2023052400          | 5.44.0                  |
 | -                   | `4.4.4`              | 2023060500          | 5.44.0                  |
 | -                   | `4.4.5`              | 2023072101          | 5.44.0                  |
+| -                   | `4.4.6`              | 2023102700          | 5.44.0                  |
 
 
 Environment Variables

docker-compose.yml

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

stack/2017121800/maxima/arccos.lisp

-(mapc #'tex-setup
-      '(
-	(%acos "\\arccos ")
-	(%asin "\\arcsin ")
-	(%atan "\\arctan ")
-					; Latex's arg(x) is ... ?
-	(%cos "\\cos ")
-	(%cosh "\\cosh ")
-	(%cot "\\cot ")
-	(%coth "\\coth ")
-	(%csc "\\csc ")
-					; Latex's "deg" is ... ?
-	(%determinant "\\det ")
-	(%dim "\\dim ")
-	(%exp "\\exp ")
-	(%gcd "\\gcd ")
-					; Latex's "hom" is ... ?
-	(%inf "\\inf ")		   ; many will prefer "\\infty". Hmmm.
-					; Latex's "ker" is ... ?
-					; Latex's "lg" is ... ?
-					; lim is handled by tex-limit.
-					; Latex's "liminf" ... ?
-					; Latex's "limsup" ... ?
-	(%ln "\\ln ")
-	(%log "\\ln ")
-	(%max "\\max ")
-	(%min "\\min ")
-					; Latex's "Pr" ... ?
-	(%sec "\\sec ")
-	(%sin "\\sin ")
-	(%sinh "\\sinh ")
-					; Latex's "sup" ... ?
-	(%tan "\\tan ")
-	(%tanh "\\tanh ")
-	;; (%erf "{\\rm erf}") this would tend to set erf(x) as erf x. Unusual
-					;(%laplace "{\\cal L}")
-
-    ; Maxima built-in functions which do not have corresponding TeX symbols.
-    (%asec "{\\rm arcsec}")
-    (%acsc "{\\rm arccsc}")
-    (%acot "{\\rm arccot}")
-    (%sech "{\\rm sech}")
-    (%csch "{\\rm csch}")
-    (%asinh "{\\rm arcsinh}")
-    (%acosh "{\\rm arccosh}")
-    (%atanh "{\\rm arctanh}")
-    (%asech "{\\rm arcsech}")
-    (%acsch "{\\rm arccsch}")
-    (%acoth "{\\rm arccoth}")
-)) ;; etc
-

stack/2017121800/maxima/complexi.lisp

-;; Customize Maxima's TEX() function.
-;; Make %i print at a "j"
-;; Chris Sangwin 19 August Jan 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 $%i "\\mathrm{i}" texword)
-
-(defprop $%i "<mi>i</mi> " mathmlword)

stack/2017121800/maxima/complexj.lisp

-;; Customize Maxima's TEX() function.  
-;; Make %i print at a "j"
-;; Chris Sangwin 19 August Jan 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 $%i "\\mathrm{j}" texword)
-
-(defprop $%i "<mi>j</mi> " mathmlword)

stack/2017121800/maxima/cos-1.lisp

-(mapc #'tex-setup
-    '(
-	(%acos "\\cos^{-1}")
-	(%asin "\\sin^{-1}")
-	(%atan "\\tan^{-1}")
-					; Latex's arg(x) is ... ?
-	(%cos "\\cos ")
-	(%cosh "\\cosh ")
-	(%cot "\\cot ")
-	(%coth "\\coth ")
-	(%csc "\\csc ")
-					; Latex's "deg" is ... ?
-	(%determinant "\\det ")
-	(%dim "\\dim ")
-	(%exp "\\exp ")
-	(%gcd "\\gcd ")
-					; Latex's "hom" is ... ?
-	(%inf "\\inf ")		   ; many will prefer "\\infty". Hmmm.
-					; Latex's "ker" is ... ?
-					; Latex's "lg" is ... ?
-					; lim is handled by tex-limit.
-					; Latex's "liminf" ... ?
-					; Latex's "limsup" ... ?
-	(%ln "\\ln ")
-	(%log "\\ln ")
-	(%max "\\max ")
-	(%min "\\min ")
-					; Latex's "Pr" ... ?
-	(%sec "\\sec ")
-	(%sin "\\sin ")
-	(%sinh "\\sinh ")
-					; Latex's "sup" ... ?
-	(%tan "\\tan ")
-	(%tanh "\\tanh ")
-	;; (%erf "{\\rm erf}") this would tend to set erf(x) as erf x. Unusual
-					;(%laplace "{\\cal L}")
-
-    ; Maxima built-in functions which do not have corresponding TeX symbols.
-    (%asec "{\\rm sec}^{-1}")
-    (%acsc "{\\rm csc}^{-1} ")
-    (%acot "{\\rm cot}^{-1}")
-    (%sech "{\\rm sech}")
-    (%csch "{\\rm csch}")
-    (%asinh "{\\rm sinh}^{-1}")
-    (%acosh "{\\rm cosh}^{-1}")
-    (%atanh "{\\rm tanh}^{-1}")
-    (%asech "{\\rm sech}^{-1}")
-    (%acsch "{\\rm csch}^{-1}")
-    (%acoth "{\\rm coth}^{-1}")
-)) ;; etc
-

stack/2017121800/maxima/multiply_blank.lisp

-;; Customize Maxima's TEX() function.  
-;; 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 mtimes ("\\, ") texsym)

stack/2017121800/maxima/multiply_cross.lisp

-;; Customize Maxima's TEX() function.  
-;; 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 mtimes ("\\times ") texsym)

stack/2017121800/maxima/multiply_dot.lisp

-;; Customize Maxima's TEX() function.  
-;; 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 mtimes ("\\cdot ") texsym)

stack/2017121800/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 $noun+ tex-mplus tex)
-(defprop $noun+ ("+") texsym)
-(defprop $noun+ 100. tex-lbp)
-(defprop $noun+ 100. tex-rbp)
-
-(defprop $noun- tex-prefix tex)
-(defprop $noun- ("-") texsym)
-(defprop $noun- 100. tex-rbp)
-(defprop $noun- 100. tex-lbp)
-
-(defprop $noun* tex-nary tex)
-(defprop $noun* "\\," texsym)
-(defprop $noun* 120. tex-lbp)
-(defprop $noun* 120. tex-rbp)
-
-(defprop $noun/ tex-mquotient tex)
-(defprop $noun/ 122. tex-lbp) ;;dunno about this
-(defprop $noun/ 123. tex-rbp)
-
-(defprop $noun^ tex-mexpt tex)
-(defprop $noun^ 140. tex-lbp)
-(defprop $noun^ 139. tex-rbp)
-
-;; Chris Sangwin 3 Feb 2016.
-
-(defprop $nounand tex-nary tex)
-;;(defprop $nounand ("\\land ") texsym)
-(defprop $nounand ("\\,{\\mbox{ and }}\\, ") texsym)
-(defprop $nounand 69. tex-lbp)
-(defprop $nounand 69. tex-rbp)
-
-(defprop $nounor tex-nary tex)
-;;(defprop $nounor ("\\lor ") texsym)
-(defprop $nounor ("\\,{\\mbox{ or }}\\, ") texsym)
-(defprop $nounor 70. tex-lbp)
-(defprop $nounor 70. tex-rbp)
-
-;; Chris Sangwin 29 Sept 2017.
-
-(defprop mnot tex-prefix tex)
-(defprop mnot ("{\\rm not}") texsym)
\ No newline at end of file

stack/2017121800/maxima/sandbox.wxm

-/* [wxMaxima batch file version 1] [ DO NOT EDIT BY HAND! ]*/
-/* [ Created with wxMaxima version 15.08.2 ] */
-
-/* [wxMaxima: title   start ]
-STACK Sandbox
-   [wxMaxima: title   end   ] */
-
-/* [wxMaxima: comment start ]
-This document loads the extra files needed for STACK.
-See https://github.com/maths/moodle-qtype_stack
-
-1. Download the files from github, either using git or as a zip file.
-2. Place the files somewhere they can be read, and edit the line velow to give the location.
-   E.g. Place the files in C:\files\stack
-3. Specify a directory for temporary working files, e.g. C:\tmp    [Directories in 2 & 3 can be the same if you don't mind clutter.]
-
-Note, that plots *will not work* in this sandbox.
-   [wxMaxima: comment end   ] */
-
-/* [wxMaxima: input   start ] */
-/* In MS platforms use the forward slash as a directory seperator.  No trailing slash. */
-stacklocation:"C:/files/stack"$
-stacktmplocation:"C:/tmp"$
-
-/****************************************************
-   There should be no need to edit below this line.  
-   
-   These commands add the location to Maxima's search path. 
-*/
-file_search_maxima:append( [sconcat(stacklocation, "/question/type/stack/stack/maxima/###.{mac,mc}")] , file_search_maxima)$
-file_search_lisp:append( [sconcat(stacklocation, "/question/type/stack/stack/maxima/###.{lisp}")] , file_search_lisp)$
-file_search_maxima:append( [sconcat(stacktmplocation, "/###.{mac,mc}")] , file_search_maxima)$
-file_search_lisp:append( [sconcat(stacktmplocation, "/###.{lisp}")] , file_search_lisp)$
-
-STACK_SETUP(ex):=block(
-    MAXIMA_VERSION_NUM_EXPECTED:38.3,
-    MAXIMA_PLATFORM:"win",
-    maxima_tempdir:"",
-    IMAGE_DIR:"",
-    PLOT_SIZE:[450,300],
-    PLOT_TERMINAL:"svg",
-    PLOT_TERM_OPT:"dynamic font \\\",11\\\" linewidth 1.2",
-    DEL_CMD:"del",
-    GNUPLOT_CMD:"C:\\bin\\moodle\\server\\moodledata\\stack\\wgnuplot.exe",
-    MAXIMA_VERSION_EXPECTED:"5.41.0",
-    URL_BASE:"!ploturl!",
-    /* Define units available in STACK. */
-    stack_unit_si_prefix_code:[y, z, a, f, p, n, u, m, c, d, da, h, k, M, G, T, P, E, Z, Y],
-    stack_unit_si_prefix_multiplier:[10^-24, 10^-21, 10^-18, 10^-15, 10^-12, 10^-9, 10^-6, 10^-3, 10^-2, 10^-1, 10, 10^2, 10^3, 10^6, 10^9, 10^12, 10^15, 10^18, 10^21, 10^24],
-    stack_unit_si_prefix_tex:["\\mathrm{y}", "\\mathrm{z}", "\\mathrm{a}", "\\mathrm{f}", "\\mathrm{p}", "\\mathrm{n}", "\\mu ", "\\mathrm{m}", "\\mathrm{c}", "\\mathrm{d}", "\\mathrm{da}", "\\mathrm{h}", "\\mathrm{k}", "\\mathrm{M}", "\\mathrm{G}", "\\mathrm{T}", "\\mathrm{P}", "\\mathrm{E}", "\\mathrm{Z}", "\\mathrm{Y}"],
-    stack_unit_si_unit_code:[m, l, L, g, s, h, Hz, Bq, cd, N, Pa, cal, Cal, Btu, eV, J, W, A, ohm, C, V, F, S, Wb, T, H, Gy, rem, Sv, lx, mol, M, kat, rad],
-    stack_unit_si_unit_conversions:[m, m^3/1000, m^3/1000, kg/1000, s, s*3600, 1/s, 1/s, cd, (kg*m)/s^2, kg/(m*s^2), 4.2*J, 4200*J, 1055*J, 1.602177e-19*J, (kg*m^2)/s^2, (kg*m^2)/s^3, A, (kg*m^2)/(s^3*A^2), s*A, (kg*m^2)/(s^3*A), (s^4*A^2)/(kg*m^2), (s^3*A^2)/(kg*m^2), (kg*m^2)/(s^2*A), kg/(s^2*A), (kg*m^2)/(s^2*A^2), m^2/s^2, 0.01*Sv, m^2/s^2, cd/m^2, mol, mol/(m^3/1000), mol/s, rad],
-    stack_unit_si_unit_tex:["\\mathrm{m}", "\\mathrm{l}", "\\mathrm{L}", "\\mathrm{g}", "\\mathrm{s}", "\\mathrm{h}", "\\mathrm{Hz}", "\\mathrm{Bq}", "\\mathrm{cd}", "\\mathrm{N}", "\\mathrm{Pa}", "\\mathrm{cal}", "\\mathrm{cal}", "\\mathrm{Btu}", "\\mathrm{eV}", "\\mathrm{J}", "\\mathrm{W}", "\\mathrm{A}", "\\Omega", "\\mathrm{C}", "\\mathrm{V}", "\\mathrm{F}", "\\mathrm{S}", "\\mathrm{Wb}", "\\mathrm{T}", "\\mathrm{H}", "\\mathrm{Gy}", "\\mathrm{rem}", "\\mathrm{Sv}", "\\mathrm{lx}", "\\mathrm{mol}", "\\mathrm{M}", "\\mathrm{kat}", "\\mathrm{rad}"],
-    stack_unit_other_unit_code:[min, amu, u, mmHg, bar, cc, gal, mbar, atm, torr, rev, deg, rpm, K, day, year, in, ft, mi],
-    stack_unit_other_unit_conversions:[s*60, amu, amu, 133.322387415*Pa, 10^5*Pa, m^3*10^(-6), 3.785*l, 10^2*Pa, 101325*Pa, 101325/760*Pa, 2*pi*rad, pi*rad/180, pi*rad/(30*s), K, 86400*s, 3.156e7*s, in, 12*in, 5280*12*in],
-    stack_unit_other_unit_tex:["\\mathrm{min}", "\\mathrm{amu}", "\\mathrm{u}", "\\mathrm{mmHg}", "\\mathrm{bar}", "\\mathrm{cc}", "\\mathrm{gal}", "\\mathrm{mbar}", "\\mathrm{atm}", "\\mathrm{torr}", "\\mathrm{rev}", "\\mathrm{{}^{o}}", "\\mathrm{rpm}", "\\mathrm{K}", "\\mathrm{day}", "\\mathrm{year}", "\\mathrm{in}", "\\mathrm{ft}", "\\mathrm{mi}"],
-    true)$
-/* Load the main libraries. */
-load("stackmaxima.mac")$
-load("stats")$
-load("distrib")$
-load("descriptive")$
-print(sconcat("[ STACK-Maxima started, library version ", stackmaximaversion, " ]"))$
-/* [wxMaxima: input   end   ] */
-
-/* Maxima can't load/batch files which end with a comment! */
-"Created with wxMaxima"$

stack/2017121800/maxima/assessment.texi → stack/2023102700/maxima/assessment.texi

@@ -309,26 +309,26 @@ This test seeks to establish whether two expressions are the same when the basic
 
 The first step is to replace all arithmetic operations by a pseudo-noun form as follows.
 
-@deffn {Function} noun+ (@var{[ex]})
+@deffn {Function} nounadd (@var{[ex]})
 This is a commutative, associative, nary operator.  Normal addition is replaced by this operator when we are testing for equivalence up to associativity and commutativity.
 @end deffn
 
-@deffn {Function} noun* (@var{[ex]})
+@deffn {Function} nounmul (@var{[ex]})
 This is a commutative, associative, nary operator.  Normal multiplication is replaced by this operator when we are testing for equivalence up to associativity and commutativity.
 @end deffn
 
-@deffn {Function} noun^ (@var{a},@var{b})
+@deffn {Function} nounpow (@var{a},@var{b})
 This is a binary infix operator.  Normal exponentiation is replaced by this operator when we are testing for equivalence up to associativity and commutativity.
 @end deffn
 
-@deffn {Function} noun- (@var{ex})
-This is a prefix operator.  This is to match unary minus when we are testing for equivalence up to associativity and commutativity.  However, in practice unary minus, @code{"-"(ex)}, is replaced by @code{UNARY_MINUS noun* ex} so that it correctly commutes with multiplication.
+@deffn {Function} nounsub (@var{ex})
+This is a prefix operator.  This is to match unary minus when we are testing for equivalence up to associativity and commutativity.  However, in practice unary minus, @code{"-"(ex)}, is replaced by @code{UNARY_MINUS nounmul ex} so that it correctly commutes with multiplication.
 @end deffn
 
 We need functions which will transform expressions between these forms.
 
 @deffn {Function} noun_arith (@var{ex})
-All operations are replaced with their noun forms.  Note that unary minus function, @code{"-"(ex)} is replaced by @code{UNARY_MINUS noun* ex} so that it correctly commutes with multiplication.  Similarly, @code{ex1/ex2} is replaced by @code{ex1 noun* (UNARY_RECIP ex2)}.
+All operations are replaced with their noun forms.  Note that unary minus function, @code{"-"(ex)} is replaced by @code{UNARY_MINUS nounmul ex} so that it correctly commutes with multiplication.  Similarly, @code{ex1/ex2} is replaced by @code{ex1 nounmul (UNARY_RECIP ex2)}.
 @end deffn
 
 @deffn {Function} verb_arith (@var{ex})

stack/2023102700/maxima/contrib/validators.mac

+/*  Author Chris Sangwin
+    University of Edinburgh
+    Copyright (C) 2023 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/>. */
+
+/****************************************************************/
+/*  Bespoke validators for STACK inputs                         */
+/*                                                              */
+/*  Chris Sangwin, <C.J.Sangwin@ed.ac.uk>                       */
+/*  V1.0 June 2023                                              */
+/*                                                              */
+/*  Please use this file to add public bespoke validators.      */
+/*                                                              */
+/****************************************************************/
+
+/* The student may not use an underscore anywhere in their input. */
+
+validate_underscore(ex) := if is(sposition("_", string(ex)) = false) then "" 
+        else "Underscore characters are not permitted in this input.";
+
+/* Add in unit-test cases using STACK's s_test_case function.  At least two please! */
+s_test_case(validate_underscore(1+a1), "");
+s_test_case(validate_underscore(1+a_1), "Underscore characters are not permitted in this input.");

stack/2023102700/maxima/contrib/vectorcalculus.mac

+/*  Author Luke Longworth
+    University of Canterbury
+    Copyright (C) 2023 Luke Longworth
+
+    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/>. */
+
+/****************************************************************/
+/*  Vector calculus functions for STACK                         */
+/*                                                              */
+/*  V1.0 June 2023                                              */
+/*                                                              */
+/****************************************************************/
+
+/****************************************************************/
+/* Calculate the divergence of a vector-valued function         */
+/****************************************************************/
+div(u, vars):= block([div_vec],
+    if not(listp(vars)) or emptyp(vars) then error("div: the second argument must be a list of variables."),
+    if matrixp(u) then funcs: list_matrix_entries(u) else funcs: flatten(u),
+    /* TODO: confirm div should always simplify? */
+    div_vec: map(lambda([ex], ev(diff(funcs[ex],vars[ex]), simp)), ev(makelist(ii,ii,1,length(vars)), simp)),
+    return(apply("+", div_vec))
+);
+
+s_test_case(div([x^2*cos(y),y^3],[x,y]), 2*x*cos(y)+3*y^2);
+s_test_case(div(transpose(matrix([x^2*cos(y),y^3])),[x,y]), 2*x*cos(y)+3*y^2);
+s_test_case(div(matrix([x^2*cos(y),y^3]),[x,y]), 2*x*cos(y)+3*y^2);
+
+/****************************************************************/
+/* Calculate the curl of a vector-valued function               */
+/****************************************************************/
+curl(u,vars):= block([cux, cuy, cuz],
+    if not(listp(vars)) or emptyp(vars) then error("curl: the second argument must be a list of 3 variables."),
+    if matrixp(u) then [ux,uy,uz]: list_matrix_entries(u) else [ux,uy,uz]: flatten(u),
+    cux: diff(uz,vars[2]) - diff(uy,vars[3]),
+    cuy: diff(ux,vars[3]) - diff(uz,vars[1]),
+    cuz: diff(uy,vars[1]) - diff(ux,vars[2]),
+    return(transpose(matrix([cux,cuy,cuz])))
+);

stack/2017121800/maxima/elementary.mac → stack/2023102700/maxima/elementary.mac

@@ -14,55 +14,16 @@
     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 */
-
-/* http://www.ncl.ac.uk/math/numbas/manual.pdf and
-https://github.com/numbas/Numbas/blob/master/runtime/scripts/jme-display.js#L749
-
- unitDenominator transform x/1 to x 
- zeroPower transform x^0 to 1
- simplifyFractions transform (a*b)/(a*c) to b/c 
- zeroBase transform 0^x to 0 
- sqrtProduct simplify sqrt(a)*sqrt(b) to sqrt(a*b) 
- sqrtDivision simplify sqrt(a)/sqrt(b) to sqrt(a/b)
- sqrtSquare simplify sqrt(x^2) to x 
- trig simplify various trigonometric values e.g. sin(n*pi) to 0 
- otherNumbers simplify 2^3 to 8 
- fractionNumbers display all numbers as fractions instead of decimals
-*/
-
-/* NOTE: all these operations really need three separate
-things, as with zeroAdd:
-
-zeroAddp - the predicate which matches to the pattern zeroAdd -
-perform the rule on the top level. zeroAddr - recurse over the
-whole expression applying the rule.
-
-What about working through to the first occurance of the
-pattern?
+/* Most of the code is now in noun_simp.mac.  This is the remainder. */
 
-What about identifying the first occurance of where a rule is
-satisfied?
-
-*/
 
 /*******************************************/
 /* Control functions                       */
 /*******************************************/
 
-/* List of all available rules */
-ID_TRANS:["zeroAdd","zeroMul","oneMul","onePow","idPow","zeroPow","zPow"]$
-ALG_TRANS:["assAdd","assMul","unaryAdd","unaryMul","comAdd","comMul"]$
-NEG_TRANS:["negZero","negDef","negNeg","negInt","negMinusOne","negDistAdd","negProdA","negProdB"]$
-INT_ARITH:["intAdd","intMul","intPow"]$
-DIV_TRANS:["oneDiv","idDiv","divDivA","divDivB","recipDef","recipNeg","recipMul"]$
 DIS_TRANS:["disAddMul"]$
 POW_TRANS:["powLaw"]$
-ALL_TRANS:append(ALG_TRANS,ID_TRANS,INT_ARITH,NEG_TRANS,DIV_TRANS,DIS_TRANS,POW_TRANS)$
-
 BUG_RULES:["buggyPow","buggyNegDistAdd"]$
 
 /* Is the rule applicable at the top level? */
@@ -81,23 +42,6 @@ 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)))$
 
-
-/* Transform recursively accross an expression*/
-transr(ex,rl):=block(
-  if atom(ex) then return(ex),
-  if listp(rl) then print("ERROR: only apply one rule using transr"),
-  if trans_topp(ex,rl) then 
-      /* If applying the rule changes the expression then do so */
-      block([ex2], ex2:apply(parse_string(rl),[ex]), if ex=ex2 then ex else transr(ex2,rl) ) 
-  else return(map(lambda([ex2],transr(ex2,rl)),ex))
-)$
-
-/* Apply a list of rules recursively, in order, once each */
-transl(ex,rll):=block(
-  if atom(ex) or not(listp(rll)) or emptyp(rll) then return(ex),
-  return(transl(transr(ex,first(rll)),rest(rll)))  
-)$
- 
 /*******************************************/
 /* Higher level control functions          */
 /*******************************************/
@@ -135,131 +79,27 @@ step_through3(ex):=block([rls],
  step_through3(transr(ex,first(rls)))
 )$
 
-
-/*******************************************/
-/* Transformation rules                    */
-/*******************************************/
-
-/* 0+x -> x */ /* Strictly zero at the first part */
-zeroAddp(ex):= block(
-  if safe_op(ex)="+" and is(part(ex,1)=0) then true else false
-)$
-
-zeroAdd(ex) := block(
-  if zeroAddp(ex) then
-    return( block([ex2],ex2:rest(args(ex)), if equal(length(ex2),1) then return(part(ex,2)) else return(apply("+",rest(args(ex)))))),
-  return(ex)
-)$
-
-/* zeroMul transform 0*x to 0 */ 
-zeroMulp(ex) := block(
-  if safe_op(ex)="*" and is(part(ex,1)=0) then true else false
-)$
-
-zeroMul(ex) := block(
-  if zeroMulp(ex) then return(0) else return (ex)
-)$
-
-/* oneMul transform 1*x to x */ 
-oneMulp(ex) := block([ex2],
-  if safe_op(ex)="*" and is(part(ex,1)=1) then true else false
-)$
-
-oneMul(ex) := block([ex2],
-  if oneMulp(ex) then
-    return(block([ex2],ex2:rest(args(ex)), if equal(length(ex2),1) then return(part(ex,2)) else return(apply("*",rest(args(ex))))))
-  else return(ex)
-)$
-
-/* 1^x -> 1 */
-onePowp(ex):=block(
-  if safe_op(ex)="^" and is(part(ex,1)=1) then true else false
-)$
-
-onePow(ex):= if onePowp(ex) then 1 else ex$
-
-/* x^1 -> x */
-idPowp(ex):=block(
-  if safe_op(ex)="^" and is(part(ex,2)=1) then true else false
-)$
-
-idPow(ex):= if idPowp(ex) then part(ex,1) else ex$
-
-/* 0^x -> 0*/
-zeroPowp(ex):=block(
-  if safe_op(ex)#"^" or is(part(ex,2)=0) then return(false),
-  if is(part(ex,1)=0) then true else false
-)$
-
-zeroPow(ex):= if zeroPowp(ex) then 0 else ex$
-
-/* x^0 -> 1*/
-zPowp(ex):=block(
-  if safe_op(ex)#"^" or is(part(ex,1)=0) then return(false),
-  if is(part(ex,2)=0) then true else false
-)$
-
-zPow(ex):= if zPowp(ex) then 1 else ex$
-
-/* "+"(x) -> x. (Probably not needed, but we may end up with sums of lists of length 1.)*/
-unaryAddp(ex):= block(
-  if safe_op(ex)="+" and length(args(ex))=1 then true else false
-)$
-
-unaryAdd(ex):= if unaryAddp(ex) then first(args(ex)) else ex$
-
-/* "*"(x) -> x. (Probably not needed.)*/
-unaryMulp(ex):= block(
-  if safe_op(ex)="*" and length(args(ex))=1 then true else false
-)$
-
-unaryMul(ex):= if unaryMulp(ex) then first(args(ex)) else ex$
-
-
-/*****************************************/
-
-/* These functions "flatten" sums or products by removing uncessary parentheses
-   i.e. it enforces associativity */
-/* Note that the predicates only return true if the rule changes the expression */
-assAddp(ex):= if safe_op(ex)="+" and flatten(ex)#ex then true else false$
-assAdd(ex) := if assAddp(ex) then flatten(ex) else ex$
-
-assMulp(ex):= if safe_op(ex)="*" and flatten(ex)#ex then true else false$
-assMul(ex) := if assMulp(ex) then flatten(ex) else ex$
-
-/* Define a predicate to sort elements, NEG at the front, RECIP at the end. */
-orderelementaryp(exa,exb):=block(
- if exa=NEG then return(true),
- if exb=NEG then return(false),
- if safe_op(exa)="RECIP" and safe_op(exb)="RECIP" then return(orderlessp(part(exa,1),part(exb,1))),
- if safe_op(exa)="RECIP" then return(false),
- return(orderlessp(exa,exb))
+/* 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)
 )$
 
-/* sort(args(ex),orderelementaryp) does not work :-(  */
-elsort(l):=block([l1,l2,la],
-  la:sublist(l, lambda([ex],atom(ex))),
-  l1:sublist(l, lambda([ex],not(atom(ex)) and safe_op(ex)#"RECIP")),
-  l2:sublist(l, lambda([ex],not(atom(ex)) and safe_op(ex)="RECIP")),
-  append(sort(la,orderelementaryp),sort(l1,orderelementaryp),sort(l2,orderelementaryp))  
+/* 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)
 )$
 
-/* Sort out the order of elements, i.e. commutativity */
-/* NOTE: sort(args(ex), orderelementaryp)) should work but does not... */
-comAddp(ex):= if safe_op(ex)="+" and apply("+",elsort(args(ex)))#ex then true else false$
-comAdd(ex) := if comAddp(ex) then apply("+",elsort(args(ex))) else ex$
-
-comMulp(ex):= if safe_op(ex)="*" and apply("*",elsort(args(ex)))#ex then true else false$
-comMul(ex) := if comMulp(ex) then apply("*",elsort(args(ex))) else ex$
-
 /*******************************************/
-/* Double negation -(-(a)) */ 
-negNegp(ex):=block(
-  if safe_op(ex)#"-" then return(false),
-  if safe_op(part(ex,1))="-" then return(true) else return(false)
-)$
-
-negNeg(ex):=if negNegp(ex) then part(ex,1,1) else ex$
+/* Transformation rules  (not used)        */
+/*******************************************/
 
 /* -1*x -> -x */
 negMinusOnep(ex):=block(
@@ -272,41 +112,6 @@ negMinusOne(ex):=block(
   if length(args(ex))>2 then "-"(apply("*",rest(args(ex)))) else -second(args(ex))
 )$
 
-/* Negation of zero -0 -> 0 */ 
-negZerop(ex):=block(
-  if safe_op(ex)#"-" then return(false),
-  if is(part(ex,1)=0) then return(true) else return(false)
-)$
-
-negZero(ex):=if negZerop(ex) then 0 else ex$
-
-/* Turns the negation of an integer into an actual integer "-"(n) -> -n */ 
-negIntp(ex):=block(
-  if safe_op(ex)#"-" then return(false),
-  if integerp(part(ex,1)) then return(true) else return(false)
-)$
-
-negInt(ex):=if negIntp(ex) then ev(ex,simp) else ex$
-
-/* Turns unary minus in a product into a special symbol NEG */
-negProdAp(ex):=block(
-  if safe_op(ex)#"*" then return(false),
-  return(any_listp(lambda([ex],if safe_op(ex)="-" then true else false),args(ex)))
-)$
-
-negProdA(ex):=block(
- if negProdAp(ex)=false then return(ex),
- apply("*",maplist(lambda([ex],if safe_op(ex)="-" then NEG*first(args(ex)) else ex),args(ex)))
-)$
-
-/* matches up to NEG*... and turns this back into unary minus... */
-negProdBp(ex):=if safe_op(ex)="*" and first(args(ex))=NEG then true else false$
-
-negProdB(ex):=block(
- if negProdBp(ex)=false then return(ex),
- -apply("*",rest(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.
@@ -328,32 +133,6 @@ negDef(ex):=block([a0,a1,a2,a3],
   if emptyp(a3) then 0 else apply("+",a3)
 )$
 
-
-/* removes the first occurance of ex from the list l */
-removeonce(ex,l):=block(
- if listp(l)#true or emptyp(l)  then return([]),
- if first(l)=ex then return(rest(l)),
- append([first(l)],removeonce(ex,rest(l)))
-)$
-
-/* 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)
-)$
-
 /* Distributes "-" over addition */
 negDistAddp(ex):=block(
   if safe_op(ex)#"-" then return(false),
@@ -364,96 +143,15 @@ negDistAdd(ex):=block(
   if negDistAddp(ex) then map("-",part((ex),1)) else ex
 )$
 
-/*******************************************/
-/* Warning, this is not safe on non-atoms, it evaluates them! */ 
-notintegerp(ex):= if atom(ex) then not(integerp(ex)) else true$
 
-/* Evaluate integer arithmetic */
-intAddp(ex):=block(
-  if safe_op(ex)#"+" then return(false),
-  if length(sublist(args(ex), integerp))>1 then return(true) else return(false)
-)$
-
-intAdd(ex):=block([a1,a2], 
-  if intAddp(ex)=false then return(ex),
-  a1:sublist(args(ex), integerp),
-  a1:ev(apply("+",a1),simp),
-  a2:sublist(args(ex), notintegerp),
-  if length(a2)=0 then a1 
-  else if length(a2)=1 then a1+first(a2)
-  else a1+apply("+",a2)
-)$
-
-intMulp(ex):=block(
-  if safe_op(ex)#"*" then return(false),
-  if length(sublist(args(ex), integerp))>1 then return(true) else return(false)
-)$
-
-intMul(ex):=block([a1,a2], 
-  if intMulp(ex)=false then return(ex),
-  a1:sublist(args(ex), integerp),
-  a1:ev(apply("*",a1),simp),
-  a2:sublist(args(ex), notintegerp),
-  if length(a2)=0 then a1 
-  else if length(a2)=1 then a1*first(a2)
-  else apply("*",append([a1],a2))
-)$
-
-intPowp(ex):=block(
-  if safe_op(ex)#"^" then return(false),
-  if integerp(part((ex),1)) and part((ex),1)#0 and integerp(part((ex),2)) and part((ex),2)#0 then return(true) else return(false)
-)$
-
-intPow(ex):=block([a1,a2], 
-  if intPowp(ex)=false then return(ex),
-  ev(ex,simp)
-)$
 
 /*******************************************/
 /* Division rules */
 
-/* a/1 -> a */
-oneDivp(ex):= if safe_op(ex)="/" and part(ex,2)=1 then true else false$
-oneDiv(ex) := if oneDivp(ex) then part(ex,1) else ex$
-
 /* 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$
 
-/* a/(b/c)-> a*(c/b) */
-divDivAp(ex) := if safe_op(ex)="/" and safe_op(part(ex,2))="/" then true else false$
-divDivA(ex)  := if divDivAp(ex) then part(ex,1)*(part(ex,2,2)/part(ex,2,1)) else ex$
-
-/* (a/b)/c-> a/(c*b) */
-divDivBp(ex) := if safe_op(ex)="/" and safe_op(part(ex,1))="/" then true else false$
-divDivB(ex)  := if divDivBp(ex) then part(ex,1,1)/(part(ex,1,2)*part(ex,2)) else ex$
-
-/*******************************************/
-/* RECIP */
-
-/* re-write a/b as RECIP */
-
-recipDefp(ex) := if safe_op(ex)="/" then true else false$
-recipDef(ex)  := if recipDefp(ex) then part(ex,1)*RECIP(part(ex,2))$
-
-/* RECIP(-x) -> -RECIP(x) */
-recipNegp(ex) := if safe_op(ex)="RECIP" and safe_op(part(ex,1))="-" then true else false$
-recipNeg(ex)  := if recipNegp(ex) then -RECIP(part(ex,1,1)) else ex$
-
-/* a*RECP(b)*RECIP(c) -> a*RECIP(b*c) */
-recipMulp(ex) := block([l],
-  if safe_op(ex)#"*" then return(false),
-  if length(args(ex))=1 then return(false),
-  l:reverse(args(ex)),
-  if safe_op(first(l))="RECIP" and safe_op(second(l))="RECIP" then true else false
-)$
-
-recipMul(ex) := block([p1,p2],
-  if recipMulp(ex)#true then return(ex),
-  l:reverse(args(ex)),
-  apply("*",append(reverse(rest(rest(l))),[RECIP(part(second(l),1)*part(first(l),1))]))
-)$
-
 /*******************************************/
 /* Distribution  rules                     */
 
@@ -495,27 +193,3 @@ powLaw(ex):= block([B,l1,l2],
    return(B^apply("+",l1)*l2)
 );
 
-/*******************************************/
-/* Buggy rules */
-
-/* (a+b)^n -> a^n+b^n */
-buggyPowp(ex):=block(
-  if safe_op(ex)#"^" then return(false),
-  if safe_op(part(ex,1))="+" then true else false
-)$
-
-buggyPow(ex):= if buggyPowp(ex) then apply("+",map(lambda([ex2],ex2^part(ex,2)),args(part(ex,1)))) else ex$
-
-/* -(a+b) -> -a+b */
-buggyNegDistAddp(ex) := negDistAddp(ex)$
-buggyNegDistAdd(ex)  := if buggyNegDistAddp(ex) then apply("+",append([-first(args(part(ex,1)))],rest(args(part((ex),1))))) else ex$
-
-
-/*******************************************/
-/* Testing */ 
-simp:false; 
-/*STT:batch("rtest_elementary.mac", test);*/
-simp:false; 
-
-
-

stack/2023102700/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))))
+)