1;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3;;;     The data in this file contains enhancments.                    ;;;;;
4;;;                                                                    ;;;;;
5;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
6;;;     All rights reserved                                            ;;;;;
7;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8;;;     (c) Copyright 1980 Massachusetts Institute of Technology         ;;;
9;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10
11(in-package :maxima)
12
13(macsyma-module opers)
14
15;; This file is the run-time half of the OPERS package, an interface to the
16;; Macsyma general representation simplifier.  When new expressions are being
17;; created, the functions in this file or the macros in MOPERS should be called
18;; rather than the entrypoints in SIMP such as SIMPLIFYA or SIMPLUS.  Many of
19;; the functions in this file will do a pre-simplification to prevent
20;; unnecessary consing. [Of course, this is really the "wrong" thing, since
21;; knowledge about 0 being the additive identity of the reals is now
22;; kept in two different places.]
23
24;; The basic functions in the virtual interface are ADD, SUB, MUL, DIV, POWER,
25;; NCMUL, NCPOWER, NEG, INV.  Each of these functions assume that their
26;; arguments are simplified.  Some functions will have a "*" adjoined to the
27;; end of the name (as in ADD*).  These do not assume that their arguments are
28;; simplified.  In addition, there are a few entrypoints such as ADDN, MULN
29;; which take a list of terms as a first argument, and a simplification flag as
30;; the second argument.  The above functions are the only entrypoints to this
31;; package.
32
33;; The functions ADD2, ADD2*, MUL2, MUL2*, and MUL3 are for use internal to
34;; this package and should not be called externally.  Note that MOPERS is
35;; needed to compile this file.
36
37;; Addition primitives.
38
39(defun add2 (x y)
40  (cond ((numberp x)
41	 (cond ((numberp y) (+ x y))
42               ((=0 x) y)
43	       (t (simplifya `((mplus) ,x ,y) t))))
44        ((=0 y) x)
45	(t (simplifya `((mplus) ,x ,y) t))))
46
47(defun add2* (x y)
48  (cond
49    ((and (numberp x) (numberp y)) (+ x y))
50    ((=0 x) (simplifya y nil))
51    ((=0 y) (simplifya x nil))
52    (t (simplifya `((mplus) ,x ,y) nil))))
53
54;; The first two cases in this cond shouldn't be needed, but exist
55;; for compatibility with the old OPERS package.  The old ADDLIS
56;; deleted zeros ahead of time.  Is this worth it?
57
58(defun addn (terms simp-flag)
59  (cond ((null terms) 0)
60	(t (simplifya `((mplus) . ,terms) simp-flag))))
61
62(declare-top (special $negdistrib))
63
64(defun neg (x)
65  (cond ((numberp x) (- x))
66	(t (let (($negdistrib t))
67	     (simplifya `((mtimes) -1 ,x) t)))))
68
69(defun sub (x y)
70  (cond
71    ((and (numberp x) (numberp y)) (- x y))
72    ((=0 y) x)
73    ((=0 x) (neg y))
74    (t (add x (neg y)))))
75
76(defun sub* (x y)
77  (cond
78    ((and (numberp x) (numberp y)) (- x y))
79    ((=0 y) x)
80    ((=0 x) (neg y))
81    (t
82     (add (simplifya x nil) (mul -1 (simplifya y nil))))))
83
84;; Multiplication primitives -- is it worthwhile to handle the 3-arg
85;; case specially?  Don't simplify x*0 --> 0 since x could be non-scalar.
86
87(defun mul2 (x y)
88  (cond
89    ((and (numberp x) (numberp y)) (* x y))
90    ((=1 x) y)
91    ((=1 y) x)
92    (t (simplifya `((mtimes) ,x ,y) t))))
93
94(defun mul2* (x y)
95  (cond
96    ((and (numberp x) (numberp y)) (* x y))
97    ((=1 x) (simplifya y nil))
98    ((=1 y) (simplifya x nil))
99    (t (simplifya `((mtimes) ,x ,y) nil))))
100
101(defun mul3 (x y z)
102  (cond ((=1 x) (mul2 y z))
103	((=1 y) (mul2 x z))
104	((=1 z) (mul2 x y))
105	(t (simplifya `((mtimes) ,x ,y ,z) t))))
106
107;; The first two cases in this cond shouldn't be needed, but exist
108;; for compatibility with the old OPERS package.  The old MULSLIS
109;; deleted ones ahead of time.  Is this worth it?
110
111(defun muln (factors simp-flag)
112  (cond ((null factors) 1)
113	((atom factors) factors)
114	(t (simplifya `((mtimes) . ,factors) simp-flag))))
115
116(defun div (x y)
117  (if (=1 x)
118      (inv y)
119      (cond
120        ((and (floatp x) (floatp y))
121         (/ x y))
122        ((and ($bfloatp x) ($bfloatp y))
123         ;; Call BIGFLOATP to ensure that arguments have same precision.
124         ;; Otherwise FPQUOTIENT could return a spurious value.
125         (bcons (fpquotient (cdr (bigfloatp x)) (cdr (bigfloatp y)))))
126        (t
127          (mul x (inv y))))))
128
129(defun div* (x y)
130  (if (=1 x)
131      (inv* y)
132      (cond
133        ((and (floatp x) (floatp y))
134         (/ x y))
135        ((and ($bfloatp x) ($bfloatp y))
136         ;; Call BIGFLOATP to ensure that arguments have same precision.
137         ;; Otherwise FPQUOTIENT could return a spurious value.
138         (bcons (fpquotient (cdr (bigfloatp x)) (cdr (bigfloatp y)))))
139        (t
140          (mul (simplifya x nil) (inv* y))))))
141
142(defun ncmul2 (x y)
143  (simplifya `((mnctimes) ,x ,y) t))
144
145(defun ncmuln (factors flag)
146  (simplifya `((mnctimes) . ,factors) flag))
147
148;; Exponentiation
149
150;; Don't use BASE as a parameter name since it is special in MacLisp.
151
152(defun power (*base power)
153  (cond ((=1 power) *base)
154	(t (simplifya `((mexpt) ,*base ,power) t))))
155
156(defun power* (*base power)
157  (cond ((=1 power) (simplifya *base nil))
158	(t (simplifya `((mexpt) ,*base ,power) nil))))
159
160(defun ncpower (x y)
161  (cond ((=0 y) 1)
162	((=1 y) x)
163	(t (simplifya `((mncexpt) ,x ,y) t))))
164
165;; [Add something for constructing equations here at some point.]
166
167;; (ROOT X N) takes the Nth root of X.
168;; Warning! Simplifier may give a complex expression back, starting from a
169;; positive (evidently) real expression, viz. sqrt[(sinh-sin) / (sin-sinh)] or
170;; something.
171
172(defun root (x n)
173  (cond ((=0 x) 0)
174	((=1 x) 1)
175	(t (simplifya `((mexpt) ,x ((rat simp) 1 ,n)) t))))
176
177;; (Porm flag expr) is +expr if flag is true, and -expr
178;; otherwise.  Morp is the opposite.  Names stand for "plus or minus"
179;; and vice versa.
180
181(defun porm (s x) (if s x (neg x)))
182(defun morp (s x) (if s (neg x) x))
183