/[emacs]/emacs/lisp/calc/calc-alg.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-alg.el

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

revision 1.3.4.2 by miles, Tue Oct 14 23:35:48 2003 UTC revision 1.3.4.3 by miles, Wed Dec 8 23:31:44 2004 UTC
# Line 3  Line 3 
3  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
4    
5  ;; Author: David Gillespie <daveg@synaptics.com>  ;; Author: David Gillespie <daveg@synaptics.com>
6  ;; Maintainers: D. Goel <deego@gnufans.org>  ;; Maintainer: Jay Belanger  <belanger@truman.edu>
 ;;              Colin Walters <walters@debian.org>  
7    
8  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
9    
# Line 121  Line 120 
120    (calc-slow-wrapper    (calc-slow-wrapper
121     (calc-binary-op "pgcd" 'calcFunc-pgcd arg)))     (calc-binary-op "pgcd" 'calcFunc-pgcd arg)))
122    
123    
124  (defun calc-poly-div (arg)  (defun calc-poly-div (arg)
125    (interactive "P")    (interactive "P")
126    (calc-slow-wrapper    (calc-slow-wrapper
127     (setq calc-poly-div-remainder nil)     (let ((calc-poly-div-remainder nil))
128     (calc-binary-op "pdiv" 'calcFunc-pdiv arg)       (calc-binary-op "pdiv" 'calcFunc-pdiv arg)
129     (if (and calc-poly-div-remainder (null arg))       (if (and calc-poly-div-remainder (null arg))
130         (progn           (progn
131           (calc-clear-command-flag 'clear-message)             (calc-clear-command-flag 'clear-message)
132           (calc-record calc-poly-div-remainder "prem")             (calc-record calc-poly-div-remainder "prem")
133           (if (not (Math-zerop calc-poly-div-remainder))             (if (not (Math-zerop calc-poly-div-remainder))
134               (message "(Remainder was %s)"                 (message "(Remainder was %s)"
135                        (math-format-flat-expr calc-poly-div-remainder 0))                          (math-format-flat-expr calc-poly-div-remainder 0))
136             (message "(No remainder)"))))))               (message "(No remainder)")))))))
137    
138  (defun calc-poly-rem (arg)  (defun calc-poly-rem (arg)
139    (interactive "P")    (interactive "P")
# Line 184  Line 184 
184         (memq (car name) '(vec calcFunc-assign calcFunc-condition))         (memq (car name) '(vec calcFunc-assign calcFunc-condition))
185         name))         name))
186    
187    ;; math-eval-rules-cache and math-eval-rules-cache-other are
188    ;; declared in calc.el, but are used here by math-recompile-eval-rules.
189    (defvar math-eval-rules-cache)
190    (defvar math-eval-rules-cache-other)
191    
192  (defun math-recompile-eval-rules ()  (defun math-recompile-eval-rules ()
193    (setq math-eval-rules-cache (and (calc-has-rules 'var-EvalRules)    (setq math-eval-rules-cache (and (calc-has-rules 'var-EvalRules)
194                                     (math-compile-rewrites                                     (math-compile-rewrites
# Line 266  Line 271 
271    
272  (defalias 'calcFunc-esimplify 'math-simplify-extended)  (defalias 'calcFunc-esimplify 'math-simplify-extended)
273    
274    ;; math-top-only is local to math-simplify, but is used by
275    ;; math-simplify-step, which is called by math-simplify.
276    (defvar math-top-only)
277    
278  (defun math-simplify (top-expr)  (defun math-simplify (top-expr)
279    (let ((math-simplifying t)    (let ((math-simplifying t)
280          (top-only (consp calc-simplify-mode))          (math-top-only (consp calc-simplify-mode))
281          (simp-rules (append (and (calc-has-rules 'var-AlgSimpRules)          (simp-rules (append (and (calc-has-rules 'var-AlgSimpRules)
282                                   '((var AlgSimpRules var-AlgSimpRules)))                                   '((var AlgSimpRules var-AlgSimpRules)))
283                              (and math-living-dangerously                              (and math-living-dangerously
# Line 281  Line 290 
290                                   (calc-has-rules 'var-IntegSimpRules)                                   (calc-has-rules 'var-IntegSimpRules)
291                                   '((var IntegSimpRules var-IntegSimpRules)))))                                   '((var IntegSimpRules var-IntegSimpRules)))))
292          res)          res)
293      (if top-only      (if math-top-only
294          (let ((r simp-rules))          (let ((r simp-rules))
295            (setq res (math-simplify-step (math-normalize top-expr))            (setq res (math-simplify-step (math-normalize top-expr))
296                  calc-simplify-mode '(nil)                  calc-simplify-mode '(nil)
# Line 308  Line 317 
317  (defun math-simplify-step (a)  (defun math-simplify-step (a)
318    (if (Math-primp a)    (if (Math-primp a)
319        a        a
320      (let ((aa (if (or top-only      (let ((aa (if (or math-top-only
321                        (memq (car a) '(calcFunc-quote calcFunc-condition                        (memq (car a) '(calcFunc-quote calcFunc-condition
322                                                       calcFunc-evalto)))                                                       calcFunc-evalto)))
323                    a                    a
# Line 328  Line 337 
337  (defun math-need-std-simps ()  (defun math-need-std-simps ()
338    nil)    nil)
339    
340    ;; The function created by math-defsimplify uses the variable
341    ;; math-simplify-expr, and so is used by functions in math-defsimplify
342    (defvar math-simplify-expr)
343    
344  (math-defsimplify (+ -)  (math-defsimplify (+ -)
345    (math-simplify-plus))    (math-simplify-plus))
346    
347  (defun math-simplify-plus ()  (defun math-simplify-plus ()
348    (cond ((and (memq (car-safe (nth 1 expr)) '(+ -))    (cond ((and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -))
349                (Math-numberp (nth 2 (nth 1 expr)))                (Math-numberp (nth 2 (nth 1 math-simplify-expr)))
350                (not (Math-numberp (nth 2 expr))))                (not (Math-numberp (nth 2 math-simplify-expr))))
351           (let ((x (nth 2 expr))           (let ((x (nth 2 math-simplify-expr))
352                 (op (car expr)))                 (op (car math-simplify-expr)))
353             (setcar (cdr (cdr expr)) (nth 2 (nth 1 expr)))             (setcar (cdr (cdr math-simplify-expr)) (nth 2 (nth 1 math-simplify-expr)))
354             (setcar expr (car (nth 1 expr)))             (setcar math-simplify-expr (car (nth 1 math-simplify-expr)))
355             (setcar (cdr (cdr (nth 1 expr))) x)             (setcar (cdr (cdr (nth 1 math-simplify-expr))) x)
356             (setcar (nth 1 expr) op)))             (setcar (nth 1 math-simplify-expr) op)))
357          ((and (eq (car expr) '+)          ((and (eq (car math-simplify-expr) '+)
358                (Math-numberp (nth 1 expr))                (Math-numberp (nth 1 math-simplify-expr))
359                (not (Math-numberp (nth 2 expr))))                (not (Math-numberp (nth 2 math-simplify-expr))))
360           (let ((x (nth 2 expr)))           (let ((x (nth 2 math-simplify-expr)))
361             (setcar (cdr (cdr expr)) (nth 1 expr))             (setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr))
362             (setcar (cdr expr) x))))             (setcar (cdr math-simplify-expr) x))))
363    (let ((aa expr)    (let ((aa math-simplify-expr)
364          aaa temp)          aaa temp)
365      (while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -))      (while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -))
366        (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 expr)        (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 math-simplify-expr)
367                                         (eq (car aaa) '-) (eq (car expr) '-) t))                                         (eq (car aaa) '-)
368                                           (eq (car math-simplify-expr) '-) t))
369            (progn            (progn
370              (setcar (cdr (cdr expr)) temp)              (setcar (cdr (cdr math-simplify-expr)) temp)
371              (setcar expr '+)              (setcar math-simplify-expr '+)
372              (setcar (cdr (cdr aaa)) 0)))              (setcar (cdr (cdr aaa)) 0)))
373        (setq aa (nth 1 aa)))        (setq aa (nth 1 aa)))
374      (if (setq temp (math-combine-sum aaa (nth 2 expr)      (if (setq temp (math-combine-sum aaa (nth 2 math-simplify-expr)
375                                       nil (eq (car expr) '-) t))                                       nil (eq (car math-simplify-expr) '-) t))
376          (progn          (progn
377            (setcar (cdr (cdr expr)) temp)            (setcar (cdr (cdr math-simplify-expr)) temp)
378            (setcar expr '+)            (setcar math-simplify-expr '+)
379            (setcar (cdr aa) 0)))            (setcar (cdr aa) 0)))
380      expr))      math-simplify-expr))
381    
382  (math-defsimplify *  (math-defsimplify *
383    (math-simplify-times))    (math-simplify-times))
384    
385  (defun math-simplify-times ()  (defun math-simplify-times ()
386    (if (eq (car-safe (nth 2 expr)) '*)    (if (eq (car-safe (nth 2 math-simplify-expr)) '*)
387        (and (math-beforep (nth 1 (nth 2 expr)) (nth 1 expr))        (and (math-beforep (nth 1 (nth 2 math-simplify-expr)) (nth 1 math-simplify-expr))
388             (or (math-known-scalarp (nth 1 expr) t)             (or (math-known-scalarp (nth 1 math-simplify-expr) t)
389                 (math-known-scalarp (nth 1 (nth 2 expr)) t))                 (math-known-scalarp (nth 1 (nth 2 math-simplify-expr)) t))
390             (let ((x (nth 1 expr)))             (let ((x (nth 1 math-simplify-expr)))
391               (setcar (cdr expr) (nth 1 (nth 2 expr)))               (setcar (cdr math-simplify-expr) (nth 1 (nth 2 math-simplify-expr)))
392               (setcar (cdr (nth 2 expr)) x)))               (setcar (cdr (nth 2 math-simplify-expr)) x)))
393      (and (math-beforep (nth 2 expr) (nth 1 expr))      (and (math-beforep (nth 2 math-simplify-expr) (nth 1 math-simplify-expr))
394           (or (math-known-scalarp (nth 1 expr) t)           (or (math-known-scalarp (nth 1 math-simplify-expr) t)
395               (math-known-scalarp (nth 2 expr) t))               (math-known-scalarp (nth 2 math-simplify-expr) t))
396           (let ((x (nth 2 expr)))           (let ((x (nth 2 math-simplify-expr)))
397             (setcar (cdr (cdr expr)) (nth 1 expr))             (setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr))
398             (setcar (cdr expr) x))))             (setcar (cdr math-simplify-expr) x))))
399    (let ((aa expr)    (let ((aa math-simplify-expr)
400          aaa temp          aaa temp
401          (safe t) (scalar (math-known-scalarp (nth 1 expr))))          (safe t) (scalar (math-known-scalarp (nth 1 math-simplify-expr))))
402      (if (and (Math-ratp (nth 1 expr))      (if (and (Math-ratp (nth 1 math-simplify-expr))
403               (setq temp (math-common-constant-factor (nth 2 expr))))               (setq temp (math-common-constant-factor (nth 2 math-simplify-expr))))
404          (progn          (progn
405            (setcar (cdr (cdr expr))            (setcar (cdr (cdr math-simplify-expr))
406                    (math-cancel-common-factor (nth 2 expr) temp))                    (math-cancel-common-factor (nth 2 math-simplify-expr) temp))
407            (setcar (cdr expr) (math-mul (nth 1 expr) temp))))            (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) temp))))
408      (while (and (eq (car-safe (setq aaa (nth 2 aa))) '*)      (while (and (eq (car-safe (setq aaa (nth 2 aa))) '*)
409                  safe)                  safe)
410        (if (setq temp (math-combine-prod (nth 1 expr) (nth 1 aaa) nil nil t))        (if (setq temp (math-combine-prod (nth 1 math-simplify-expr)
411                                            (nth 1 aaa) nil nil t))
412            (progn            (progn
413              (setcar (cdr expr) temp)              (setcar (cdr math-simplify-expr) temp)
414              (setcar (cdr aaa) 1)))              (setcar (cdr aaa) 1)))
415        (setq safe (or scalar (math-known-scalarp (nth 1 aaa) t))        (setq safe (or scalar (math-known-scalarp (nth 1 aaa) t))
416              aa (nth 2 aa)))              aa (nth 2 aa)))
417      (if (and (setq temp (math-combine-prod aaa (nth 1 expr) nil nil t))      (if (and (setq temp (math-combine-prod aaa (nth 1 math-simplify-expr) nil nil t))
418               safe)               safe)
419          (progn          (progn
420            (setcar (cdr expr) temp)            (setcar (cdr math-simplify-expr) temp)
421            (setcar (cdr (cdr aa)) 1)))            (setcar (cdr (cdr aa)) 1)))
422      (if (and (eq (car-safe (nth 1 expr)) 'frac)      (if (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac)
423               (memq (nth 1 (nth 1 expr)) '(1 -1)))               (memq (nth 1 (nth 1 math-simplify-expr)) '(1 -1)))
424          (math-div (math-mul (nth 2 expr) (nth 1 (nth 1 expr)))          (math-div (math-mul (nth 2 math-simplify-expr)
425                    (nth 2 (nth 1 expr)))                              (nth 1 (nth 1 math-simplify-expr)))
426        expr)))                    (nth 2 (nth 1 math-simplify-expr)))
427          math-simplify-expr)))
428    
429  (math-defsimplify /  (math-defsimplify /
430    (math-simplify-divide))    (math-simplify-divide))
431    
432  (defun math-simplify-divide ()  (defun math-simplify-divide ()
433    (let ((np (cdr expr))    (let ((np (cdr math-simplify-expr))
434          (nover nil)          (nover nil)
435          (nn (and (or (eq (car expr) '/) (not (Math-realp (nth 2 expr))))          (nn (and (or (eq (car math-simplify-expr) '/)
436                   (math-common-constant-factor (nth 2 expr))))                       (not (Math-realp (nth 2 math-simplify-expr))))
437                     (math-common-constant-factor (nth 2 math-simplify-expr))))
438          n op)          n op)
439      (if nn      (if nn
440          (progn          (progn
441            (setq n (and (or (eq (car expr) '/) (not (Math-realp (nth 1 expr))))            (setq n (and (or (eq (car math-simplify-expr) '/)
442                         (math-common-constant-factor (nth 1 expr))))                             (not (Math-realp (nth 1 math-simplify-expr))))
443                           (math-common-constant-factor (nth 1 math-simplify-expr))))
444            (if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n))            (if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n))
445                (progn                (progn
446                  (setcar (cdr expr) (math-mul (nth 2 nn) (nth 1 expr)))                  (setcar (cdr math-simplify-expr)
447                  (setcar (cdr (cdr expr))                          (math-mul (nth 2 nn) (nth 1 math-simplify-expr)))
448                          (math-cancel-common-factor (nth 2 expr) nn))                  (setcar (cdr (cdr math-simplify-expr))
449                            (math-cancel-common-factor (nth 2 math-simplify-expr) nn))
450                  (if (and (math-negp nn)                  (if (and (math-negp nn)
451                           (setq op (assq (car expr) calc-tweak-eqn-table)))                           (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table)))
452                      (setcar expr (nth 1 op))))                      (setcar math-simplify-expr (nth 1 op))))
453              (if (and n (not (eq (setq n (math-frac-gcd n nn)) 1)))              (if (and n (not (eq (setq n (math-frac-gcd n nn)) 1)))
454                  (progn                  (progn
455                    (setcar (cdr expr)                    (setcar (cdr math-simplify-expr)
456                            (math-cancel-common-factor (nth 1 expr) n))                            (math-cancel-common-factor (nth 1 math-simplify-expr) n))
457                    (setcar (cdr (cdr expr))                    (setcar (cdr (cdr math-simplify-expr))
458                            (math-cancel-common-factor (nth 2 expr) n))                            (math-cancel-common-factor (nth 2 math-simplify-expr) n))
459                    (if (and (math-negp n)                    (if (and (math-negp n)
460                             (setq op (assq (car expr) calc-tweak-eqn-table)))                             (setq op (assq (car math-simplify-expr)
461                        (setcar expr (nth 1 op))))))))                                            calc-tweak-eqn-table)))
462                          (setcar math-simplify-expr (nth 1 op))))))))
463      (if (and (eq (car-safe (car np)) '/)      (if (and (eq (car-safe (car np)) '/)
464               (math-known-scalarp (nth 2 expr) t))               (math-known-scalarp (nth 2 math-simplify-expr) t))
465          (progn          (progn
466            (setq np (cdr (nth 1 expr)))            (setq np (cdr (nth 1 math-simplify-expr)))
467            (while (eq (car-safe (setq n (car np))) '*)            (while (eq (car-safe (setq n (car np))) '*)
468              (and (math-known-scalarp (nth 2 n) t)              (and (math-known-scalarp (nth 2 n) t)
469                   (math-simplify-divisor (cdr n) (cdr (cdr expr)) nil t))                   (math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nil t))
470              (setq np (cdr (cdr n))))              (setq np (cdr (cdr n))))
471            (math-simplify-divisor np (cdr (cdr expr)) nil t)            (math-simplify-divisor np (cdr (cdr math-simplify-expr)) nil t)
472            (setq nover t            (setq nover t
473                  np (cdr (cdr (nth 1 expr))))))                  np (cdr (cdr (nth 1 math-simplify-expr))))))
474      (while (eq (car-safe (setq n (car np))) '*)      (while (eq (car-safe (setq n (car np))) '*)
475        (and (math-known-scalarp (nth 2 n) t)        (and (math-known-scalarp (nth 2 n) t)
476             (math-simplify-divisor (cdr n) (cdr (cdr expr)) nover t))             (math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nover t))
477        (setq np (cdr (cdr n))))        (setq np (cdr (cdr n))))
478      (math-simplify-divisor np (cdr (cdr expr)) nover t)      (math-simplify-divisor np (cdr (cdr math-simplify-expr)) nover t)
479      expr))      math-simplify-expr))
480    
481  (defun math-simplify-divisor (np dp nover dover)  ;; The variables math-simplify-divisor-nover and math-simplify-divisor-dover
482    ;; are local variables for math-simplify-divisor, but are used by
483    ;; math-simplify-one-divisor.
484    (defvar math-simplify-divisor-nover)
485    (defvar math-simplify-divisor-dover)
486    
487    (defun math-simplify-divisor (np dp math-simplify-divisor-nover
488                                     math-simplify-divisor-dover)
489    (cond ((eq (car-safe (car dp)) '/)    (cond ((eq (car-safe (car dp)) '/)
490           (math-simplify-divisor np (cdr (car dp)) nover dover)           (math-simplify-divisor np (cdr (car dp))
491                                    math-simplify-divisor-nover
492                                    math-simplify-divisor-dover)
493           (and (math-known-scalarp (nth 1 (car dp)) t)           (and (math-known-scalarp (nth 1 (car dp)) t)
494                (math-simplify-divisor np (cdr (cdr (car dp)))                (math-simplify-divisor np (cdr (cdr (car dp)))
495                                       nover (not dover))))                                       math-simplify-divisor-nover
496          ((or (or (eq (car expr) '/)                                       (not math-simplify-divisor-dover))))
497            ((or (or (eq (car math-simplify-expr) '/)
498                   (let ((signs (math-possible-signs (car np))))                   (let ((signs (math-possible-signs (car np))))
499                     (or (memq signs '(1 4))                     (or (memq signs '(1 4))
500                         (and (memq (car expr) '(calcFunc-eq calcFunc-neq))                         (and (memq (car math-simplify-expr) '(calcFunc-eq calcFunc-neq))
501                              (eq signs 5))                              (eq signs 5))
502                         math-living-dangerously)))                         math-living-dangerously)))
503               (math-numberp (car np)))               (math-numberp (car np)))
504           (let ((n (car np))           (let ((n (car np))
505                 d dd temp op                 d dd
506                 (safe t) (scalar (math-known-scalarp n)))                 (safe t) (scalar (math-known-scalarp n)))
507             (while (and (eq (car-safe (setq d (car dp))) '*)             (while (and (eq (car-safe (setq d (car dp))) '*)
508                         safe)                         safe)
# Line 483  Line 513 
513                 (math-simplify-one-divisor np dp))))))                 (math-simplify-one-divisor np dp))))))
514    
515  (defun math-simplify-one-divisor (np dp)  (defun math-simplify-one-divisor (np dp)
516    (if (setq temp (math-combine-prod (car np) (car dp) nover dover t))    (let ((temp (math-combine-prod (car np) (car dp) math-simplify-divisor-nover
517        (progn                                   math-simplify-divisor-dover t))
518          (and (not (memq (car expr) '(/ calcFunc-eq calcFunc-neq)))          op)
519               (math-known-negp (car dp))      (if temp
520               (setq op (assq (car expr) calc-tweak-eqn-table))          (progn
521               (setcar expr (nth 1 op)))            (and (not (memq (car math-simplify-expr) '(/ calcFunc-eq calcFunc-neq)))
522          (setcar np (if nover (math-div 1 temp) temp))                 (math-known-negp (car dp))
523          (setcar dp 1))                 (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table))
524      (and dover (not nover) (eq (car expr) '/)                 (setcar math-simplify-expr (nth 1 op)))
525           (eq (car-safe (car dp)) 'calcFunc-sqrt)            (setcar np (if math-simplify-divisor-nover (math-div 1 temp) temp))
526           (Math-integerp (nth 1 (car dp)))            (setcar dp 1))
527           (progn        (and math-simplify-divisor-dover (not math-simplify-divisor-nover)
528             (setcar np (math-mul (car np)             (eq (car math-simplify-expr) '/)
529                                  (list 'calcFunc-sqrt (nth 1 (car dp)))))             (eq (car-safe (car dp)) 'calcFunc-sqrt)
530             (setcar dp (nth 1 (car dp)))))))             (Math-integerp (nth 1 (car dp)))
531               (progn
532                 (setcar np (math-mul (car np)
533                                      (list 'calcFunc-sqrt (nth 1 (car dp)))))
534                 (setcar dp (nth 1 (car dp))))))))
535    
536  (defun math-common-constant-factor (expr)  (defun math-common-constant-factor (expr)
537    (if (Math-realp expr)    (if (Math-realp expr)
# Line 546  Line 580 
580    (math-simplify-mod))    (math-simplify-mod))
581    
582  (defun math-simplify-mod ()  (defun math-simplify-mod ()
583    (and (Math-realp (nth 2 expr))    (and (Math-realp (nth 2 math-simplify-expr))
584         (Math-posp (nth 2 expr))         (Math-posp (nth 2 math-simplify-expr))
585         (let ((lin (math-is-linear (nth 1 expr)))         (let ((lin (math-is-linear (nth 1 math-simplify-expr)))
586               t1 t2 t3)               t1 t2 t3)
587           (or (and lin           (or (and lin
588                    (or (math-negp (car lin))                    (or (math-negp (car lin))
589                        (not (Math-lessp (car lin) (nth 2 expr))))                        (not (Math-lessp (car lin) (nth 2 math-simplify-expr))))
590                    (list '%                    (list '%
591                          (list '+                          (list '+
592                                (math-mul (nth 1 lin) (nth 2 lin))                                (math-mul (nth 1 lin) (nth 2 lin))
593                                (math-mod (car lin) (nth 2 expr)))                                (math-mod (car lin) (nth 2 math-simplify-expr)))
594                          (nth 2 expr)))                          (nth 2 math-simplify-expr)))
595               (and lin               (and lin
596                    (not (math-equal-int (nth 1 lin) 1))                    (not (math-equal-int (nth 1 lin) 1))
597                    (math-num-integerp (nth 1 lin))                    (math-num-integerp (nth 1 lin))
598                    (math-num-integerp (nth 2 expr))                    (math-num-integerp (nth 2 math-simplify-expr))
599                    (setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 expr)))                    (setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 math-simplify-expr)))
600                    (not (math-equal-int t1 1))                    (not (math-equal-int t1 1))
601                    (list '*                    (list '*
602                          t1                          t1
# Line 572  Line 606 
606                                                (nth 2 lin))                                                (nth 2 lin))
607                                      (let ((calc-prefer-frac t))                                      (let ((calc-prefer-frac t))
608                                        (math-div (car lin) t1)))                                        (math-div (car lin) t1)))
609                                (math-div (nth 2 expr) t1))))                                (math-div (nth 2 math-simplify-expr) t1))))
610               (and (math-equal-int (nth 2 expr) 1)               (and (math-equal-int (nth 2 math-simplify-expr) 1)
611                    (math-known-integerp (if lin                    (math-known-integerp (if lin
612                                             (math-mul (nth 1 lin) (nth 2 lin))                                             (math-mul (nth 1 lin) (nth 2 lin))
613                                           (nth 1 expr)))                                           (nth 1 math-simplify-expr)))
614                    (if lin (math-mod (car lin) 1) 0))))))                    (if lin (math-mod (car lin) 1) 0))))))
615    
616  (math-defsimplify (calcFunc-eq calcFunc-neq calcFunc-lt  (math-defsimplify (calcFunc-eq calcFunc-neq calcFunc-lt
617                                 calcFunc-gt calcFunc-leq calcFunc-geq)                                 calcFunc-gt calcFunc-leq calcFunc-geq)
618    (if (= (length expr) 3)    (if (= (length math-simplify-expr) 3)
619        (math-simplify-ineq)))        (math-simplify-ineq)))
620    
621  (defun math-simplify-ineq ()  (defun math-simplify-ineq ()
622    (let ((np (cdr expr))    (let ((np (cdr math-simplify-expr))
623          n)          n)
624      (while (memq (car-safe (setq n (car np))) '(+ -))      (while (memq (car-safe (setq n (car np))) '(+ -))
625        (math-simplify-add-term (cdr (cdr n)) (cdr (cdr expr))        (math-simplify-add-term (cdr (cdr n)) (cdr (cdr math-simplify-expr))
626                                (eq (car n) '-) nil)                                (eq (car n) '-) nil)
627        (setq np (cdr n)))        (setq np (cdr n)))
628      (math-simplify-add-term np (cdr (cdr expr)) nil (eq np (cdr expr)))      (math-simplify-add-term np (cdr (cdr math-simplify-expr)) nil
629                                (eq np (cdr math-simplify-expr)))
630      (math-simplify-divide)      (math-simplify-divide)
631      (let ((signs (math-possible-signs (cons '- (cdr expr)))))      (let ((signs (math-possible-signs (cons '- (cdr math-simplify-expr)))))
632        (or (cond ((eq (car expr) 'calcFunc-eq)        (or (cond ((eq (car math-simplify-expr) 'calcFunc-eq)
633                   (or (and (eq signs 2) 1)                   (or (and (eq signs 2) 1)
634                       (and (memq signs '(1 4 5)) 0)))                       (and (memq signs '(1 4 5)) 0)))
635                  ((eq (car expr) 'calcFunc-neq)                  ((eq (car math-simplify-expr) 'calcFunc-neq)
636                   (or (and (eq signs 2) 0)                   (or (and (eq signs 2) 0)
637                       (and (memq signs '(1 4 5)) 1)))                       (and (memq signs '(1 4 5)) 1)))
638                  ((eq (car expr) 'calcFunc-lt)                  ((eq (car math-simplify-expr) 'calcFunc-lt)
639                   (or (and (eq signs 1) 1)                   (or (and (eq signs 1) 1)
640                       (and (memq signs '(2 4 6)) 0)))                       (and (memq signs '(2 4 6)) 0)))
641                  ((eq (car expr) 'calcFunc-gt)                  ((eq (car math-simplify-expr) 'calcFunc-gt)
642                   (or (and (eq signs 4) 1)                   (or (and (eq signs 4) 1)
643                       (and (memq signs '(1 2 3)) 0)))                       (and (memq signs '(1 2 3)) 0)))
644                  ((eq (car expr) 'calcFunc-leq)                  ((eq (car math-simplify-expr) 'calcFunc-leq)
645                   (or (and (eq signs 4) 0)                   (or (and (eq signs 4) 0)
646                       (and (memq signs '(1 2 3)) 1)))                       (and (memq signs '(1 2 3)) 1)))
647                  ((eq (car expr) 'calcFunc-geq)                  ((eq (car math-simplify-expr) 'calcFunc-geq)
648                   (or (and (eq signs 1) 0)                   (or (and (eq signs 1) 0)
649                       (and (memq signs '(2 4 6)) 1))))                       (and (memq signs '(2 4 6)) 1))))
650            expr))))            math-simplify-expr))))
651    
652  (defun math-simplify-add-term (np dp minus lplain)  (defun math-simplify-add-term (np dp minus lplain)
653    (or (math-vectorp (car np))    (or (math-vectorp (car np))
# Line 644  Line 679 
679                  (setcar dp (setq n (math-neg temp)))))))))                  (setcar dp (setq n (math-neg temp)))))))))
680    
681  (math-defsimplify calcFunc-sin  (math-defsimplify calcFunc-sin
682    (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)    (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
683             (nth 1 (nth 1 expr)))             (nth 1 (nth 1 math-simplify-expr)))
684        (and (math-looks-negp (nth 1 expr))        (and (math-looks-negp (nth 1 math-simplify-expr))
685             (math-neg (list 'calcFunc-sin (math-neg (nth 1 expr)))))             (math-neg (list 'calcFunc-sin (math-neg (nth 1 math-simplify-expr)))))
686        (and (eq calc-angle-mode 'rad)        (and (eq calc-angle-mode 'rad)
687             (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi))))             (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
688               (and n               (and n
689                    (math-known-sin (car n) (nth 1 n) 120 0))))                    (math-known-sin (car n) (nth 1 n) 120 0))))
690        (and (eq calc-angle-mode 'deg)        (and (eq calc-angle-mode 'deg)
691             (let ((n (math-integer-plus (nth 1 expr))))             (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
692               (and n               (and n
693                    (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0))))                    (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0))))
694        (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)        (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
695             (list 'calcFunc-sqrt (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))             (list 'calcFunc-sqrt (math-sub 1 (math-sqr
696        (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)                                               (nth 1 (nth 1 math-simplify-expr))))))
697             (math-div (nth 1 (nth 1 expr))        (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
698               (math-div (nth 1 (nth 1 math-simplify-expr))
699                       (list 'calcFunc-sqrt                       (list 'calcFunc-sqrt
700                             (math-add 1 (math-sqr (nth 1 (nth 1 expr)))))))                             (math-add 1 (math-sqr
701        (let ((m (math-should-expand-trig (nth 1 expr))))                                          (nth 1 (nth 1 math-simplify-expr)))))))
702          (let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
703          (and m (integerp (car m))          (and m (integerp (car m))
704               (let ((n (car m)) (a (nth 1 m)))               (let ((n (car m)) (a (nth 1 m)))
705                 (list '+                 (list '+
# Line 672  Line 709 
709                             (list 'calcFunc-sin a))))))))                             (list 'calcFunc-sin a))))))))
710    
711  (math-defsimplify calcFunc-cos  (math-defsimplify calcFunc-cos
712    (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)    (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
713             (nth 1 (nth 1 expr)))             (nth 1 (nth 1 math-simplify-expr)))
714        (and (math-looks-negp (nth 1 expr))        (and (math-looks-negp (nth 1 math-simplify-expr))
715             (list 'calcFunc-cos (math-neg (nth 1 expr))))             (list 'calcFunc-cos (math-neg (nth 1 math-simplify-expr))))
716        (and (eq calc-angle-mode 'rad)        (and (eq calc-angle-mode 'rad)
717             (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi))))             (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
718               (and n               (and n
719                    (math-known-sin (car n) (nth 1 n) 120 300))))                    (math-known-sin (car n) (nth 1 n) 120 300))))
720        (and (eq calc-angle-mode 'deg)        (and (eq calc-angle-mode 'deg)
721             (let ((n (math-integer-plus (nth 1 expr))))             (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
722               (and n               (and n
723                    (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300))))                    (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300))))
724        (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)        (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
725             (list 'calcFunc-sqrt (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))             (list 'calcFunc-sqrt
726        (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)                   (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))
727          (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
728             (math-div 1             (math-div 1
729                       (list 'calcFunc-sqrt                       (list 'calcFunc-sqrt
730                             (math-add 1 (math-sqr (nth 1 (nth 1 expr)))))))                             (math-add 1
731        (let ((m (math-should-expand-trig (nth 1 expr))))                                       (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
732          (let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
733          (and m (integerp (car m))          (and m (integerp (car m))
734               (let ((n (car m)) (a (nth 1 m)))               (let ((n (car m)) (a (nth 1 m)))
735                 (list '-                 (list '-
# Line 752  Line 791 
791                   (t nil))))))                   (t nil))))))
792    
793  (math-defsimplify calcFunc-tan  (math-defsimplify calcFunc-tan
794    (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan)    (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
795             (nth 1 (nth 1 expr)))             (nth 1 (nth 1 math-simplify-expr)))
796        (and (math-looks-negp (nth 1 expr))        (and (math-looks-negp (nth 1 math-simplify-expr))
797             (math-neg (list 'calcFunc-tan (math-neg (nth 1 expr)))))             (math-neg (list 'calcFunc-tan (math-neg (nth 1 math-simplify-expr)))))
798        (and (eq calc-angle-mode 'rad)        (and (eq calc-angle-mode 'rad)
799             (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi))))             (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
800               (and n               (and n
801                    (math-known-tan (car n) (nth 1 n) 120))))                    (math-known-tan (car n) (nth 1 n) 120))))
802        (and (eq calc-angle-mode 'deg)        (and (eq calc-angle-mode 'deg)
803             (let ((n (math-integer-plus (nth 1 expr))))             (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
804               (and n               (and n
805                    (math-known-tan (car n) (nth 1 n) '(frac 2 3)))))                    (math-known-tan (car n) (nth 1 n) '(frac 2 3)))))
806        (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin)        (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
807             (math-div (nth 1 (nth 1 expr))             (math-div (nth 1 (nth 1 math-simplify-expr))
808                       (list 'calcFunc-sqrt                       (list 'calcFunc-sqrt
809                             (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))))                             (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
810        (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos)        (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
811             (math-div (list 'calcFunc-sqrt             (math-div (list 'calcFunc-sqrt
812                             (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))                             (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))
813                       (nth 1 (nth 1 expr))))                       (nth 1 (nth 1 math-simplify-expr))))
814        (let ((m (math-should-expand-trig (nth 1 expr))))        (let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
815          (and m          (and m
816               (if (equal (car m) '(frac 1 2))               (if (equal (car m) '(frac 1 2))
817                   (math-div (math-sub 1 (list 'calcFunc-cos (nth 1 m)))                   (math-div (math-sub 1 (list 'calcFunc-cos (nth 1 m)))
818                             (list 'calcFunc-sin (nth 1 m)))                             (list 'calcFunc-sin (nth 1 m)))
819                 (math-div (list 'calcFunc-sin (nth 1 expr))                 (math-div (list 'calcFunc-sin (nth 1 math-simplify-expr))
820                           (list 'calcFunc-cos (nth 1 expr))))))))                           (list 'calcFunc-cos (nth 1 math-simplify-expr))))))))
821    
822  (defun math-known-tan (plus n mul)  (defun math-known-tan (plus n mul)
823    (setq n (math-mul n mul))    (setq n (math-mul n mul))
# Line 813  Line 852 
852                   (t nil))))))                   (t nil))))))
853    
854  (math-defsimplify calcFunc-sinh  (math-defsimplify calcFunc-sinh
855    (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh)    (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
856             (nth 1 (nth 1 expr)))             (nth 1 (nth 1 math-simplify-expr)))
857        (and (math-looks-negp (nth 1 expr))        (and (math-looks-negp (nth 1 math-simplify-expr))
858             (math-neg (list 'calcFunc-sinh (math-neg (nth 1 expr)))))             (math-neg (list 'calcFunc-sinh (math-neg (nth 1 math-simplify-expr)))))
859        (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh)        (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
860             math-living-dangerously             math-living-dangerously
861             (list 'calcFunc-sqrt (math-sub (math-sqr (nth 1 (nth 1 expr))) 1)))             (list 'calcFunc-sqrt
862        (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh)                   (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))
863          (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
864             math-living-dangerously             math-living-dangerously
865             (math-div (nth 1 (nth 1 expr))             (math-div (nth 1 (nth 1 math-simplify-expr))
866                       (list 'calcFunc-sqrt                       (list 'calcFunc-sqrt
867                             (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))))                             (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
868        (let ((m (math-should-expand-trig (nth 1 expr) t)))        (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t)))
869          (and m (integerp (car m))          (and m (integerp (car m))
870               (let ((n (car m)) (a (nth 1 m)))               (let ((n (car m)) (a (nth 1 m)))
871                 (if (> n 1)                 (if (> n 1)
# Line 836  Line 876 
876                                 (list 'calcFunc-sinh a)))))))))                                 (list 'calcFunc-sinh a)))))))))
877    
878  (math-defsimplify calcFunc-cosh  (math-defsimplify calcFunc-cosh
879    (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh)    (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
880             (nth 1 (nth 1 expr)))             (nth 1 (nth 1 math-simplify-expr)))
881        (and (math-looks-negp (nth 1 expr))        (and (math-looks-negp (nth 1 math-simplify-expr))
882             (list 'calcFunc-cosh (math-neg (nth 1 expr))))             (list 'calcFunc-cosh (math-neg (nth 1 math-simplify-expr))))
883        (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh)        (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
884             math-living-dangerously             math-living-dangerously
885             (list 'calcFunc-sqrt (math-add (math-sqr (nth 1 (nth 1 expr))) 1)))             (list 'calcFunc-sqrt
886        (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh)                   (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))
887          (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
888             math-living-dangerously             math-living-dangerously
889             (math-div 1             (math-div 1
890                       (list 'calcFunc-sqrt                       (list 'calcFunc-sqrt
891                             (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))))                             (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
892        (let ((m (math-should-expand-trig (nth 1 expr) t)))        (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t)))
893          (and m (integerp (car m))          (and m (integerp (car m))
894               (let ((n (car m)) (a (nth 1 m)))               (let ((n (car m)) (a (nth 1 m)))
895                 (if (> n 1)                 (if (> n 1)
# Line 859  Line 900 
900                                 (list 'calcFunc-sinh a)))))))))                                 (list 'calcFunc-sinh a)))))))))
901    
902  (math-defsimplify calcFunc-tanh  (math-defsimplify calcFunc-tanh
903    (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh)    (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
904             (nth 1 (nth 1 expr)))             (nth 1 (nth 1 math-simplify-expr)))
905        (and (math-looks-negp (nth 1 expr))        (and (math-looks-negp (nth 1 math-simplify-expr))
906             (math-neg (list 'calcFunc-tanh (math-neg (nth 1 expr)))))             (math-neg (list 'calcFunc-tanh (math-neg (nth 1 math-simplify-expr)))))
907        (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh)        (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
908             math-living-dangerously             math-living-dangerously
909             (math-div (nth 1 (nth 1 expr))             (math-div (nth 1 (nth 1 math-simplify-expr))
910                       (list 'calcFunc-sqrt                       (list 'calcFunc-sqrt
911                             (math-add (math-sqr (nth 1 (nth 1 expr))) 1))))                             (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
912        (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh)        (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
913             math-living-dangerously             math-living-dangerously
914             (math-div (list 'calcFunc-sqrt             (math-div (list 'calcFunc-sqrt
915                             (math-sub (math-sqr (nth 1 (nth 1 expr))) 1))                             (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))
916                       (nth 1 (nth 1 expr))))                       (nth 1 (nth 1 math-simplify-expr))))
917        (let ((m (math-should-expand-trig (nth 1 expr) t)))        (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t)))
918          (and m          (and m
919               (if (equal (car m) '(frac 1 2))               (if (equal (car m) '(frac 1 2))
920                   (math-div (math-sub (list 'calcFunc-cosh (nth 1 m)) 1)                   (math-div (math-sub (list 'calcFunc-cosh (nth 1 m)) 1)
921                             (list 'calcFunc-sinh (nth 1 m)))                             (list 'calcFunc-sinh (nth 1 m)))
922                 (math-div (list 'calcFunc-sinh (nth 1 expr))                 (math-div (list 'calcFunc-sinh (nth 1 math-simplify-expr))
923                           (list 'calcFunc-cosh (nth 1 expr))))))))                           (list 'calcFunc-cosh (nth 1 math-simplify-expr))))))))
924    
925  (math-defsimplify calcFunc-arcsin  (math-defsimplify calcFunc-arcsin
926    (or (and (math-looks-negp (nth 1 expr))    (or (and (math-looks-negp (nth 1 math-simplify-expr))
927             (math-neg (list 'calcFunc-arcsin (math-neg (nth 1 expr)))))             (math-neg (list 'calcFunc-arcsin (math-neg (nth 1 math-simplify-expr)))))
928        (and (eq (nth 1 expr) 1)        (and (eq (nth 1 math-simplify-expr) 1)
929             (math-quarter-circle t))             (math-quarter-circle t))
930        (and (equal (nth 1 expr) '(frac 1 2))        (and (equal (nth 1 math-simplify-expr) '(frac 1 2))
931             (math-div (math-half-circle t) 6))             (math-div (math-half-circle t) 6))
932        (and math-living-dangerously        (and math-living-dangerously
933             (eq (car-safe (nth 1 expr)) 'calcFunc-sin)             (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sin)
934             (nth 1 (nth 1 expr)))             (nth 1 (nth 1 math-simplify-expr)))
935        (and math-living-dangerously        (and math-living-dangerously
936             (eq (car-safe (nth 1 expr)) 'calcFunc-cos)             (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos)
937             (math-sub (math-quarter-circle t)             (math-sub (math-quarter-circle t)
938                       (nth 1 (nth 1 expr))))))                       (nth 1 (nth 1 math-simplify-expr))))))
939    
940  (math-defsimplify calcFunc-arccos  (math-defsimplify calcFunc-arccos
941    (or (and (eq (nth 1 expr) 0)    (or (and (eq (nth 1 math-simplify-expr) 0)
942             (math-quarter-circle t))             (math-quarter-circle t))
943        (and (eq (nth 1 expr) -1)        (and (eq (nth 1 math-simplify-expr) -1)
944             (math-half-circle t))             (math-half-circle t))
945        (and (equal (nth 1 expr) '(frac 1 2))        (and (equal (nth 1 math-simplify-expr) '(frac 1 2))
946             (math-div (math-half-circle t) 3))             (math-div (math-half-circle t) 3))
947        (and (equal (nth 1 expr) '(frac -1 2))        (and (equal (nth 1 math-simplify-expr) '(frac -1 2))
948             (math-div (math-mul (math-half-circle t) 2) 3))             (math-div (math-mul (math-half-circle t) 2) 3))
949        (and math-living-dangerously        (and math-living-dangerously
950             (eq (car-safe (nth 1 expr)) 'calcFunc-cos)             (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos)
951             (nth 1 (nth 1 expr)))             (nth 1 (nth 1 math-simplify-expr)))
952        (and math-living-dangerously        (and math-living-dangerously
953             (eq (car-safe (nth 1 expr)) 'calcFunc-sin)             (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sin)
954             (math-sub (math-quarter-circle t)             (math-sub (math-quarter-circle t)
955                       (nth 1 (nth 1 expr))))))                       (nth 1 (nth 1 math-simplify-expr))))))
956    
957  (math-defsimplify calcFunc-arctan  (math-defsimplify calcFunc-arctan
958    (or (and (math-looks-negp (nth 1 expr))    (or (and (math-looks-negp (nth 1 math-simplify-expr))
959             (math-neg (list 'calcFunc-arctan (math-neg (nth 1 expr)))))             (math-neg (list 'calcFunc-arctan (math-neg (nth 1 math-simplify-expr)))))
960        (and (eq (nth 1 expr) 1)        (and (eq (nth 1 math-simplify-expr) 1)
961             (math-div (math-half-circle t) 4))             (math-div (math-half-circle t) 4))
962        (and math-living-dangerously        (and math-living-dangerously
963             (eq (car-safe (nth 1 expr)) 'calcFunc-tan)             (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-tan)
964             (nth 1 (nth 1 expr)))))             (nth 1 (nth 1 math-simplify-expr)))))
965    
966  (math-defsimplify calcFunc-arcsinh  (math-defsimplify calcFunc-arcsinh
967    (or (and (math-looks-negp (nth 1 expr))    (or (and (math-looks-negp (nth 1 math-simplify-expr))
968             (math-neg (list 'calcFunc-arcsinh (math-neg (nth 1 expr)))))             (math-neg (list 'calcFunc-arcsinh (math-neg (nth 1 math-simplify-expr)))))
969        (and (eq (car-safe (nth 1 expr)) 'calcFunc-sinh)        (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sinh)
970             (or math-living-dangerously             (or math-living-dangerously
971                 (math-known-realp (nth 1 (nth 1 expr))))                 (math-known-realp (nth 1 (nth 1 math-simplify-expr))))
972             (nth 1 (nth 1 expr)))))             (nth 1 (nth 1 math-simplify-expr)))))
973    
974  (math-defsimplify calcFunc-arccosh  (math-defsimplify calcFunc-arccosh
975    (and (eq (car-safe (nth 1 expr)) 'calcFunc-cosh)    (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh)
976         (or math-living-dangerously         (or math-living-dangerously
977             (math-known-realp (nth 1 (nth 1 expr))))             (math-known-realp (nth 1 (nth 1 math-simplify-expr))))
978         (nth 1 (nth 1 expr))))         (nth 1 (nth 1 math-simplify-expr))))
979    
980  (math-defsimplify calcFunc-arctanh  (math-defsimplify calcFunc-arctanh
981    (or (and (math-looks-negp (nth 1 expr))    (or (and (math-looks-negp (nth 1 math-simplify-expr))
982             (math-neg (list 'calcFunc-arctanh (math-neg (nth 1 expr)))))             (math-neg (list 'calcFunc-arctanh (math-neg (nth 1 math-simplify-expr)))))
983        (and (eq (car-safe (nth 1 expr)) 'calcFunc-tanh)        (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-tanh)
984             (or math-living-dangerously             (or math-living-dangerously
985                 (math-known-realp (nth 1 (nth 1 expr))))                 (math-known-realp (nth 1 (nth 1 math-simplify-expr))))
986             (nth 1 (nth 1 expr)))))             (nth 1 (nth 1 math-simplify-expr)))))
987    
988  (math-defsimplify calcFunc-sqrt  (math-defsimplify calcFunc-sqrt
989    (math-simplify-sqrt))    (math-simplify-sqrt))
990    
991  (defun math-simplify-sqrt ()  (defun math-simplify-sqrt ()
992    (or (and (eq (car-safe (nth 1 expr)) 'frac)    (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac)
993             (math-div (list 'calcFunc-sqrt (math-mul (nth 1 (nth 1 expr))             (math-div (list 'calcFunc-sqrt
994                                                      (nth 2 (nth 1 expr))))                             (math-mul (nth 1 (nth 1 math-simplify-expr))
995                       (nth 2 (nth 1 expr))))                                       (nth 2 (nth 1 math-simplify-expr))))
996        (let ((fac (if (math-objectp (nth 1 expr))                       (nth 2 (nth 1 math-simplify-expr))))
997                       (math-squared-factor (nth 1 expr))        (let ((fac (if (math-objectp (nth 1 math-simplify-expr))
998                     (math-common-constant-factor (nth 1 expr)))))                       (math-squared-factor (nth 1 math-simplify-expr))
999                       (math-common-constant-factor (nth 1 math-simplify-expr)))))
1000          (and fac (not (eq fac 1))          (and fac (not (eq fac 1))
1001               (math-mul (math-normalize (list 'calcFunc-sqrt fac))               (math-mul (math-normalize (list 'calcFunc-sqrt fac))
1002                         (math-normalize                         (math-normalize
1003                          (list 'calcFunc-sqrt                          (list 'calcFunc-sqrt
1004                                (math-cancel-common-factor (nth 1 expr) fac))))))                                (math-cancel-common-factor
1005                                   (nth 1 math-simplify-expr) fac))))))
1006        (and math-living-dangerously        (and math-living-dangerously
1007             (or (and (eq (car-safe (nth 1 expr)) '-)             (or (and (eq (car-safe (nth 1 math-simplify-expr)) '-)
1008                      (math-equal-int (nth 1 (nth 1 expr)) 1)                      (math-equal-int (nth 1 (nth 1 math-simplify-expr)) 1)
1009                      (eq (car-safe (nth 2 (nth 1 expr))) '^)                      (eq (car-safe (nth 2 (nth 1 math-simplify-expr))) '^)
1010                      (math-equal-int (nth 2 (nth 2 (nth 1 expr))) 2)                      (math-equal-int (nth 2 (nth 2 (nth 1 math-simplify-expr))) 2)
1011                      (or (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr))))                      (or (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr))))
1012                                   'calcFunc-sin)                                   'calcFunc-sin)
1013                               (list 'calcFunc-cos                               (list 'calcFunc-cos
1014                                     (nth 1 (nth 1 (nth 2 (nth 1 expr))))))                                     (nth 1 (nth 1 (nth 2 (nth 1 math-simplify-expr))))))
1015                          (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr))))                          (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr))))
1016                                   'calcFunc-cos)                                   'calcFunc-cos)
1017                               (list 'calcFunc-sin                               (list 'calcFunc-sin
1018                                     (nth 1 (nth 1 (nth 2 (nth 1 expr))))))))                                     (nth 1 (nth 1 (nth 2
1019                 (and (eq (car-safe (nth 1 expr)) '-)                                                        (nth 1 math-simplify-expr))))))))
1020                      (math-equal-int (nth 2 (nth 1 expr)) 1)                 (and (eq (car-safe (nth 1 math-simplify-expr)) '-)
1021                      (eq (car-safe (nth 1 (nth 1 expr))) '^)                      (math-equal-int (nth 2 (nth 1 math-simplify-expr)) 1)
1022                      (math-equal-int (nth 2 (nth 1 (nth 1 expr))) 2)                      (eq (car-safe (nth 1 (nth 1 math-simplify-expr))) '^)
1023                      (and (eq (car-safe (nth 1 (nth 1 (nth 1 expr))))                      (math-equal-int (nth 2 (nth 1 (nth 1 math-simplify-expr))) 2)
1024                        (and (eq (car-safe (nth 1 (nth 1 (nth 1 math-simplify-expr))))
1025                               'calcFunc-cosh)                               'calcFunc-cosh)
1026                           (list 'calcFunc-sinh                           (list 'calcFunc-sinh
1027                                 (nth 1 (nth 1 (nth 1 (nth 1 expr)))))))                                 (nth 1 (nth 1 (nth 1 (nth 1 math-simplify-expr)))))))
1028                 (and (eq (car-safe (nth 1 expr)) '+)                 (and (eq (car-safe (nth 1 math-simplify-expr)) '+)
1029                      (let ((a (nth 1 (nth 1 expr)))                      (let ((a (nth 1 (nth 1 math-simplify-expr)))
1030                            (b (nth 2 (nth 1 expr))))                            (b (nth 2 (nth 1 math-simplify-expr))))
1031                        (and (or (and (math-equal-int a 1)                        (and (or (and (math-equal-int a 1)
1032                                      (setq a b b (nth 1 (nth 1 expr))))                                      (setq a b b (nth 1 (nth 1 math-simplify-expr))))
1033                                 (math-equal-int b 1))                                 (math-equal-int b 1))
1034                             (eq (car-safe a) '^)                             (eq (car-safe a) '^)
1035                             (math-equal-int (nth 2 a) 2)                             (math-equal-int (nth 2 a) 2)
# Line 994  Line 1038 
1038                                 (and (eq (car-safe (nth 1 a)) 'calcFunc-tan)                                 (and (eq (car-safe (nth 1 a)) 'calcFunc-tan)
1039                                      (list '/ 1 (list 'calcFunc-cos                                      (list '/ 1 (list 'calcFunc-cos
1040                                                       (nth 1 (nth 1 a)))))))))                                                       (nth 1 (nth 1 a)))))))))
1041                 (and (eq (car-safe (nth 1 expr)) '^)                 (and (eq (car-safe (nth 1 math-simplify-expr)) '^)
1042                      (list '^                      (list '^
1043                            (nth 1 (nth 1 expr))                            (nth 1 (nth 1 math-simplify-expr))
1044                            (math-div (nth 2 (nth 1 expr)) 2)))                            (math-div (nth 2 (nth 1 math-simplify-expr)) 2)))
1045                 (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt)                 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt)
1046                      (list '^ (nth 1 (nth 1 expr)) (math-div 1 4)))                      (list '^ (nth 1 (nth 1 math-simplify-expr)) (math-div 1 4)))
1047                 (and (memq (car-safe (nth 1 expr)) '(* /))                 (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
1048                      (list (car (nth 1 expr))                      (list (car (nth 1 math-simplify-expr))
1049                            (list 'calcFunc-sqrt (nth 1 (nth 1 expr)))                            (list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr)))
1050                            (list 'calcFunc-sqrt (nth 2 (nth 1 expr)))))                            (list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr)))))
1051                 (and (memq (car-safe (nth 1 expr)) '(+ -))                 (and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -))
1052                      (not (math-any-floats (nth 1 expr)))                      (not (math-any-floats (nth 1 math-simplify-expr)))
1053                      (let ((f (calcFunc-factors (calcFunc-expand                      (let ((f (calcFunc-factors (calcFunc-expand
1054                                                  (nth 1 expr)))))                                                  (nth 1 math-simplify-expr)))))
1055                        (and (math-vectorp f)                        (and (math-vectorp f)
1056                             (or (> (length f) 2)                             (or (> (length f) 2)
1057                                 (> (nth 2 (nth 1 f)) 1))                                 (> (nth 2 (nth 1 f)) 1))
# Line 1043  Line 1087 
1087          fac)))          fac)))
1088    
1089  (math-defsimplify calcFunc-exp  (math-defsimplify calcFunc-exp
1090    (math-simplify-exp (nth 1 expr)))    (math-simplify-exp (nth 1 math-simplify-expr)))
1091    
1092  (defun math-simplify-exp (x)  (defun math-simplify-exp (x)
1093    (or (and (eq (car-safe x) 'calcFunc-ln)    (or (and (eq (car-safe x) 'calcFunc-ln)
# Line 1074  Line 1118 
1118                    (list '+ c (list '* s '(var i var-i))))))))                    (list '+ c (list '* s '(var i var-i))))))))
1119    
1120  (math-defsimplify calcFunc-ln  (math-defsimplify calcFunc-ln
1121    (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-exp)    (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp)
1122             (or math-living-dangerously             (or math-living-dangerously
1123                 (math-known-realp (nth 1 (nth 1 expr))))                 (math-known-realp (nth 1 (nth 1 math-simplify-expr))))
1124             (nth 1 (nth 1 expr)))             (nth 1 (nth 1 math-simplify-expr)))
1125        (and (eq (car-safe (nth 1 expr)) '^)        (and (eq (car-safe (nth 1 math-simplify-expr)) '^)
1126             (equal (nth 1 (nth 1 expr)) '(var e var-e))             (equal (nth 1 (nth 1 math-simplify-expr)) '(var e var-e))
1127             (or math-living-dangerously             (or math-living-dangerously
1128                 (math-known-realp (nth 2 (nth 1 expr))))                 (math-known-realp (nth 2 (nth 1 math-simplify-expr))))
1129             (nth 2 (nth 1 expr)))             (nth 2 (nth 1 math-simplify-expr)))
1130        (and calc-symbolic-mode        (and calc-symbolic-mode
1131             (math-known-negp (nth 1 expr))             (math-known-negp (nth 1 math-simplify-expr))
1132             (math-add (list 'calcFunc-ln (math-neg (nth 1 expr)))             (math-add (list 'calcFunc-ln (math-neg (nth 1 math-simplify-expr)))
1133                       '(* (var pi var-pi) (var i var-i))))                       '(* (var pi var-pi) (var i var-i))))
1134        (and calc-symbolic-mode        (and calc-symbolic-mode
1135             (math-known-imagp (nth 1 expr))             (math-known-imagp (nth 1 math-simplify-expr))
1136             (let* ((ip (calcFunc-im (nth 1 expr)))             (let* ((ip (calcFunc-im (nth 1 math-simplify-expr)))
1137                    (ips (math-possible-signs ip)))                    (ips (math-possible-signs ip)))
1138               (or (and (memq ips '(4 6))               (or (and (memq ips '(4 6))
1139                        (math-add (list 'calcFunc-ln ip)                        (math-add (list 'calcFunc-ln ip)
# Line 1103  Line 1147 
1147    
1148  (defun math-simplify-pow ()  (defun math-simplify-pow ()
1149    (or (and math-living-dangerously    (or (and math-living-dangerously
1150             (or (and (eq (car-safe (nth 1 expr)) '^)             (or (and (eq (car-safe (nth 1 math-simplify-expr)) '^)
1151                      (list '^                      (list '^
1152                            (nth 1 (nth 1 expr))                            (nth 1 (nth 1 math-simplify-expr))
1153                            (math-mul (nth 2 expr) (nth 2 (nth 1 expr)))))                            (math-mul (nth 2 math-simplify-expr)
1154                 (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt)                                      (nth 2 (nth 1 math-simplify-expr)))))
1155                   (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt)
1156                      (list '^                      (list '^
1157                            (nth 1 (nth 1 expr))                            (nth 1 (nth 1 math-simplify-expr))
1158                            (math-div (nth 2 expr) 2)))                            (math-div (nth 2 math-simplify-expr) 2)))
1159                 (and (memq (car-safe (nth 1 expr)) '(* /))                 (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
1160                      (list (car (nth 1 expr))                      (list (car (nth 1 math-simplify-expr))
1161                            (list '^ (nth 1 (nth 1 expr)) (nth 2 expr))                            (list '^ (nth 1 (nth 1 math-simplify-expr))
1162                            (list '^ (nth 2 (nth 1 expr)) (nth 2 expr))))))                                  (nth 2 math-simplify-expr))
1163        (and (math-equal-int (nth 1 expr) 10)                            (list '^ (nth 2 (nth 1 math-simplify-expr))
1164             (eq (car-safe (nth 2 expr)) 'calcFunc-log10)                                  (nth 2 math-simplify-expr))))))
1165             (nth 1 (nth 2 expr)))        (and (math-equal-int (nth 1 math-simplify-expr) 10)
1166        (and (equal (nth 1 expr) '(var e var-e))             (eq (car-safe (nth 2 math-simplify-expr)) 'calcFunc-log10)
1167             (math-simplify-exp (nth 2 expr)))             (nth 1 (nth 2 math-simplify-expr)))
1168        (and (eq (car-safe (nth 1 expr)) 'calcFunc-exp)        (and (equal (nth 1 math-simplify-expr) '(var e var-e))
1169               (math-simplify-exp (nth 2 math-simplify-expr)))
1170          (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp)
1171             (not math-integrating)             (not math-integrating)
1172             (list 'calcFunc-exp (math-mul (nth 1 (nth 1 expr)) (nth 2 expr))))             (list 'calcFunc-exp (math-mul (nth 1 (nth 1 math-simplify-expr))
1173        (and (equal (nth 1 expr) '(var i var-i))                                           (nth 2 math-simplify-expr))))
1174          (and (equal (nth 1 math-simplify-expr) '(var i var-i))
1175             (math-imaginary-i)             (math-imaginary-i)
1176             (math-num-integerp (nth 2 expr))             (math-num-integerp (nth 2 math-simplify-expr))
1177             (let ((x (math-mod (math-trunc (nth 2 expr)) 4)))             (let ((x (math-mod (math-trunc (nth 2 math-simplify-expr)) 4)))
1178               (cond ((eq x 0) 1)               (cond ((eq x 0) 1)
1179                     ((eq x 1) (nth 1 expr))                     ((eq x 1) (nth 1 math-simplify-expr))
1180                     ((eq x 2) -1)                     ((eq x 2) -1)
1181                     ((eq x 3) (math-neg (nth 1 expr))))))                     ((eq x 3) (math-neg (nth 1 math-simplify-expr))))))
1182        (and math-integrating        (and math-integrating
1183             (integerp (nth 2 expr))             (integerp (nth 2 math-simplify-expr))
1184             (>= (nth 2 expr) 2)             (>= (nth 2 math-simplify-expr) 2)
1185             (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-cos)             (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos)
1186                      (math-mul (math-pow (nth 1 expr) (- (nth 2 expr) 2))                      (math-mul (math-pow (nth 1 math-simplify-expr)
1187                                            (- (nth 2 math-simplify-expr) 2))
1188                                (math-sub 1                                (math-sub 1
1189                                          (math-sqr                                          (math-sqr
1190                                           (list 'calcFunc-sin                                           (list 'calcFunc-sin
1191                                                 (nth 1 (nth 1 expr)))))))                                                 (nth 1 (nth 1 math-simplify-expr)))))))
1192                 (and (eq (car-safe (nth 1 expr)) 'calcFunc-cosh)                 (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh)
1193                      (math-mul (math-pow (nth 1 expr) (- (nth 2 expr) 2))                      (math-mul (math-pow (nth 1 math-simplify-expr)
1194                                            (- (nth 2 math-simplify-expr) 2))
1195                                (math-add 1                                (math-add 1
1196                                          (math-sqr                                          (math-sqr
1197                                           (list 'calcFunc-sinh                                           (list 'calcFunc-sinh
1198                                                 (nth 1 (nth 1 expr)))))))))                                                 (nth 1 (nth 1 math-simplify-expr)))))))))
1199        (and (eq (car-safe (nth 2 expr)) 'frac)        (and (eq (car-safe (nth 2 math-simplify-expr)) 'frac)
1200             (Math-ratp (nth 1 expr))             (Math-ratp (nth 1 math-simplify-expr))
1201             (Math-posp (nth 1 expr))             (Math-posp (nth 1 math-simplify-expr))
1202             (if (equal (nth 2 expr) '(frac 1 2))             (if (equal (nth 2 math-simplify-expr) '(frac 1 2))
1203                 (list 'calcFunc-sqrt (nth 1 expr))                 (list 'calcFunc-sqrt (nth 1 math-simplify-expr))
1204               (let ((flr (math-floor (nth 2 expr))))               (let ((flr (math-floor (nth 2 math-simplify-expr))))
1205                 (and (not (Math-zerop flr))                 (and (not (Math-zerop flr))
1206                      (list '* (list '^ (nth 1 expr) flr)                      (list '* (list '^ (nth 1 math-simplify-expr) flr)
1207                            (list '^ (nth 1 expr)                            (list '^ (nth 1 math-simplify-expr)
1208                                  (math-sub (nth 2 expr) flr)))))))                                  (math-sub (nth 2 math-simplify-expr) flr)))))))
1209        (and (eq (math-quarter-integer (nth 2 expr)) 2)        (and (eq (math-quarter-integer (nth 2 math-simplify-expr)) 2)
1210             (let ((temp (math-simplify-sqrt)))             (let ((temp (math-simplify-sqrt)))
1211               (and temp               (and temp
1212                    (list '^ temp (math-mul (nth 2 expr) 2)))))))                    (list '^ temp (math-mul (nth 2 math-simplify-expr) 2)))))))
1213    
1214  (math-defsimplify calcFunc-log10  (math-defsimplify calcFunc-log10
1215    (and (eq (car-safe (nth 1 expr)) '^)    (and (eq (car-safe (nth 1 math-simplify-expr)) '^)
1216         (math-equal-int (nth 1 (nth 1 expr)) 10)         (math-equal-int (nth 1 (nth 1 math-simplify-expr)) 10)
1217         (or math-living-dangerously         (or math-living-dangerously
1218             (math-known-realp (nth 2 (nth 1 expr))))             (math-known-realp (nth 2 (nth 1 math-simplify-expr))))
1219         (nth 2 (nth 1 expr))))         (nth 2 (nth 1 math-simplify-expr))))
1220    
1221    
1222  (math-defsimplify calcFunc-erf  (math-defsimplify calcFunc-erf
1223    (or (and (math-looks-negp (nth 1 expr))    (or (and (math-looks-negp (nth 1 math-simplify-expr))
1224             (math-neg (list 'calcFunc-erf (math-neg (nth 1 expr)))))             (math-neg (list 'calcFunc-erf (math-neg (nth 1 math-simplify-expr)))))
1225        (and (eq (car-safe (nth 1 expr)) 'calcFunc-conj)        (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj)
1226             (list 'calcFunc-conj (list 'calcFunc-erf (nth 1 (nth 1 expr)))))))             (list 'calcFunc-conj
1227                     (list 'calcFunc-erf (nth 1 (nth 1 math-simplify-expr)))))))
1228    
1229  (math-defsimplify calcFunc-erfc  (math-defsimplify calcFunc-erfc
1230    (or (and (math-looks-negp (nth 1 expr))    (or (and (math-looks-negp (nth 1 math-simplify-expr))
1231             (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 expr)))))             (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 math-simplify-expr)))))
1232        (and (eq (car-safe (nth 1 expr)) 'calcFunc-conj)        (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj)
1233             (list 'calcFunc-conj (list 'calcFunc-erfc (nth 1 (nth 1 expr)))))))             (list 'calcFunc-conj
1234                     (list 'calcFunc-erfc (nth 1 (nth 1 math-simplify-expr)))))))
1235    
1236    
1237  (defun math-linear-in (expr term &optional always)  (defun math-linear-in (expr term &optional always)
# Line 1325  Line 1377 
1377      thing))      thing))
1378    
1379  ;;; Substitute all occurrences of old for new in expr (non-destructive).  ;;; Substitute all occurrences of old for new in expr (non-destructive).
1380  (defun math-expr-subst (expr old new)  
1381    ;; The variables math-expr-subst-old and math-expr-subst-new are local
1382    ;; for math-expr-subst, but used by math-expr-subst-rec.
1383    (defvar math-expr-subst-old)
1384    (defvar math-expr-subst-new)
1385    
1386    (defun math-expr-subst (expr math-expr-subst-old math-expr-subst-new)
1387    (math-expr-subst-rec expr))    (math-expr-subst-rec expr))
1388    
1389  (defalias 'calcFunc-subst 'math-expr-subst)  (defalias 'calcFunc-subst 'math-expr-subst)
1390    
1391  (defun math-expr-subst-rec (expr)  (defun math-expr-subst-rec (expr)
1392    (cond ((equal expr old) new)    (cond ((equal expr math-expr-subst-old) math-expr-subst-new)
1393          ((Math-primp expr) expr)          ((Math-primp expr) expr)
1394          ((memq (car expr) '(calcFunc-deriv          ((memq (car expr) '(calcFunc-deriv
1395                              calcFunc-tderiv))                              calcFunc-tderiv))
1396           (if (= (length expr) 2)           (if (= (length expr) 2)
1397               (if (equal (nth 1 expr) old)               (if (equal (nth 1 expr) math-expr-subst-old)
1398                   (append expr (list new))                   (append expr (list math-expr-subst-new))
1399                 expr)                 expr)
1400             (list (car expr) (nth 1 expr)             (list (car expr) (nth 1 expr)
1401                   (math-expr-subst-rec (nth 2 expr)))))                   (math-expr-subst-rec (nth 2 expr)))))
# Line 1375  Line 1433 
1433        expr)))        expr)))
1434    
1435  ;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...),  ;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...),
1436  ;;; else return nil if not in polynomial form.  If "loose", coefficients  ;;; else return nil if not in polynomial form.  If "loose" (math-is-poly-loose),
1437  ;;; may contain x, e.g., sin(x) + cos(x) x^2 is a loose polynomial in x.  ;;; coefficients may contain x, e.g., sin(x) + cos(x) x^2 is a loose polynomial in x.
1438  (defun math-is-polynomial (expr var &optional degree loose)  
1439    (let* ((math-poly-base-variable (if loose  ;; The variables math-is-poly-degree and math-is-poly-loose are local to
1440                                        (if (eq loose 'gen) var '(var XXX XXX))  ;; math-is-polynomial, but are used by math-is-poly-rec
1441    (defvar math-is-poly-degree)
1442    (defvar math-is-poly-loose)
1443    
1444    (defun math-is-polynomial (expr var &optional math-is-poly-degree math-is-poly-loose)
1445      (let* ((math-poly-base-variable (if math-is-poly-loose
1446                                          (if (eq math-is-poly-loose 'gen) var '(var XXX XXX))
1447                                      math-poly-base-variable))                                      math-poly-base-variable))
1448           (poly (math-is-poly-rec expr math-poly-neg-powers)))           (poly (math-is-poly-rec expr math-poly-neg-powers)))
1449      (and (or (null degree)      (and (or (null math-is-poly-degree)
1450               (<= (length poly) (1+ degree)))               (<= (length poly) (1+ math-is-poly-degree)))
1451           poly)))           poly)))
1452    
1453  (defun math-is-poly-rec (expr negpow)  (defun math-is-poly-rec (expr negpow)
# Line 1431  Line 1495 
1495                                  (n pow)                                  (n pow)
1496                                  (accum (list 1)))                                  (accum (list 1)))
1497                              (and p1                              (and p1
1498                                   (or (null degree)                                   (or (null math-is-poly-degree)
1499                                       (<= (* (1- (length p1)) n) degree))                                       (<= (* (1- (length p1)) n) math-is-poly-degree))
1500                                   (progn                                   (progn
1501                                     (while (>= n 1)                                     (while (>= n 1)
1502                                       (setq accum (math-poly-mul accum p1)                                       (setq accum (math-poly-mul accum p1)
# Line 1460  Line 1524 
1524                  (and p1                  (and p1
1525                       (let ((p2 (math-is-poly-rec (nth 2 expr) negpow)))                       (let ((p2 (math-is-poly-rec (nth 2 expr) negpow)))
1526                         (and p2                         (and p2
1527                              (or (null degree)                              (or (null math-is-poly-degree)
1528                                  (<= (- (+ (length p1) (length p2)) 2) degree))                                  (<= (- (+ (length p1) (length p2)) 2)
1529                                        math-is-poly-degree))
1530                              (math-poly-mul p1 p2))))))                              (math-poly-mul p1 p2))))))
1531               ((eq (car expr) '/)               ((eq (car expr) '/)
1532                (and (or (not (math-poly-depends (nth 2 expr) var))                (and (or (not (math-poly-depends (nth 2 expr) var))
# Line 1481  Line 1546 
1546                (math-is-poly-rec (list '^ (nth 1 expr) '(frac 1 2)) negpow))                (math-is-poly-rec (list '^ (nth 1 expr) '(frac 1 2)) negpow))
1547               (t nil))               (t nil))
1548         (and (or (not (math-poly-depends expr var))         (and (or (not (math-poly-depends expr var))
1549                  loose)                  math-is-poly-loose)
1550              (not (eq (car expr) 'vec))              (not (eq (car expr) 'vec))
1551              (list expr)))))              (list expr)))))
1552    
# Line 1517  Line 1582 
1582      (math-expr-depends expr var)))      (math-expr-depends expr var)))
1583    
1584  ;;; Find the variable (or sub-expression) which is the base of polynomial expr.  ;;; Find the variable (or sub-expression) which is the base of polynomial expr.
1585  (defun math-polynomial-base (mpb-top-expr &optional mpb-pred)  ;; The variables math-poly-base-const-ok and math-poly-base-pred are
1586    (or mpb-pred  ;; local to math-polynomial-base, but are used by math-polynomial-base-rec.
1587        (setq mpb-pred (function (lambda (base) (math-polynomial-p  (defvar math-poly-base-const-ok)
1588    (defvar math-poly-base-pred)
1589    
1590    (defun math-polynomial-base (mpb-top-expr &optional math-poly-base-pred)
1591      (or math-poly-base-pred
1592          (setq math-poly-base-pred (function (lambda (base) (math-polynomial-p
1593                                                 mpb-top-expr base)))))                                                 mpb-top-expr base)))))
1594    (or (let ((const-ok nil))    (or (let ((math-poly-base-const-ok nil))
1595          (math-polynomial-base-rec mpb-top-expr))          (math-polynomial-base-rec mpb-top-expr))
1596        (let ((const-ok t))        (let ((math-poly-base-const-ok t))
1597          (math-polynomial-base-rec mpb-top-expr))))          (math-polynomial-base-rec mpb-top-expr))))
1598    
1599  (defun math-polynomial-base-rec (mpb-expr)  (defun math-polynomial-base-rec (mpb-expr)
# Line 1537  Line 1607 
1607                  (math-polynomial-base-rec (nth 1 mpb-expr)))                  (math-polynomial-base-rec (nth 1 mpb-expr)))
1608             (and (eq (car mpb-expr) 'calcFunc-exp)             (and (eq (car mpb-expr) 'calcFunc-exp)
1609                  (math-polynomial-base-rec '(var e var-e)))                  (math-polynomial-base-rec '(var e var-e)))
1610             (and (or const-ok (math-expr-contains-vars mpb-expr))             (and (or math-poly-base-const-ok (math-expr-contains-vars mpb-expr))
1611                  (funcall mpb-pred mpb-expr)                  (funcall math-poly-base-pred mpb-expr)
1612                  mpb-expr))))                  mpb-expr))))
1613    
1614  ;;; Return non-nil if expr refers to any variables.  ;;; Return non-nil if expr refers to any variables.

Legend:
Removed from v.1.3.4.2  
changed lines
  Added in v.1.3.4.3

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