From: Chris S. <san...@us...> - 2010-12-06 19:18:34
|
Update of /cvsroot/stack/stack-dev/maxima In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv5140/maxima Modified Files: assessment.mac rtest_assessment_simpboth.mac Removed Files: noun_arith.mac unittests.mac Log Message: --- noun_arith.mac DELETED --- Index: assessment.mac =================================================================== RCS file: /cvsroot/stack/stack-dev/maxima/assessment.mac,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** assessment.mac 6 Dec 2010 16:03:38 -0000 1.2 --- assessment.mac 6 Dec 2010 19:18:25 -0000 1.3 *************** *** 24,34 **** /* ********************************** */ - /* Load assessment files */ - /* ********************************** */ - - load("noun_arith.mac")$ - - - /* ********************************** */ /* General list and utility functions */ /* ********************************** */ --- 24,27 ---- *************** *** 312,315 **** --- 305,432 ---- )$ + /* ********************************** */ + /* Noun arithmatic */ + /* ********************************** */ + + /* ** Noun forms of the arithmatic functions ** */ + + /* These function define arithmetic functions which do + not perform their actual mathematical functions. That is to say + noun forms of the standard arithmetic functions. This is to + give much finer control over the simplification of very elementary + expressions. + + Chris Sangwin 21 Oct 2005. + Chris Sangwin 7 Nov 2009, with help from JHD. + */ + + /* Create noun forms of the functions of +, -, *, / and ^ + as follows. + + noun+ + - noun- + * noun* + / noun/ + ^ noun^ + */ + + /* For each of these we do the following. + (1) They are defined as infix and nary operators in Maxima + with the binding precedences of their namesakes. + (2) The tex() function is modified to display them exactly as + their namesakes. This should work with a *mix* of noun and + active operators + (3) verb_arith(expr) which will replace noun versions with their + active counterparts. + (4) noun_arith(expr) which will replace arithmetic operators with their + noun counterparts. + */ + + /* (1) */ + nary("noun+",100); + prefix("noun-",100); + nary("noun*",120); + infix("noun/",122,123); + infix("noun^",140,139); + prefix("UNARY_RECIP",100); + + /* (2) */ + load("noun_arith.lisp"); + + /* (3) */ + + declare("noun+",commutative); + declare("noun+",lassociative); + declare("noun+",rassociative); + + declare("noun*",commutative); + declare("noun*",lassociative); + declare("noun*",rassociative); + + /* (4) */ + verb_arith(ex) := block( + ex:subst("+","noun+",ex), + ex:subst("*","noun*",ex), + ex:subst("-","noun-",ex), + ex:subst(DIV_OP,"noun/",ex), + ex:subst("^","noun^",ex), + define(UNARY_RECIP a, a^(-1)), + ex:ev(ex,UNARY_MINUS=-1), + remfunction("noun+","noun*","noun/","noun^","noun-"),ex)$ + + /* (5) */ + noun_arith(ex) := block( + ex:subst("noun+","+",ex), + ex:subst("noun*","*",ex), + ex:subst(lambda([ex],UNARY_MINUS noun* ex),"-",ex), /* Unary minus really communtes with multipication*/ + ex:subst(lambda([ex1,ex2], ex1 noun* (UNARY_RECIP ex2)),DIV_OP,ex), /* Turn 1/x into x^(-1), in a special form */ + ex:subst("noun^","^",ex), + ev(ex))$ + + /* (6) */ + gather_reduce(ex) := block( + ex:subst("+","noun+",ex), + ex:subst("*","noun*",ex), + ex:subst("-","noun-",ex), + ex:ev(ex,simp), + ex:subst("noun+","+",ex), + ex:subst("noun*","*",ex), + ex:subst("noun-","-",ex), + ex)$ + + /* (7) */ + /* Returns true iff ex1 and ex2 are equal up to commutativity and associativity */ + equals_commute_associate(ex1,ex2) := block([oldsimp,ex1n,ex2n,ret], + oldsimp:simp, + simp:false, + ex1n:noun_arith(ex1), + ex2n:noun_arith(ex2), + simp:true, + if ex1n=ex2n then ret:true else ret:false, + simp:oldsimp, + ret)$ + + /* An answer test in the context of commutative+associative addition and multiplication.*/ + ATEqual_com_ass(sa,sb) := + block([RawMark,FeedBack,AnswerNote,ret,SAA,SBB], + RawMark:0, FeedBack:"", AnswerNote:"", + SAA:errcatch(ev(sa,simp,fullratsimp,nouns)), + if (is(SAA=[STACKERROR]) or is(SAA=[])) then return(StackReturnOb("0","ATEqual_com_ass_STACKERROR_SAns","")), + SBB:errcatch(ev(sb,simp,fullratsimp,nouns)), + if (is(SBB=[STACKERROR]) or is(SBB=[])) then return(StackReturnOb("0","ATEqual_com_ass_STACKERROR_TAns","")), + /* We need to check things are of the same type */ + ret:ATSameTypefun(sa,sb), + if ret[2]=0 then + (ret[3]:concat("ATEqual_com_ass:",ret[3]), return(StackReturnOb(string(ret[2]),ret[3],ret[4])) ), + ret:block([simp:true,ret],ATAlgEquivfun(sa,sb)), + if ret[2]=0 then + (ret[3]:concat("ATEqual_com_ass: (not AlgEquiv) ",ret[3]), return(StackReturnOb(string(ret[2]),ret[3],"")) ), + /* Now actually apply this test */ + if equals_commute_associate(sa,sb) then + (RawMark:1, AnswerNote:"") + else + (RawMark:0, AnswerNote:"AlgEquiv, but not equal"), + return(StackReturnOb(string(RawMark),AnswerNote,FeedBack)) + )$ + /* ********************************** */ Index: rtest_assessment_simpboth.mac =================================================================== RCS file: /cvsroot/stack/stack-dev/maxima/rtest_assessment_simpboth.mac,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** rtest_assessment_simpboth.mac 1 Dec 2010 18:32:25 -0000 1.2 --- rtest_assessment_simpboth.mac 6 Dec 2010 19:18:25 -0000 1.3 *************** *** 208,238 **** false$ ! stack_op(1); ""$ ! stack_op(x); ""$ ! stack_op(%pi); ""$ ! stack_op(z+3); "+"$ ! stack_op(3*z); "*"$ ! stack_op(3^z); "^"$ ! stack_op(3/z); "/"$ ! stack_op(sin(3*z)); "sin"$ ! stack_op((-1)/(1+x^2)); "/"$ ! stack_op(1-x); "+"$ ! stack_op(x-1); "+"$ ! stack_op(-(x-1)); "+"$ ! stack_op(-1/(1+x^2)); "/"$ ! stack_op(-2*x); "*"$ --- 208,238 ---- false$ ! safe_op(1); ""$ ! safe_op(x); ""$ ! safe_op(%pi); ""$ ! safe_op(z+3); "+"$ ! safe_op(3*z); "*"$ ! safe_op(3^z); "^"$ ! safe_op(3/z); "/"$ ! safe_op(sin(3*z)); "sin"$ ! safe_op((-1)/(1+x^2)); "/"$ ! safe_op(1-x); "+"$ ! safe_op(x-1); "+"$ ! safe_op(-(x-1)); "+"$ ! safe_op(-1/(1+x^2)); "/"$ ! safe_op(-2*x); "*"$ --- unittests.mac DELETED --- |