Menu
▾
▴
[Stack-cvs] stack-dev/maxima stackmaxima.mac,1.84.2.1,1.84.2.2
|
From: Chris S. <san...@us...> - 2010-11-09 14:50:50
|
Update of /cvsroot/stack/stack-dev/maxima In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv2596/maxima Modified Files: Tag: grobner stackmaxima.mac Log Message: Index: stackmaxima.mac =================================================================== RCS file: /cvsroot/stack/stack-dev/maxima/stackmaxima.mac,v retrieving revision 1.84.2.1 retrieving revision 1.84.2.2 diff -C2 -d -r1.84.2.1 -r1.84.2.2 *** stackmaxima.mac 9 Nov 2010 13:39:39 -0000 1.84.2.1 --- stackmaxima.mac 9 Nov 2010 14:50:41 -0000 1.84.2.2 *************** *** 51,57 **** stack_reset(1000); - alias(int,integrate); /* Allows integrate to be called with int() */ - alias(ln,log); alias(simplify,fullratsimp); /* Allows simplify to be something */ --- 51,55 ---- *************** *** 62,65 **** --- 60,72 ---- /* ********************************** */ + /* Logarithms */ + /* ********************************** */ + alias(ln,log); + load("log10"); + texput(log10,"\\log\\mathrm{10}",prefix); + alias(lg,log10); + texput(lg,"\\mathrm{lg}",prefix); + + /* ********************************** */ /* Load contributed packages */ /* ********************************** */ *************** *** 238,247 **** ); ! /* ******************************************* */ ! /* A return object string */ ! /* */ ! /* rawmk should be a float/int between 0 and 1 */ ! /* amswernote, is for teacher stats */ ! /* ******************************************* */ StackReturnOb(rawmk,ansnote,fb):=block([str], --- 245,254 ---- ); ! /* ********************************************* */ ! /* A return object string */ ! /* */ ! /* rawmark should be a float/int between 0 and 1 */ ! /* answernote, is for teacher stats */ ! /* ********************************************* */ StackReturnOb(rawmk,ansnote,fb):=block([str], *************** *** 260,263 **** --- 267,272 ---- exs:errcatch(ev(expr,simp)), if exs=[] then return(false), + if length(expr)#1 then print(StackAddFeedback("","CommaError",string(expr),string(setify(expr)))), + expr:first(expr), /* Check for floats, and if there are any then throw an error */ if ForbidFloats and anyfloatex(expr) then *************** *** 276,293 **** )$ ! /*JPH validate an expression without type checking. Floats and mathematical errors only. */ ! stack_validate_typeless(ex,ForbidFloats,LowestTerms) := block( [simp:false,exs], /* Try to simply the expression to catch CAS errors */ ! exs:errcatch(ev(ex,simp)), if exs=[] then return(false), /* Check for floats, and if there are any then throw an error */ ! if ForbidFloats and anyfloatex(ex) then print(StackAddFeedback("","Illegal_floats")), /* Checks fractions are in lowest terms */ ! if LowestTerms and all_lowest_termsex(ex)=false then print(StackAddFeedback("","Lowest_Terms")), /* Now display the result */ simp:false, ! return(ex) )$ --- 285,304 ---- )$ ! /*validate an expression without type checking. Floats and mathematical errors only. */ ! stack_validate_typeless(expr,ForbidFloats,LowestTerms) := block( [simp:false,exs], /* Try to simply the expression to catch CAS errors */ ! exs:errcatch(ev(expr,simp)), if exs=[] then return(false), + if length(expr)#1 then print(StackAddFeedback("","CommaError",expr,setify(expr))), + expr:first(expr), /* Check for floats, and if there are any then throw an error */ ! if ForbidFloats and anyfloatex(expr) then print(StackAddFeedback("","Illegal_floats")), /* Checks fractions are in lowest terms */ ! if LowestTerms and all_lowest_termsex(expr)=false then print(StackAddFeedback("","Lowest_Terms")), /* Now display the result */ simp:false, ! return(expr) )$ *************** *** 389,397 **** /* ********************************** */ - if is(MAXIMA_VERSION_NUM <= 5.12) then block( - round(x) := ?round(x), - truncate(x) := ?truncate(x) - ); - /* numberp() does not "work" when simp:false, since unary minus is an unevaluated function... */ simp_numberp(ex) := block( --- 400,403 ---- *************** *** 416,433 **** )$ - - stack_matrix_size(m) := block( - mLength : length(m), - if(mLength > 0) then mWidth : length(m[1]) - else mWidth : 0, - - ret : [mLength, mWidth], - return(ret))$ - - if is(MAXIMA_VERSION_NUM <= 5.11) then block( - matrix_size(x) := stack_matrix_size(x) - ); /* MAXMA >= 5.12 includes matrix_size function. JPH 10-12-07 */ - - decimalplaces(x,n) := block([simp:true,fpprintprec],fpprintprec:n,float(round(10^n*float(x))/(10^n)))$ --- 422,425 ---- *************** *** 486,490 **** ); ! /* commonfac(l) returns the hcf of a list of numbers */ commonfaclist(l) := block([i,a,ret], if listp(l) then --- 478,482 ---- ); ! /* commonfac(l) returns the gcd of a list of numbers */ commonfaclist(l) := block([i,a,ret], if listp(l) then *************** *** 516,529 **** )$ - /* Old code 25/9/9 - ex1:part(ex,1), - ex2:part(ex,2), - ex1:ev(setify(factorlist(ex1)),simp), - ex2:ev(setify(factorlist(ex2)),simp), - ex3:intersect(ex1,ex2), - if ex3={} then return(true), - return(false) - */ - /* Create a list with all parts for which numberp(ex)=true */ list_expression_numbers(ex) := block([ex2], --- 508,511 ---- *************** *** 590,593 **** --- 572,592 ---- )$ + /* ********************************** */ + /* Parts of expressions */ + /* ********************************** */ + + /* op(ex) is unsafe on atoms: this is a fix. */ + /* This function always returns a string */ + stack_op(ex) := block( + if atom(ex) then return(""), + if op(ex)#"-" then + if stringp(op(ex)) then return(op(ex)) else return(string(op(ex))) + else + if atom(first(ex)) then + return("") + else + if stringp(op(first(ex))) then return(op((first(ex)))) else return(string(op(ex))) + )$ + /* This function takes an expression ex and returns a list of coefficients of v */ coeff_list(ex,v):= block([deg,kloop,cl], *************** *** 629,645 **** )$ - /* Reduces an inequality to either ? > 0 or ? >=0 */ - ineqreduce(ex) := block([op2,ex2], - if atom(ex) then return(ex), - if op(ex)="=" then return(ev(part(ex,1) - part(ex,2),simp,trigreduce) = 0), - if op(ex)=">" then return(ev(part(ex,1) - part(ex,2),simp,trigreduce) > 0), - if op(ex)=">=" then return(ev(part(ex,1) - part(ex,2),simp,trigreduce) >= 0), - if op(ex)="<" then return(ev(part(ex,2) - part(ex,1),simp,trigreduce) > 0), - if op(ex)="<=" then return(ev(part(ex,2) - part(ex,1),simp,trigreduce) >= 0), - ex2:args(ex), - ex2:map(ineqreduce,ex2), - return(apply(op(ex),ex2)) - )$ - expressionp(ex) := block( if matrixp(ex) or listp(ex) or equationp(ex) or inequalityp(ex) or setp(ex) then --- 628,631 ---- *************** *** 769,773 **** /* Otherwise we have two expressions*/ if Stack_Test(SA,SB) then ! RawMark:1, ret:[true,RawMark,AnswerNote,FeedBack], return(ret) --- 755,761 ---- /* Otherwise we have two expressions*/ if Stack_Test(SA,SB) then ! RawMark:1 ! else if Stack_Test(exdowncase(SA),exdowncase(SB)) then ! AnswerNote:"ATAlgEquiv WrongCase ", ret:[true,RawMark,AnswerNote,FeedBack], return(ret) *************** *** 777,781 **** ATList(SA,SB):= block([AddFeedBack,SAN,SAl,SBl,ret,retnew,k], ! /* Get sizes of matrices */ SAN : SA, SAl : length(SA), --- 765,769 ---- ATList(SA,SB):= block([AddFeedBack,SAN,SAl,SBl,ret,retnew,k], ! /* Get sizes of lists */ SAN : SA, SAl : length(SA), *************** *** 787,791 **** ret:[true,1,"",""], AddFeedBack:false, ! for k:1 thru SAl do block( retnew:ATAlgEquivfun(SA[k],SB[k]), ret[1]:ret[1] and retnew[1], --- 775,779 ---- ret:[true,1,"",""], AddFeedBack:false, ! for k:1 thru SAl do block([retnew], retnew:ATAlgEquivfun(SA[k],SB[k]), ret[1]:ret[1] and retnew[1], *************** *** 805,816 **** )$ /* Two equations are the "same" when they have identical roots with identical multiplicities */ ATEquation(SA,SB):= block([RawMark,SA1,SB1,SB2], RawMark:0, ! SA1:fullratsimp(trigexpand(rhs(SA)-lhs(SA))), ! SB1:fullratsimp(trigexpand(rhs(SB)-lhs(SB))), ! SA1:SA1*denom(SA1), ! SB1:SB1*denom(SB1), if SA1#0 then /* We need a slight hack to turn %i+1 into a number */ --- 793,842 ---- )$ + /* Equations */ + stack_eqnprepare(ex):=block([ret], + ret:fullratsimp(trigexpand(rhs(ex)-lhs(ex))), + ret:ret*denom(ret), + return(expand(ret)) + )$ + + stack_eqncompare(SA,SB,sl):=block([ret,G0,G1], + G0 :poly_buchberger(SA,sl), + G1 :poly_buchberger(SB,sl), + ret:poly_grobner_equal(G0,G1,sl), + return(ret) + )$ + + stack_assignmentp(ex):=block( + if atom(ex) then return(false) + else if op(ex)#"=" then return(false) + else if atom(lhs(ex)) and not(real_numberp(lhs(ex))) and real_numberp(rhs(ex)) then return(true) + else return(false) + )$ + + stack_assignmentrev(ex):=block( + if atom(ex) then return(ex) + else if op(ex)#"=" then return(ex) + else if real_numberp(lhs(ex)) and not(real_numberp(rhs(ex))) then return(rhs(ex)=lhs(ex)) + else return(ex) + )$ + + /* Take a list of equations, and re-evaluate it in the context of any assignments of the form d=10 + This is needed in practice with systems of equations, as students may write [d=10, d=v*t] */ + stack_eval_assignments(ex):= block([asl,sl], + if not(listp(ex)) then return(ex), + sl:maplist(stack_assignmentrev,ex), + asl:filter(stack_assignmentp,sl), + if not(emptyp(asl)) then + (sl:listify(setdifference(setify(sl),setify(asl))), + sl:ev(sl,asl)), + return(sl) + )$ + /* Two equations are the "same" when they have identical roots with identical multiplicities */ ATEquation(SA,SB):= block([RawMark,SA1,SB1,SB2], RawMark:0, ! SA1:stack_eqnprepare(SA), ! SB1:stack_eqnprepare(SB), if SA1#0 then /* We need a slight hack to turn %i+1 into a number */ *************** *** 821,829 **** )$ ATInequality(SA,SB):= block([RawMark,FeedBack,AnswerNote,SA1,SB1,samex], RawMark:0, FeedBack:"", AnswerNote:"", ! SA:ineqreduce(SA), ! SB:ineqreduce(SB), SA1:ev(part(SA,1),simp), SB1:ev(part(SB,1),simp), --- 847,869 ---- )$ + /* Reduces an inequality to either ? > 0 or ? >=0 */ + stack_ineqprepare(ex) := block([op2,ex2], + if atom(ex) then return(ex), + if op(ex)="=" then return(ev(part(ex,1) - part(ex,2),simp,trigreduce) = 0), + if op(ex)=">" then return(ev(part(ex,1) - part(ex,2),simp,trigreduce) > 0), + if op(ex)=">=" then return(ev(part(ex,1) - part(ex,2),simp,trigreduce) >= 0), + if op(ex)="<" then return(ev(part(ex,2) - part(ex,1),simp,trigreduce) > 0), + if op(ex)="<=" then return(ev(part(ex,2) - part(ex,1),simp,trigreduce) >= 0), + ex2:args(ex), + ex2:map(stack_ineqprepare,ex2), + return(apply(op(ex),ex2)) + )$ + + ATInequality(SA,SB):= block([RawMark,FeedBack,AnswerNote,SA1,SB1,samex], RawMark:0, FeedBack:"", AnswerNote:"", ! SA:stack_ineqprepare(SA), ! SB:stack_ineqprepare(SB), SA1:ev(part(SA,1),simp), SB1:ev(part(SB,1),simp), *************** *** 884,889 **** FeedBack:"", /* Check they are equal */ ! SA:map(ineqreduce,map(trigreduce,SA)), ! SB:map(ineqreduce,map(trigreduce,SB)), if (subsetp(SA,SB) and subsetp(SB,SA)) then return([true,1,AnswerNote,FeedBack]), --- 924,929 ---- FeedBack:"", /* Check they are equal */ ! SA:map(stack_ineqprepare,map(trigreduce,SA)), ! SB:map(stack_ineqprepare,map(trigreduce,SB)), if (subsetp(SA,SB) and subsetp(SB,SA)) then return([true,1,AnswerNote,FeedBack]), *************** *** 1010,1045 **** )$ - /* Equations - Following added to work with ATSysEquiv answer test */ - stack_eqnprepare(ex):=block([ret], - ret:fullratsimp(trigexpand(rhs(ex)-lhs(ex))), - ret:ret*denom(ret), - return(expand(ret)) - )$ - - stack_assignmentp(ex):=block( - if atom(ex) then return(false) - else if op(ex)#"=" then return(false) - else if atom(lhs(ex)) and not(real_numberp(lhs(ex))) and real_numberp(rhs(ex)) then return(true) - else return(false) - )$ - - stack_assignmentrev(ex):=block( - if atom(ex) then return(ex) - else if op(ex)#"=" then return(ex) - else if real_numberp(lhs(ex)) and not(real_numberp(rhs(ex))) then return(rhs(ex)=lhs(ex)) - else return(ex) - )$ - - /* Take a list of equations, and re-evaluate it in the context of any assignments of the form d=10 - This is needed in practice with systems of equations, as students may write [d=10, d=v*t] */ - stack_eval_assignments(ex):= block([asl,sl], - if not(listp(ex)) then return(ex), - sl:maplist(stack_assignmentrev,ex), - asl:filter(stack_assignmentp,sl), - if not(emptyp(asl)) then - (sl:listify(setdifference(setify(sl),setify(asl))), - sl:ev(sl,asl)), - return(sl) - )$ /* This function makes a substitution of all variables for their lower case equivalents. --- 1050,1053 ---- *************** *** 1054,1058 **** return(subst(lv,ex)))$ - /**********************************************/ /* */ --- 1062,1065 ---- *************** *** 1114,1137 **** /* Are all list elements not atoms? */ ! if subsetp({true}, setify(maplist(atom, SA))) then return(StackReturnOb("0","ATSysEquiv_SA_not_eq_list",StackAddFeedback("","ATSysEquiv_SA_not_eq_list"))), ! if subsetp({true}, setify(maplist(atom, SB))) then return(StackReturnOb("0","ATSysEquiv_SB_not_eq_list",StackAddFeedback("","ATSysEquiv_SB_not_eq_list"))), /* Are all list elements equations? */ ! if is({"="}#setify(maplist(op,SA))) then return(StackReturnOb("0","ATSysEquiv_SA_not_eq_list",StackAddFeedback("","ATSysEquiv_SA_not_eq_list"))), ! if is({"="}#setify(maplist(op,SB))) then return(StackReturnOb("0","ATSysEquiv_SB_not_eq_list",StackAddFeedback("","ATSysEquiv_SB_not_eq_list"))), /* Turn our equations into expressions */ ! S1: maplist(stack_eqnprepare,stack_eval_assignments(exdowncase(SA))), ! S2: maplist(stack_eqnprepare,stack_eval_assignments(exdowncase(SB))), kill(SB), /* Is each expression a polynomial? */ ! if subsetp({false}, setify(maplist(polynomialpsimp, S1))) then return(StackReturnOb("0","ATSysEquiv_SA_not_poly_eq_list",StackAddFeedback("","ATSysEquiv_SA_not_poly_eq_list"))), ! if subsetp({false}, setify(maplist(polynomialpsimp, S2))) then return(StackReturnOb("0","ATSysEquiv_SB_not_poly_eq_list",StackAddFeedback("","ATSysEquiv_SB_not_poly_eq_list"))), --- 1121,1144 ---- /* Are all list elements not atoms? */ ! if ev(all_listp(atom,SA),simp) then return(StackReturnOb("0","ATSysEquiv_SA_not_eq_list",StackAddFeedback("","ATSysEquiv_SA_not_eq_list"))), ! if ev(all_listp(atom,SB),simp) then return(StackReturnOb("0","ATSysEquiv_SB_not_eq_list",StackAddFeedback("","ATSysEquiv_SB_not_eq_list"))), /* Are all list elements equations? */ ! if ev(not all_listp(equationp,SA),simp) then return(StackReturnOb("0","ATSysEquiv_SA_not_eq_list",StackAddFeedback("","ATSysEquiv_SA_not_eq_list"))), ! if ev(not all_listp(equationp,SB),simp) then return(StackReturnOb("0","ATSysEquiv_SB_not_eq_list",StackAddFeedback("","ATSysEquiv_SB_not_eq_list"))), /* Turn our equations into expressions */ ! S1: ev(maplist(stack_eqnprepare,stack_eval_assignments(exdowncase(SA))),simp), ! S2: ev(maplist(stack_eqnprepare,stack_eval_assignments(exdowncase(SB))),simp), kill(SB), /* Is each expression a polynomial? */ ! if not all_listp(polynomialpsimp, S1) then return(StackReturnOb("0","ATSysEquiv_SA_not_poly_eq_list",StackAddFeedback("","ATSysEquiv_SA_not_poly_eq_list"))), ! if not all_listp(polynomialpsimp, S2) then return(StackReturnOb("0","ATSysEquiv_SB_not_poly_eq_list",StackAddFeedback("","ATSysEquiv_SB_not_poly_eq_list"))), *************** *** 1147,1152 **** return(ATSysEquivVars(S1,S2)), ! GA :poly_buchberger(S1,varlist), ! GB :poly_buchberger(S2,varlist), kill(S1,S2), --- 1154,1159 ---- return(ATSysEquivVars(S1,S2)), ! GA :ev(poly_buchberger(S1,varlist),simp), ! GB :ev(poly_buchberger(S2,varlist),simp), kill(S1,S2), *************** *** 1209,1216 **** for k:1 thru length(S1) do block([], ! if poly_grobner_member(stack_eqnprepare(stack_eval_assignments(exdowncase(S1[k]))), GB, varlist) then ! ret:append(ret,[S1[k]]) else ! ret:append(ret,[texcolor("red", S1[k])])), return(StackReturnOb("0","ATSysEquiv_SA_system_overdetermined",StackAddFeedback("","ATSysEquiv_SA_system_overdetermined", StackDISP(ret, "\$\$")))) --- 1216,1223 ---- for k:1 thru length(S1) do block([], ! if ev(poly_grobner_member(stack_eqnprepare(stack_eval_assignments(exdowncase(S1[k]))), GB, varlist),simp) then ! ret:append(ret,[S1[ev(k,simp)]]) else ! ret:append(ret,[texcolor("red", S1[ev(k,simp)])])), return(StackReturnOb("0","ATSysEquiv_SA_system_overdetermined",StackAddFeedback("","ATSysEquiv_SA_system_overdetermined", StackDISP(ret, "\$\$")))) *************** *** 1219,1276 **** - /******************************************************************/ - - /* This takes an expression of the student and a list of expressions from the teacher. - The purpose of this test is to allow many comparisons with a single call to the CAS. - The results are returned in the AnswerNote as a list of lists, one list for each test - - 0 = false - 1 = true - -1 = test not applied (eg SameType=false, means no point in looking for algebraic equivalence) - - Three tests applied. - (1) SameType - (2) AlgEquiv - (3) Equal_com_ass - Validity, errors and feedback are not used in the main test. The "raw mark" is always 0. - */ - ATMultiEquiv(SA,SBl) :=block([ret,k,SAe,SB,SBe,SBlen,SBSameType,SBALgEquiv,SBEqualComAss,AnswerNote], - /* Error catch */ - if listp(SBl)=false then return(StackReturnOb("0","Teacher's answer not list","")), - SAe:errcatch(ev(SA,simp,fullratsimp,nouns)), - if is(SAe=[STACKERROR]) then return(StackReturnOb(0,"ATMultiEquiv_STACKERROR_SAns","")), - SBe:errcatch(ev(SBl,simp,fullratsimp,nouns)), - if is(SBe=[STACKERROR]) then return(StackReturnOb(0,"ATMultiEquiv_STACKERROR_TAns","")), - /* Set up return arrays */ - SBlen:length(SBl), - SBSameType:makelist(0,i,1,SBlen), - SBALgEquiv:makelist(0,i,1,SBlen), - SBEqualComAss:makelist(0,i,1,SBlen), - /* Loop over SBl */ - for k:1 thru SBlen step 1 do block( - k:ev(k,simp), - SB:SBl[k], - /* Are the expressions the same type? */ - ret:ATSameTypefun(SA,SB), - SBSameType[k]:ret[2], - if ret[2]=0 then - (SBALgEquiv[k]:-1,SBEqualComAss[k]:-1) - else block( - /* Check for Algebraic Equivalence */ - ret:block([simp:true,ret],ATAlgEquivfun(SA,SB)), - SBALgEquiv[k]:ret[2], - if ret[2]=0 then - (SBEqualComAss[k]:-1) - else block( - SBEqualComAss[k]:if equals_commute_associate(SA,SB) then 1 else 0 - ) - ) /* End of if AlgEquiv */ - ), /* End of loop over SBL */ - /* Send back results */ - AnswerNote:[SBSameType,SBALgEquiv,SBEqualComAss], - return(StackReturnOb("0",string(AnswerNote),"")) - )$ - - /*****************************************************************/ --- 1226,1229 ---- *************** *** 1619,1657 **** )$ - /*********************************************************/ - /* Test added by Chris Sangwin, 21/2/8. */ - /* Extends notion of "partial fractions" to equations */ - /* Needed for ECP's trials of the ODE code */ - /*********************************************************/ - - PartFracEq(SA,TA,var) := block([ret], - ret:ATAlgEquivfun(SA,SB), - if ret[2]=1 then block( - if equationp(TA) then - block ([ret1,ret2], - ret1:PartFracfun(lhs(SA),lhs(TA),var), - ret2:PartFracfun(rhs(SA),rhs(TA),var), - if ret1[2]=1 then - (if rhs(SA)=rhs(TA) then - true - else if ret2[2]=1 then - true - else - false - ) - else if ret2[2]=1 then - (if lhs(SA)=lhs(TA) then - true - else - false - ) - ) else - block ([ret:PartFracfun(SA,TA,var)], - ret[2] - ) - ) else - false - )$ - /* ************************ATSingFracTest****************************** */ /* requires: Student Answer */ --- 1572,1575 ---- *************** *** 1936,1939 **** --- 1854,1865 ---- )$ + /* This function strips off any trailing constant of integration from an expression, which is not a number */ + strip_int_const(ex,v):=block([ex2], + ex2:ex, + if not(atom(ex)) then + if op(ex)="+" then + ex2:apply("+",filter(lambda([ex2],not(freeof(v,ex2)) or simp_numberp(ex2)),args(ex))), + return(ex2))$ + /* An answer test for integration questions.*/ /* sa is the students' ansewer, sbl is a list consisting of (1) the answer, and (2) the variable */ *************** *** 1976,1983 **** val:true, rawmk:0, fb:"", ansnote:"", ret:[val,rawmk,ansnote,fb], ! SB:ev(SB,logexpand:super), /* This expands out logarithms for constants eg ln(k*|x|) */ ! if freeof(v,coeff(SB,v,0)) then SB:SB-coeff(SB,v,0), /* This strips off any trailing constant of integration from the teacher's answer */ ! SAa:ev(SA,logexpand:super)-coeff(ev(SA,logexpand:super),v,0), /* This strips off any trailing constant of integration */ ! /* check for constant of integration - code copied from Stack_Test */ ex:errcatch(ev(fullratsimp(SA-SB),simp,trigexpand:true,logexpand:super,keepfloat:true)), if ex=[] then return(false), --- 1902,1912 ---- val:true, rawmk:0, fb:"", ansnote:"", ret:[val,rawmk,ansnote,fb], ! /* This expands out logarithms for constants, e.g. ln(k*|x|) */ ! SB:ev(SB,logexpand:super), ! /* This strips off any trailing constant of integration from the teacher's answer */ ! SB:strip_int_const(SB,v), ! /* This strips off any trailing constant of integration from the student's answer */ ! SAa:strip_int_const(ev(SA,logexpand:super),v), ! /* Check for constant of integration - code copied from Stack_Test */ ex:errcatch(ev(fullratsimp(SA-SB),simp,trigexpand:true,logexpand:super,keepfloat:true)), if ex=[] then return(false), *************** *** 2109,2296 **** )$ - ATEquationfun(SA,SB,var,AT) := block([ret,ret0,ret1,ret2,lLHSv,lRHSv,mLHSv,mRHSv], - ret:ATEqnRet(SA,SB,var,"AE"), - ret0:ret, - - /* if is("I"=AT) then ( - lLHSv:append(listofvars(lhs(SA)),listofvars(lhs(SB))), - lRHSv:append(listofvars(rhs(SA)),listofvars(rhs(SB))), - mLHSv:member(var,lLHSv), - mRHSv:member(var,lRHSv) - ),*/ - - /* print("ATEqnRet for AE of SA with SB ",ret),*/ - if (is(ret[1]=true) and not(is("AE"=AT)))then block( - if (equationp(SB) and equationp(SA)) then block ([ret1,ret2], - ret1:ATEqnRet(lhs(SA),lhs(SB),var,AT), - /* print("ATEqnRet for AT LHSs of SA with SB ",ret1),*/ - ret2:ATEqnRet(rhs(SA),rhs(SB),var,AT), - /* print("ATEqnRet for AT RHSs of SA with SB ",ret2),*/ - if (ret1[3]=concat("ATE_unknowntest_",AT) or ret2[3]=concat("ATE_unknowntest_",AT)) then - ret:[false,0,ret1[3],""] - else ( - if (is(ret1[1]=false)) then /* Checks for validity of L and RHSs before continuing */ - if (is(ret2[1]=false)) then - ret:[false,0,concat(AT,"E_LF_RF"),""] - else - ret:[false,0,concat(AT,"E_LF_RV"),""] - else - if (is(ret2[1]=false)) then - ret:[false,0,concat(AT,"E_LV_RF"),""] - else block( - /* print("In [1]<>false else loop"),*/ - if (is(ret1[2]=1) and is(ret2[2]=1) and not(is(rhs(SA)=rhs(SB))) and not(is(lhs(SA)=lhs(SB)))) then - ret:[true,1,concat(AT,"E_L",AT,"_R",AT),""] /* e.g. PFE_LPF_RPF or IE_LI_RI */ - else - if (is(ret1[2]=0) and is(ret2[2]=0)) then block( - ret[2]:0, - ret[3]:concat(concat(AT,"E_N",AT)," ",ret1[3]," ",ret2[3]), /* the inner concat is probably unnecessary but is there for clarity, for now */ - ret[4]:concat(ret1[4],ret2[4]), - return(ret) - ) - else - if is(rhs(SA)=rhs(SB)) then block( - /* print("RHSs equal"),*/ - if is(lhs(SA)=lhs(SB)) then - if is(ret1[2]=1) then - if is(ret2[2]=1) then - ret[3]:concat(AT,"E_LU_RU") - else - (ret[3]:concat(concat(AT,"E_LU_RU")," ",ret2[3]),ret[2]:0) - else - if is(ret2[2]=1) then - (ret[3]:concat(concat(AT,"E_LU_RU")," ",ret1[3]),ret[2]:0) - else /* ret1[2]=0=ret2[2] */ - (ret[3]:concat(concat(AT,"E_LU_RU")," ",ret1[3]," ",ret2[3]),ret[2]:0) - else /* RHS equal, LHSs not equal */ - if is(ret1[2]=1) then - if is(ret2[2]=1) then - (ret[3]:concat(AT,"E_L",AT,"_RU"),ret[2]:1) - else - if (is(AT="I")) then - if (is(ret1[3]="ATInt_const") and is(ret2[3]="ATInt_const")) then - (ret[3]:concat(concat(AT,"E_L",AT,"_RU")," ",ret1[3]," ",ret2[3]),ret[2]:0) - else if (is(ret1[3]="ATInt_const") or is(ret2[3]="ATInt_const")) then - (ret[3]:concat(concat(AT,"E_L",AT,"_RU")," ",ret1[3]," ",ret2[3]),ret[2]:1) - else - (ret[3]:concat(concat(AT,"E_L",AT,"_RU")," ",ret1[3]," ",ret2[3]),ret[2]:0) - else - (ret[3]:concat(concat(AT,"E_L",AT,"_RU")," ",ret2[3]),ret[2]:0) - else - if is(ret2[2]=1) then - if (is(AT="I")) then - if (is(ret1[3]="ATInt_const") and is(ret2[3]="ATInt_const")) then - (ret[3]:concat(concat(AT,"E_L",AT,"_RU")," ",ret1[3]," ",ret2[3]),ret[2]:0) - else if (is(ret1[3]="ATInt_const") or is(ret2[3]="ATInt_const")) then - (ret[3]:concat(concat(AT,"E_L",AT,"_RU")," ",ret1[3]," ",ret2[3]),ret[2]:1) - else - (ret[3]:concat(concat(AT,"E_L",AT,"_RU")," ",ret1[3]," ",ret2[3]),ret[2]:0) - else - (ret[3]:concat(concat(AT,"E_L",AT,"_RU")," ",ret1[3]),ret[2]:0) - else - (ret[3]:concat(concat(AT,"E_L",AT,"_RU")," ",ret1[3]," ",ret2[3]),ret[2]:0), - /* if is(ret1[2]=1) then - ret[3]:concat(AT,"E_L",AT,"_RU") - else - (ret[3]:concat(concat(AT,"E_LN",AT,"_RU")," ",ret1[3]),ret[2]:0), */ - return(ret) - ) /* RHSs not equal */ - else - if is(lhs(SA)=lhs(SB)) then block( - if is(ret1[2]=1) then - if is(ret2[2]=1) then - (ret[3]:concat(AT,"E_LU_R",AT),ret[2]:1) - else - if (is(AT="I")) then - if (is(ret1[3]="ATInt_const") and is(ret2[3]="ATInt_const")) then - (ret[3]:concat(concat(AT,"E_LU_RN",AT)," ",ret1[3]," ",ret2[3]),ret[2]:0) - else if (is(ret1[3]="ATInt_const") or is(ret2[3]="ATInt_const")) then - (ret[3]:concat(concat(AT,"E_LU_RN",AT)," ",ret1[3]," ",ret2[3]),ret[2]:1) - else - (ret[3]:concat(concat(AT,"E_LU_RN",AT)," ",ret1[3]," ",ret2[3]),ret[2]:0) - else - (ret[3]:concat(concat(AT,"E_LU_RN",AT)," ",ret2[3]),ret[2]:0) - else /* ret1[2]=0 */ - if is(ret2[2]=1) then - if (is(AT="I")) then - if (is(ret1[3]="ATInt_const") and is(ret2[3]="ATInt_const")) then - (ret[3]:concat(concat(AT,"E_LU_R",AT)," ",ret1[3]," ",ret2[3]),ret[2]:0) - else if (is(ret1[3]="ATInt_const") or is(ret2[3]="ATInt_const")) then - (ret[3]:concat(concat(AT,"E_LU_R",AT)," ",ret1[3]," ",ret2[3]),ret[2]:1) - else - (ret[3]:concat(concat(AT,"E_LU_R",AT)," ",ret1[3]," ",ret2[3]),ret[2]:0) - else - (ret[3]:concat(concat(AT,"E_LU_R",AT)," ",ret1[3]),ret[2]:0) - else - if (is(AT="I")) then - if (is(ret1[3]="ATInt_const") and is(ret2[3]="ATInt_const")) then - (ret[3]:concat(concat(AT,"E_LU_RN",AT)," ",ret1[3]," ",ret2[3]),ret[2]:0) - else if (is(ret1[3]="ATInt_const") or is(ret2[3]="ATInt_const")) then - (ret[3]:concat(concat(AT,"E_LU_RN",AT)," ",ret1[3]," ",ret2[3]),ret[2]:1) - else - (ret[3]:concat(concat(AT,"E_LU_RN",AT)," ",ret1[3]," ",ret2[3]),ret[2]:0) - else - (ret[3]:concat(concat(AT,"E_LU_RN",AT)," ",ret1[3]),ret[2]:0), - return(ret) - ) - else - if is(ret1[2]=1) then - if (is(AT="I")) then - if (is(ret1[3]="ATInt_const") and is(ret2[3]="ATInt_const")) then - (ret[3]:concat(concat(AT,"E_L",AT,"_RN")," ",ret1[3]," ",ret2[3]),ret[2]:0) - else if (is(ret1[3]="ATInt_const") or is(ret2[3]="ATInt_const")) then - (ret[3]:concat(concat(AT,"E_L",AT,"_RN")," ",ret1[3]," ",ret2[3]),ret[2]:1) - else - (ret[3]:concat(concat(AT,"E_L",AT,"_RN")," ",ret1[3]," ",ret2[3]),ret[2]:0) - else - (ret[3]:concat(concat(AT,"E_L",AT,"_RN")," ",ret2[3]),ret[2]:0) - else block( - ret[3]:concat(concat(AT,"E_LN_R",AT)," ",ret1[3]), - ret[2]:0, - return(ret) - ) - ) - ) - ) - else block( - ret:ATEqnRet(SA,SB,var,AT), - if is(ret[2]=0) then - ret[3]:concat(concat(AT,"E_not_eqns")," ",ret[3]) - else - ret[3]:concat(AT,"E_not_eqns") - ) - ) - else ( - if not(is("AE"=AT)) then - if equationp(SA) then - ret:[false,0,concat(AT,"E_SAE_SBN"),"ATAlgEquiv_SA_not_equation"] - else - if equationp(SB) then - ret:[false,0,concat(AT,"E_SBE_SAN"),"ATAlgEquiv_TA_not_equation"] - else - ret:[false,0,concat(AT,"E_NAE_other"),""] - ), - return(ret) - )$ - - ATEqnRet(cl,ll,opt,test) := block([rt], - if is(test="I") then - rt:Intfun(cl,ll,opt) - else if is(test="D") then - rt:Difffun(cl,ll,opt) - else if is(test="PF") then - if (atom(cl) or atom(ll)) then - rt:ATAlgEquivfun(cl,ll) - else - rt:PartFracfun(cl,ll,opt) - else if is(test="FF") then - rt:FacFormfun(cl,ll,opt) - else if is(test="AE") then - rt:ATAlgEquivfun(cl,ll) - else /* Something invalid passed */ - rt:[false,0,concat("ATE_unknowntest_",test),""], /* val,rawmk,ansnote,fb */ - return(rt) - )$ - /* Description : forme echelonne par lignes d'une matrice rectangulaire --- 2038,2041 ---- |
