/[emacs]/emacs/lisp/calc/calcalg3.el
ViewVC logotype

Diff of /emacs/lisp/calc/calcalg3.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by eliz, Tue Nov 6 18:59:06 2001 UTC revision 1.2 by walters, Wed Nov 14 09:08:56 2001 UTC
# Line 1  Line 1 
1  ;; Calculator for GNU Emacs, part II [calc-alg-3.el]  ;; Calculator for GNU Emacs, part II [calc-alg-3.el]
2  ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
3  ;; Written by Dave Gillespie, daveg@synaptics.com.  ;; Written by Dave Gillespie, daveg@synaptics.com.
4    
5  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 47  Line 47 
47           (calc-enter-result 1 "root" (list func           (calc-enter-result 1 "root" (list func
48                                             (calc-top-n 2)                                             (calc-top-n 2)
49                                             var                                             var
50                                             (calc-top-n 1)))))))                                             (calc-top-n 1))))))))
 )  
51    
52  (defun calc-find-minimum (var)  (defun calc-find-minimum (var)
53    (interactive "sVariable(s) to minimize over: ")    (interactive "sVariable(s) to minimize over: ")
# Line 73  Line 72 
72           (calc-enter-result 1 tag (list func           (calc-enter-result 1 tag (list func
73                                          (calc-top-n 2)                                          (calc-top-n 2)
74                                          var                                          var
75                                          (calc-top-n 1)))))))                                          (calc-top-n 1))))))))
 )  
76    
77  (defun calc-find-maximum (var)  (defun calc-find-maximum (var)
78    (interactive "sVariable to maximize over: ")    (interactive "sVariable to maximize over: ")
79    (calc-invert-func)    (calc-invert-func)
80    (calc-find-minimum var)    (calc-find-minimum var))
 )  
81    
82    
83  (defun calc-poly-interp (arg)  (defun calc-poly-interp (arg)
# Line 94  Line 91 
91       (if (calc-is-hyperbolic)       (if (calc-is-hyperbolic)
92           (calc-enter-result 1 "rati" (list 'calcFunc-ratint data (calc-top 1)))           (calc-enter-result 1 "rati" (list 'calcFunc-ratint data (calc-top 1)))
93         (calc-enter-result 1 "poli" (list 'calcFunc-polint data         (calc-enter-result 1 "poli" (list 'calcFunc-polint data
94                                           (calc-top 1))))))                                           (calc-top 1)))))))
 )  
95    
96    
97  (defun calc-curve-fit (arg &optional model coefnames varnames)  (defun calc-curve-fit (arg &optional model coefnames varnames)
# Line 312  Line 308 
308                                    coefnames)                                    coefnames)
309                                  data))                                  data))
310         (if (consp calc-fit-to-trail)         (if (consp calc-fit-to-trail)
311             (calc-record (calc-normalize calc-fit-to-trail) "parm")))))             (calc-record (calc-normalize calc-fit-to-trail) "parm"))))))
 )  
312    
313  (defun calc-invent-independent-variables (n &optional but)  (defun calc-invent-independent-variables (n &optional but)
314    (calc-invent-variables n but '(x y z t) "x")    (calc-invent-variables n but '(x y z t) "x"))
 )  
315    
316  (defun calc-invent-parameter-variables (n &optional but)  (defun calc-invent-parameter-variables (n &optional but)
317    (calc-invent-variables n but '(a b c d) "a")    (calc-invent-variables n but '(a b c d) "a"))
 )  
318    
319  (defun calc-invent-variables (num but names base)  (defun calc-invent-variables (num but names base)
320    (let ((vars nil)    (let ((vars nil)
# Line 337  Line 330 
330        (or (symbolp names) (setq names (cdr names))))        (or (symbolp names) (setq names (cdr names))))
331      (if (= n 0)      (if (= n 0)
332          (nreverse vars)          (nreverse vars)
333        (calc-invent-variables num but t base)))        (calc-invent-variables num but t base))))
 )  
334    
335  (defun calc-get-fit-variables (nv nc &optional defv defc with-y homog)  (defun calc-get-fit-variables (nv nc &optional defv defc with-y homog)
336    (or (= nv (if with-y (1+ nvars) nvars))    (or (= nv (if with-y (1+ nvars) nvars))
# Line 394  Line 386 
386      (if coefnames      (if coefnames
387          (setq model (math-multi-subst model (cdr coefnames) (cdr coefs))))          (setq model (math-multi-subst model (cdr coefnames) (cdr coefs))))
388      (setq varnames vars      (setq varnames vars
389            coefnames coefs))            coefnames coefs)))
 )  
390    
391    
392    
# Line 422  Line 413 
413                              limit)                              limit)
414                  (math-newton-root expr deriv next orig-guess limit)                  (math-newton-root expr deriv next orig-guess limit)
415                (math-reject-arg next "*Newton's method failed to converge"))))                (math-reject-arg next "*Newton's method failed to converge"))))
416        (math-reject-arg next "*Newton's method encountered a singularity")))        (math-reject-arg next "*Newton's method encountered a singularity"))))
 )  
417    
418  ;;; Inspired by "rtsafe"  ;;; Inspired by "rtsafe"
419  (defun math-newton-search-root (expr deriv guess vguess ostep oostep  (defun math-newton-search-root (expr deriv guess vguess ostep oostep
# Line 494  Line 484 
484                  (and (Math-negp vlow) (Math-negp vhigh)))                  (and (Math-negp vlow) (Math-negp vhigh)))
485              (math-search-root expr deriv low vlow high vhigh)              (math-search-root expr deriv low vlow high vhigh)
486            (math-newton-search-root expr deriv nil nil nil ostep            (math-newton-search-root expr deriv nil nil nil ostep
487                                     low vlow high vhigh)))))                                     low vlow high vhigh))))))
 )  
488    
489  ;;; Search for a root in an interval with no overt zero crossing.  ;;; Search for a root in an interval with no overt zero crossing.
490  (defun math-search-root (expr deriv low vlow high vhigh)  (defun math-search-root (expr deriv low vlow high vhigh)
# Line 579  Line 568 
568                                           low vlow high vhigh)                                           low vlow high vhigh)
569                (math-bisect-root expr low vlow high vhigh))))                (math-bisect-root expr low vlow high vhigh))))
570        (math-reject-arg (list 'intv 3 low high)        (math-reject-arg (list 'intv 3 low high)
571                         "*Unable to find a sign change in this interval")))                         "*Unable to find a sign change in this interval"))))
 )  
572    
573  ;;; "rtbis"  (but we should be using Brent's method)  ;;; "rtbis"  (but we should be using Brent's method)
574  (defun math-bisect-root (expr low vlow high vhigh)  (defun math-bisect-root (expr low vlow high vhigh)
# Line 602  Line 590 
590                  vhigh vmid)                  vhigh vmid)
591          (setq low mid          (setq low mid
592                vlow vmid)))                vlow vmid)))
593      (list 'vec mid vmid))      (list 'vec mid vmid)))
 )  
594    
595  ;;; "mnewt"  ;;; "mnewt"
596  (defun math-newton-multi (expr jacob n guess orig-guess limit)  (defun math-newton-multi (expr jacob n guess orig-guess limit)
# Line 628  Line 615 
615                          limit)                          limit)
616              (math-newton-multi expr jacob n next orig-guess limit)              (math-newton-multi expr jacob n next orig-guess limit)
617            (math-reject-arg nil "*Newton's method failed to converge"))            (math-reject-arg nil "*Newton's method failed to converge"))
618        (list 'vec next expr-val)))        (list 'vec next expr-val))))
 )  
619    
620  (defvar math-root-vars [(var DUMMY var-DUMMY)])  (defvar math-root-vars [(var DUMMY var-DUMMY)])
621    
# Line 746  Line 732 
732                          (not (Math-numberp vlow))                          (not (Math-numberp vlow))
733                          (not (Math-numberp vhigh)))                          (not (Math-numberp vhigh)))
734                      (math-search-root expr deriv low vlow high vhigh)                      (math-search-root expr deriv low vlow high vhigh)
735                    (math-bisect-root expr low vlow high vhigh)))))))))                    (math-bisect-root expr low vlow high vhigh))))))))))
 )  
736    
737  (defun calcFunc-root (expr var guess)  (defun calcFunc-root (expr var guess)
738    (math-find-root expr var guess nil)    (math-find-root expr var guess nil))
 )  
739    
740  (defun calcFunc-wroot (expr var guess)  (defun calcFunc-wroot (expr var guess)
741    (math-find-root expr var guess t)    (math-find-root expr var guess t))
 )  
742    
743    
744    
# Line 773  Line 756 
756        (math-float a)        (math-float a)
757      (if (eq (car a) 'float)      (if (eq (car a) 'float)
758          a          a
759        (math-reject-arg a 'realp)))        (math-reject-arg a 'realp))))
 )  
760    
761    
762  ;;; A bracket for a minimum is a < b < c where f(b) < f(a) and f(b) < f(c).  ;;; A bracket for a minimum is a < b < c where f(b) < f(a) and f(b) < f(c).
# Line 842  Line 824 
824              c u  vc vu))              c u  vc vu))
825      (if (math-lessp-float a c)      (if (math-lessp-float a c)
826          (list a va b vb c vc)          (list a va b vb c vc)
827        (list c vc b vb a va)))        (list c vc b vb a va))))
 )  
828    
829  (defun math-narrow-min (expr a c intv)  (defun math-narrow-min (expr a c intv)
830    (let ((xvals (list a c))    (let ((xvals (list a c))
# Line 893  Line 874 
874                     (and (not yvals)                     (and (not yvals)
875                          (list (nth 3 intv) min)))))                          (list (nth 3 intv) min)))))
876            (math-reject-arg nil (format "*Unable to find a %s in the interval"            (math-reject-arg nil (format "*Unable to find a %s in the interval"
877                                         math-min-or-max)))))                                         math-min-or-max))))))
 )  
878    
879  ;;; "brent"  ;;; "brent"
880  (defun math-brent-min (expr prec a va x vx b vb)  (defun math-brent-min (expr prec a va x vx b vb)
# Line 986  Line 966 
966          (setq v w  vv vw          (setq v w  vv vw
967                w x  vw vx                w x  vw vx
968                x u  vx vu)))                x u  vx vu)))
969      (list 'vec x vx))      (list 'vec x vx)))
 )  
970    
971  ;;; "powell"  ;;; "powell"
972  (defun math-powell-min (expr n guesses prec)  (defun math-powell-min (expr n guesses prec)
# Line 1047  Line 1026 
1026              (while (<= (setq i (1+ i)) n)              (while (<= (setq i (1+ i)) n)
1027                (setcar (nthcdr ibig (nth i xi))                (setcar (nthcdr ibig (nth i xi))
1028                        (nth i (nth 1 res)))))))                        (nth i (nth 1 res)))))))
1029      (list 'vec p fret))      (list 'vec p fret)))
 )  
1030    
1031  (defun math-line-min-func (expr n)  (defun math-line-min-func (expr n)
1032    (let ((m -1))    (let ((m -1))
# Line 1059  Line 1037 
1037                         '(var DUMMY var-DUMMY)                         '(var DUMMY var-DUMMY)
1038                         (list 'calcFunc-mrow '(var line-xi line-xi) (1+ m)))                         (list 'calcFunc-mrow '(var line-xi line-xi) (1+ m)))
1039                   (list 'calcFunc-mrow '(var line-p line-p) (1+ m)))))                   (list 'calcFunc-mrow '(var line-p line-p) (1+ m)))))
1040      (math-evaluate-expr expr))      (math-evaluate-expr expr)))
 )  
1041    
1042  (defun math-line-min (f1dim line-p line-xi n prec)  (defun math-line-min (f1dim line-p line-xi n prec)
1043    (let* ((var-DUMMY nil)    (let* ((var-DUMMY nil)
# Line 1068  Line 1045 
1045           (params (math-widen-min expr '(float 0 0) '(float 1 0)))           (params (math-widen-min expr '(float 0 0) '(float 1 0)))
1046           (res (apply 'math-brent-min expr prec params))           (res (apply 'math-brent-min expr prec params))
1047           (xi (math-mul (nth 1 res) line-xi)))           (xi (math-mul (nth 1 res) line-xi)))
1048      (list (math-add line-p xi) xi (nth 2 res)))      (list (math-add line-p xi) xi (nth 2 res))))
 )  
1049    
1050    
1051  (defvar math-min-vars [(var DUMMY var-DUMMY)])  (defvar math-min-vars [(var DUMMY var-DUMMY)])
# Line 1168  Line 1144 
1144            (setq guesses (cdr guesses)))            (setq guesses (cdr guesses)))
1145          (if isvec          (if isvec
1146              (list 'vec vec (nth 2 res))              (list 'vec vec (nth 2 res))
1147            (list 'vec (nth 1 vec) (nth 2 res))))))            (list 'vec (nth 1 vec) (nth 2 res)))))))
 )  
1148  (setq math-min-or-max "minimum")  (setq math-min-or-max "minimum")
1149    
1150  (defun calcFunc-minimize (expr var guess)  (defun calcFunc-minimize (expr var guess)
# Line 1177  Line 1152 
1152          (math-min-or-max "minimum"))          (math-min-or-max "minimum"))
1153      (math-find-minimum (math-normalize expr)      (math-find-minimum (math-normalize expr)
1154                         (math-normalize var)                         (math-normalize var)
1155                         (math-normalize guess) nil))                         (math-normalize guess) nil)))
 )  
1156    
1157  (defun calcFunc-wminimize (expr var guess)  (defun calcFunc-wminimize (expr var guess)
1158    (let ((calc-internal-prec (max (/ calc-internal-prec 2) 3))    (let ((calc-internal-prec (max (/ calc-internal-prec 2) 3))
1159          (math-min-or-max "minimum"))          (math-min-or-max "minimum"))
1160      (math-find-minimum (math-normalize expr)      (math-find-minimum (math-normalize expr)
1161                         (math-normalize var)                         (math-normalize var)
1162                         (math-normalize guess) t))                         (math-normalize guess) t)))
 )  
1163    
1164  (defun calcFunc-maximize (expr var guess)  (defun calcFunc-maximize (expr var guess)
1165    (let* ((calc-internal-prec (max (/ calc-internal-prec 2) 3))    (let* ((calc-internal-prec (max (/ calc-internal-prec 2) 3))
# Line 1194  Line 1167 
1167           (res (math-find-minimum (math-normalize (math-neg expr))           (res (math-find-minimum (math-normalize (math-neg expr))
1168                                   (math-normalize var)                                   (math-normalize var)
1169                                   (math-normalize guess) nil)))                                   (math-normalize guess) nil)))
1170      (list 'vec (nth 1 res) (math-neg (nth 2 res))))      (list 'vec (nth 1 res) (math-neg (nth 2 res)))))
 )  
1171    
1172  (defun calcFunc-wmaximize (expr var guess)  (defun calcFunc-wmaximize (expr var guess)
1173    (let* ((calc-internal-prec (max (/ calc-internal-prec 2) 3))    (let* ((calc-internal-prec (max (/ calc-internal-prec 2) 3))
# Line 1203  Line 1175 
1175           (res (math-find-minimum (math-normalize (math-neg expr))           (res (math-find-minimum (math-normalize (math-neg expr))
1176                                   (math-normalize var)                                   (math-normalize var)
1177                                   (math-normalize guess) t)))                                   (math-normalize guess) t)))
1178      (list 'vec (nth 1 res) (math-neg (nth 2 res))))      (list 'vec (nth 1 res) (math-neg (nth 2 res)))))
 )  
1179    
1180    
1181    
# Line 1223  Line 1194 
1194      (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))      (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
1195      (math-with-extra-prec 2      (math-with-extra-prec 2
1196        (cons 'vec (math-poly-interp (cdr (nth 1 data)) (cdr (nth 2 data)) x        (cons 'vec (math-poly-interp (cdr (nth 1 data)) (cdr (nth 2 data)) x
1197                                     nil))))                                     nil)))))
 )  
1198  (put 'calcFunc-polint 'math-expandable t)  (put 'calcFunc-polint 'math-expandable t)
1199    
1200    
# Line 1240  Line 1210 
1210      (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))      (or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
1211      (math-with-extra-prec 2      (math-with-extra-prec 2
1212        (cons 'vec (math-poly-interp (cdr (nth 1 data)) (cdr (nth 2 data)) x        (cons 'vec (math-poly-interp (cdr (nth 1 data)) (cdr (nth 2 data)) x
1213                                     (cdr (cdr (cdr (nth 1 data))))))))                                     (cdr (cdr (cdr (nth 1 data)))))))))
 )  
1214  (put 'calcFunc-ratint 'math-expandable t)  (put 'calcFunc-ratint 'math-expandable t)
1215    
1216    
# Line 1295  Line 1264 
1264            (setq ns (1- ns)            (setq ns (1- ns)
1265                  dy (nth ns d)))                  dy (nth ns d)))
1266          (setq y (math-add y dy)))          (setq y (math-add y dy)))
1267        (list y dy)))        (list y dy))))
 )  
1268    
1269    
1270    
# Line 1335  Line 1303 
1303                                (math-ninteg-romberg                                (math-ninteg-romberg
1304                                 'math-ninteg-midpoint expr                                 'math-ninteg-midpoint expr
1305                                 (math-float lo) (math-float hi) nil))))                                 (math-float lo) (math-float hi) nil))))
1306        sum))        sum)))
 )  
1307    
1308    
1309  ;;; Open Romberg method; "qromo" in section 4.4.  ;;; Open Romberg method; "qromo" in section 4.4.
# Line 1365  Line 1332 
1332                        h (cdr h)))                        h (cdr h)))
1333              (setq curh (math-div-float curh '(float 9 0))))              (setq curh (math-div-float curh '(float 9 0))))
1334            ss            ss
1335            (math-reject-arg nil (format "*Integral failed to converge")))))            (math-reject-arg nil (format "*Integral failed to converge"))))))
 )  
1336    
1337    
1338  (defun math-ninteg-evaluate (expr x mode)  (defun math-ninteg-evaluate (expr x mode)
# Line 1378  Line 1344 
1344          (math-reject-arg res "*Integrand does not evaluate to a number"))          (math-reject-arg res "*Integrand does not evaluate to a number"))
1345      (if (eq mode 'inf)      (if (eq mode 'inf)
1346          (setq res (math-mul res (math-sqr x))))          (setq res (math-mul res (math-sqr x))))
1347      res)      res))
 )  
1348    
1349    
1350  (defun math-ninteg-midpoint (expr lo hi mode)    ; uses "integ-temp"  (defun math-ninteg-midpoint (expr lo hi mode)    ; uses "integ-temp"
# Line 1417  Line 1382 
1382                                 expr                                 expr
1383                                 (math-mul (math-add lo hi) '(float 5 -1))                                 (math-mul (math-add lo hi) '(float 5 -1))
1384                                 mode)))))                                 mode)))))
1385    (nth 1 integ-temp)    (nth 1 integ-temp))
 )  
1386    
1387    
1388    
# Line 1437  Line 1401 
1401    (set (nth 2 (aref math-dummy-vars math-dummy-counter)) nil)    (set (nth 2 (aref math-dummy-vars math-dummy-counter)) nil)
1402    (prog1    (prog1
1403        (aref math-dummy-vars math-dummy-counter)        (aref math-dummy-vars math-dummy-counter)
1404      (setq math-dummy-counter (1+ math-dummy-counter)))      (setq math-dummy-counter (1+ math-dummy-counter))))
 )  
1405    
1406    
1407    
1408  (defun calcFunc-fit (expr vars &optional coefs data)  (defun calcFunc-fit (expr vars &optional coefs data)
1409    (let ((math-in-fit 10))    (let ((math-in-fit 10))
1410      (math-with-extra-prec 2      (math-with-extra-prec 2
1411        (math-general-fit expr vars coefs data nil)))        (math-general-fit expr vars coefs data nil))))
 )  
1412    
1413  (defun calcFunc-efit (expr vars &optional coefs data)  (defun calcFunc-efit (expr vars &optional coefs data)
1414    (let ((math-in-fit 10))    (let ((math-in-fit 10))
1415      (math-with-extra-prec 2      (math-with-extra-prec 2
1416        (math-general-fit expr vars coefs data 'sdev)))        (math-general-fit expr vars coefs data 'sdev))))
 )  
1417    
1418  (defun calcFunc-xfit (expr vars &optional coefs data)  (defun calcFunc-xfit (expr vars &optional coefs data)
1419    (let ((math-in-fit 10))    (let ((math-in-fit 10))
1420      (math-with-extra-prec 2      (math-with-extra-prec 2
1421        (math-general-fit expr vars coefs data 'full)))        (math-general-fit expr vars coefs data 'full))))
 )  
1422    
1423  (defun math-general-fit (expr vars coefs data mode)  (defun math-general-fit (expr vars coefs data mode)
1424    (let ((calc-simplify-mode nil)    (let ((calc-simplify-mode nil)
# Line 1746  Line 1706 
1706                 (if (and have-sdevs (> n mm))                 (if (and have-sdevs (> n mm))
1707                     (list 'calcFunc-utpc chisq (- n mm))                     (list 'calcFunc-utpc chisq (- n mm))
1708                   '(var nan var-nan)))                   '(var nan var-nan)))
1709         expr)))         expr))))
 )  
1710    
1711  (setq math-in-fit 0)  (setq math-in-fit 0)
1712  (setq calc-fit-to-trail nil)  (setq calc-fit-to-trail nil)
# Line 1757  Line 1716 
1716        (progn        (progn
1717          (setq x (aref math-dummy-vars (+ first-var x -1)))          (setq x (aref math-dummy-vars (+ first-var x -1)))
1718          (or (calc-var-value (nth 2 x)) x))          (or (calc-var-value (nth 2 x)) x))
1719      (math-reject-arg x))      (math-reject-arg x)))
 )  
1720    
1721  (defun calcFunc-fitparam (x)  (defun calcFunc-fitparam (x)
1722    (if (>= math-in-fit 2)    (if (>= math-in-fit 2)
1723        (progn        (progn
1724          (setq x (aref math-dummy-vars (+ first-coef x -1)))          (setq x (aref math-dummy-vars (+ first-coef x -1)))
1725          (or (calc-var-value (nth 2 x)) x))          (or (calc-var-value (nth 2 x)) x))
1726      (math-reject-arg x))      (math-reject-arg x)))
 )  
1727    
1728  (defun calcFunc-fitdummy (x)  (defun calcFunc-fitdummy (x)
1729    (if (= math-in-fit 3)    (if (= math-in-fit 3)
1730        (nth x new-coefs)        (nth x new-coefs)
1731      (math-reject-arg x))      (math-reject-arg x)))
 )  
1732    
1733  (defun calcFunc-hasfitvars (expr)  (defun calcFunc-hasfitvars (expr)
1734    (if (Math-primp expr)    (if (Math-primp expr)
1735        0        0
1736      (if (eq (car expr) 'calcFunc-fitvar)      (if (eq (car expr) 'calcFunc-fitvar)
1737          (nth 1 expr)          (nth 1 expr)
1738        (apply 'max (mapcar 'calcFunc-hasfitvars (cdr expr)))))        (apply 'max (mapcar 'calcFunc-hasfitvars (cdr expr))))))
 )  
1739    
1740  (defun calcFunc-hasfitparams (expr)  (defun calcFunc-hasfitparams (expr)
1741    (if (Math-primp expr)    (if (Math-primp expr)
1742        0        0
1743      (if (eq (car expr) 'calcFunc-fitparam)      (if (eq (car expr) 'calcFunc-fitparam)
1744          (nth 1 expr)          (nth 1 expr)
1745        (apply 'max (mapcar 'calcFunc-hasfitparams (cdr expr)))))        (apply 'max (mapcar 'calcFunc-hasfitparams (cdr expr))))))
 )  
1746    
1747    
1748  (defun math-all-vars-but (expr but)  (defun math-all-vars-but (expr but)
# Line 1798  Line 1752 
1752        (setq vars (delq (assoc (car-safe p) vars) vars)        (setq vars (delq (assoc (car-safe p) vars) vars)
1753              p (cdr p)))              p (cdr p)))
1754      (sort (mapcar 'car vars)      (sort (mapcar 'car vars)
1755            (function (lambda (x y) (string< (nth 1 x) (nth 1 y))))))            (function (lambda (x y) (string< (nth 1 x) (nth 1 y)))))))
 )  
1756    
1757  (defun math-all-vars-in (expr)  (defun math-all-vars-in (expr)
1758    (let ((vars nil)    (let ((vars nil)
1759          found)          found)
1760      (math-all-vars-rec expr)      (math-all-vars-rec expr)
1761      vars)      vars))
 )  
1762    
1763  (defun math-all-vars-rec (expr)  (defun math-all-vars-rec (expr)
1764    (if (Math-primp expr)    (if (Math-primp expr)
# Line 1816  Line 1768 
1768                    (setcdr found (1+ (cdr found)))                    (setcdr found (1+ (cdr found)))
1769                  (setq vars (cons (cons expr 1) vars)))))                  (setq vars (cons (cons expr 1) vars)))))
1770      (while (setq expr (cdr expr))      (while (setq expr (cdr expr))
1771        (math-all-vars-rec (car expr))))        (math-all-vars-rec (car expr)))))
 )  
   
   
   
1772    
1773    ;;; calcalg3.el ends here

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26