src/opers.lisp

   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))