Menu
▾
▴
[Stack-cvs] stack-dev/maxima stackmaxima.mac,1.84,1.84.2.1
|
From: Matthew B. <ba...@us...> - 2010-11-09 13:39:48
|
Update of /cvsroot/stack/stack-dev/maxima In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv15447/maxima Modified Files: Tag: grobner stackmaxima.mac Log Message: Code for the SysEquiv answer test. Index: stackmaxima.mac =================================================================== RCS file: /cvsroot/stack/stack-dev/maxima/stackmaxima.mac,v retrieving revision 1.84 retrieving revision 1.84.2.1 diff -C2 -d -r1.84 -r1.84.2.1 *** stackmaxima.mac 1 Nov 2010 14:34:29 -0000 1.84 --- stackmaxima.mac 9 Nov 2010 13:39:39 -0000 1.84.2.1 *************** *** 51,55 **** --- 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 */ *************** *** 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 */ /* ********************************** */ --- 62,65 ---- *************** *** 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 --- 260,263 ---- *************** *** 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) )$ --- 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) )$ *************** *** 400,403 **** --- 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( *************** *** 422,425 **** --- 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)))$ *************** *** 478,482 **** ); ! /* commonfac(l) returns the gcd of a list of numbers */ commonfaclist(l) := block([i,a,ret], if listp(l) then --- 486,490 ---- ); ! /* commonfac(l) returns the hcf of a list of numbers */ commonfaclist(l) := block([i,a,ret], if listp(l) then *************** *** 508,511 **** --- 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], *************** *** 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], --- 590,593 ---- *************** *** 628,631 **** --- 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 *************** *** 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) --- 769,773 ---- /* Otherwise we have two expressions*/ if Stack_Test(SA,SB) then ! RawMark:1, ret:[true,RawMark,AnswerNote,FeedBack], return(ret) *************** *** 765,769 **** ATList(SA,SB):= block([AddFeedBack,SAN,SAl,SBl,ret,retnew,k], ! /* Get sizes of lists */ SAN : SA, SAl : length(SA), --- 777,781 ---- ATList(SA,SB):= block([AddFeedBack,SAN,SAl,SBl,ret,retnew,k], ! /* Get sizes of matrices */ SAN : SA, SAl : length(SA), *************** *** 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], --- 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], *************** *** 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 */ --- 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 */ *************** *** 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), --- 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), *************** *** 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]), --- 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]), *************** *** 1050,1053 **** --- 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. *************** *** 1063,1066 **** --- 1055,1276 ---- + /**********************************************/ + /* */ + /* System Equivalence Test */ + /* */ + /* An addition to STACK using Grobner Bases */ + /* */ + /**********************************************/ + + + /* + + What these functions do: + + - Determine whether the student's and teacher's answers are systems of equations + - Convert the two systems of equations into two systems of expressions + - Determine whether both systems are systems of multivariate polynomials + - Compare the variables in student's and teacher's answers, if they're not the same tell the student + - Find their Buchberger polynomials of the two systems + - Use the Buchberger polynomials to compare the Grobner bases of the two systems + - If the Grobner bases are not equal, determine whether the student's is a subset of the teacher's + - If student's system has equations which should not be there, tell them which ones. + */ + + + + /* + Main function of the System Equivalence test + + Takes two inputs, checks whether they are + lists of polynomials and delegates everything + else to other functions. + + Process: + + - Is each answer a list? + - Is each list element not an atom? + - Is each list element an equation? + - Is each list element a polynomial? + */ + + /* Edited files: SysEquiv.php, AnsTestcontroller.php, lang/en/stack.php */ + + ATSysEquiv(SA,SB):=block([keepfloat,RawMark,FeedBack,AnswerNote,SAA,SAB,S1,S2,varlist,GA,GB,ret], + RawMark:0, FeedBack:"", AnswerNote:"", + keepfloat:true, /* See pg 23 */ + + /* Turn on simplification and error catch */ + SAA:errcatch(ev(SA,simp,fullratsimp,nouns)), + if (is(SAA=[STACKERROR]) or is(SAA=[])) then return(StackReturnOb("0","ATLowestTerms_STACKERROR_SAns","")), + SAB:errcatch(ev(SB,simp,fullratsimp,nouns)), + if (is(SAB=[STACKERROR]) or is(SAB=[])) then return(StackReturnOb("0","ATLowestTerms_STACKERROR_TAns","")), + + /* Are both answers lists? */ + if not listp(SA) then + return(StackReturnOb("0","ATSysEquiv_SA_not_list",StackAddFeedback("","ATSysEquiv_SA_not_list"))), + if not listp(SB) then + return(StackReturnOb("0","ATSysEquiv_SB_not_list",StackAddFeedback("","ATSysEquiv_SB_not_list"))), + + /* 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"))), + + /* + At this point have two lists of polynomials. We now check whether the + student's and teacher's polynomials have the same variables. If they do, + we find their Grobner bases and determine whether the systems of + equations have the same solutions + */ + + varlist: listofvars(S2), + if not is(listofvars(S1)=varlist) then + return(ATSysEquivVars(S1,S2)), + + GA :poly_buchberger(S1,varlist), + GB :poly_buchberger(S2,varlist), + kill(S1,S2), + + /* Determine whether our two lists of polynomials have the same Grobner Bases */ + if poly_grobner_equal(GA, GB, varlist) then + return(StackReturnOb("1","","")), + + /* + We now know the student's answer is in the correct form but there is + something wrong with it. From here we use the grobner package to + determine which, if any, of their equations is correct. + */ + + return(ATSysEquivGrob(GA, GB, SA, varlist)) + + + )$ + + + /* Checks that an expression is a polynomial */ + + polynomialpsimp(e):=block([], + return(polynomialp(e, listofvars(e))) + )$ + + + /* Takes two lists of expressions and compares the variables in each */ + + ATSysEquivVars(S1,S2):=block([XA,XB], + XA: setify(listofvars(S1)), + XB: setify(listofvars(S2)), + if subsetp(XA,XB) then + return(StackReturnOb("0","ATSysEquiv_SA_missing_variables",StackAddFeedback("","ATSysEquiv_SA_missing_variables"))), + if subsetp(XB,XA) then + return(StackReturnOb("0","ATSysEquiv_SA_extra_variables",StackAddFeedback("","ATSysEquiv_SA_extra_variables"))) + )$ + + /* + Grobner basis comparison + + This function takes two Grobner bases and a set of variables and determines + whether the student's system is underdetermined or overdetermined. It also + takes the student's original system so that if it is overdetermined it can + tell them which equations should not be there. + */ + + ATSysEquivGrob(GA,GB,S1,varlist):=block([retl,ret], + + /* Is the student's system underdetermined? */ + + if poly_grobner_subsetp(GA,GB,varlist) then + return(StackReturnOb("0","ATSysEquiv_SA_system_underdetermined",StackAddFeedback("","ATSysEquiv_SA_system_underdetermined"))), + + /* + Given that the student's system is neither underdetermined nor equal to + the teacher's, we need to find which equations do not belong in the system. + */ + + ret:[], + + 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, "\$\$")))) + + )$ + + + /******************************************************************/ + + /* 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),"")) + )$ + + /*****************************************************************/ *************** *** 1409,1412 **** --- 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 */ *************** *** 1691,1702 **** )$ - /* 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 */ --- 1936,1939 ---- *************** *** 1739,1749 **** 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), --- 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), *************** *** 1875,1878 **** --- 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 |
