| blob | a767d57d897210ae9c64f88fb7965f592cf8a2eb |
1 ;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;; The data in this file contains enhancements. ;;;;;
4 ;;; ;;;;;
5 ;;; Copyright (c) 1984,1987 by William Schelter,University of Texas ;;;;;
6 ;;; All rights reserved ;;;;;
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; (c) Copyright 1982 Massachusetts Institute of Technology ;;;
9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
18 equations ;List of E-labels
20 broken-not-freeof
21 mult ;Some crock which tracks multiplicities.
24 *myvar
38 "Causes the user will be warned if SOLVE is called with either a
39 null equation list or a null variable list. For example,
42 ;; Utility macros
44 ;; This macro returns the number of trivial equations. It counts up the
45 ;; number of zeros in a list.
47 ;(defmacro nzlist (llist)
48 ; `(do ((l ,llist (cdr l))
49 ; (zcount 0))
50 ; ((null l) zcount)
51 ; (if (and (integerp (car l)) (zerop (car l)))
52 ; (incf zcount))))
54 ;; This is only called on a variable.
59 ;; Finds variables, changes equations into expressions without MEQUAL.
60 ;; Checks for consistency between the number of unknowns and equations.
61 ;; Calls SOLVEX for simultaneous equations and SSOLVE for a single equation.
66 $keepfloat $ratfac ; In case user has set these
71 ;; Create the equation list (this is a lisp list, not 'MLIST)
74 ;; If an atom, cons it.
76 ;; If we have a list of equations, move everything over
77 ;; to one side, so x=5 -> x-5=0.
80 ;; We can't solve inequalities
84 ;; Finally, assume we have just one equation, and put it
85 ;; on one side again.
89 ;; If the variable list wasn't supplied we have to supply it
90 ;; ourselves. Also remove constants like $%pi from the list.
97 ;; If we have got a variable list then if it's a list apply
98 ;; meval to each entry and then weed out duplicates. Else, just
99 ;; cons it.
106 ;; Some sanity checks and warning messages.
116 ;; Deal with special cases.
118 ;; Trivially true equations for any set of variables.
122 ;; Trivially false equations: return []
126 ;; One equation in one variable: SSOLVE
130 ;; We were given a variable list, or there are same # of eqns
131 ;; as unknowns: SOLVEX.
141 ;; We don't know what to do, so complain. The let sets u to varl
142 ;; but as an MLIST list and e to the original eqns coerced to a
143 ;; list.
147 ;; MFORMAT doesn't have ~:[~] yet, so I just change this to
148 ;; make one of two possible calls to MERROR. Smaller codesize
149 ;; then what was here before anyway.
153 ~%Unknowns given : ~%~M~
155 u e)
158 ~%Unknowns given : ~%~M~
160 u e)))))
163 ;; Removes anything from its list arg which solve considers not to be a
164 ;; variable, i.e. constants, functions or subscripted variables without
165 ;; numeric args.
173 ;; Solve a single equation for a single unknown.
174 ;; Obtains roots via solve and prints them.
178 equations multi)
182 ($programmode
186 *roots
201 ;; Solve takes three arguments, the expression to solve for zero, the variable
202 ;; to solve for, and what multiplicity this solution is assumed to have (from
203 ;; higher-level Solve's). Solve returns NIL. Isn't that useful? The lists
204 ;; *roots and *failures are special variables to which Solve prepends solutions
205 ;; and their multiplicities in that order: *roots contains explicit solutions
206 ;; of the form <var>=<function of independent variables>, and *failures
207 ;; contains equations which if solved would yield additional solutions.
209 ;; Factors expression and reduces exponents by their gcd (via solventhp)
215 varlist expsumsplit)
218 ;; Cancel out any simple
219 ;; (non-algebraic) common factors in numerator and
220 ;; denominator without altering the structure of the
221 ;; expression too much.
222 ;; Also, RJFPROB in TEST;SOLVE TEST is now solved.
223 ;; - JPG
255 mult))
297 ;;; The following takes care of cases where the expression is already in
298 ;;; factored form. This can introduce spurious roots if one of the factors
299 ;;; is an expression that can be undefined or infinity for certain values of
300 ;;; the variable in question. But soon this will be no worry because I will
301 ;;; add a list of "possible bad roots" to what $SOLVE returns.
302 ;;; Passes multiplicity to recursive calls to solve.
319 ;; no solutions: c^x is never zero
327 ;;; Predicate to test for presence of troublesome trig functions to be
328 ;;; canonicalized. A table of when to make substitutions should
329 ;;; be used here.
330 ;;; trig kind => SIN | COS | TAN ... subst to make
331 ;;; number around in expression -> 1 1 0 ......
332 ;;; what you want to be able to do for example is to see if SIN and COS^2
333 ;;; are around and then make a reasonable substitution.
346 ;; Predicate to see when obviously not to substitute for trigs.
347 ;; A hack in the direction of expression properties-table driven
348 ;; substition. The "measure" of the expression is the total number
349 ;; of different kinds of trig functions in the expression.
356 ;; To get the total "value" of things in a table, this case an assoc list.
357 ;; (MEASURE FUNCTION ASSOCIATION-LIST SET) where FUNCTION is a function mapping
358 ;; the range of the ASSOCIATION-LIST viewed as a function on the SET, to the
359 ;; integers.
364 sum)
366 ;; Named for uniqueness only
373 ;; A function that can EXTEND a function
374 ;; over two association lists. Note that I have been using association lists
375 ;; as mere functions (that is, as sets of ordered pairs).
376 ;; (EXTEND '+ L1 L2 S) could also be to take the union of two multi-sets in the
377 ;; sample space S. (what the '&%%#?& has this got to do with SOLVE?)
386 value))))
388 ;; For the case where the value of assoc is NIL, we will need a special "+"
393 ;; To recursively looks through a list
394 ;; structure (the VLIST) for members of the SET appearing in the MACSYMA
395 ;; functional position (caar list). Returning an assoc. list of appearance
396 ;; frequencies. Notice the use of EXTEND.
405 made)))))
410 assl set))
413 set))))))
423 var exp))))
425 ;; Here are the canonical trig substitutions.
455 ;; Predicate to replace ISLINEAR....Returns NIL if not of for A*X+B, A and B
456 ;; freeof X, else returns (A . B)
459 ;; Expand the expression at one level, i.e. distribute products
460 ;; over sums, but leave exponentiations alone.
461 ;; (X+1)^2*(X+Y) --> X*(X+1)^2 + Y*(X+1)^2
488 ;; Function to test if a term from an expanded expression is a linear term
489 ;; check and see that exactly one item in the product is the main var and
490 ;; all others are free of the main var. Returns NIL or a G-REP expression.
506 ;no-main-var at top level -=> not linear
509 ;note it...it has to be there to be a linear term
517 ;;; DISPATCHING FUNCTION ON DEGREE OF EXPRESSION
518 ;;; This is a crock of shit, it should be data driven and be able to
519 ;;; dispatch to all manner of special cases that are in a table.
520 ;;; EXP here is a polynomial in MRAT form. All of this well-structured,
521 ;;; intelligently-designed code works by side effect. SOLVECUBIC
522 ;;; takes something that looks like (G0003 3 4 1 1 0 10) as an argument
523 ;;; and returns something like ((MEQUAL) $X ((MTIMES) ...)). You figure
524 ;;; out where the $X comes from.
526 ;;; It comes from GENVARS/VARLIST, of course. Isn't this wonderful rational
527 ;;; function package irrational? If you don't know about GENVARS and
528 ;;; VARLIST, you'd better bite the bullet and learn...everything depends
529 ;;; on them. The canonical example of mis-use of special variables!
530 ;;; --RWK
538 nil)
553 ;; The Solve-by-decomposition program returns the cons of (ROOTS . FAILURES).
554 ;; It returns a "Solution" object, that is, a CONS with the CAR being the
555 ;; failures and the CDR being the successes.
556 ;; It takes a POLY as an argument and returns a SOLUTION.
564 decomp
567 ;; DECOMP-TRACE is the recursive function which maps itself down the
568 ;; intermediate solutions until the end is reached. If it encounters
569 ;; non-solvable equations it stops. It returns a SOLUTION object, that is, a
570 ;; CONS with the CAR being the failures and the CDR being the successes.
577 ;; End test
587 ;; Decomp-chain is the function which formats the mess for the recursive call.
588 ;; It returns a "Solution" object, that is, a CONS with the CAR being the
589 ;; failures and the CDR being the successes.
593 ;; Include the var itself in the decomposition
598 ;; RE-SOLVE calls SOLVE recursively, returning a SOLUTION object.
599 ;; Will not decompose or factor.
604 ;; We've already decomposed and factored
610 ;; SOLVENTH programs test to see if the variable of interest appears
611 ;; to some power in all terms. If so, a new variable is substituted for it
612 ;; and the simpler expression solved with the multiplicity
613 ;; adjusted accordingly.
614 ;; SOLVENTHP returns gcd of exponents.
622 ;; Reduces exponents by their gcd.
641 wins)
645 fails)
659 varlist))
667 ;; Will decompose or factor
673 ;; Sees if expression is of the form A*F<X>^N+B.
682 ;; Solves the special case A*F<X>^N+B.
702 ;; ADISPLINE displays a line like DISPLINE, and in addition, notes that it is
703 ;; not free of *VAR if it isn't.
706 ;; This may be redundant, but nice if ADISPLINE gets used where not needed.
712 linelabel))
715 ;; Predicate to check if an expression which may be broken up
716 ;; is freeof
720 ;; For consistency, use backwards args.
721 ;; == (freeof var exp) but works even if solution is broken up ($breakup=t)
731 ;; Adds solutions to roots list.
732 ;; Solves for inverse of functions (via USOLVE)
748 ;; Solve a linear equation. Argument is a polynomial in pseudo-cre form.
749 ;; This function is called for side-effect only.
756 mult))
758 ;; Solve a quadratic equation. Argument is a polynomial in pseudo-cre form.
759 ;; This function is called for side-effect only.
760 ;; The code for handling the case where the discriminant = 0 seems to never
761 ;; be run. Presumably, the expression is factored higher up.
771 ;; At this point, everything is back in general representation.
778 mult)
780 mult)))))
782 ;; Reorders V so that members which contain the variable of
783 ;; interest come first.
792 v)
797 ;; Solves for variable when it occurs within a function by taking the inverse.
798 ;; When this code is fixed, the `((mplus) ,x ,y) forms should be rewritten as
799 ;; (MAKE-MPLUS X Y). I didn't do this because the code was buggy and it should
800 ;; be fixed first. - cwh
801 ;; You mean you didn't do it because you were buggy. Hope you're fixed soon!
802 ;; --RWK
804 ;; Solve <exp> = <*myvar> for <*var>, where <*myvar>=<op>(...)
823 ;; There is a bug right here.
824 ;; SOLVE(SQRT(U)+1) should return U=1
825 ;; This code is entered with EXP = -1, OP = MEXPT
826 ;; *VAR = U, and *MYVAR = ((MEXPT) U ((RAT) 1 2))
827 ;; BULLSHIT -- RWK. That is precisely the bug
828 ;; this code was added to fix!
843 (mtell (intl:gettext "~&solve: using arc-trig functions to get a solution.~%Some solutions will be lost.~%"))
856 ;; Predicate for determining if an expression is messy enough to
857 ;; generate a new linelabel for it.
858 ;; Expression must be in general form.
898 ;; This flag is T if called from SOLVE
899 ;; and NIL if called from LINSOLVE.
910 ;;I put this in the value cell--wfs
917 ind))
922 ;; (LINSORT '(((MEQUAL) A2 FOO) ((MEQUAL) A3 BAR)) '(A3 A2))
923 ;; returns (((MEQUAL) A3 BAR) ((MEQUAL) A2 FOO)) .