Mercurial > emacs
annotate lisp/calc/calc-rules.el @ 99613:785924da433d
(Splitting Windows, Deleting Windows)
(Selecting Windows, Cyclic Window Ordering)
(Buffers and Windows, Displaying Buffers, Choosing Window)
(Dedicated Windows, Window Point, Window Start and End)
(Textual Scrolling, Vertical Scrolling, Horizontal Scrolling)
(Size of Window, Resizing Windows, Window Configurations)
(Window Parameters): Avoid @var at beginning of sentences and
reword accordingly.
author | Martin Rudalics <rudalics@gmx.at> |
---|---|
date | Sun, 16 Nov 2008 10:15:30 +0000 |
parents | 6c9af2bfcfee |
children | a9dc0e7c3f2b |
rev | line source |
---|---|
41413 | 1 ;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
2 |
64325
1db49616ce05
Update copyright information.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
62442
diff
changeset
|
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, |
79702 | 4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
5 |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
6 ;; Author: David Gillespie <daveg@synaptics.com> |
77465
1154f082efd9
Update maintainer's address.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
76595
diff
changeset
|
7 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
40785 | 8 |
9 ;; This file is part of GNU Emacs. | |
10 | |
94654
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
76595
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
12 ;; it under the terms of the GNU General Public License as published by |
94654
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
40785 | 15 |
76595
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
16 ;; GNU Emacs is distributed in the hope that it will be useful, |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
19 ;; GNU General Public License for more details. |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
20 |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
21 ;; You should have received a copy of the GNU General Public License |
94654
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
40785 | 23 |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
24 ;;; Commentary: |
40785 | 25 |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
26 ;;; Code: |
40785 | 27 |
28 ;; This file is autoloaded from calc-ext.el. | |
58670
f5725a8f81c8
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
29 |
40785 | 30 (require 'calc-ext) |
31 (require 'calc-macs) | |
32 | |
33 (defun calc-compile-rule-set (name rules) | |
34 (prog2 | |
35 (message "Preparing rule set %s..." name) | |
36 (math-read-plain-expr rules t) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
37 (message "Preparing rule set %s...done" name))) |
40785 | 38 |
39 (defun calc-CommuteRules () | |
40 "CommuteRules" | |
41 (calc-compile-rule-set | |
42 "CommuteRules" "[ | |
43 iterations(1), | |
44 select(plain(a + b)) := select(plain(b + a)), | |
45 select(plain(a - b)) := select(plain((-b) + a)), | |
46 select(plain((1/a) * b)) := select(b / a), | |
47 select(plain(a * b)) := select(b * a), | |
48 select((1/a) / b) := select((1/b) / a), | |
49 select(a / b) := select((1/b) * a), | |
50 select((a^b) ^ c) := select((a^c) ^ b), | |
51 select(log(a, b)) := select(1 / log(b, a)), | |
52 select(plain(a && b)) := select(b && a), | |
53 select(plain(a || b)) := select(b || a), | |
54 select(plain(a = b)) := select(b = a), | |
55 select(plain(a != b)) := select(b != a), | |
56 select(a < b) := select(b > a), | |
57 select(a > b) := select(b < a), | |
58 select(a <= b) := select(b >= a), | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
59 select(a >= b) := select(b <= a) ]")) |
40785 | 60 |
61 (defun calc-JumpRules () | |
62 "JumpRules" | |
63 (calc-compile-rule-set | |
64 "JumpRules" "[ | |
65 iterations(1), | |
66 plain(select(x) = y) := 0 = select(-x) + y, | |
67 plain(a + select(x) = y) := a = select(-x) + y, | |
68 plain(a - select(x) = y) := a = select(x) + y, | |
69 plain(select(x) + a = y) := a = select(-x) + y, | |
70 plain(a * select(x) = y) := a = y / select(x), | |
71 plain(a / select(x) = y) := a = select(x) * y, | |
72 plain(select(x) / a = y) := 1/a = y / select(x), | |
73 plain(a ^ select(2) = y) := a = select(sqrt(y)), | |
74 plain(a ^ select(x) = y) := a = y ^ select(1/x), | |
75 plain(select(x) ^ a = y) := a = log(y, select(x)), | |
76 plain(log(a, select(x)) = y) := a = select(x) ^ y, | |
77 plain(log(select(x), a) = y) := a = select(x) ^ (1/y), | |
78 plain(y = select(x)) := y - select(x) = 0, | |
79 plain(y = a + select(x)) := y - select(x) = a, | |
80 plain(y = a - select(x)) := y + select(x) = a, | |
81 plain(y = select(x) + a) := y - select(x) = a, | |
82 plain(y = a * select(x)) := y / select(x) = a, | |
83 plain(y = a / select(x)) := y * select(x) = a, | |
84 plain(y = select(x) / a) := y / select(x) = 1/a, | |
85 plain(y = a ^ select(2)) := select(sqrt(y)) = a, | |
86 plain(y = a ^ select(x)) := y ^ select(1/x) = a, | |
87 plain(y = select(x) ^ a) := log(y, select(x)) = a, | |
88 plain(y = log(a, select(x))) := select(x) ^ y = a, | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
89 plain(y = log(select(x), a)) := select(x) ^ (1/y) = a ]")) |
40785 | 90 |
91 (defun calc-DistribRules () | |
92 "DistribRules" | |
93 (calc-compile-rule-set | |
94 "DistribRules" "[ | |
95 iterations(1), | |
96 x * select(a + b) := x*select(a) + x*b, | |
97 x * select(sum(a,b,c,d)) := sum(x*select(a),b,c,d), | |
98 x / select(a + b) := 1 / (select(a)/x + b/x), | |
99 select(a + b) / x := select(a)/x + b/x, | |
100 sum(select(a),b,c,d) / x := sum(select(a)/x,b,c,d), | |
101 x ^ select(a + b) := x^select(a) * x^b, | |
102 x ^ select(sum(a,b,c,d)) := prod(x^select(a),b,c,d), | |
103 x ^ select(a * b) := (x^a)^select(b), | |
104 x ^ select(a / b) := (x^a)^select(1/b), | |
105 select(a + b) ^ n := select(x) | |
106 :: integer(n) :: n >= 2 | |
107 :: let(x, expandpow(a+b,n)) | |
108 :: quote(matches(x,y+z)), | |
109 select(a + b) ^ x := a*select(a+b)^(x-1) + b*select(a+b)^(x-1), | |
110 select(a * b) ^ x := a^x * select(b)^x, | |
111 select(prod(a,b,c,d)) ^ x := prod(select(a)^x,b,c,d), | |
112 select(a / b) ^ x := select(a)^x / b^x, | |
113 select(- a) ^ x := (-1)^x * select(a)^x, | |
114 plain(-select(a + b)) := select(-a) - b, | |
115 plain(-select(sum(a,b,c,d))) := sum(select(-a),b,c,d), | |
116 plain(-select(a * b)) := select(-a) * b, | |
117 plain(-select(a / b)) := select(-a) / b, | |
118 sqrt(select(a * b)) := sqrt(select(a)) * sqrt(b), | |
119 sqrt(select(prod(a,b,c,d))) := prod(sqrt(select(a)),b,c,d), | |
120 sqrt(select(a / b)) := sqrt(select(a)) / sqrt(b), | |
121 sqrt(select(- a)) := sqrt(-1) sqrt(select(a)), | |
122 exp(select(a + b)) := exp(select(a)) / exp(-b) :: negative(b), | |
123 exp(select(a + b)) := exp(select(a)) * exp(b), | |
124 exp(select(sum(a,b,c,d))) := prod(exp(select(a)),b,c,d), | |
125 exp(select(a * b)) := exp(select(a)) ^ b :: constant(b), | |
126 exp(select(a * b)) := exp(select(a)) ^ b, | |
127 exp(select(a / b)) := exp(select(a)) ^ (1/b), | |
128 ln(select(a * b)) := ln(select(a)) + ln(b), | |
129 ln(select(prod(a,b,c,d))) := sum(ln(select(a)),b,c,d), | |
130 ln(select(a / b)) := ln(select(a)) - ln(b), | |
131 ln(select(a ^ b)) := ln(select(a)) * b, | |
132 log10(select(a * b)) := log10(select(a)) + log10(b), | |
133 log10(select(prod(a,b,c,d))) := sum(log10(select(a)),b,c,d), | |
134 log10(select(a / b)) := log10(select(a)) - log10(b), | |
135 log10(select(a ^ b)) := log10(select(a)) * b, | |
136 log(select(a * b), x) := log(select(a), x) + log(b,x), | |
137 log(select(prod(a,b,c,d)),x) := sum(log(select(a),x),b,c,d), | |
138 log(select(a / b), x) := log(select(a), x) - log(b,x), | |
139 log(select(a ^ b), x) := log(select(a), x) * b, | |
140 log(a, select(b)) := ln(a) / select(ln(b)), | |
141 sin(select(a + b)) := sin(select(a)) cos(b) + cos(a) sin(b), | |
142 sin(select(2 a)) := 2 sin(select(a)) cos(a), | |
143 sin(select(n a)) := 2sin((n-1) select(a)) cos(a) - sin((n-2) a) | |
144 :: integer(n) :: n > 2, | |
145 cos(select(a + b)) := cos(select(a)) cos(b) - sin(a) sin(b), | |
146 cos(select(2 a)) := 2 cos(select(a))^2 - 1, | |
147 cos(select(n a)) := 2cos((n-1) select(a)) cos(a) - cos((n-2) a) | |
148 :: integer(n) :: n > 2, | |
149 tan(select(a + b)) := (tan(select(a)) + tan(b)) / | |
150 (1 - tan(a) tan(b)), | |
151 tan(select(2 a)) := 2 tan(select(a)) / (1 - tan(a)^2), | |
152 tan(select(n a)) := (tan((n-1) select(a)) + tan(a)) / | |
153 (1 - tan((n-1) a) tan(a)) | |
154 :: integer(n) :: n > 2, | |
60080
c3660f1897f5
(calc-DistribRules, calc-NegateRules): Add rules.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58670
diff
changeset
|
155 cot(select(a + b)) := (cot(select(a)) cot(b) - 1) / |
c3660f1897f5
(calc-DistribRules, calc-NegateRules): Add rules.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58670
diff
changeset
|
156 (cot(a) + cot(b)), |
40785 | 157 sinh(select(a + b)) := sinh(select(a)) cosh(b) + cosh(a) sinh(b), |
158 cosh(select(a + b)) := cosh(select(a)) cosh(b) + sinh(a) sinh(b), | |
159 tanh(select(a + b)) := (tanh(select(a)) + tanh(b)) / | |
160 (1 + tanh(a) tanh(b)), | |
60080
c3660f1897f5
(calc-DistribRules, calc-NegateRules): Add rules.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58670
diff
changeset
|
161 coth(select(a + b)) := (coth(select(a)) coth(b) + 1) / |
c3660f1897f5
(calc-DistribRules, calc-NegateRules): Add rules.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58670
diff
changeset
|
162 (coth(a) + coth(b)), |
40785 | 163 x && select(a || b) := (x && select(a)) || (x && b), |
164 select(a || b) && x := (select(a) && x) || (b && x), | |
165 ! select(a && b) := (!a) || (!b), | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
166 ! select(a || b) := (!a) && (!b) ]")) |
40785 | 167 |
168 (defun calc-MergeRules () | |
169 "MergeRules" | |
170 (calc-compile-rule-set | |
171 "MergeRules" "[ | |
172 iterations(1), | |
173 (x*opt(a)) + select(x*b) := x * (a + select(b)), | |
174 (x*opt(a)) - select(x*b) := x * (a - select(b)), | |
175 sum(select(x)*a,b,c,d) := x * sum(select(a),b,c,d), | |
176 (a/x) + select(b/x) := (a + select(b)) / x, | |
177 (a/x) - select(b/x) := (a - select(b)) / x, | |
178 sum(a/select(x),b,c,d) := sum(select(a),b,c,d) / x, | |
179 (a/opt(b)) + select(c/d) := ((select(a)*d) + (b*c)) / (b*d), | |
180 (a/opt(b)) - select(c/d) := ((select(a)*d) - (b*c)) / (b*d), | |
181 (x^opt(a)) * select(x^b) := x ^ (a + select(b)), | |
182 (x^opt(a)) / select(x^b) := x ^ (a - select(b)), | |
183 select(x^a) / (x^opt(b)) := x ^ (select(a) - b), | |
184 prod(select(x)^a,b,c,d) := x ^ sum(select(a),b,c,d), | |
185 select(x^a) / (x^opt(b)) := x ^ (select(a) - b), | |
186 (a^x) * select(b^x) := select((a * b) ^x), | |
187 (a^x) / select(b^x) := select((b / b) ^ x), | |
188 select(a^x) / (b^x) := select((a / b) ^ x), | |
189 prod(a^select(x),b,c,d) := select(prod(a,b,c,d) ^ x), | |
190 (a^x) * select(b^y) := select((a * b^(y-x)) ^x), | |
191 (a^x) / select(b^y) := select((b / b^(y-x)) ^ x), | |
192 select(a^x) / (b^y) := select((a / b^(y-x)) ^ x), | |
193 select(x^a) ^ b := x ^ select(a * b), | |
194 (x^a) ^ select(b) := x ^ select(a * b), | |
195 select(sqrt(a)) ^ b := select(a ^ (b / 2)), | |
196 sqrt(a) ^ select(b) := select(a ^ (b / 2)), | |
197 sqrt(select(a) ^ b) := select(a ^ (b / 2)), | |
198 sqrt(a ^ select(b)) := select(a ^ (b / 2)), | |
199 sqrt(a) * select(sqrt(b)) := select(sqrt(a * b)), | |
200 sqrt(a) / select(sqrt(b)) := select(sqrt(a / b)), | |
201 select(sqrt(a)) / sqrt(b) := select(sqrt(a / b)), | |
202 prod(select(sqrt(a)),b,c,d) := select(sqrt(prod(a,b,c,d))), | |
203 exp(a) * select(exp(b)) := select(exp(a + b)), | |
204 exp(a) / select(exp(b)) := select(exp(a - b)), | |
205 select(exp(a)) / exp(b) := select(exp(a - b)), | |
206 prod(select(exp(a)),b,c,d) := select(exp(sum(a,b,c,d))), | |
207 select(exp(a)) ^ b := select(exp(a * b)), | |
208 exp(a) ^ select(b) := select(exp(a * b)), | |
209 ln(a) + select(ln(b)) := select(ln(a * b)), | |
210 ln(a) - select(ln(b)) := select(ln(a / b)), | |
211 select(ln(a)) - ln(b) := select(ln(a / b)), | |
212 sum(select(ln(a)),b,c,d) := select(ln(prod(a,b,c,d))), | |
213 b * select(ln(a)) := select(ln(a ^ b)), | |
214 select(b) * ln(a) := select(ln(a ^ b)), | |
215 select(ln(a)) / ln(b) := select(log(a, b)), | |
216 ln(a) / select(ln(b)) := select(log(a, b)), | |
217 select(ln(a)) / b := select(ln(a ^ (1/b))), | |
218 ln(a) / select(b) := select(ln(a ^ (1/b))), | |
219 log10(a) + select(log10(b)) := select(log10(a * b)), | |
220 log10(a) - select(log10(b)) := select(log10(a / b)), | |
221 select(log10(a)) - log10(b) := select(log10(a / b)), | |
222 sum(select(log10(a)),b,c,d) := select(log10(prod(a,b,c,d))), | |
223 b * select(log10(a)) := select(log10(a ^ b)), | |
224 select(b) * log10(a) := select(log10(a ^ b)), | |
225 select(log10(a)) / log10(b) := select(log(a, b)), | |
226 log10(a) / select(log10(b)) := select(log(a, b)), | |
227 select(log10(a)) / b := select(log10(a ^ (1/b))), | |
228 log10(a) / select(b) := select(log10(a ^ (1/b))), | |
229 log(a,x) + select(log(b,x)) := select(log(a * b,x)), | |
230 log(a,x) - select(log(b,x)) := select(log(a / b,x)), | |
231 select(log(a,x)) - log(b,x) := select(log(a / b,x)), | |
232 sum(select(log(a,x)),b,c,d) := select(log(prod(a,b,c,d),x)), | |
233 b * select(log(a,x)) := select(log(a ^ b,x)), | |
234 select(b) * log(a,x) := select(log(a ^ b,x)), | |
235 select(log(a,x)) / log(b,x) := select(log(a, b)), | |
236 log(a,x) / select(log(b,x)) := select(log(a, b)), | |
237 select(log(a,x)) / b := select(log(a ^ (1/b),x)), | |
238 log(a,x) / select(b) := select(log(a ^ (1/b),x)), | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
239 select(x && a) || (x && opt(b)) := x && (select(a) || b) ]")) |
40785 | 240 |
241 (defun calc-NegateRules () | |
242 "NegateRules" | |
243 (calc-compile-rule-set | |
244 "NegateRules" "[ | |
245 iterations(1), | |
246 a + select(x) := a - select(-x), | |
247 a - select(x) := a + select(-x), | |
248 sum(select(x),b,c,d) := -sum(select(-x),b,c,d), | |
249 a * select(x) := -a * select(-x), | |
250 a / select(x) := -a / select(-x), | |
251 select(x) / a := -select(-x) / a, | |
252 prod(select(x),b,c,d) := (-1)^(d-c+1) * prod(select(-x),b,c,d), | |
253 select(x) ^ n := select(-x) ^ a :: integer(n) :: n%2 = 0, | |
254 select(x) ^ n := -(select(-x) ^ a) :: integer(n) :: n%2 = 1, | |
255 select(x) ^ a := (-select(-x)) ^ a, | |
256 a ^ select(x) := (1 / a)^select(-x), | |
257 abs(select(x)) := abs(select(-x)), | |
258 i sqrt(select(x)) := -sqrt(select(-x)), | |
259 sqrt(select(x)) := i sqrt(select(-x)), | |
260 re(select(x)) := -re(select(-x)), | |
261 im(select(x)) := -im(select(-x)), | |
262 conj(select(x)) := -conj(select(-x)), | |
263 trunc(select(x)) := -trunc(select(-x)), | |
264 round(select(x)) := -round(select(-x)), | |
265 floor(select(x)) := -ceil(select(-x)), | |
266 ceil(select(x)) := -floor(select(-x)), | |
267 ftrunc(select(x)) := -ftrunc(select(-x)), | |
268 fround(select(x)) := -fround(select(-x)), | |
269 ffloor(select(x)) := -fceil(select(-x)), | |
270 fceil(select(x)) := -ffloor(select(-x)), | |
271 exp(select(x)) := 1 / exp(select(-x)), | |
272 sin(select(x)) := -sin(select(-x)), | |
273 cos(select(x)) := cos(select(-x)), | |
274 tan(select(x)) := -tan(select(-x)), | |
60080
c3660f1897f5
(calc-DistribRules, calc-NegateRules): Add rules.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58670
diff
changeset
|
275 sec(select(x)) := sec(select(-x)), |
c3660f1897f5
(calc-DistribRules, calc-NegateRules): Add rules.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58670
diff
changeset
|
276 csc(select(x)) := -csc(select(-x)), |
c3660f1897f5
(calc-DistribRules, calc-NegateRules): Add rules.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58670
diff
changeset
|
277 cot(select(x)) := -cot(select(-x)), |
40785 | 278 arcsin(select(x)) := -arcsin(select(-x)), |
279 arccos(select(x)) := 4 arctan(1) - arccos(select(-x)), | |
280 arctan(select(x)) := -arctan(select(-x)), | |
281 sinh(select(x)) := -sinh(select(-x)), | |
282 cosh(select(x)) := cosh(select(-x)), | |
283 tanh(select(x)) := -tanh(select(-x)), | |
60080
c3660f1897f5
(calc-DistribRules, calc-NegateRules): Add rules.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58670
diff
changeset
|
284 sech(select(x)) := sech(select(-x)), |
c3660f1897f5
(calc-DistribRules, calc-NegateRules): Add rules.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58670
diff
changeset
|
285 csch(select(x)) := -csch(select(-x)), |
c3660f1897f5
(calc-DistribRules, calc-NegateRules): Add rules.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58670
diff
changeset
|
286 coth(select(x)) := -coth(select(-x)), |
40785 | 287 arcsinh(select(x)) := -arcsinh(select(-x)), |
288 arctanh(select(x)) := -arctanh(select(-x)), | |
289 select(x) = a := select(-x) = -a, | |
290 select(x) != a := select(-x) != -a, | |
291 select(x) < a := select(-x) > -a, | |
292 select(x) > a := select(-x) < -a, | |
293 select(x) <= a := select(-x) >= -a, | |
294 select(x) >= a := select(-x) <= -a, | |
295 a < select(x) := -a > select(-x), | |
296 a > select(x) := -a < select(-x), | |
297 a <= select(x) := -a >= select(-x), | |
298 a >= select(x) := -a <= select(-x), | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
299 select(x) := -select(-x) ]")) |
40785 | 300 |
301 (defun calc-InvertRules () | |
302 "InvertRules" | |
303 (calc-compile-rule-set | |
304 "InvertRules" "[ | |
305 iterations(1), | |
306 a * select(x) := a / select(1/x), | |
307 a / select(x) := a * select(1/x), | |
308 select(x) / a := 1 / (select(1/x) a), | |
309 prod(select(x),b,c,d) := 1 / prod(select(1/x),b,c,d), | |
310 abs(select(x)) := 1 / abs(select(1/x)), | |
311 sqrt(select(x)) := 1 / sqrt(select(1/x)), | |
312 ln(select(x)) := -ln(select(1/x)), | |
313 log10(select(x)) := -log10(select(1/x)), | |
314 log(select(x), a) := -log(select(1/x), a), | |
315 log(a, select(x)) := -log(a, select(1/x)), | |
316 arctan(select(x)) := simplify(2 arctan(1))-arctan(select(1/x)), | |
317 select(x) = a := select(1/x) = 1/a, | |
318 select(x) != a := select(1/x) != 1/a, | |
319 select(x) < a := select(1/x) > 1/a, | |
320 select(x) > a := select(1/x) < 1/a, | |
321 select(x) <= a := select(1/x) >= 1/a, | |
322 select(x) >= a := select(1/x) <= 1/a, | |
323 a < select(x) := 1/a > select(1/x), | |
324 a > select(x) := 1/a < select(1/x), | |
325 a <= select(x) := 1/a >= select(1/x), | |
326 a >= select(x) := 1/a <= select(1/x), | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
327 select(x) := 1 / select(1/x) ]")) |
40785 | 328 |
329 | |
330 (defun calc-FactorRules () | |
331 "FactorRules" | |
332 (calc-compile-rule-set | |
333 "FactorRules" "[ | |
334 thecoefs(x, [z, a+b, c]) := thefactors(x, [d x + d a/c, (c/d) x + (b/d)]) | |
335 :: z = a b/c :: let(d := pgcd(pcont(c), pcont(b))), | |
336 thecoefs(x, [z, a, c]) := thefactors(x, [(r x + a/(2 r))^2]) | |
337 :: z = (a/2)^2/c :: let(r := esimplify(sqrt(c))) | |
338 :: !matches(r, sqrt(rr)), | |
339 thecoefs(x, [z, 0, c]) := thefactors(x, [rc x + rz, rc x - rz]) | |
340 :: negative(z) | |
341 :: let(rz := esimplify(sqrt(-z))) :: !matches(rz, sqrt(rzz)) | |
342 :: let(rc := esimplify(sqrt(c))) :: !matches(rc, sqrt(rcc)), | |
343 thecoefs(x, [z, 0, c]) := thefactors(x, [rz + rc x, rz - rc x]) | |
344 :: negative(c) | |
345 :: let(rz := esimplify(sqrt(z))) :: !matches(rz, sqrt(rzz)) | |
346 :: let(rc := esimplify(sqrt(-c))) :: !matches(rc, sqrt(rcc)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
347 ]")) |
40785 | 348 ;;(setq var-FactorRules 'calc-FactorRules) |
349 | |
350 | |
351 (defun calc-IntegAfterRules () | |
352 "IntegAfterRules" | |
353 (calc-compile-rule-set | |
354 "IntegAfterRules" "[ | |
355 opt(a) ln(x) + opt(b) ln(y) := 2 a esimplify(arctanh(x-1)) | |
356 :: a + b = 0 :: nrat(x + y) = 2 || nrat(x - y) = 2, | |
357 a * (b + c) := a b + a c :: constant(a) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
358 ]")) |
40785 | 359 |
360 ;;(setq var-IntegAfterRules 'calc-IntegAfterRules) | |
361 | |
362 | |
363 (defun calc-FitRules () | |
364 "FitRules" | |
365 (calc-compile-rule-set | |
366 "FitRules" "[ | |
367 | |
368 schedule(1,2,3,4), | |
369 iterations(inf), | |
370 | |
371 phase(1), | |
372 e^x := exp(x), | |
373 x^y := exp(y ln(x)) :: !istrue(constant(y)), | |
374 x/y := x fitinv(y), | |
375 fitinv(x y) := fitinv(x) fitinv(y), | |
376 exp(a) exp(b) := exp(a + b), | |
377 a exp(b) := exp(ln(a) + b) :: !hasfitvars(a), | |
378 fitinv(exp(a)) := exp(-a), | |
379 ln(a b) := ln(a) + ln(b), | |
380 ln(fitinv(a)) := -ln(a), | |
381 log10(a b) := log10(a) + log10(b), | |
382 log10(fitinv(a)) := -log10(a), | |
383 log(a,b) := ln(a)/ln(b), | |
384 ln(exp(a)) := a, | |
385 a*(b+c) := a*b + a*c, | |
386 (a+b)^n := x :: integer(n) :: n >= 2 | |
387 :: let(x, expandpow(a+b,n)) | |
388 :: quote(matches(x,y+z)), | |
389 | |
390 phase(1,2), | |
391 fitmodel(y = x) := fitmodel(0, y - x), | |
392 fitmodel(y, x+c) := fitmodel(y-c, x) :: !hasfitparams(c), | |
393 fitmodel(y, x c) := fitmodel(y/c, x) :: !hasfitparams(c), | |
394 fitmodel(y, x/(c opt(d))) := fitmodel(y c, x/d) :: !hasfitparams(c), | |
395 fitmodel(y, apply(f,[x])) := fitmodel(yy, x) | |
396 :: hasfitparams(x) | |
397 :: let(FTemp() = yy, | |
398 solve(apply(f,[FTemp()]) = y, | |
399 FTemp())), | |
400 fitmodel(y, apply(f,[x,c])) := fitmodel(yy, x) | |
401 :: !hasfitparams(c) | |
402 :: let(FTemp() = yy, | |
403 solve(apply(f,[FTemp(),c]) = y, | |
404 FTemp())), | |
405 fitmodel(y, apply(f,[c,x])) := fitmodel(yy, x) | |
406 :: !hasfitparams(c) | |
407 :: let(FTemp() = yy, | |
408 solve(apply(f,[c,FTemp()]) = y, | |
409 FTemp())), | |
410 | |
411 phase(2,3), | |
412 fitmodel(y, x) := fitsystem(y, [], [], fitpart(1,1,x)), | |
413 fitpart(a,b,plain(x + y)) := fitpart(a,b,x) + fitpart(a,b,y), | |
414 fitpart(a,b,plain(x - y)) := fitpart(a,b,x) + fitpart(-a,b,y), | |
415 fitpart(a,b,plain(-x)) := fitpart(-a,b,x), | |
416 fitpart(a,b,x opt(c)) := fitpart(a,x b,c) :: !hasfitvars(x), | |
417 fitpart(a,x opt(b),c) := fitpart(x a,b,c) :: !hasfitparams(x), | |
418 fitpart(a,x y + x opt(z),c) := fitpart(a,x*(y+z),c), | |
419 fitpart(a,b,c) := fitpart2(a,b,c), | |
420 | |
421 phase(3), | |
422 fitpart2(a1,b1,x) + fitpart2(a2,b2,x) := fitpart(1, a1 b1 + a2 b2, x), | |
423 fitpart2(a1,x,c1) + fitpart2(a2,x,c2) := fitpart2(1, x, a1 c1 + a2 c2), | |
424 | |
425 phase(4), | |
426 fitinv(x) := 1 / x, | |
427 exp(x + ln(y)) := y exp(x), | |
428 exp(x ln(y)) := y^x, | |
429 ln(x) + ln(y) := ln(x y), | |
430 ln(x) - ln(y) := ln(x/y), | |
431 x*y + x*z := x*(y+z), | |
432 fitsystem(y, xv, pv, fitpart2(a,fitparam(b),c) + opt(d)) | |
433 := fitsystem(y, rcons(xv, a c), | |
434 rcons(pv, fitdummy(b) = fitparam(b)), d) | |
435 :: b = vlen(pv)+1, | |
436 fitsystem(y, xv, pv, fitpart2(a,b,c) + opt(d)) | |
437 := fitsystem(y, rcons(xv, a c), | |
438 rcons(pv, fitdummy(vlen(pv)+1) = b), d), | |
439 fitsystem(y, xv, pv, 0) := fitsystem(y, xv, cons(fvh,fvt)) | |
440 :: !hasfitparams(xv) | |
441 :: let(cons(fvh,fvt), | |
442 solve(pv, table(fitparam(j), j, 1, | |
443 hasfitparams(pv)))), | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
444 fitparam(n) = x := x ]")) |
40785 | 445 |
58670
f5725a8f81c8
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
446 (provide 'calc-rules) |
f5725a8f81c8
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
447 |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79702
diff
changeset
|
448 ;; arch-tag: 0ed54a52-38f3-4ed7-9ca7-b8ecf8f2febe |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
449 ;;; calc-rules.el ends here |