| blob | 36960a134e315174ee6a2cf464eb2a4eedf02410 |
1 ;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;; The data in this file contains enhancments. ;;;;;
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 $algebraic equations ;List of E-labels
20 $%emode genvar genpairs varlist broken-not-freeof
21 mult ;Some crock which tracks multiplicities.
24 *myvar $listconstvars
26 $keepfloat $ratfac
30 "Causes solutions to cubic and quartic equations to be expressed in
34 "Set to a list of the multiplicities of the individual solutions
41 "Causes SOLVE to return its answers explicitly as elements
51 "If T, then SOLVE will try to factor the expression. The FALSE
52 setting may be desired in zl-SOME cases where factoring is not
56 "Causes the user will be warned if SOLVE is called with either a
57 null equation list or a null variable list. For example,
61 "Causes SOLVE to print a warning message when it is uses
62 inverse trigonometric functions to solve an equation,
66 "SOLVE will use RADCAN which will make SOLVE slower but will allow
69 ;; Utility macros
71 ;; This macro returns the number of trivial equations. It counts up the
72 ;; number of zeros in a list.
74 ;(defmacro nzlist (llist)
75 ; `(do ((l ,llist (cdr l))
76 ; (zcount 0))
77 ; ((null l) zcount)
78 ; (if (and (integerp (car l)) (zerop (car l)))
79 ; (incf zcount))))
81 ;; This is only called on a variable.
86 ;; Finds variables, changes equations into expressions without MEQUAL.
87 ;; Checks for consistency between the number of unknowns and equations.
88 ;; Calls SOLVEX for simultaneous equations and SSOLVE for a single equation.
93 $keepfloat $ratfac ; In case user has set these
98 ;; Create the equation list (this is a lisp list, not 'MLIST)
101 ;; If an atom, cons it.
103 ;; If we have a list of equations, move everything over
104 ;; to one side, so x=5 -> x-5=0.
107 ;; We can't solve inequalities
111 ;; Finally, assume we have just one equation, and put it
112 ;; on one side again.
116 ;; If the variable list wasn't supplied we have to supply it
117 ;; ourselves. Also remove constants like $%pi from the list.
124 ;; If we have got a variable list then if it's a list apply
125 ;; meval to each entry and then weed out duplicates. Else, just
126 ;; cons it.
133 ;; Some sanity checks and warning messages.
143 ;; Deal with special cases.
145 ;; Trivially true equations for any set of variables.
149 ;; Trivially false equations: return []
153 ;; One equation in one variable: SSOLVE
157 ;; We were given a variable list, or there are same # of eqns
158 ;; as unknowns: SOLVEX.
168 ;; We don't know what to do, so complain. The let sets u to varl
169 ;; but as an MLIST list and e to the original eqns coerced to a
170 ;; list.
174 ;; MFORMAT doesn't have ~:[~] yet, so I just change this to
175 ;; make one of two possible calls to MERROR. Smaller codesize
176 ;; then what was here before anyway.
180 ~%Unknowns given : ~%~M~
182 u e)
185 ~%Unknowns given : ~%~M~
187 u e)))))
190 ;; Removes anything from its list arg which solve considers not to be a
191 ;; variable, i.e. constants, functions or subscripted variables without
192 ;; numeric args.
200 ;; Solve a single equation for a single unknown.
201 ;; Obtains roots via solve and prints them.
208 ($programmode
212 *roots
223 ;; Solve takes three arguments, the expression to solve for zero, the variable
224 ;; to solve for, and what multiplicity this solution is assumed to have (from
225 ;; higher-level Solve's). Solve returns NIL. Isn't that useful? The lists
226 ;; *roots and *failures are special variables to which Solve prepends solutions
227 ;; and their multiplicities in that order: *roots contains explicit solutions
228 ;; of the form <var>=<function of independent variables>, and *failures
229 ;; contains equations which if solved would yield additional solutions.
231 ;; Factors expression and reduces exponents by their gcd (via solventhp)
237 varlist expsumsplit)
240 ;; Cancel out any simple
241 ;; (non-algebraic) common factors in numerator and
242 ;; denominator without altering the structure of the
243 ;; expression too much.
244 ;; Also, RJFPROB in TEST;SOLVE TEST is now solved.
245 ;; - JPG
277 mult))
319 ;;; The following takes care of cases where the expression is already in
320 ;;; factored form. This can introduce spurious roots if one of the factors
321 ;;; is an expression that can be undefined or infinity for certain values of
322 ;;; the variable in question. But soon this will be no worry because I will
323 ;;; add a list of "possible bad roots" to what $SOLVE returns.
324 ;;; Passes multiplicity to recursive calls to solve.
341 ;; no solutions: c^x is never zero
349 ;;; Predicate to test for presence of troublesome trig functions to be
350 ;;; canonicalized. A table of when to make substitutions should
351 ;;; be used here.
352 ;;; trig kind => SIN | COS | TAN ... subst to make
353 ;;; number around in expression -> 1 1 0 ......
354 ;;; what you want to be able to do for example is to see if SIN and COS^2
355 ;;; are around and then make a reasonable substitution.
368 ;; Predicate to see when obviously not to substitute for trigs.
369 ;; A hack in the direction of expression properties-table driven
370 ;; substition. The "measure" of the expression is the total number
371 ;; of different kinds of trig functions in the expression.
378 ;; To get the total "value" of things in a table, this case an assoc list.
379 ;; (MEASURE FUNCTION ASSOCIATION-LIST SET) where FUNCTION is a function mapping
380 ;; the range of the ASSOCIATION-LIST viewed as a function on the SET, to the
381 ;; integers.
386 sum)
388 ;; Named for uniqueness only
395 ;; A function that can EXTEND a function
396 ;; over two association lists. Note that I have been using association lists
397 ;; as mere functions (that is, as sets of ordered pairs).
398 ;; (EXTEND '+ L1 L2 S) could also be to take the union of two multi-sets in the
399 ;; sample space S. (what the '&%%#?& has this got to do with SOLVE?)
408 value))))
410 ;; For the case where the value of assoc is NIL, we will need a special "+"
415 ;; To recursively looks through a list
416 ;; structure (the VLIST) for members of the SET appearing in the MACSYMA
417 ;; functional position (caar list). Returning an assoc. list of appearance
418 ;; frequencies. Notice the use of EXTEND.
427 made)))))
432 assl set))
435 set))))))
445 var exp))))
447 ;; Here are the canonical trig substitutions.
477 ;; Predicate to replace ISLINEAR....Returns NIL if not of for A*X+B, A and B
478 ;; freeof X, else returns (A . B)
481 ;; Expand the expression at one level, i.e. distribute products
482 ;; over sums, but leave exponentiations alone.
483 ;; (X+1)^2*(X+Y) --> X*(X+1)^2 + Y*(X+1)^2
510 ;; Function to test if a term from an expanded expression is a linear term
511 ;; check and see that exactly one item in the product is the main var and
512 ;; all others are free of the main var. Returns NIL or a G-REP expression.
528 ;no-main-var at top level -=> not linear
531 ;note it...it has to be there to be a linear term
539 ;;; DISPATCHING FUNCTION ON DEGREE OF EXPRESSION
540 ;;; This is a crock of shit, it should be data driven and be able to
541 ;;; dispatch to all manner of special cases that are in a table.
542 ;;; EXP here is a polynomial in MRAT form. All of this well-structured,
543 ;;; intelligently-designed code works by side effect. SOLVECUBIC
544 ;;; takes something that looks like (G0003 3 4 1 1 0 10) as an argument
545 ;;; and returns something like ((MEQUAL) $X ((MTIMES) ...)). You figure
546 ;;; out where the $X comes from.
548 ;;; It comes from GENVARS/VARLIST, of course. Isn't this wonderful rational
549 ;;; function package irrational? If you don't know about GENVARS and
550 ;;; VARLIST, you'd better bite the bullet and learn...everything depends
551 ;;; on them. The canonical example of mis-use of special variables!
552 ;;; --RWK
560 nil)
575 ;; The Solve-by-decomposition program returns the cons of (ROOTS . FAILURES).
576 ;; It returns a "Solution" object, that is, a CONS with the CAR being the
577 ;; failures and the CDR being the successes.
578 ;; It takes a POLY as an argument and returns a SOLUTION.
586 decomp
589 ;; DECOMP-TRACE is the recursive function which maps itself down the
590 ;; intermediate solutions until the end is reached. If it encounters
591 ;; non-solvable equations it stops. It returns a SOLUTION object, that is, a
592 ;; CONS with the CAR being the failures and the CDR being the successes.
599 ;; End test
609 ;; Decomp-chain is the function which formats the mess for the recursive call.
610 ;; It returns a "Solution" object, that is, a CONS with the CAR being the
611 ;; failures and the CDR being the successes.
615 ;; Include the var itself in the decomposition
620 ;; RE-SOLVE calls SOLVE recursively, returning a SOLUTION object.
621 ;; Will not decompose or factor.
626 ;; We've already decomposed and factored
632 ;; SOLVENTH programs test to see if the variable of interest appears
633 ;; to some power in all terms. If so, a new variable is substituted for it
634 ;; and the simpler expression solved with the multiplicity
635 ;; adjusted accordingly.
636 ;; SOLVENTHP returns gcd of exponents.
644 ;; Reduces exponents by their gcd.
663 wins)
667 fails)
681 varlist))
689 ;; Will decompose or factor
695 ;; Sees if expression is of the form A*F<X>^N+B.
704 ;; Solves the special case A*F<X>^N+B.
724 ;; ADISPLINE displays a line like DISPLINE, and in addition, notes that it is
725 ;; not free of *VAR if it isn't.
728 ;; This may be redundant, but nice if ADISPLINE gets used where not needed.
734 linelabel))
737 ;; Predicate to check if an expression which may be broken up
738 ;; is freeof
742 ;; For consistency, use backwards args.
743 ;; == (freeof var exp) but works even if solution is broken up ($breakup=t)
753 ;; Adds solutions to roots list.
754 ;; Solves for inverse of functions (via USOLVE)
770 ;; Solve a linear equation. Argument is a polynomial in pseudo-cre form.
771 ;; This function is called for side-effect only.
778 mult))
780 ;; Solve a quadratic equation. Argument is a polynomial in pseudo-cre form.
781 ;; This function is called for side-effect only.
782 ;; The code for handling the case where the discriminant = 0 seems to never
783 ;; be run. Presumably, the expression is factored higher up.
793 ;; At this point, everything is back in general representation.
800 mult)
802 mult)))))
804 ;; Reorders V so that members which contain the variable of
805 ;; interest come first.
814 v)
819 ;; Solves for variable when it occurs within a function by taking the inverse.
820 ;; When this code is fixed, the `((mplus) ,x ,y) forms should be rewritten as
821 ;; (MAKE-MPLUS X Y). I didn't do this because the code was buggy and it should
822 ;; be fixed first. - cwh
823 ;; You mean you didn't do it because you were buggy. Hope you're fixed soon!
824 ;; --RWK
826 ;; Solve <exp> = <*myvar> for <*var>, where <*myvar>=<op>(...)
845 ;; There is a bug right here.
846 ;; SOLVE(SQRT(U)+1) should return U=1
847 ;; This code is entered with EXP = -1, OP = MEXPT
848 ;; *VAR = U, and *MYVAR = ((MEXPT) U ((RAT) 1 2))
849 ;; BULLSHIT -- RWK. That is precisely the bug
850 ;; this code was added to fix!
865 (mtell (intl:gettext "~&solve: using arc-trig functions to get a solution.~%Some solutions will be lost.~%"))
878 ;; Predicate for determining if an expression is messy enough to
879 ;; generate a new linelabel for it.
880 ;; Expression must be in general form.
920 ;; This flag is T if called from SOLVE
921 ;; and NIL if called from LINSOLVE.
932 ;;I put this in the value cell--wfs
939 ind))
944 ;; (LINSORT '(((MEQUAL) A2 FOO) ((MEQUAL) A3 BAR)) '(A3 A2))
945 ;; returns (((MEQUAL) A3 BAR) ((MEQUAL) A2 FOO)) .