Menu
▾
▴
[Maxima-commits] CVS: maxima/share/algebra/solver linsolve.mac,1.1,1.2 misc.mac,1.1,1.2 slvrtbox.mac,1.2,1.3 solver.mac,1.2,1.3
|
From: Andrej V. <an...@us...> - 2006-04-21 00:46:06
|
Update of /cvsroot/maxima/maxima/share/algebra/solver In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4014/share/algebra/solver Modified Files: linsolve.mac misc.mac slvrtbox.mac solver.mac Log Message: Updating Solver package to current maxima: - lot's of function downcasing - make it compatible with new set functions Examples in Solver1.pdf work as shown. Index: linsolve.mac =================================================================== RCS file: /cvsroot/maxima/maxima/share/algebra/solver/linsolve.mac,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- linsolve.mac 23 Dec 2002 05:31:22 -0000 1.1 +++ linsolve.mac 21 Apr 2006 00:45:57 -0000 1.2 @@ -23,40 +23,51 @@ Solve_Inconsistent_Error is false, LinsolveWarn and Linsolve_Params, but acts as if Linsolve_Params is false */ -define_variable( Solve_Inconsistent_Error, true, any)$ +define_variable( Solve_Inconsistent_Error, false, any)$ define_variable( Solve_Inconsistent_Eqn_Nos, false, any)$ -LinsolveM(ees,vees):=block([ne:length(ees),nv:length(vees),nvees,ns,am,tam,r, +LinsolveM(ees,vees):=block( + [ne:length(ees),nv:length(vees),nvees,ns,am,tam,r, ic], /* check to see if there are less equations than unknowns, if so, solve for the first ones */ - ns:min(ne,nv), - nvees:rest(vees,ns-nv), + ns:min(ne,nv), + nvees:rest(vees,ns-nv), /* construct the augmented coef matrix and triangularize it. this assumes that all the non linear terms are on the rhs of the equations (ees) */ - am:augcoefmatrix(ees,nvees), - tam:triangularize(am), + am:augcoefmatrix(ees,nvees), + tam:triangularize(am), /* search for inconsistant equations. this assumes that they are on the bottom of the matrix. there may be a better way of doing this but i am not sure of it */ /* copy the rhs, its the last column of the matrix, and whack it */ - r:col(tam,ns+1), tam:submatrix(tam,ns+1), ic:[], - for i:ne thru 1 step -1 do block([az:true], - map(lambda([x],if x # 0 then az:false), tam[i]), - if az = true and r[i] # 0 then ic:endcons(i, ic) - ), - if ic # [] then ( /* equations are inconsistant */ - if Solve_Inconsistent_Error = false then ( - Solve_Inconsistent_Eqn_Nos:ic, return([inconsistant]))) - else (if Solve_Inconsistent_Error = false then - Solve_Inconsistent_Eqn_Nos:[]), - block([x:make_array('any,ns), l], - for i:ns thru 1 step -1 do - x[i-1]:(-r[i]-sum(tam[i,k]*x[k-1],k,i+1,ns))/tam[i,i], + r:col(tam,ns+1), + tam:submatrix(tam,ns+1), + ic:[], + for i:ne thru 1 step -1 do block( + [az:true], + map(lambda([x],if x # 0 then az:false), tam[i]), + if az = true and r[i] # 0 then ic:endcons(i, ic) + ), + if ic # [] then ( /* equations are inconsistant */ + if Solve_Inconsistent_Error = false then ( + Solve_Inconsistent_Eqn_Nos:ic, return([inconsistant]) + ) + ) + else ( + if Solve_Inconsistent_Error = false then + Solve_Inconsistent_Eqn_Nos : [] + else error("Inconsistent equations found!") + ), + block( + [x:make_array('any,ns), l], + for i:ns thru 1 step -1 do + x[i-1]:(-r[i]-sum(tam[i,k]*x[k-1],k,i+1,ns))/tam[i,i], l:map(first,listarray(x)), if globalsolve = true then - /* this line does not work correctly */ - map(lambda([x,y],x::y,globalsetq(x,y)),nvees,l) + /* this line does not work correctly */ + map(lambda([x,y],x::y,globalsetq(x,y)),nvees,l) else map(lambda([x,y],x=y),nvees,l) - ))$ + ) +)$ Index: misc.mac =================================================================== RCS file: /cvsroot/maxima/maxima/share/algebra/solver/misc.mac,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- misc.mac 23 Dec 2002 05:31:49 -0000 1.1 +++ misc.mac 21 Apr 2006 00:45:57 -0000 1.2 @@ -19,18 +19,57 @@ Dan Stanger dan...@ie... please contact me for updates to this code */ + /******************************************************************************/ /* Powers creates a list of low powers in a variable */ /******************************************************************************/ -Powers(e,v):=maplist( - lambda([p],lopow(p,v)), e)$ + +Powers(e,v) := + if atom(e) then [lopow(e,v)] + else if part(e,0)="+" or part(e, 0)="-" then + maplist(lambda([p],lopow(p,v)), e) + else + [lopow(e,v)]$ + /******************************************************************************/ /* pop pops the first element off a list and returns it */ /******************************************************************************/ -Pop( l) ::= buildq([l],block([t:first(l)],l:rest(l),t))$ + +Pop(l) ::= buildq([l],block([t:first(l)],l:rest(l),t))$ + /******************************************************************************/ /* Set_Element modifies lists or matrixes and returns the list or matrix */ /******************************************************************************/ -Set_Element(o,i,j, [l]):=if matrixp(o) then block( - if l # [] then (o[i,j]:first(l),o) else (o[i]:j,o)) -else (o[i]:j,o)$ + +Set_Element(o,i,j, [l]):= + if matrixp(o) then ( + if l # [] then ( + o[i,j]:first(l), + o + ) + else ( + o[i]:j, + o + ) + ) + else ( + o[i]:j, + o + )$ + +EquationP(eq) := part(eq,0)="="$ + +/******************************************************************************/ +/* Solver does not know maxima sets - workarounds for set functions. */ +/******************************************************************************/ + +Setify(lst) := listify(setify(lst))$ + +DisjointP(l1, l2) := disjointp(setify(l1), setify(l2))$ + +Intersection(l1, l2) := listify(intersection(setify(l1), setify(l2)))$ + +SetDifference(l1, l2) := listify(setdifference(setify(l1), setify(l2)))$ + +Union([l]) := listify(lreduce(union, map(setify, l)))$ + Index: slvrtbox.mac =================================================================== RCS file: /cvsroot/maxima/maxima/share/algebra/solver/slvrtbox.mac,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- slvrtbox.mac 7 Sep 2005 03:27:13 -0000 1.2 +++ slvrtbox.mac 21 Apr 2006 00:45:57 -0000 1.3 @@ -20,7 +20,7 @@ /* Author(s) : Eckhard Hennig, Ralf Sommer */ /* Project start: 17.01.1995 */ /* Completed : 17.01.1995 */ -/* Last change : 17.08.1995 */ +/* last change : 17.08.1995 */ /* Time : 15:38 */ /******************************************************************************/ /* Changes : ||||| | */ @@ -31,42 +31,42 @@ /* Version information: see below function definition of SetVersion */ /******************************************************************************/ -/* Last change: 17.08.1995 */ +/* last change: 17.08.1995 */ /* Time : 15:38 */ /* By : Eckhard Hennig */ /* Description: Function Position now accepts non list arguments */ /******************************************************************************/ -/* Last change: 28.06.1995 */ +/* last change: 28.06.1995 */ /* Time : 13:53 */ /* By : Eckhard Hennig */ /* Description: Function SortSolveOrder added. */ /******************************************************************************/ -/* Last change: 28.05.1995 */ +/* last change: 28.05.1995 */ /* Time : 12:06 */ /* By : Eckhard Hennig */ /* Description: Default function for Solver_Break_Test added. */ /******************************************************************************/ -/* Last change: 13.02.1995 */ +/* last change: 13.02.1995 */ /* Time : 09.19 */ /* By : Eckhard Hennig */ /* Description: Initial value of MsgLvl set to 0. */ /******************************************************************************/ -/* Last change: 31.01.1995 */ +/* last change: 31.01.1995 */ /* Time : 10.06 */ /* By : Eckhard Hennig */ -/* Description: Problem with Solver_Verbose:FALSE fixed. */ +/* Description: Problem with Solver_Verbose:false fixed. */ /******************************************************************************/ -/* Last change: 24.01.1995 */ +/* last change: 24.01.1995 */ /* Time : 16.40 */ /* By : Eckhard Hennig */ /* Description: Version property added. */ /******************************************************************************/ -/* Last change: 17.01.1995 */ +/* last change: 17.01.1995 */ /* Time : 18.20 */ /* By : Eckhard Hennig, Ralf Sommer */ /* Description: Most functions moved from AI's TOOLBOX.MAC into SLVRTBOX.MAC */ /* Variable Solver_Verbose added (linked to MsgLevel via */ -/* VALUE_CHECK property) */ +/* value_check property) */ /******************************************************************************/ /******************************************************************************/ @@ -87,7 +87,7 @@ SetVersion( [ InfoList ] ) := ( mode_declare( - InfoList, LIST + InfoList, list ), SetProp( @@ -123,7 +123,7 @@ /* Global variables */ /******************************************************************************/ -define_variable( MsgLvl, 0, FIXNUM )$ +define_variable( MsgLvl, 0, fixnum )$ /******************************************************************************/ /* MsgLevel controls the amount of output AI generates. If MsgLevel is */ @@ -134,33 +134,33 @@ /* PrintMsg( <'OFF | 'FALSE |'SHORT | 'DETAIL | 'ALWAYS>, <stuff> ). */ /******************************************************************************/ -define_variable( MsgLevel, 'FALSE, ANY_CHECK )$ +define_variable( MsgLevel, 'FALSE, any_check )$ put( 'MsgLevel, lambda( [ x ], - IF member( x, [ 'OFF, 'FALSE, 'SHORT, 'DETAIL ] ) - OR ( debugmode AND ( x = 'DEBUG ) ) - THEN + if member( x, [ 'OFF, 'FALSE, 'SHORT, 'DETAIL ] ) + or ( debugmode and ( x = 'DEBUG ) ) + then MsgLvl : mode_identity( - FIXNUM, + fixnum, assoc( x, [ - 'OFF = 0, 'FALSE = 0, FALSE = 0, + 'OFF = 0, 'FALSE = 0, false = 0, 'SHORT = 1, 'DETAIL = 2, 'DEBUG = 10 ] ) ) - ELSE + else ErrorHandler( "InvMsgLvl", x, 'Fatal ) ), - 'VALUE_CHECK + 'value_check )$ -define_variable( Solver_Verbose, FALSE, ANY_CHECK )$ +define_variable( Solver_Verbose, false, any_check )$ put( 'Solver_Verbose, @@ -175,7 +175,7 @@ [ OTHERWISE, ErrorHandler( "InvVerbMode", VerboseMode, 'Fatal ) ] ) ), - 'VALUE_CHECK + 'value_check )$ @@ -197,7 +197,7 @@ User_Props, list ), - /* Get all properties of Symbol and extract the sublist which begins */ + /* get all properties of Symbol and extract the sublist which begins */ /* with the keyword "User Properties". */ UserProps : sublist( @@ -290,7 +290,7 @@ /******************************************************************************/ AssocP( Object ) := - listp( Object ) and not member( 'FALSE, map( 'EquationP, Object ) )$ + listp( Object ) and not member( 'false, map( 'EquationP, Object ) )$ /******************************************************************************/ @@ -465,7 +465,7 @@ /******************************************************************************/ ListMatrix( Mat ) := - if MatrixP( Mat ) then + if matrixp( Mat ) then substpart( "[", copymatrix(Mat), 0 ) else false$ @@ -511,7 +511,7 @@ /******************************************************************************/ /* SolverJustDoIt is the default Solver_Break_Test function. It simply returns*/ -/* FALSE, hence the Solver never stops. */ +/* false, hence the Solver never stops. */ /******************************************************************************/ SolverJustDoIt( Eq, Var, Val ) := false$ @@ -526,4 +526,3 @@ SlvOrd, lambda( [a, b], third( a ) < third( b ) ) )$ - Index: solver.mac =================================================================== RCS file: /cvsroot/maxima/maxima/share/algebra/solver/solver.mac,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- solver.mac 7 Sep 2005 03:27:13 -0000 1.2 +++ solver.mac 21 Apr 2006 00:45:57 -0000 1.3 @@ -9,8 +9,8 @@ /* your option) any later version. */ /* */ /* This library 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 */ +/* WITHOUT any WARRANTY; without even the implied warranty of */ +/* MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the GNU */ /* Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General Public */ @@ -24,16 +24,17 @@ [...2737 lines suppressed...] DumpToFile( Sols, Eqs, Vars ) := ( - Mode_Declare( - [ Sols, Eqs, Vars ], LIST + mode_declare( + [ Sols, Eqs, Vars ], list ), - BLOCK( + block( [ Solutions, Equations, Variables ], PrintMsg( 'SHORT, SolverMsg["Dump"], Solver_Dump_File ), - Apply( + apply( 'StringOut, [ Solver_Dump_File, |