File: opers.lisp

package info (click to toggle)
maxima 5.27.0-3
  • links: PTS
  • area: main
  • in suites: wheezy
  • size: 120,648 kB
  • sloc: lisp: 322,503; fortran: 14,666; perl: 14,343; tcl: 11,031; sh: 4,146; makefile: 2,047; ansic: 471; awk: 24; sed: 10
file content (166 lines) | stat: -rw-r--r-- 5,433 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;     The data in this file contains enhancments.                    ;;;;;
;;;                                                                    ;;;;;
;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
;;;     All rights reserved                                            ;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;     (c) Copyright 1980 Massachusetts Institute of Technology         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package :maxima)

(macsyma-module opers)

;; This file is the run-time half of the OPERS package, an interface to the
;; Macsyma general representation simplifier.  When new expressions are being
;; created, the functions in this file or the macros in MOPERS should be called
;; rather than the entrypoints in SIMP such as SIMPLIFYA or SIMPLUS.  Many of
;; the functions in this file will do a pre-simplification to prevent
;; unnecessary consing. [Of course, this is really the "wrong" thing, since
;; knowledge about 0 being the additive identity of the reals is now
;; kept in two different places.]

;; The basic functions in the virtual interface are ADD, SUB, MUL, DIV, POWER,
;; NCMUL, NCPOWER, NEG, INV.  Each of these functions assume that their
;; arguments are simplified.  Some functions will have a "*" adjoined to the
;; end of the name (as in ADD*).  These do not assume that their arguments are
;; simplified.  In addition, there are a few entrypoints such as ADDN, MULN
;; which take a list of terms as a first argument, and a simplification flag as
;; the second argument.  The above functions are the only entrypoints to this
;; package.

;; The functions ADD2, ADD2*, MUL2, MUL2*, and MUL3 are for use internal to
;; this package and should not be called externally.  Note that MOPERS is
;; needed to compile this file.

;; Addition primitives.

(defmfun add2 (x y)
  (cond ((numberp x)
	 (cond ((numberp y) (+ x y))
               ((=0 x) y)
	       (t (simplifya `((mplus) ,x ,y) t))))
        ((=0 y) x)
	(t (simplifya `((mplus) ,x ,y) t))))

(defmfun add2* (x y)
  (cond
    ((and (numberp x) (numberp y)) (+ x y))
    ((=0 x) (simplifya y nil))
    ((=0 y) (simplifya x nil))
    (t (simplifya `((mplus) ,x ,y) nil))))

;; The first two cases in this cond shouldn't be needed, but exist
;; for compatibility with the old OPERS package.  The old ADDLIS
;; deleted zeros ahead of time.  Is this worth it?

(defmfun addn (terms simp-flag)
  (cond ((null terms) 0)
	(t (simplifya `((mplus) . ,terms) simp-flag))))

(declare-top (special $negdistrib))

(defmfun neg (x)
  (cond ((numberp x) (- x))
	(t (let (($negdistrib t))
	     (simplifya `((mtimes) -1 ,x) t)))))

(defmfun sub (x y)
  (cond
    ((and (numberp x) (numberp y)) (- x y))
    ((=0 y) x)
    ((=0 x) (neg y))
    (t (add x (neg y)))))

(defmfun sub* (x y)
  (cond
    ((and (numberp x) (numberp y)) (- x y))
    ((=0 y) x)
    ((=0 x) (neg y))
    (t
     (add (simplifya x nil) (mul -1 (simplifya y nil))))))

;; Multiplication primitives -- is it worthwhile to handle the 3-arg
;; case specially?  Don't simplify x*0 --> 0 since x could be non-scalar.

(defmfun mul2 (x y)
  (cond
    ((and (numberp x) (numberp y)) (* x y))
    ((=1 x) y)
    ((=1 y) x)
    (t (simplifya `((mtimes) ,x ,y) t))))

(defmfun mul2* (x y)
  (cond
    ((and (numberp x) (numberp y)) (* x y))
    ((=1 x) (simplifya y nil))
    ((=1 y) (simplifya x nil))
    (t (simplifya `((mtimes) ,x ,y) nil))))

(defmfun mul3 (x y z)
  (cond ((=1 x) (mul2 y z))
	((=1 y) (mul2 x z))
	((=1 z) (mul2 x y))
	(t (simplifya `((mtimes) ,x ,y ,z) t))))

;; The first two cases in this cond shouldn't be needed, but exist
;; for compatibility with the old OPERS package.  The old MULSLIS
;; deleted ones ahead of time.  Is this worth it?

(defmfun muln (factors simp-flag)
  (cond ((null factors) 1)
	((atom factors) factors)
	(t (simplifya `((mtimes) . ,factors) simp-flag))))

(defmfun div (x y)
  (if (=1 x)
      (inv y)
      (mul x (inv y))))

(defmfun div* (x y)
  (if (=1 x)
      (inv* y)
      (mul (simplifya x nil) (inv* y))))

(defmfun ncmul2 (x y)
  (simplifya `((mnctimes) ,x ,y) t))

(defmfun ncmuln (factors flag)
  (simplifya `((mnctimes) . ,factors) flag))

;; Exponentiation

;; Don't use BASE as a parameter name since it is special in MacLisp.

(defmfun power (*base power)
  (cond ((=1 power) *base)
	(t (simplifya `((mexpt) ,*base ,power) t))))

(defmfun power* (*base power)
  (cond ((=1 power) (simplifya *base nil))
	(t (simplifya `((mexpt) ,*base ,power) nil))))

(defmfun ncpower (x y)
  (cond ((=0 y) 1)
	((=1 y) x)
	(t (simplifya `((mncexpt) ,x ,y) t))))

;; [Add something for constructing equations here at some point.]

;; (ROOT X N) takes the Nth root of X.
;; Warning! Simplifier may give a complex expression back, starting from a
;; positive (evidently) real expression, viz. sqrt[(sinh-sin) / (sin-sinh)] or
;; something.

(defmfun root (x n)
  (cond ((=0 x) 0)
	((=1 x) 1)
	(t (simplifya `((mexpt) ,x ((rat simp) 1 ,n)) t))))

;; (Porm flag expr) is +expr if flag is true, and -expr
;; otherwise.  Morp is the opposite.  Names stand for "plus or minus"
;; and vice versa.

(defmfun porm (s x) (if s x (neg x)))
(defmfun morp (s x) (if s (neg x) x))