calc-alg.el 68.6 KB
Newer Older
1
;;; calc-alg.el --- algebraic functions for Calc
2

Jay Belanger's avatar
Jay Belanger committed
3
;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2005, 2006, 2007 Free Software Foundation, Inc.
5 6

;; Author: David Gillespie <daveg@synaptics.com>
Jay Belanger's avatar
Jay Belanger committed
7
;; Maintainer: Jay Belanger  <jay.p.belanger@gmail.com>
Eli Zaretskii's avatar
Eli Zaretskii committed
8 9 10

;; This file is part of GNU Emacs.

11 12 13 14 15
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

Eli Zaretskii's avatar
Eli Zaretskii committed
16
;; GNU Emacs is distributed in the hope that it will be useful,
17 18 19 20 21 22 23 24
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Eli Zaretskii's avatar
Eli Zaretskii committed
25

26
;;; Commentary:
Eli Zaretskii's avatar
Eli Zaretskii committed
27

28
;;; Code:
Eli Zaretskii's avatar
Eli Zaretskii committed
29 30 31

;; This file is autoloaded from calc-ext.el.

Jay Belanger's avatar
Jay Belanger committed
32
(require 'calc-ext)
Eli Zaretskii's avatar
Eli Zaretskii committed
33 34 35 36 37 38 39 40 41 42
(require 'calc-macs)

;;; Algebra commands.

(defun calc-alg-evaluate (arg)
  (interactive "p")
  (calc-slow-wrapper
   (calc-with-default-simplification
    (let ((math-simplify-only nil))
      (calc-modify-simplify-mode arg)
43
      (calc-enter-result 1 "dsmp" (calc-top 1))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
44 45 46 47 48 49 50

(defun calc-modify-simplify-mode (arg)
  (if (= (math-abs arg) 2)
      (setq calc-simplify-mode 'alg)
    (if (>= (math-abs arg) 3)
	(setq calc-simplify-mode 'ext)))
  (if (< arg 0)
51
      (setq calc-simplify-mode (list calc-simplify-mode))))
Eli Zaretskii's avatar
Eli Zaretskii committed
52 53 54 55 56

(defun calc-simplify ()
  (interactive)
  (calc-slow-wrapper
   (calc-with-default-simplification
57
    (calc-enter-result 1 "simp" (math-simplify (calc-top-n 1))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
58 59 60 61 62

(defun calc-simplify-extended ()
  (interactive)
  (calc-slow-wrapper
   (calc-with-default-simplification
63
    (calc-enter-result 1 "esmp" (math-simplify-extended (calc-top-n 1))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
64 65 66 67 68 69 70

(defun calc-expand-formula (arg)
  (interactive "p")
  (calc-slow-wrapper
   (calc-with-default-simplification
    (let ((math-simplify-only nil))
      (calc-modify-simplify-mode arg)
71
      (calc-enter-result 1 "expf"
Eli Zaretskii's avatar
Eli Zaretskii committed
72 73 74 75 76
			 (if (> arg 0)
			     (let ((math-expand-formulas t))
			       (calc-top-n 1))
			   (let ((top (calc-top-n 1)))
			     (or (math-expand-formula top)
77
				 top))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
78 79 80 81 82 83

(defun calc-factor (arg)
  (interactive "P")
  (calc-slow-wrapper
   (calc-unary-op "fctr" (if (calc-is-hyperbolic)
			     'calcFunc-factors 'calcFunc-factor)
84
		  arg)))
Eli Zaretskii's avatar
Eli Zaretskii committed
85 86 87 88 89 90 91

(defun calc-expand (n)
  (interactive "P")
  (calc-slow-wrapper
   (calc-enter-result 1 "expa"
		      (append (list 'calcFunc-expand
				    (calc-top-n 1))
92
			      (and n (list (prefix-numeric-value n)))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
93

94
;;; Write out powers (a*b*...)^n as a*b*...*a*b*...
95 96
(defun calcFunc-powerexpand (expr)
  (math-normalize (math-map-tree 'math-powerexpand expr)))
97

98
(defun math-powerexpand (expr)
99
  (if (eq (car-safe expr) '^)
100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
      (let ((n (nth 2 expr)))
        (cond ((and (integerp n)
                    (> n 0))
               (let ((i 1)
                     (a (nth 1 expr))
                     (prod (nth 1 expr)))
                 (while (< i n)
                   (setq prod (math-mul prod a))
                   (setq i (1+ i)))
                 prod))
              ((and (integerp n)
                    (< n 0))
               (let ((i -1)
                     (a (math-pow (nth 1 expr) -1))
                     (prod (math-pow (nth 1 expr) -1)))
                 (while (> i n)
                   (setq prod (math-mul a prod))
                   (setq i (1- i)))
                 prod))
              (t
               expr)))
121 122
    expr))

123
(defun calc-powerexpand ()
124 125
  (interactive)
  (calc-slow-wrapper
126 127
   (calc-enter-result 1 "pexp"
		      (calcFunc-powerexpand (calc-top-n 1)))))
128

Eli Zaretskii's avatar
Eli Zaretskii committed
129 130 131 132 133 134 135 136 137 138 139
(defun calc-collect (&optional var)
  (interactive "sCollect terms involving: ")
  (calc-slow-wrapper
   (if (or (equal var "") (equal var "$") (null var))
       (calc-enter-result 2 "clct" (cons 'calcFunc-collect
					 (calc-top-list-n 2)))
     (let ((var (math-read-expr var)))
       (if (eq (car-safe var) 'error)
	   (error "Bad format in expression: %s" (nth 1 var)))
       (calc-enter-result 1 "clct" (list 'calcFunc-collect
					 (calc-top-n 1)
140
					 var))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
141 142 143 144

(defun calc-apart (arg)
  (interactive "P")
  (calc-slow-wrapper
145
   (calc-unary-op "aprt" 'calcFunc-apart arg)))
Eli Zaretskii's avatar
Eli Zaretskii committed
146 147 148 149

(defun calc-normalize-rat (arg)
  (interactive "P")
  (calc-slow-wrapper
150
   (calc-unary-op "nrat" 'calcFunc-nrat arg)))
Eli Zaretskii's avatar
Eli Zaretskii committed
151 152 153 154

(defun calc-poly-gcd (arg)
  (interactive "P")
  (calc-slow-wrapper
155
   (calc-binary-op "pgcd" 'calcFunc-pgcd arg)))
Eli Zaretskii's avatar
Eli Zaretskii committed
156

157

Eli Zaretskii's avatar
Eli Zaretskii committed
158 159 160
(defun calc-poly-div (arg)
  (interactive "P")
  (calc-slow-wrapper
161 162 163 164 165 166 167 168 169 170
   (let ((calc-poly-div-remainder nil))
     (calc-binary-op "pdiv" 'calcFunc-pdiv arg)
     (if (and calc-poly-div-remainder (null arg))
         (progn
           (calc-clear-command-flag 'clear-message)
           (calc-record calc-poly-div-remainder "prem")
           (if (not (Math-zerop calc-poly-div-remainder))
               (message "(Remainder was %s)"
                        (math-format-flat-expr calc-poly-div-remainder 0))
             (message "(No remainder)")))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
171 172 173 174

(defun calc-poly-rem (arg)
  (interactive "P")
  (calc-slow-wrapper
175
   (calc-binary-op "prem" 'calcFunc-prem arg)))
Eli Zaretskii's avatar
Eli Zaretskii committed
176 177 178 179 180 181

(defun calc-poly-div-rem (arg)
  (interactive "P")
  (calc-slow-wrapper
   (if (calc-is-hyperbolic)
       (calc-binary-op "pdvr" 'calcFunc-pdivide arg)
182
     (calc-binary-op "pdvr" 'calcFunc-pdivrem arg))))
Eli Zaretskii's avatar
Eli Zaretskii committed
183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210

(defun calc-substitute (&optional oldname newname)
  (interactive "sSubstitute old: ")
  (calc-slow-wrapper
   (let (old new (num 1) expr)
     (if (or (equal oldname "") (equal oldname "$") (null oldname))
	 (setq new (calc-top-n 1)
	       old (calc-top-n 2)
	       expr (calc-top-n 3)
	       num 3)
       (or newname
	   (progn (calc-unread-command ?\C-a)
		  (setq newname (read-string (concat "Substitute old: "
						     oldname
						     ", new: ")
					     oldname))))
       (if (or (equal newname "") (equal newname "$") (null newname))
	   (setq new (calc-top-n 1)
		 expr (calc-top-n 2)
		 num 2)
	 (setq new (if (stringp newname) (math-read-expr newname) newname))
	 (if (eq (car-safe new) 'error)
	     (error "Bad format in expression: %s" (nth 1 new)))
	 (setq expr (calc-top-n 1)))
       (setq old (if (stringp oldname) (math-read-expr oldname) oldname))
       (if (eq (car-safe old) 'error)
	   (error "Bad format in expression: %s" (nth 1 old)))
       (or (math-expr-contains expr old)
211
	   (error "No occurrences found")))
212
     (calc-enter-result num "sbst" (math-expr-subst expr old new)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
213 214 215 216 217 218


(defun calc-has-rules (name)
  (setq name (calc-var-value name))
  (and (consp name)
       (memq (car name) '(vec calcFunc-assign calcFunc-condition))
219
       name))
Eli Zaretskii's avatar
Eli Zaretskii committed
220

221 222 223 224 225
;; math-eval-rules-cache and math-eval-rules-cache-other are
;; declared in calc.el, but are used here by math-recompile-eval-rules.
(defvar math-eval-rules-cache)
(defvar math-eval-rules-cache-other)

Eli Zaretskii's avatar
Eli Zaretskii committed
226 227 228 229 230
(defun math-recompile-eval-rules ()
  (setq math-eval-rules-cache (and (calc-has-rules 'var-EvalRules)
				   (math-compile-rewrites
				    '(var EvalRules var-EvalRules)))
	math-eval-rules-cache-other (assq nil math-eval-rules-cache)
231
	math-eval-rules-cache-tag (calc-var-value 'var-EvalRules)))
Eli Zaretskii's avatar
Eli Zaretskii committed
232 233 234 235 236 237 238 239 240 241 242


;;; Try to expand a formula according to its definition.
(defun math-expand-formula (expr)
  (and (consp expr)
       (symbolp (car expr))
       (or (get (car expr) 'calc-user-defn)
	   (get (car expr) 'math-expandable))
       (let ((res (let ((math-expand-formulas t))
		    (apply (car expr) (cdr expr)))))
	 (and (not (eq (car-safe res) (car expr)))
243
	      res))))
Eli Zaretskii's avatar
Eli Zaretskii committed
244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298




;;; True if A comes before B in a canonical ordering of expressions.  [P X X]
(defun math-beforep (a b)   ; [Public]
  (cond ((and (Math-realp a) (Math-realp b))
	 (let ((comp (math-compare a b)))
	   (or (eq comp -1)
	       (and (eq comp 0)
		    (not (equal a b))
		    (> (length (memq (car-safe a)
				     '(bigneg nil bigpos frac float)))
		       (length (memq (car-safe b)
				     '(bigneg nil bigpos frac float))))))))
	((equal b '(neg (var inf var-inf))) nil)
	((equal a '(neg (var inf var-inf))) t)
	((equal a '(var inf var-inf)) nil)
	((equal b '(var inf var-inf)) t)
	((Math-realp a)
	 (if (and (eq (car-safe b) 'intv) (math-intv-constp b))
	     (if (or (math-beforep a (nth 2 b)) (Math-equal a (nth 2 b)))
		 t
	       nil)
	   t))
	((Math-realp b)
	 (if (and (eq (car-safe a) 'intv) (math-intv-constp a))
	     (if (math-beforep (nth 2 a) b)
		 t
	       nil)
	   nil))
	((and (eq (car a) 'intv) (eq (car b) 'intv)
	      (math-intv-constp a) (math-intv-constp b))
	 (let ((comp (math-compare (nth 2 a) (nth 2 b))))
	   (cond ((eq comp -1) t)
		 ((eq comp 1) nil)
		 ((and (memq (nth 1 a) '(2 3)) (memq (nth 1 b) '(0 1))) t)
		 ((and (memq (nth 1 a) '(0 1)) (memq (nth 1 b) '(2 3))) nil)
		 ((eq (setq comp (math-compare (nth 3 a) (nth 3 b))) -1) t)
		 ((eq comp 1) nil)
		 ((and (memq (nth 1 a) '(0 2)) (memq (nth 1 b) '(1 3))) t)
		 (t nil))))
	((not (eq (not (Math-objectp a)) (not (Math-objectp b))))
	 (Math-objectp a))
	((eq (car a) 'var)
	 (if (eq (car b) 'var)
	     (string-lessp (symbol-name (nth 1 a)) (symbol-name (nth 1 b)))
	   (not (Math-numberp b))))
	((eq (car b) 'var) (Math-numberp a))
	((eq (car a) (car b))
	 (while (and (setq a (cdr a) b (cdr b)) a
		     (equal (car a) (car b))))
	 (and b
	      (or (null a)
		  (math-beforep (car a) (car b)))))
299
	(t (string-lessp (symbol-name (car a)) (symbol-name (car b))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
300 301


302
(defsubst math-simplify-extended (a)
Eli Zaretskii's avatar
Eli Zaretskii committed
303
  (let ((math-living-dangerously t))
304 305 306
    (math-simplify a)))

(defalias 'calcFunc-esimplify 'math-simplify-extended)
Eli Zaretskii's avatar
Eli Zaretskii committed
307

308 309 310 311
;; math-top-only is local to math-simplify, but is used by 
;; math-simplify-step, which is called by math-simplify.
(defvar math-top-only)

Eli Zaretskii's avatar
Eli Zaretskii committed
312 313
(defun math-simplify (top-expr)
  (let ((math-simplifying t)
314
	(math-top-only (consp calc-simplify-mode))
Eli Zaretskii's avatar
Eli Zaretskii committed
315 316 317 318 319 320 321 322 323 324 325 326
	(simp-rules (append (and (calc-has-rules 'var-AlgSimpRules)
				 '((var AlgSimpRules var-AlgSimpRules)))
			    (and math-living-dangerously
				 (calc-has-rules 'var-ExtSimpRules)
				 '((var ExtSimpRules var-ExtSimpRules)))
			    (and math-simplifying-units
				 (calc-has-rules 'var-UnitSimpRules)
				 '((var UnitSimpRules var-UnitSimpRules)))
			    (and math-integrating
				 (calc-has-rules 'var-IntegSimpRules)
				 '((var IntegSimpRules var-IntegSimpRules)))))
	res)
327
    (if math-top-only
Eli Zaretskii's avatar
Eli Zaretskii committed
328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343
	(let ((r simp-rules))
	  (setq res (math-simplify-step (math-normalize top-expr))
		calc-simplify-mode '(nil)
		top-expr (math-normalize res))
	  (while r
	    (setq top-expr (math-rewrite top-expr (car r)
					 '(neg (var inf var-inf)))
		  r (cdr r))))
      (calc-with-default-simplification
       (while (let ((r simp-rules))
		(setq res (math-normalize top-expr))
		(while r
		  (setq res (math-rewrite res (car r))
			r (cdr r)))
		(not (equal top-expr (setq res (math-simplify-step res)))))
	 (setq top-expr res)))))
344 345 346
  top-expr)

(defalias 'calcFunc-simplify 'math-simplify)
Eli Zaretskii's avatar
Eli Zaretskii committed
347 348 349 350 351 352 353

;;; The following has a "bug" in that if any recursive simplifications
;;; occur only the first handler will be tried; this doesn't really
;;; matter, since math-simplify-step is iterated to a fixed point anyway.
(defun math-simplify-step (a)
  (if (Math-primp a)
      a
354
    (let ((aa (if (or math-top-only
Eli Zaretskii's avatar
Eli Zaretskii committed
355 356 357 358 359 360 361 362 363 364 365 366
		      (memq (car a) '(calcFunc-quote calcFunc-condition
						     calcFunc-evalto)))
		  a
		(cons (car a) (mapcar 'math-simplify-step (cdr a))))))
      (and (symbolp (car aa))
	   (let ((handler (get (car aa) 'math-simplify)))
	     (and handler
		  (while (and handler
			      (equal (setq aa (or (funcall (car handler) aa)
						  aa))
				     a))
		    (setq handler (cdr handler))))))
367
      aa)))
Eli Zaretskii's avatar
Eli Zaretskii committed
368 369


Jay Belanger's avatar
Jay Belanger committed
370 371 372 373 374 375 376 377 378 379 380 381 382
(defmacro math-defsimplify (funcs &rest code)
  (append '(progn)
          (mapcar (function
                   (lambda (func)
                     (list 'put (list 'quote func) ''math-simplify
                           (list 'nconc
                                 (list 'get (list 'quote func) ''math-simplify)
                                 (list 'list
                                       (list 'function
                                             (append '(lambda (math-simplify-expr))
                                                     code)))))))
                  (if (symbolp funcs) (list funcs) funcs))))
(put 'math-defsimplify 'lisp-indent-hook 1)
Eli Zaretskii's avatar
Eli Zaretskii committed
383

384 385 386 387
;; The function created by math-defsimplify uses the variable
;; math-simplify-expr, and so is used by functions in math-defsimplify
(defvar math-simplify-expr)

Eli Zaretskii's avatar
Eli Zaretskii committed
388 389 390 391
(math-defsimplify (+ -)
  (math-simplify-plus))

(defun math-simplify-plus ()
392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407
  (cond ((and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -))
	      (Math-numberp (nth 2 (nth 1 math-simplify-expr)))
	      (not (Math-numberp (nth 2 math-simplify-expr))))
	 (let ((x (nth 2 math-simplify-expr))
	       (op (car math-simplify-expr)))
	   (setcar (cdr (cdr math-simplify-expr)) (nth 2 (nth 1 math-simplify-expr)))
	   (setcar math-simplify-expr (car (nth 1 math-simplify-expr)))
	   (setcar (cdr (cdr (nth 1 math-simplify-expr))) x)
	   (setcar (nth 1 math-simplify-expr) op)))
	((and (eq (car math-simplify-expr) '+)
	      (Math-numberp (nth 1 math-simplify-expr))
	      (not (Math-numberp (nth 2 math-simplify-expr))))
	 (let ((x (nth 2 math-simplify-expr)))
	   (setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr))
	   (setcar (cdr math-simplify-expr) x))))
  (let ((aa math-simplify-expr)
Eli Zaretskii's avatar
Eli Zaretskii committed
408 409
	aaa temp)
    (while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -))
410 411 412
      (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 math-simplify-expr)
				       (eq (car aaa) '-) 
                                       (eq (car math-simplify-expr) '-) t))
Eli Zaretskii's avatar
Eli Zaretskii committed
413
	  (progn
414 415
	    (setcar (cdr (cdr math-simplify-expr)) temp)
	    (setcar math-simplify-expr '+)
Eli Zaretskii's avatar
Eli Zaretskii committed
416 417
	    (setcar (cdr (cdr aaa)) 0)))
      (setq aa (nth 1 aa)))
418 419
    (if (setq temp (math-combine-sum aaa (nth 2 math-simplify-expr)
				     nil (eq (car math-simplify-expr) '-) t))
Eli Zaretskii's avatar
Eli Zaretskii committed
420
	(progn
421 422
	  (setcar (cdr (cdr math-simplify-expr)) temp)
	  (setcar math-simplify-expr '+)
Eli Zaretskii's avatar
Eli Zaretskii committed
423
	  (setcar (cdr aa) 0)))
424
    math-simplify-expr))
Eli Zaretskii's avatar
Eli Zaretskii committed
425 426 427 428 429

(math-defsimplify *
  (math-simplify-times))

(defun math-simplify-times ()
430 431 432 433 434 435 436 437 438 439 440 441 442 443
  (if (eq (car-safe (nth 2 math-simplify-expr)) '*)
      (and (math-beforep (nth 1 (nth 2 math-simplify-expr)) (nth 1 math-simplify-expr))
	   (or (math-known-scalarp (nth 1 math-simplify-expr) t)
	       (math-known-scalarp (nth 1 (nth 2 math-simplify-expr)) t))
	   (let ((x (nth 1 math-simplify-expr)))
	     (setcar (cdr math-simplify-expr) (nth 1 (nth 2 math-simplify-expr)))
	     (setcar (cdr (nth 2 math-simplify-expr)) x)))
    (and (math-beforep (nth 2 math-simplify-expr) (nth 1 math-simplify-expr))
	 (or (math-known-scalarp (nth 1 math-simplify-expr) t)
	     (math-known-scalarp (nth 2 math-simplify-expr) t))
	 (let ((x (nth 2 math-simplify-expr)))
	   (setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr))
	   (setcar (cdr math-simplify-expr) x))))
  (let ((aa math-simplify-expr)
Eli Zaretskii's avatar
Eli Zaretskii committed
444
	aaa temp
445 446 447
	(safe t) (scalar (math-known-scalarp (nth 1 math-simplify-expr))))
    (if (and (Math-ratp (nth 1 math-simplify-expr))
	     (setq temp (math-common-constant-factor (nth 2 math-simplify-expr))))
Eli Zaretskii's avatar
Eli Zaretskii committed
448
	(progn
449 450 451
	  (setcar (cdr (cdr math-simplify-expr))
		  (math-cancel-common-factor (nth 2 math-simplify-expr) temp))
	  (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) temp))))
Eli Zaretskii's avatar
Eli Zaretskii committed
452 453
    (while (and (eq (car-safe (setq aaa (nth 2 aa))) '*)
		safe)
454 455
      (if (setq temp (math-combine-prod (nth 1 math-simplify-expr) 
                                        (nth 1 aaa) nil nil t))
Eli Zaretskii's avatar
Eli Zaretskii committed
456
	  (progn
457
	    (setcar (cdr math-simplify-expr) temp)
Eli Zaretskii's avatar
Eli Zaretskii committed
458 459 460
	    (setcar (cdr aaa) 1)))
      (setq safe (or scalar (math-known-scalarp (nth 1 aaa) t))
	    aa (nth 2 aa)))
461
    (if (and (setq temp (math-combine-prod aaa (nth 1 math-simplify-expr) nil nil t))
Eli Zaretskii's avatar
Eli Zaretskii committed
462 463
	     safe)
	(progn
464
	  (setcar (cdr math-simplify-expr) temp)
Eli Zaretskii's avatar
Eli Zaretskii committed
465
	  (setcar (cdr (cdr aa)) 1)))
466 467 468 469 470 471
    (if (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac)
	     (memq (nth 1 (nth 1 math-simplify-expr)) '(1 -1)))
	(math-div (math-mul (nth 2 math-simplify-expr) 
                            (nth 1 (nth 1 math-simplify-expr)))
		  (nth 2 (nth 1 math-simplify-expr)))
      math-simplify-expr)))
Eli Zaretskii's avatar
Eli Zaretskii committed
472 473 474 475 476

(math-defsimplify /
  (math-simplify-divide))

(defun math-simplify-divide ()
477
  (let ((np (cdr math-simplify-expr))
Eli Zaretskii's avatar
Eli Zaretskii committed
478
	(nover nil)
479 480 481
	(nn (and (or (eq (car math-simplify-expr) '/) 
                     (not (Math-realp (nth 2 math-simplify-expr))))
		 (math-common-constant-factor (nth 2 math-simplify-expr))))
Eli Zaretskii's avatar
Eli Zaretskii committed
482 483 484
	n op)
    (if nn
	(progn
485 486 487
	  (setq n (and (or (eq (car math-simplify-expr) '/) 
                           (not (Math-realp (nth 1 math-simplify-expr))))
		       (math-common-constant-factor (nth 1 math-simplify-expr))))
Eli Zaretskii's avatar
Eli Zaretskii committed
488 489
	  (if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n))
	      (progn
490 491 492 493
		(setcar (cdr math-simplify-expr) 
                        (math-mul (nth 2 nn) (nth 1 math-simplify-expr)))
		(setcar (cdr (cdr math-simplify-expr))
			(math-cancel-common-factor (nth 2 math-simplify-expr) nn))
Eli Zaretskii's avatar
Eli Zaretskii committed
494
		(if (and (math-negp nn)
495 496
			 (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table)))
		    (setcar math-simplify-expr (nth 1 op))))
Eli Zaretskii's avatar
Eli Zaretskii committed
497 498
	    (if (and n (not (eq (setq n (math-frac-gcd n nn)) 1)))
		(progn
499 500 501 502
		  (setcar (cdr math-simplify-expr)
			  (math-cancel-common-factor (nth 1 math-simplify-expr) n))
		  (setcar (cdr (cdr math-simplify-expr))
			  (math-cancel-common-factor (nth 2 math-simplify-expr) n))
Eli Zaretskii's avatar
Eli Zaretskii committed
503
		  (if (and (math-negp n)
504 505 506
			   (setq op (assq (car math-simplify-expr) 
                                          calc-tweak-eqn-table)))
		      (setcar math-simplify-expr (nth 1 op))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
507
    (if (and (eq (car-safe (car np)) '/)
508
	     (math-known-scalarp (nth 2 math-simplify-expr) t))
Eli Zaretskii's avatar
Eli Zaretskii committed
509
	(progn
510
	  (setq np (cdr (nth 1 math-simplify-expr)))
Eli Zaretskii's avatar
Eli Zaretskii committed
511 512
	  (while (eq (car-safe (setq n (car np))) '*)
	    (and (math-known-scalarp (nth 2 n) t)
513
		 (math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nil t))
Eli Zaretskii's avatar
Eli Zaretskii committed
514
	    (setq np (cdr (cdr n))))
515
	  (math-simplify-divisor np (cdr (cdr math-simplify-expr)) nil t)
Eli Zaretskii's avatar
Eli Zaretskii committed
516
	  (setq nover t
517
		np (cdr (cdr (nth 1 math-simplify-expr))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
518 519
    (while (eq (car-safe (setq n (car np))) '*)
      (and (math-known-scalarp (nth 2 n) t)
520
	   (math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nover t))
Eli Zaretskii's avatar
Eli Zaretskii committed
521
      (setq np (cdr (cdr n))))
522 523 524 525 526 527 528 529
    (math-simplify-divisor np (cdr (cdr math-simplify-expr)) nover t)
    math-simplify-expr))

;; The variables math-simplify-divisor-nover and math-simplify-divisor-dover
;; are local variables for math-simplify-divisor, but are used by
;; math-simplify-one-divisor.
(defvar math-simplify-divisor-nover)
(defvar math-simplify-divisor-dover)
Eli Zaretskii's avatar
Eli Zaretskii committed
530

531 532
(defun math-simplify-divisor (np dp math-simplify-divisor-nover 
                                 math-simplify-divisor-dover)
Eli Zaretskii's avatar
Eli Zaretskii committed
533
  (cond ((eq (car-safe (car dp)) '/)
534 535 536
	 (math-simplify-divisor np (cdr (car dp)) 
                                math-simplify-divisor-nover 
                                math-simplify-divisor-dover)
Eli Zaretskii's avatar
Eli Zaretskii committed
537 538
	 (and (math-known-scalarp (nth 1 (car dp)) t)
	      (math-simplify-divisor np (cdr (cdr (car dp)))
539 540 541
				     math-simplify-divisor-nover 
                                     (not math-simplify-divisor-dover))))
	((or (or (eq (car math-simplify-expr) '/)
Eli Zaretskii's avatar
Eli Zaretskii committed
542 543
		 (let ((signs (math-possible-signs (car np))))
		   (or (memq signs '(1 4))
544
		       (and (memq (car math-simplify-expr) '(calcFunc-eq calcFunc-neq))
Eli Zaretskii's avatar
Eli Zaretskii committed
545 546 547
			    (eq signs 5))
		       math-living-dangerously)))
	     (math-numberp (car np)))
548 549 550
	 (let (d
               (safe t) 
               (scalar (math-known-scalarp (car np))))
Eli Zaretskii's avatar
Eli Zaretskii committed
551 552 553 554 555 556
	   (while (and (eq (car-safe (setq d (car dp))) '*)
		       safe)
	     (math-simplify-one-divisor np (cdr d))
	     (setq safe (or scalar (math-known-scalarp (nth 1 d) t))
		   dp (cdr (cdr d))))
	   (if safe
557
	       (math-simplify-one-divisor np dp))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
558 559

(defun math-simplify-one-divisor (np dp)
560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578
  (let ((temp (math-combine-prod (car np) (car dp) math-simplify-divisor-nover 
                                 math-simplify-divisor-dover t))
        op)
    (if temp 
        (progn
          (and (not (memq (car math-simplify-expr) '(/ calcFunc-eq calcFunc-neq)))
               (math-known-negp (car dp))
               (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table))
               (setcar math-simplify-expr (nth 1 op)))
          (setcar np (if math-simplify-divisor-nover (math-div 1 temp) temp))
          (setcar dp 1))
      (and math-simplify-divisor-dover (not math-simplify-divisor-nover) 
           (eq (car math-simplify-expr) '/)
           (eq (car-safe (car dp)) 'calcFunc-sqrt)
           (Math-integerp (nth 1 (car dp)))
           (progn
             (setcar np (math-mul (car np)
                                  (list 'calcFunc-sqrt (nth 1 (car dp)))))
             (setcar dp (nth 1 (car dp))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597

(defun math-common-constant-factor (expr)
  (if (Math-realp expr)
      (if (Math-ratp expr)
	  (and (not (memq expr '(0 1 -1)))
	       (math-abs expr))
	(if (math-ratp (setq expr (math-to-simple-fraction expr)))
	    (math-common-constant-factor expr)))
    (if (memq (car expr) '(+ - cplx sdev))
	(let ((f1 (math-common-constant-factor (nth 1 expr)))
	      (f2 (math-common-constant-factor (nth 2 expr))))
	  (and f1 f2
	       (not (eq (setq f1 (math-frac-gcd f1 f2)) 1))
	       f1))
      (if (memq (car expr) '(* polar))
	  (math-common-constant-factor (nth 1 expr))
	(if (eq (car expr) '/)
	    (or (math-common-constant-factor (nth 1 expr))
		(and (Math-integerp (nth 2 expr))
598
		     (list 'frac 1 (math-abs (nth 2 expr))))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
599 600 601 602 603 604 605 606 607

(defun math-cancel-common-factor (expr val)
  (if (memq (car-safe expr) '(+ - cplx sdev))
      (progn
	(setcar (cdr expr) (math-cancel-common-factor (nth 1 expr) val))
	(setcar (cdr (cdr expr)) (math-cancel-common-factor (nth 2 expr) val))
	expr)
    (if (eq (car-safe expr) '*)
	(math-mul (math-cancel-common-factor (nth 1 expr) val) (nth 2 expr))
608
      (math-div expr val))))
Eli Zaretskii's avatar
Eli Zaretskii committed
609 610 611 612 613 614 615 616 617 618 619 620

(defun math-frac-gcd (a b)
  (if (Math-zerop a)
      b
    (if (Math-zerop b)
	a
      (if (and (Math-integerp a)
	       (Math-integerp b))
	  (math-gcd a b)
	(and (Math-integerp a) (setq a (list 'frac a 1)))
	(and (Math-integerp b) (setq b (list 'frac b 1)))
	(math-make-frac (math-gcd (nth 1 a) (nth 1 b))
621
			(math-gcd (nth 2 a) (nth 2 b)))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
622 623 624 625 626

(math-defsimplify %
  (math-simplify-mod))

(defun math-simplify-mod ()
627 628 629
  (and (Math-realp (nth 2 math-simplify-expr))
       (Math-posp (nth 2 math-simplify-expr))
       (let ((lin (math-is-linear (nth 1 math-simplify-expr)))
Eli Zaretskii's avatar
Eli Zaretskii committed
630 631 632
	     t1 t2 t3)
	 (or (and lin
		  (or (math-negp (car lin))
633
		      (not (Math-lessp (car lin) (nth 2 math-simplify-expr))))
Eli Zaretskii's avatar
Eli Zaretskii committed
634 635 636
		  (list '%
			(list '+
			      (math-mul (nth 1 lin) (nth 2 lin))
637 638
			      (math-mod (car lin) (nth 2 math-simplify-expr)))
			(nth 2 math-simplify-expr)))
Eli Zaretskii's avatar
Eli Zaretskii committed
639 640 641
	     (and lin
		  (not (math-equal-int (nth 1 lin) 1))
		  (math-num-integerp (nth 1 lin))
642 643
		  (math-num-integerp (nth 2 math-simplify-expr))
		  (setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 math-simplify-expr)))
Eli Zaretskii's avatar
Eli Zaretskii committed
644 645 646 647 648 649 650 651 652
		  (not (math-equal-int t1 1))
		  (list '*
			t1
			(list '%
			      (list '+
				    (math-mul (math-div (nth 1 lin) t1)
					      (nth 2 lin))
				    (let ((calc-prefer-frac t))
				      (math-div (car lin) t1)))
653 654
			      (math-div (nth 2 math-simplify-expr) t1))))
	     (and (math-equal-int (nth 2 math-simplify-expr) 1)
Eli Zaretskii's avatar
Eli Zaretskii committed
655 656
		  (math-known-integerp (if lin
					   (math-mul (nth 1 lin) (nth 2 lin))
657
					 (nth 1 math-simplify-expr)))
658
		  (if lin (math-mod (car lin) 1) 0))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
659 660 661

(math-defsimplify (calcFunc-eq calcFunc-neq calcFunc-lt
			       calcFunc-gt calcFunc-leq calcFunc-geq)
662
  (if (= (length math-simplify-expr) 3)
Eli Zaretskii's avatar
Eli Zaretskii committed
663 664 665
      (math-simplify-ineq)))

(defun math-simplify-ineq ()
666
  (let ((np (cdr math-simplify-expr))
Eli Zaretskii's avatar
Eli Zaretskii committed
667 668
	n)
    (while (memq (car-safe (setq n (car np))) '(+ -))
669
      (math-simplify-add-term (cdr (cdr n)) (cdr (cdr math-simplify-expr))
Eli Zaretskii's avatar
Eli Zaretskii committed
670 671
			      (eq (car n) '-) nil)
      (setq np (cdr n)))
672 673
    (math-simplify-add-term np (cdr (cdr math-simplify-expr)) nil 
                            (eq np (cdr math-simplify-expr)))
Eli Zaretskii's avatar
Eli Zaretskii committed
674
    (math-simplify-divide)
675 676
    (let ((signs (math-possible-signs (cons '- (cdr math-simplify-expr)))))
      (or (cond ((eq (car math-simplify-expr) 'calcFunc-eq)
Eli Zaretskii's avatar
Eli Zaretskii committed
677 678
		 (or (and (eq signs 2) 1)
		     (and (memq signs '(1 4 5)) 0)))
679
		((eq (car math-simplify-expr) 'calcFunc-neq)
Eli Zaretskii's avatar
Eli Zaretskii committed
680 681
		 (or (and (eq signs 2) 0)
		     (and (memq signs '(1 4 5)) 1)))
682
		((eq (car math-simplify-expr) 'calcFunc-lt)
Eli Zaretskii's avatar
Eli Zaretskii committed
683 684
		 (or (and (eq signs 1) 1)
		     (and (memq signs '(2 4 6)) 0)))
685
		((eq (car math-simplify-expr) 'calcFunc-gt)
Eli Zaretskii's avatar
Eli Zaretskii committed
686 687
		 (or (and (eq signs 4) 1)
		     (and (memq signs '(1 2 3)) 0)))
688
		((eq (car math-simplify-expr) 'calcFunc-leq)
Eli Zaretskii's avatar
Eli Zaretskii committed
689 690
		 (or (and (eq signs 4) 0)
		     (and (memq signs '(1 2 3)) 1)))
691
		((eq (car math-simplify-expr) 'calcFunc-geq)
Eli Zaretskii's avatar
Eli Zaretskii committed
692 693
		 (or (and (eq signs 1) 0)
		     (and (memq signs '(2 4 6)) 1))))
694
	  math-simplify-expr))))
Eli Zaretskii's avatar
Eli Zaretskii committed
695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722

(defun math-simplify-add-term (np dp minus lplain)
  (or (math-vectorp (car np))
      (let ((rplain t)
	    n d dd temp)
	(while (memq (car-safe (setq n (car np) d (car dp))) '(+ -))
	  (setq rplain nil)
	  (if (setq temp (math-combine-sum n (nth 2 d)
					   minus (eq (car d) '+) t))
	      (if (or lplain (eq (math-looks-negp temp) minus))
		  (progn
		    (setcar np (setq n (if minus (math-neg temp) temp)))
		    (setcar (cdr (cdr d)) 0))
		(progn
		  (setcar np 0)
		  (setcar (cdr (cdr d)) (setq n (if (eq (car d) '+)
						    (math-neg temp)
						  temp))))))
	  (setq dp (cdr d)))
	(if (setq temp (math-combine-sum n d minus t t))
	    (if (or lplain
		    (and (not rplain)
			 (eq (math-looks-negp temp) minus)))
		(progn
		  (setcar np (setq n (if minus (math-neg temp) temp)))
		  (setcar dp 0))
	      (progn
		(setcar np 0)
723
		(setcar dp (setq n (math-neg temp)))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
724 725

(math-defsimplify calcFunc-sin
726 727 728 729
  (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
	   (nth 1 (nth 1 math-simplify-expr)))
      (and (math-looks-negp (nth 1 math-simplify-expr))
	   (math-neg (list 'calcFunc-sin (math-neg (nth 1 math-simplify-expr)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
730
      (and (eq calc-angle-mode 'rad)
731
	   (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
Eli Zaretskii's avatar
Eli Zaretskii committed
732 733 734
	     (and n
		  (math-known-sin (car n) (nth 1 n) 120 0))))
      (and (eq calc-angle-mode 'deg)
735
	   (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
Eli Zaretskii's avatar
Eli Zaretskii committed
736 737
	     (and n
		  (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0))))
738 739 740 741 742
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
	   (list 'calcFunc-sqrt (math-sub 1 (math-sqr 
                                             (nth 1 (nth 1 math-simplify-expr))))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
	   (math-div (nth 1 (nth 1 math-simplify-expr))
Eli Zaretskii's avatar
Eli Zaretskii committed
743
		     (list 'calcFunc-sqrt
744 745 746
			   (math-add 1 (math-sqr 
                                        (nth 1 (nth 1 math-simplify-expr)))))))
      (let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
Eli Zaretskii's avatar
Eli Zaretskii committed
747 748 749 750 751 752
	(and m (integerp (car m))
	     (let ((n (car m)) (a (nth 1 m)))
	       (list '+
		     (list '* (list 'calcFunc-sin (list '* (1- n) a))
			   (list 'calcFunc-cos a))
		     (list '* (list 'calcFunc-cos (list '* (1- n) a))
753
			   (list 'calcFunc-sin a))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
754 755

(math-defsimplify calcFunc-cos
756 757 758 759
  (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
	   (nth 1 (nth 1 math-simplify-expr)))
      (and (math-looks-negp (nth 1 math-simplify-expr))
	   (list 'calcFunc-cos (math-neg (nth 1 math-simplify-expr))))
Eli Zaretskii's avatar
Eli Zaretskii committed
760
      (and (eq calc-angle-mode 'rad)
761
	   (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
Eli Zaretskii's avatar
Eli Zaretskii committed
762 763 764
	     (and n
		  (math-known-sin (car n) (nth 1 n) 120 300))))
      (and (eq calc-angle-mode 'deg)
765
	   (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
Eli Zaretskii's avatar
Eli Zaretskii committed
766 767
	     (and n
		  (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300))))
768 769 770 771
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
	   (list 'calcFunc-sqrt 
                 (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
Eli Zaretskii's avatar
Eli Zaretskii committed
772 773
	   (math-div 1
		     (list 'calcFunc-sqrt
774 775 776
			   (math-add 1 
                                     (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
      (let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
Eli Zaretskii's avatar
Eli Zaretskii committed
777 778 779 780 781 782
	(and m (integerp (car m))
	     (let ((n (car m)) (a (nth 1 m)))
	       (list '-
		     (list '* (list 'calcFunc-cos (list '* (1- n) a))
			   (list 'calcFunc-cos a))
		     (list '* (list 'calcFunc-sin (list '* (1- n) a))
783
			   (list 'calcFunc-sin a))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
784

785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833
(math-defsimplify calcFunc-sec
  (or (and (math-looks-negp (nth 1 math-simplify-expr))
	   (list 'calcFunc-sec (math-neg (nth 1 math-simplify-expr))))
      (and (eq calc-angle-mode 'rad)
	   (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
	     (and n
		  (math-div 1 (math-known-sin (car n) (nth 1 n) 120 300)))))
      (and (eq calc-angle-mode 'deg)
	   (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
	     (and n
                  (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300)))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
           (math-div 
            1
            (list 'calcFunc-sqrt 
                  (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
           (math-div 
            1
            (nth 1 (nth 1 math-simplify-expr))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
           (list 'calcFunc-sqrt
                 (math-add 1 
                           (math-sqr (nth 1 (nth 1 math-simplify-expr))))))))

(math-defsimplify calcFunc-csc
  (or (and (math-looks-negp (nth 1 math-simplify-expr))
	   (math-neg (list 'calcFunc-csc (math-neg (nth 1 math-simplify-expr)))))
      (and (eq calc-angle-mode 'rad)
	   (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
	     (and n
                  (math-div 1 (math-known-sin (car n) (nth 1 n) 120 0)))))
      (and (eq calc-angle-mode 'deg)
	   (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
	     (and n
                  (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0)))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
	   (math-div 1 (nth 1 (nth 1 math-simplify-expr))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
           (math-div 
            1
            (list 'calcFunc-sqrt (math-sub 1 (math-sqr 
                                              (nth 1 (nth 1 math-simplify-expr)))))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
	   (math-div (list 'calcFunc-sqrt
			   (math-add 1 (math-sqr 
                                        (nth 1 (nth 1 math-simplify-expr)))))
                     (nth 1 (nth 1 math-simplify-expr))))))

Eli Zaretskii's avatar
Eli Zaretskii committed
834 835 836 837 838 839 840 841 842 843 844 845
(defun math-should-expand-trig (x &optional hyperbolic)
  (let ((m (math-is-multiple x)))
    (and math-living-dangerously
	 m (or (and (integerp (car m)) (> (car m) 1))
	       (equal (car m) '(frac 1 2)))
	 (or math-integrating
	     (memq (car-safe (nth 1 m))
		   (if hyperbolic
		       '(calcFunc-arcsinh calcFunc-arccosh calcFunc-arctanh)
		     '(calcFunc-arcsin calcFunc-arccos calcFunc-arctan)))
	     (and (eq (car-safe (nth 1 m)) 'calcFunc-ln)
		  (eq hyperbolic 'exp)))
846
	 m)))
Eli Zaretskii's avatar
Eli Zaretskii committed
847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883

(defun math-known-sin (plus n mul off)
  (setq n (math-mul n mul))
  (and (math-num-integerp n)
       (setq n (math-mod (math-add (math-trunc n) off) 240))
       (if (>= n 120)
	   (and (setq n (math-known-sin plus (- n 120) 1 0))
		(math-neg n))
	 (if (> n 60)
	     (setq n (- 120 n)))
	 (if (math-zerop plus)
	     (and (or calc-symbolic-mode
		      (memq n '(0 20 60)))
		  (cdr (assq n
			     '( (0 . 0)
				(10 . (/ (calcFunc-sqrt
					  (- 2 (calcFunc-sqrt 3))) 2))
				(12 . (/ (- (calcFunc-sqrt 5) 1) 4))
				(15 . (/ (calcFunc-sqrt
					  (- 2 (calcFunc-sqrt 2))) 2))
				(20 . (/ 1 2))
				(24 . (* (^ (/ 1 2) (/ 3 2))
					 (calcFunc-sqrt
					  (- 5 (calcFunc-sqrt 5)))))
				(30 . (/ (calcFunc-sqrt 2) 2))
				(36 . (/ (+ (calcFunc-sqrt 5) 1) 4))
				(40 . (/ (calcFunc-sqrt 3) 2))
				(45 . (/ (calcFunc-sqrt
					  (+ 2 (calcFunc-sqrt 2))) 2))
				(48 . (* (^ (/ 1 2) (/ 3 2))
					 (calcFunc-sqrt
					  (+ 5 (calcFunc-sqrt 5)))))
				(50 . (/ (calcFunc-sqrt
					  (+ 2 (calcFunc-sqrt 3))) 2))
				(60 . 1)))))
	   (cond ((eq n 0) (math-normalize (list 'calcFunc-sin plus)))
		 ((eq n 60) (math-normalize (list 'calcFunc-cos plus)))
884
		 (t nil))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
885 886

(math-defsimplify calcFunc-tan
887 888 889 890
  (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
	   (nth 1 (nth 1 math-simplify-expr)))
      (and (math-looks-negp (nth 1 math-simplify-expr))
	   (math-neg (list 'calcFunc-tan (math-neg (nth 1 math-simplify-expr)))))
Eli Zaretskii's avatar
Eli Zaretskii committed
891
      (and (eq calc-angle-mode 'rad)
892
	   (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
Eli Zaretskii's avatar
Eli Zaretskii committed
893 894 895
	     (and n
		  (math-known-tan (car n) (nth 1 n) 120))))
      (and (eq calc-angle-mode 'deg)
896
	   (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
Eli Zaretskii's avatar
Eli Zaretskii committed
897 898
	     (and n
		  (math-known-tan (car n) (nth 1 n) '(frac 2 3)))))
899 900
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
	   (math-div (nth 1 (nth 1 math-simplify-expr))
Eli Zaretskii's avatar
Eli Zaretskii committed
901
		     (list 'calcFunc-sqrt
902 903
			   (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
Eli Zaretskii's avatar
Eli Zaretskii committed
904
	   (math-div (list 'calcFunc-sqrt
905 906 907
			   (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))
		     (nth 1 (nth 1 math-simplify-expr))))
      (let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
Eli Zaretskii's avatar
Eli Zaretskii committed
908 909 910 911
	(and m
	     (if (equal (car m) '(frac 1 2))
		 (math-div (math-sub 1 (list 'calcFunc-cos (nth 1 m)))
			   (list 'calcFunc-sin (nth 1 m)))
912 913
	       (math-div (list 'calcFunc-sin (nth 1 math-simplify-expr))
			 (list 'calcFunc-cos (nth 1 math-simplify-expr))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
914

915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936
(math-defsimplify calcFunc-cot
  (or (and (math-looks-negp (nth 1 math-simplify-expr))
	   (math-neg (list 'calcFunc-cot (math-neg (nth 1 math-simplify-expr)))))
      (and (eq calc-angle-mode 'rad)
	   (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi))))
	     (and n
                  (math-div 1 (math-known-tan (car n) (nth 1 n) 120)))))
      (and (eq calc-angle-mode 'deg)
	   (let ((n (math-integer-plus (nth 1 math-simplify-expr))))
	     (and n
                  (math-div 1 (math-known-tan (car n) (nth 1 n) '(frac 2 3))))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin)
	   (math-div (list 'calcFunc-sqrt
			   (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))
                     (nth 1 (nth 1 math-simplify-expr))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos)
	   (math-div (nth 1 (nth 1 math-simplify-expr))
                     (list 'calcFunc-sqrt
			   (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
	   (math-div 1 (nth 1 (nth 1 math-simplify-expr))))))

Eli Zaretskii's avatar
Eli Zaretskii committed
937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966
(defun math-known-tan (plus n mul)
  (setq n (math-mul n mul))
  (and (math-num-integerp n)
       (setq n (math-mod (math-trunc n) 120))
       (if (> n 60)
	   (and (setq n (math-known-tan plus (- 120 n) 1))
		(math-neg n))
	 (if (math-zerop plus)
	     (and (or calc-symbolic-mode
		      (memq n '(0 30 60)))
		  (cdr (assq n '( (0 . 0)
				  (10 . (- 2 (calcFunc-sqrt 3)))
				  (12 . (calcFunc-sqrt
					 (- 1 (* (/ 2 5) (calcFunc-sqrt 5)))))
				  (15 . (- (calcFunc-sqrt 2) 1))
				  (20 . (/ (calcFunc-sqrt 3) 3))
				  (24 . (calcFunc-sqrt
					 (- 5 (* 2 (calcFunc-sqrt 5)))))
				  (30 . 1)
				  (36 . (calcFunc-sqrt
					 (+ 1 (* (/ 2 5) (calcFunc-sqrt 5)))))
				  (40 . (calcFunc-sqrt 3))
				  (45 . (+ (calcFunc-sqrt 2) 1))
				  (48 . (calcFunc-sqrt
					 (+ 5 (* 2 (calcFunc-sqrt 5)))))
				  (50 . (+ 2 (calcFunc-sqrt 3)))
				  (60 . (var uinf var-uinf))))))
	   (cond ((eq n 0) (math-normalize (list 'calcFunc-tan plus)))
		 ((eq n 60) (math-normalize (list '/ -1
						  (list 'calcFunc-tan plus))))
967
		 (t nil))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
968 969

(math-defsimplify calcFunc-sinh
970 971 972 973 974
  (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
	   (nth 1 (nth 1 math-simplify-expr)))
      (and (math-looks-negp (nth 1 math-simplify-expr))
	   (math-neg (list 'calcFunc-sinh (math-neg (nth 1 math-simplify-expr)))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
Eli Zaretskii's avatar
Eli Zaretskii committed
975
	   math-living-dangerously
976 977 978
	   (list 'calcFunc-sqrt 
                 (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
Eli Zaretskii's avatar
Eli Zaretskii committed
979
	   math-living-dangerously
980
	   (math-div (nth 1 (nth 1 math-simplify-expr))
Eli Zaretskii's avatar
Eli Zaretskii committed
981
		     (list 'calcFunc-sqrt
982 983
			   (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
      (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t)))
Eli Zaretskii's avatar
Eli Zaretskii committed
984 985 986 987 988 989 990
	(and m (integerp (car m))
	     (let ((n (car m)) (a (nth 1 m)))
	       (if (> n 1)
		   (list '+
			 (list '* (list 'calcFunc-sinh (list '* (1- n) a))
			       (list 'calcFunc-cosh a))
			 (list '* (list 'calcFunc-cosh (list '* (1- n) a))
991
			       (list 'calcFunc-sinh a)))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
992 993

(math-defsimplify calcFunc-cosh
994 995 996 997 998
  (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
	   (nth 1 (nth 1 math-simplify-expr)))
      (and (math-looks-negp (nth 1 math-simplify-expr))
	   (list 'calcFunc-cosh (math-neg (nth 1 math-simplify-expr))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
Eli Zaretskii's avatar
Eli Zaretskii committed
999
	   math-living-dangerously
1000 1001 1002
	   (list 'calcFunc-sqrt 
                 (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
Eli Zaretskii's avatar
Eli Zaretskii committed
1003 1004 1005
	   math-living-dangerously
	   (math-div 1
		     (list 'calcFunc-sqrt
1006 1007
			   (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
      (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t)))
Eli Zaretskii's avatar
Eli Zaretskii committed
1008 1009 1010 1011 1012 1013 1014
	(and m (integerp (car m))
	     (let ((n (car m)) (a (nth 1 m)))
	       (if (> n 1)
		   (list '+
			 (list '* (list 'calcFunc-cosh (list '* (1- n) a))
			       (list 'calcFunc-cosh a))
			 (list '* (list 'calcFunc-sinh (list '* (1- n) a))
1015
			       (list 'calcFunc-sinh a)))))))))
Eli Zaretskii's avatar
Eli Zaretskii committed
1016 1017

(math-defsimplify calcFunc-tanh
1018 1019 1020 1021 1022
  (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh)
	   (nth 1 (nth 1 math-simplify-expr)))
      (and (math-looks-negp (nth 1 math-simplify-expr))
	   (math-neg (list 'calcFunc-tanh (math-neg (nth 1 math-simplify-expr)))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
Eli Zaretskii's avatar
Eli Zaretskii committed
1023
	   math-living-dangerously
1024
	   (math-div (nth 1 (nth 1 math-simplify-expr))
Eli Zaretskii's avatar
Eli Zaretskii committed
1025
		     (list 'calcFunc-sqrt
1026 1027
			   (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))))
      (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
Eli Zaretskii's avatar
Eli Zaretskii committed
1028 1029
	   math-living-dangerously
	   (math-div (list 'calcFunc-sqrt
1030 1031 1032
			   (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))
		     (nth 1 (nth 1 math-simplify-expr))))
      (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t)))
Eli Zaretskii's avatar
Eli Zaretskii committed
1033 1034 1035