formula-manipulation.a68
1 COMMENT
2
3 @section Synopsis
4
5 Symbolic computing in Algol 68.
6
7 Based on example 11.10 in the Revised Report on Algol 68.
8
9 COMMENT
10
11 PR quiet PR
12
13 # Data structure #
14
15 MODE FORM = UNION (REF CONST, REF VAR, REF DYAD, REF MONAD),
16 DYAD = STRUCT (FORM lhs, INT op, FORM rhs),
17 MONAD = STRUCT (INT op, FORM rhs),
18 VAR = STRUCT (STRING name, REF CONST value),
19 CONST = STRUCT (NUM value),
20 NUM = LONG LONG REAL;
21
22 # Access ops #
23
24 OP VALUE = (REF CONST c) REF NUM: value OF c,
25 VALUE = (REF VAR v) REF CONST: value OF v,
26 NAME = (REF VAR v) REF STRING: name OF v,
27 LHS = (REF DYAD t) REF FORM: lhs OF t,
28 RHS = (REF DYAD t) REF FORM: rhs OF t,
29 RHS = (REF MONAD t) REF FORM: rhs OF t,
30 OPER = (REF DYAD t) REF INT: op OF t,
31 OPER = (REF MONAD t) REF INT: op OF t,
32 NUMER = (FORM f) NUM: CASE f
33 IN (REF CONST c): (c :/=: NIL | VALUE (c))
34 ESAC;
35
36 # Generate objects #
37
38 PROC new num = (NUM v) REF NUM: HEAP NUM := v;
39 PROC new dyad = (FORM u, INT op, FORM v) REF DYAD: NEW DYAD := (u, op, v);
40 PROC new monad = (INT op, FORM v) REF MONAD: NEW MONAD := (op, v);
41 PROC new var = (STRING name, REF CONST value) REF VAR: NEW VAR := (name, value);
42 PROC new const = (NUM x) REF CONST: (NEW CONST c; VALUE c := x; c);
43
44 PROC zero = REF CONST: new const (0),
45 one = REF CONST: new const (1),
46 two = REF CONST: new const (2);
47
48 PROC half = FORM: one / two;
49
50 # Basic routines and ops #
51
52 INT plus = 1, minus = 2, times = 3, over = 4, up = 5;
53
54 PROC const = (FORM f) BOOL:
55 CASE f
56 IN (REF CONST u): u :/=: NIL
57 OUT FALSE
58 ESAC;
59
60 OP DUP = (FORM f) FORM:
61 CASE f
62 IN (REF CONST u): new const (VALUE u),
63 (REF VAR u): new var (NAME u, VALUE u),
64 (REF DYAD u): new dyad (DUP LHS u, OPER u, DUP RHS u),
65 (REF MONAD u): new monad (OPER u, DUP RHS u)
66 ESAC;
67
68 OP = = (FORM f, g) BOOL:
69 CASE f
70 IN (REF CONST u): CASE g
71 IN (REF CONST v): IF (u :=: NIL) OR (v :=: NIL)
72 THEN FALSE
73 ELSE VALUE u = VALUE v
74 FI
75 OUT FALSE
76 ESAC,
77 (REF VAR u): (g | (REF VAR v): NAME u = NAME v | FALSE),
78 (REF DYAD u): (g | (REF DYAD v): OPER u = OPER v AND LHS u = LHS v AND RHS u = RHS v | FALSE),
79 (REF MONAD u): (g | (REF MONAD v): OPER u = OPER v AND RHS u = RHS v | FALSE)
80 OUT FALSE
81 ESAC;
82
83 OP /= = (FORM f, g) BOOL: NOT (f = g);
84
85 # Pretty print NUM. #
86
87 OP PRETTY = (NUM z) STRING:
88 IF ABS (z - ROUND z) < 10 * long long small real
89 THEN whole (z, 0)
90 ELIF ABS (z) >= 0.1 THEF ABS (z) <= 10
91 THEN STRING buf;
92 FOR digits TO real width
93 WHILE puts (buf, fixed (z, 0, digits));
94 NUM y;
95 gets (buf, y);
96 z /= y
97 DO ~ OD;
98 buf
99 ELSE STRING buf, INT expw = 4;
100 FOR digits TO real width
101 WHILE puts (buf, float (z, 4 + digits + expw, digits, expw));
102 NUM y;
103 gets (buf, y);
104 z /= y
105 DO ~ OD;
106 buf
107 FI;
108
109 # Basic math. Indulge yourself adding more heuristics. #
110
111 OP + = (FORM f) FORM: SIMPL f;
112
113 OP - = (FORM f) FORM:
114 (FORM s = SIMPL f; s = zero | s | new monad (minus, s));
115
116 OP + = (FORM f, g) FORM:
117 IF FORM s = SIMPL f, t = SIMPL g;
118 s = zero
119 THEN t
120 ELIF t = zero
121 THEN s
122 ELIF s = t
123 THEN new const (2) * s
124 ELIF const (s) THEF const (t)
125 THEN new const (NUMER (s) + NUMER (t))
126 ELSE new dyad (s, plus, t)
127 FI;
128
129 OP - = (FORM f, g) FORM:
130 IF FORM s = SIMPL f, t = SIMPL g;
131 s = zero
132 THEN new monad (minus, t)
133 ELIF t = zero
134 THEN s
135 ELIF s = t
136 THEN zero
137 ELIF const (s) THEF const (t)
138 THEN new const (NUMER (s) - NUMER (t))
139 ELSE new dyad (s, minus, t)
140 FI;
141
142 OP * = (FORM f, g) FORM:
143 IF FORM s = SIMPL f, t = SIMPL g;
144 s = zero OR t = zero
145 THEN zero
146 ELIF s = one
147 THEN t
148 ELIF t = one
149 THEN s
150 ELIF const (s) THEF const (t)
151 THEN new const (NUMER (s) * NUMER (t))
152 ELSE new dyad (s, times, t)
153 FI;
154
155 OP / = (FORM f, g) FORM:
156 IF FORM s = SIMPL f, t = SIMPL g;
157 t = zero
158 THEN REF CONST (NIL)
159 ELIF s = zero
160 THEN zero
161 ELIF t = one
162 THEN s
163 ELIF const (s) THEF const (t)
164 THEN new const (NUMER (s) / NUMER (t))
165 ELSE new dyad (s, over, t)
166 FI;
167
168 OP ^ = (FORM f, g) FORM:
169 IF FORM s = SIMPL f, t = SIMPL g;
170 t = zero
171 THEN one
172 ELIF t = one
173 THEN s
174 ELIF const (s) THEF const (t)
175 THEN new const (NUMER (s) ** NUMER (t))
176 ELSE new dyad (s, up, t)
177 FI;
178
179 OP SIMPL = (FORM f) FORM:
180 CASE f
181 IN (REF CONST u): u,
182 (REF VAR u): (VALUE u :=: NIL | u | VALUE u),
183 (REF MONAD u):
184 CASE OPER u
185 IN SIMPL RHS u,
186 -SIMPL RHS u
187 ESAC,
188 (REF DYAD u):
189 CASE OPER u
190 IN SIMPL LHS u + SIMPL RHS u,
191 SIMPL LHS u - SIMPL RHS u,
192 SIMPL LHS u * SIMPL RHS u,
193 SIMPL LHS u / SIMPL RHS u,
194 SIMPL LHS u ^ SIMPL RHS u
195 ESAC
196 OUT f
197 ESAC;
198
199 OP EVAL = (FORM f) FORM:
200 # Simplify as much as rules allow #
201 BEGIN FORM u := DUP f, v;
202 DO v := DUP u;
203 u := SIMPL u
204 UNTIL u = v
205 OD;
206 u
207 END;
208
209 # Applications of above definitions: derivative. #
210
211 PROC deriv = (FORM f, # with respect to # REF VAR x) FORM:
212 CASE f
213 IN (REF CONST): zero,
214 (REF VAR v): (v = x | one | zero),
215 (REF MONAD u):
216 CASE FORM s = RHS u;
217 OPER u
218 IN + deriv (s, x),
219 - deriv (s, x)
220 ESAC,
221 (REF DYAD u):
222 CASE FORM s = LHS u, t = RHS u;
223 FORM deriv s = deriv (s, x), deriv t = deriv (t, x);
224 OPER u
225 IN deriv s + deriv t,
226 deriv s - deriv t,
227 s * deriv t + deriv s * t,
228 (deriv s - u * deriv t) / t,
229 # (t | (REF CONST c): t * s ^ new const (VALUE c - 1) * deriv s) #
230 t * s ^ (t - one) * deriv s
231 ESAC
232 ESAC;
233
234 # A tiny demonstration #
235
236 PROC write = (FORM f) VOID:
237 CASE f
238 IN (REF CONST c): print ((c :=: NIL | "(empty)" | PRETTY VALUE c)),
239 (REF VAR v): print (NAME v),
240 (REF MONAD u):
241 BEGIN
242 print (("(", (OPER u | "+", "-")));
243 write (RHS u);
244 print (")")
245 END,
246 (REF DYAD u):
247 BEGIN
248 print ("(");
249 write (LHS u);
250 print ((OPER u | " + ", " - ", " * ", " / ", " ^ "));
251 write (RHS u);
252 print (")")
253 END
254 ESAC;
255
256 PROC demo = (FORM f, REF VAR z) VOID:
257 BEGIN write (f);
258 print (" => ");
259 write (EVAL f);
260 IF z :/=: NIL
261 THEN print ("; d/d");
262 write (z);
263 print (" = ");
264 write (EVAL deriv (EVAL f, z))
265 FI;
266 newline (standout)
267 END;
268
269 REF VAR pi var = new var ("pi", new const (qpi)),
270 x = new var ("x", NIL),
271 y = new var ("y", NIL);
272
273 demo (zero - y, y);
274 demo (x ^ half, x);
275 demo (x ^ y, x);
276 demo (pi var + pi var, NIL);
277 demo (new const (2) ^ new const (3) + one, NIL)
|
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|
