move stack into repository itself

.gitignore

+# Swap
+[._]*.s[a-v][a-z]
+!*.svg  # comment out if you don't need vector files
+[._]*.sw[a-p]
+[._]s[a-rt-v][a-z]
+[._]ss[a-gi-z]
+[._]sw[a-p]
+
+# Session
+Session.vim
+Sessionx.vim
+
+# Temporary
+.netrwhist
+*~
+# Auto-generated tag files
+tags
+# Persistent undo
+[._]*.un~

.gitmodules

-[submodule "assStackQuestion"]
-	path = assStackQuestion
-	url = https://github.com/ilifau/assStackQuestion.git
-	branch = master-ilias53
-[submodule "goe_web"]
-	path = goe_web
-	url = https://gitlab.gwdg.de/martin.heide/goe_web.git
-	branch = master
-[submodule "moodle-qtype_stack"]
-	path = moodle-qtype_stack
-	url = https://github.com/maths/moodle-qtype_stack.git

Dockerfile

@@ -2,7 +2,7 @@ FROM debian:stable
 
 # e.g. 5.41.0
 ARG MAXIMA_VERSION
-# e.g. 1.4.11
+# e.g. 2.0.22.0.2
 ARG SBCL_VERSION
 # e.g. assStackQuestion/classes/stack/maxima
 ARG LIB_PATH

assStackQuestion @ 12439ff1

-Subproject commit 12439ff1a3a16280e115ce1fab4a23b985c90509

build.sh

-#/bin/bash
 REGISTRY=$1
-
-for sbcl_version in $(cat sbcl_version); do
-for maxima_version in $(cat maxima_version); do
-for stack_version in $(cat stack_version); do
-IFS=",";
-set ${stack_version};
-# checkout repository
-cd assStackQuestion;
-#git checkout $2
-cd ../
-./buildimage.sh ${sbcl_version} ${maxima_version} $1 "assStackQuestion/classes/stack/maxima" ${REGISTRY} || exit 1
-unset IFS
-done
-#for moodle_version in $(cat moodle_version); do
-#cd moodle-qtype_stack
-#git checkout ${moodle_version}
-#cd ../
-#echo "starting to build image for:"
-#echo "sbcl: "${sbcl_version}
-#echo "maxima: "${maxima_version}
-#echo "moodle: "${moodle_version}
-#done
-done
+grep -v '^#' versions | \
+while read -r line; do
+	maxima_version="$(echo "$line" | cut -f1)"
+	sbcl_version="$(echo "$line" | cut -f2)"
+	stack_version="$(echo "$line" | cut -f3)"
+	./buildimage.sh "${sbcl_version}" "${maxima_version}" "$stack_version" "stack/$stack_version/maxima" "${REGISTRY}" || exit 1
 done

buildimage.sh

-#/bin/bash
+##/bin/bash
 # arg1: sbcl version
 # arg2: maxima version
 # arg3: stack or moodle version: "stack-XXX" or "moodlev.X"
@@ -6,17 +6,17 @@
 # arg5: REGISTRY IP
 #
 echo "starting to build image for:"
-echo "sbcl: "$1
-echo "maxima: "$2
-echo $3
+echo "sbcl: $1"
+echo "maxima: $2"
+echo "stack: $3"
 # tag the image
-IMAGENAME=$5"/sbcl"$1"_maxima"$2"_"$3
+IMAGENAME="$5/sbcl-$1_maxima-$2_stack-$3"
 # check if the image already exists on the server
-docker pull ${IMAGENAME}
+docker pull "${IMAGENAME}"
 # build it
-docker build -t ${IMAGENAME} --build-arg MAXIMA_VERSION=$2 --build-arg SBCL_VERSION=$1 --build-arg LIB_PATH=$4 . || exit 1
-echo ${IMAGENAME}" wurde erfolgreich gebaut."
+docker build -t "${IMAGENAME}" --build-arg MAXIMA_VERSION="$2" --build-arg SBCL_VERSION="$1" --build-arg LIB_PATH="$4" . || exit 1
+echo "${IMAGENAME} wurde erfolgreich gebaut."
 # testing?
 # push it
-docker push ${IMAGENAME}
+docker push "${IMAGENAME}"
 

goe_web @ 249bdf42

-Subproject commit 249bdf42d888a5c4a6254f79a5c95b877e087d81

maxima_version

-5.41.0

moodle-qtype_stack @ 1cb32dc1

-Subproject commit 1cb32dc19faeb428b3b8daca0f72e2478877ed6c

moodle_version

-v4.3.0beta3
-v4.3.0beta2
-v4.3.0beta
-v4.3.0alpha
-v4.2.3
-v4.2.2
-v4.2.2a
-v4.2.1
-v4.2
-v4.1
-v4.0.1
-v4.0
-v3.6
-v3.5.7
-v3.5.6
-v3.5.5
-v3.5
-v3.4
-v3.3.3
-v3.3.2
-v3.3.1
-v3.3
-v3.2
-v3.1
-v3.0
-v3.0rc1
-v3.0beta1

sbcl_version

-2.0.2

stack/2014083000/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/2014083000/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/2014083000/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/2014083000/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/2014083000/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 */
+/* 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?
+
+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"]$
+ALL_TRANS:append(ALG_TRANS,ID_TRANS,INT_ARITH,NEG_TRANS,DIV_TRANS)$
+
+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)))$
+
+
+/* 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          */
+/*******************************************/
+ 
+/* 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)))
+)$
+
+
+/*******************************************/
+/* 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))
+)$
+
+/* sort(args(ex),orderelementaryp) does not work :-(  */
+elsort(l):=block([l1,l2],
+  l1:sublist(l, lambda([ex],safe_op(ex)#"RECIP")),
+  l2:sublist(l, lambda([ex],safe_op(ex)="RECIP")),
+  append(sort(l1,orderelementaryp),sort(l2,orderelementaryp))  
+)$
+
+/* 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$
+
+/* -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))
+)$
+
+/* 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.
+   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)
+)$
+
+
+/* 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),
+  if safe_op(part((ex),1))="+" then true else false 
+)$
+
+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))]))
+)$
+
+/*******************************************/
+/* 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/2014083000/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)$
+
+
+/* This function applies the binary function f to two lists a and b
+   returning a list [ f(a[1],b[1]), f(a[2],b[2]), ... ]
+   zip_with quietly gives up when one of the list runs out of elements.  */
+zip_with(f,a,b) := block(
+  if listp(a)= false then return(false),
+  if listp(b)= false then return(false),
+  if a = [] then return([]),
+  if b = [] then return([]),
+  cons(f(first(a),first(b)),zip_with(f,rest(a),rest(b)))
+)$
+
+/* 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)
+)$
+
+
+
+
+
+
+