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