Skip to content
Snippets Groups Projects
Commit c1380727 authored by Lennart Kramer's avatar Lennart Kramer
Browse files

add stackmaxima 2023102700

parent 5cdca990
No related branches found
No related tags found
No related merge requests found
Expand all Show whitespace changes
Inline Side-by-side
Showing
with 2905 additions and 42 deletions
stack/2017121800/maxima/expandfeedback.mac → stack/2023102700/maxima/expandfeedback.mac
+ 0
− 17
View file @ c1380727
......@@ -23,17 +23,6 @@ COLOR_LIST:["red", "Blue" , "YellowOrange", "Bittersweet" , "BlueViolet" , "Aq
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)$
......@@ -131,9 +120,3 @@ tut_expand_full(ex) := block([ret,seps],
display_steps(ret)
)$
stack/2017121800/maxima/experimental.mac → stack/2023102700/maxima/experimental.mac
+ 71
− 0
View file @ c1380727
......@@ -34,110 +34,6 @@ rand_recurse(ex) := block(
/* 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))));
/****************************************************************/
/* Inequality functions for STACK */
/* */
/* Chris Sangwin, <chris@sangwin.com> */
/* V0.2 July 2013 */
/* */
/****************************************************************/
/****************************************************************/
/* Reporting support functions for STACK */
/* */
/* Chris Sangwin, <chris@sangwin.com> */
/* V0.1 January 2013 */
/* */
/****************************************************************/
/* Sample ways of representing a PRT in which we might have errors */
/* Evaluate a single node safely. */
node_no(prt,num,inputs) := block([res,err],
/* Type checking */
if not(listp(prt)) then (print("STACK exception: node_no expects its first argument to be a list."), return(false)),
if not(integerp(num)) then (print("STACK exception: node_no expects its second argument to be an integer."), return(false)),
if is(length(prt)<num) then (print("STACK exception: node_no expects its second argument to less than the length of the first."), return(false)),
/* Do computation */
res:errcatch(ev(prt[num],inputs,nouns)),
if is([] = res) then
print(concat("Previous error generated by node number ", string(num), ".")),
if is([] = res) then
[]
else
first(res)
);
/* Actually traverse the PRT with given inputs */
/* Inputs should be in the form of equations such as [ans1=x^2] */
traverse_prt(inputs) := block(
/* Type checking */
if not(listp(inputs)) then (print("STACK exception: traverse_prt expects its argument to be a list."), return(false)),
if not(alllistp(equationp,inputs)) then (print("STACK exception: traverse_prt expects its argument to be a list of equations."), return(false)),
/* Setup PRT */
simp:false,
PRTtests:[
'ATAlgEquiv(ans1,x^3),
'ATInt(ans2,[x^3,x]),
'ATInt(ans2/0,[x^3,x])
],
quiet:[false,false,false],
nexttrue:[2,3,1],
nextfalse:[1,1,1],
/* Creatlist to store previously visited nodes */
visited:makelist(false, length(PRTtests)),
current_node:1,
feedback:[],
answernote:[],
/* Actually traverse the tree */
while not(visited[current_node]) do block([res],
visited[current_node]:true,
res:node_no(PRTtests,current_node,inputs),
if not(listp(res)) then return(false),
/* Feedback */
if not(quiet[current_node]) then feedback:cons(res[4], feedback),
feedback:cons(concat("[STACK-feedback:",string(current_node),"-",string(res[2]),"]"), feedback),
/* Answernotes */
if not(is(res[3] = "")) then answernote:cons(res[3], answernote),
answernote:cons(concat(string(current_node),"-",string(res[2])), answernote),
/* Update to next node */
if res[2] then
current_node:nexttrue[current_node]
else
current_node:nextfalse[current_node]
),
answernote:simplode(reverse(sublist(answernote, lambda([ex],not(is(ex=""))))), " | " ),
feedback:simplode(reverse(sublist(feedback, lambda([ex],not(is(ex=""))))), " | " ),
[answernote, feedback]
)$
print("[ STACK-reports started. ]")$
/****************************************************************/
/* Unary minus functions for STACK */
/* */
/* Chris Sangwin, <chris@sangwin.com> */
/* V0.1 March 2014 */
/* */
/****************************************************************/
/* Transforms --x into x recursively in the case simp:false */
unary_minus_minus_simp(ex) := block(
if atom(ex) then return(ex),
if op(ex) = "-" and first(args(ex))<0 then return(ev(ex,simp)),
if op(ex) = "-" and atom(first(args(ex))) then return(ex),
if op(ex) = "-" and op(first(args(ex))) = "-" then return(first(args(first(args(ex))))),
apply(op(ex), map(unary_minus_minus_simp, args(ex)) )
)$
/* Transforms --x into x recursively in the case simp:false */
unary_minus_add_distrib(ex) := block(
if atom(ex) then return(ex),
if op(ex) = "-" and atom(first(args(ex))) then return(ex),
if op(ex) = "-" and op(first(args(ex))) = "+" then return(apply("+", map(lambda([ex2],-ex2), args(first(args(ex)))))),
apply(op(ex), map(unary_minus_add_distrib, args(ex)) )
)$
/****************************************************************/
/* Square root functions for STACK */
/* */
......
stack/2023102700/maxima/fboundp.mac 0 → 100644
+ 99
− 0
View file @ c1380727
/* 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/2017121800/maxima/inequalities.mac → stack/2023102700/maxima/inequalities.mac
+ 29
− 11
View file @ c1380727
......@@ -29,6 +29,7 @@
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),
......@@ -41,14 +42,18 @@ ineqprepare(ex) := block([op2, ex2],
/* Turn a single variable polynomial expression into a +1/-1 monic polynomial.
This is used with inequalities. */
make_monic(ex) := block([v,vc],
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. */
ev(expand(ex/abs(numerical_coeff(ex))), simp)
/* 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. */
......@@ -64,7 +69,8 @@ numerical_coeff(ex):= block([v, vc],
make_monic_eq(ex) := block([v],
if mapatom(ex) then return(ex),
if not(polynomialpsimp(ex)) then return(ex),
ex:expand(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),
......@@ -182,7 +188,7 @@ single_linear_ineq_reduce(ex, exo):=block([exg,exl],
*/
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 print("ERROR: single_linear_ineq_reduce_h expects second argument to be max or min."),
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)))),
......@@ -205,6 +211,14 @@ 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! */
......@@ -226,10 +240,14 @@ linear_inequality_to_interval(ex) := block([ex2, v, p, 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],
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 >, >= */
......
stack/2023102700/maxima/intervals.mac 0 → 100644
+ 942
− 0
View file @ c1380727
This diff is collapsed.
stack/2023102700/maxima/local.mac 0 → 100644
+ 1
− 0
View file @ c1380727
/* Site-specific Maxima code can be put here. */
stack/2023102700/maxima/noun_arith.lisp 0 → 100644
+ 53
− 0
View file @ c1380727
;; 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/2023102700/maxima/noun_simp.mac 0 → 100644
+ 671
− 0
View file @ c1380727
This diff is collapsed.
stack/2023102700/maxima/numericaltest.mac 0 → 100644
+ 464
− 0
View file @ c1380727
This diff is collapsed.
stack/2017121800/maxima/rtest_assessment_simpboth.mac → stack/2023102700/maxima/rtest_assessment_simpboth.mac
+ 16
− 12
View file @ c1380727
......@@ -125,13 +125,13 @@ irred_Q(1-x,x);
irred_Q(2-3*x,x);
[true,"",false]$
irred_Q(2*x-2,x);
[false,"stack_trans('irred_Q_commonint'); ",true]$
[false,"stack_trans('irred_Q_commonint'); !NEWLINE!",true]$
irred_Q(t+t*x,x);
[false,"",false]$
[false,"stack_trans('ATFacForm_notpoly'); !NEWLINE!"]$
irred_Q(3*x^2,x);
[true,"",false]$
irred_Q(4*x^2,x);
[true,"stack_trans('irred_Q_optional_fac' , !quot!\\(4\\,x^2\\)!quot! ); ",false]$
[true,"stack_trans('irred_Q_optional_fac' , !quot!\\(4\\,x^2\\)!quot! ); !NEWLINE!",false]$
irred_Q(x^2-4,x);
[false,"",false]$
irred_Q(x^2-2,x);
......@@ -151,22 +151,24 @@ irred_Q(1+x^2+x^5,x);
irred_Q(n^3-1,n);
[false,"",false]$
irred_Q(3*x-6*x^3+3*x^6,x);
[false,"stack_trans('irred_Q_commonint'); ",false]$
[false,"stack_trans('irred_Q_commonint'); !NEWLINE!",false]$
irred_Q(9-3*x+3*x^5,x);
[false,"stack_trans('irred_Q_commonint'); ",true]$
[false,"stack_trans('irred_Q_commonint'); !NEWLINE!",true]$
irred_power_Qp(2,x);
PartFrac_term_p(2,x);
true$
irred_power_Qp((x-1)^2,x);
PartFrac_term_p(1/(x-1)^2,x);
true$
irred_power_Qp((3*x-6)^4,x);
PartFrac_term_p(1/(3*x-6)^4,x);
true$
irred_power_Qp(x^2-1,x);
PartFrac_term_p(1/(x^2-1),x);
false$
irred_power_Qp(3*x-6*x^3+3*x^6,x);
PartFrac_term_p(1/(3*x-6*x^3+3*x^6),x);
false$
irred_power_Qp(9-3*x+3*x^5,x);
PartFrac_term_p(1/(9-3*x+3*x^5),x);
true$
PartFrac_term_p(x/(x-1),x);
false$
continuousp(x^2,x,1);
true$
......@@ -312,7 +314,7 @@ stack_disp(a+1, "i");
stack_disp(1, "i");
"\\(1\\)"$
stack_disp(false, "i");
"\\(\\mathbf{false}\\)"$
"\\(\\mathbf{!BOOLFALSE!}\\)"$
stack_disp(ab0, "i");
"\\({{\\it ab}}_{0}\\)"$
stack_disp(epsilon0345, "i");
......@@ -371,3 +373,5 @@ factorlist(-x^2-5*x+6);
factorlist(x^3-1);
[x-1,x^2+x+1]$
cartesian_product({1, 2}, {3, 4});
{[1, 3], [1, 4], [2, 3], [2, 4]}$
stack/2017121800/maxima/rtest_assessment_simpfalse.mac → stack/2023102700/maxima/rtest_assessment_simpfalse.mac
+ 2
− 2
View file @ c1380727
......@@ -105,9 +105,9 @@ 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*(1/x+1/1)$
3*(x^-1+1^-1)$
buggy_pow( 3*(x+1)^-2 );
3*(1/x^2+1/1^2)$
3*(x^-2+1^-2)$
buggy_pow(sin(sqrt(a+b)));
sin(sqrt(a)+sqrt(b))$
......
stack/2023102700/maxima/s_test_case.lisp 0 → 100644
+ 4
− 0
View file @ c1380727
;; Needed to read in files as textfiles.
(defun readline (stream) (read-line stream nil nil))
stack/2023102700/maxima/s_test_case.mac 0 → 100644
+ 65
− 0
View file @ c1380727
/* Author Chris Sangwin
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/>. */
/* ******************************************************** */
/* Run STACK packages bespoke maxima unit tests. */
/* */
/* To use this in the sandbox try something like */
/* */
/* stacklocation:"/var/www/html/m40/question/type/stack"$ */
/* load("s_test_case.mac"); */
/* ******************************************************** */
print("************ s_test_case results.");
load("s_test_case.lisp")$
s_test_case_eval(ex1, ex2):= if(is(ex1=ex2)) then true else sconcat("Expected '", string(ex2), "' but got '", string(ex1), "'.");
read_s_test_file(filename) := block([filedescr, stream, oneline, soneline, eof, cnt, s_failing],
/* Load the file to define any functions etc. it contains. */
load(filename),
/* A list to hold test cases which fail. */
s_failing:[],
eof: false,
filedescr:file_search(filename),
stream: ?open(filedescr),
while not eof do block(
oneline: ?readline(stream),
soneline: strim(" ", string(oneline)),
if is(slength(soneline)>12) and is(substring(soneline, 1, 13)="\"s_test_case") then block([ex],
ex:parse_string(oneline),
ex:ev(ex, s_test_case=s_test_case_eval),
if stringp(ex) then s_failing:append(s_failing, [[oneline, ex]])
),
eof: not(?stringp(oneline))
),
if emptyp(s_failing) then print(sconcat("All passed for: ", filename)) else block(
print(sconcat("FAILED in: ", filename)),
print(s_failing)
)
)$
/* Automatically find files in the contrib directory. */
contrib_files:directory(sconcat(stacklocation, "/stack/maxima/contrib/*.mac"))$
if emptyp(contrib_files) then print("WARNING: you need to redefine the stacklocation variable correctly to run the tests!");
print("simp:false");
simp:false;
/* Load files in the contrib directory and run the tests. */
while not(emptyp(contrib_files)) do block(
read_s_test_file(first(contrib_files)),
contrib_files:rest(contrib_files)
);
stack/2023102700/maxima/sandbox.wxm 0 → 100644
+ 107
− 0
View file @ c1380727
This diff is collapsed.
stack/2023102700/maxima/stack44.mac 0 → 100644
+ 12
− 0
View file @ c1380727
/*load("sqdnst")*/
sqrtdenest(a) :=
subst("^" = lambda([a, b],
block([discr, max, min],
if evenp(denom(b)) and not atom(a) and inpart(a, 0) = "+"
and (max:max(first(a), rest(a)),
min:a-max,
numberp(discr:sqrt(1-(min/max)^2)))
then (sqrt(max*(1+discr)/2)+signum(min)*sqrt(max*(1-discr)/2))^(2*b)
else a^b)),
a
)$
\ No newline at end of file
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment