← Back to branch summary

~ubuntu-branches/ubuntu/hoary/scilab/hoary

« back to all changes in this revision

Viewing changes to ocaml/symbolicExpression.ml

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2005-01-09 22:58:21 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20050109225821-473xr8vhgugxxx5j
Tags: 3.0-12
http://bugs.debian.org/255869
changed configure.in to build scilab's own malloc.o, closes: #255869

Show diffs side-by-side

added added

removed removed

Lines of Context:
ocaml/symbolicExpression.ml
 
1
 
 
2
 
 
3
open Num
 
4
 
 
5
exception Infinite_result of string
 
6
 
 
7
 
 
8
(* Type definitions *)
 
9
 
 
10
type t =
 
11
  {
 
12
    nature: nature;
 
13
    sortingHash: int;
 
14
    hash: int;
 
15
    mutable count: int;
 
16
    mutable replacement: t
 
17
  }
 
18
and nature =
 
19
  | Addition of t list
 
20
  | And of t list
 
21
  | ArcCosine of t
 
22
  | ArcHyperbolicCosine of t
 
23
  | ArcHyperbolicSine of t
 
24
  | ArcHyperbolicTangent of t
 
25
  | ArcSine of t
 
26
  | ArcTangent of t
 
27
  | BlackBox of string * t list
 
28
  | BooleanValue of bool
 
29
  | Constant of string
 
30
  | Cosine of t
 
31
  | Derivative of t * num
 
32
  | DiscreteVariable of int
 
33
  | Equality of t * t
 
34
  | Exponential of t
 
35
  | Floor of t
 
36
  | Greater of t * t
 
37
  | HyperbolicCosine of t
 
38
  | HyperbolicSine of t
 
39
  | HyperbolicTangent of t
 
40
  | If of t * t * t
 
41
  | Logarithm of t
 
42
  | Multiplication of t list
 
43
  | Not of t
 
44
  | Number of num
 
45
  | Or of t list
 
46
  | Parameter of int
 
47
  | PartialDerivative of t * t
 
48
  | RationalPower of t * num
 
49
  | Sign of t
 
50
  | Sine of t
 
51
  | Tangent of t
 
52
  | TimeVariable
 
53
  | Variable of int
 
54
 
 
55
 
 
56
(* Node utilities *)
 
57
 
 
58
let nature node = node.nature
 
59
 
 
60
let hash node = node.hash
 
61
 
 
62
(* List utilities *)
 
63
 
 
64
let rec eq_list nodes nodes' = match nodes, nodes' with
 
65
  | [], [] -> true
 
66
  | node :: nodes, node' :: nodes' when node == node' -> eq_list nodes nodes'
 
67
  | _ -> false
 
68
 
 
69
let insert node nodes =
 
70
  let rec insert_into nodes = match nodes with
 
71
    | [] -> [node]
 
72
    | node' :: _ when node.sortingHash <= node'.sortingHash -> node :: nodes
 
73
    | node' :: nodes' -> node' :: insert_into nodes'
 
74
  in insert_into nodes
 
75
 
 
76
let remove node nodes =
 
77
  let rec remove_from = function
 
78
    | [] -> []
 
79
    | node' :: nodes' when node == node' -> nodes'
 
80
    | node' :: nodes' -> node' :: remove_from nodes'
 
81
  in remove_from nodes
 
82
 
 
83
let sort nodes =
 
84
  List.sort
 
85
    (fun node node' ->
 
86
      if node.sortingHash < node'.sortingHash then -1
 
87
      else if node.sortingHash > node'.sortingHash then 1
 
88
      else 0)
 
89
    nodes
 
90
 
 
91
let union nodes nodes' =
 
92
  List.fold_left
 
93
    (fun acc node -> if List.exists (( == ) node) acc then acc else node :: acc)
 
94
    nodes
 
95
    nodes'
 
96
 
 
97
let intersection nodes nodes' =
 
98
  List.fold_left
 
99
    (fun acc node ->
 
100
      if List.exists (( == ) node) nodes then node :: acc else acc)
 
101
    []
 
102
    nodes'
 
103
 
 
104
 
 
105
(* Node collections *)
 
106
 
 
107
type node = t
 
108
 
 
109
module Node =
 
110
  struct
 
111
    type t = node
 
112
    let hash node = node.hash
 
113
  end
 
114
 
 
115
module NodeSet = GraphNodeSet.Make(Node)
 
116
 
 
117
let global_count = ref 0
 
118
 
 
119
let unique_integer =
 
120
  let i = ref 0
 
121
  in function () -> let v = !i in begin incr i; v end
 
122
 
 
123
let create_node nature hash =
 
124
  let rec node =
 
125
    {
 
126
      nature = nature;
 
127
      sortingHash = unique_integer ();
 
128
      hash = hash;
 
129
      count = !global_count;
 
130
      replacement = node
 
131
    }
 
132
  in node
 
133
 
 
134
let additionNodeSet =
 
135
  let equal nodeList node = match node.nature with
 
136
    | Addition nodes -> eq_list nodeList nodes
 
137
    | _ -> invalid_arg "Argument mismatch."
 
138
  and hash nodes =
 
139
    List.fold_left
 
140
      (fun sum elt -> (sum lsl 3) + elt.hash)
 
141
      0x248c44
 
142
      nodes
 
143
  and create nodes hash = create_node (Addition nodes) hash
 
144
  in NodeSet.create 101 equal hash create
 
145
 
 
146
let andNodeSet =
 
147
  let equal nodeList node = match node.nature with
 
148
    | And nodes -> eq_list nodeList nodes
 
149
    | _ -> invalid_arg "Argument mismatch."
 
150
  and hash nodes =
 
151
    List.fold_left
 
152
      (fun sum elt -> (sum lsl 6) + elt.hash)
 
153
      0xe41e902
 
154
      nodes
 
155
  and create nodes hash = create_node (And nodes) hash
 
156
  in NodeSet.create 101 equal hash create
 
157
 
 
158
let arcCosineNodeSet =
 
159
  let equal node1 node = match node.nature with
 
160
    | ArcCosine node -> node == node1
 
161
    | _ -> invalid_arg "Argument mismatch."
 
162
  and hash node1 = (node1.hash lsl 6) lxor 0x4211038
 
163
  and create node1 hash = create_node (ArcCosine node1) hash
 
164
  in NodeSet.create 101 equal hash create
 
165
 
 
166
let arcHyperbolicCosineNodeSet =
 
167
  let equal node1 node = match node.nature with
 
168
    | ArcHyperbolicCosine node -> node == node1
 
169
    | _ -> invalid_arg "Argument mismatch."
 
170
  and hash node1 = (node1.hash lsl 4) lxor 0x24a5b008
 
171
  and create node1 hash = create_node (ArcHyperbolicCosine node1) hash
 
172
  in NodeSet.create 101 equal hash create
 
173
 
 
174
let arcHyperbolicSineNodeSet =
 
175
  let equal node1 node = match node.nature with
 
176
    | ArcHyperbolicSine node -> node == node1
 
177
    | _ -> invalid_arg "Argument mismatch."
 
178
  and hash node1 = (node1.hash lsl 3) lxor 0x21a8d400
 
179
  and create node1 hash = create_node (ArcHyperbolicSine node1) hash
 
180
  in NodeSet.create 101 equal hash create
 
181
 
 
182
let arcHyperbolicTangentNodeSet =
 
183
  let equal node1 node = match node.nature with
 
184
    | ArcHyperbolicTangent node -> node == node1
 
185
    | _ -> invalid_arg "Argument mismatch."
 
186
  and hash node1 = (node1.hash lsl 5) lxor 0x2bd00c4
 
187
  and create node1 hash = create_node (ArcHyperbolicTangent node1) hash
 
188
  in NodeSet.create 101 equal hash create
 
189
 
 
190
let arcSineNodeSet =
 
191
  let equal node1 node = match node.nature with
 
192
    | ArcSine node -> node == node1
 
193
    | _ -> invalid_arg "Argument mismatch."
 
194
  and hash node1 = (node1.hash lsl 3) lxor 0x114500a0
 
195
  and create node1 hash = create_node (ArcSine node1) hash
 
196
  in NodeSet.create 101 equal hash create
 
197
 
 
198
let arcTangentNodeSet =
 
199
  let equal node1 node = match node.nature with
 
200
    | ArcTangent node -> node == node1
 
201
    | _ -> invalid_arg "Argument mismatch."
 
202
  and hash node1 = (node1.hash lsl 4) lxor 0x200aa000
 
203
  and create node1 hash = create_node (ArcTangent node1) hash
 
204
  in NodeSet.create 101 equal hash create
 
205
 
 
206
let blackBoxNodeSet =
 
207
  let equal (string, nodeList) node = match node.nature with
 
208
    | BlackBox (name, nodes) -> name = string && eq_list nodeList nodes
 
209
    | _ -> invalid_arg "Argument mismatch."
 
210
  and hash (string, nodes) =
 
211
    (GraphNodeSet.hash string +
 
212
    List.fold_left (fun sum elt -> (sum lsl 3) + elt.hash) 0x20a0 nodes) land
 
213
    max_int
 
214
  and create (string, nodes) hash = create_node (BlackBox (string, nodes)) hash
 
215
  in NodeSet.create 101 equal hash create
 
216
 
 
217
let constantNodeSet =
 
218
  let equal string node = match node.nature with
 
219
    | Constant name -> name = string
 
220
    | _ -> invalid_arg "Argument mismatch."
 
221
  and hash string = GraphNodeSet.hash string lxor 0x709dc0
 
222
  and create string hash = create_node (Constant string) hash
 
223
  in NodeSet.create 101 equal hash create
 
224
 
 
225
let cosineNodeSet =
 
226
  let equal node1 node = match node.nature with
 
227
    | Cosine node -> node == node1
 
228
    | _ -> invalid_arg "Argument mismatch."
 
229
  and hash node1 = (node1.hash lsl 5) lxor 0x208af001
 
230
  and create node1 hash = create_node (Cosine node1) hash
 
231
  in NodeSet.create 101 equal hash create
 
232
 
 
233
let derivativeNodeSet =
 
234
  let equal (node1, num) node = match node.nature with
 
235
    | Derivative (node', num') -> node1 == node' && eq_num num num'
 
236
    | _ -> invalid_arg "Argument mismatch."
 
237
  and hash (node, num) =
 
238
    (GraphNodeSet.hash num lsl 10) lxor (node.hash + 0x1410200d)
 
239
  and create (node, num) hash = create_node (Derivative (node, num)) hash
 
240
  in NodeSet.create 101 equal hash create
 
241
 
 
242
let discreteVariableNodeSet =
 
243
  let equal i node = match node.nature with
 
244
    | DiscreteVariable i' -> i = i'
 
245
    | _ -> invalid_arg "Argument mismatch."
 
246
  and hash i = GraphNodeSet.hash i lxor 0x2fb049a3
 
247
  and create i hash = create_node (DiscreteVariable i) hash
 
248
  in NodeSet.create 101 equal hash create
 
249
 
 
250
let equalityNodeSet =
 
251
  let equal (node1, node2) node = match node.nature with
 
252
    | Equality (leftHandNode, rightHandNode) ->
 
253
        leftHandNode == node1 && rightHandNode == node2
 
254
    | _ -> invalid_arg "Argument mismatch."
 
255
  and hash (node1, node2) = (node1.hash lsl 5) lxor (node2.hash + 0x5218c660)
 
256
  and create (node1, node2) hash = create_node (Equality (node1, node2)) hash
 
257
  in NodeSet.create 101 equal hash create
 
258
 
 
259
let exponentialNodeSet =
 
260
  let equal node1 node = match node.nature with
 
261
    | Exponential node -> node == node1
 
262
    | _ -> invalid_arg "Argument mismatch."
 
263
  and hash node1 = (node1.hash lsl 4) lxor 0x20c22a00
 
264
  and create node1 hash = create_node (Exponential node1) hash
 
265
  in NodeSet.create 101 equal hash create
 
266
 
 
267
let floorNodeSet =
 
268
  let equal node1 node = match node.nature with
 
269
    | Floor node -> node == node1
 
270
    | _ -> invalid_arg "Argument mismatch."
 
271
  and hash node1 = (node1.hash lsl 2) lxor 0x8788b02
 
272
  and create node1 hash = create_node (Floor node1) hash
 
273
  in NodeSet.create 101 equal hash create
 
274
 
 
275
let greaterNodeSet =
 
276
  let equal (node1, node2) node = match node.nature with
 
277
    | Greater (leftHandNode, rightHandNode) ->
 
278
        leftHandNode == node1 && rightHandNode == node2
 
279
    | _ -> invalid_arg "Argument mismatch."
 
280
  and hash (node1, node2) =
 
281
    (node1.hash lsl 18) lxor (node2.hash + 0x11e02c02)
 
282
  and create (node1, node2) hash = create_node (Greater (node1, node2)) hash
 
283
  in NodeSet.create 101 equal hash create
 
284
 
 
285
let hyperbolicCosineNodeSet =
 
286
  let equal node1 node = match node.nature with
 
287
    | HyperbolicCosine node -> node == node1
 
288
    | _ -> invalid_arg "Argument mismatch."
 
289
  and hash node1 = (node1.hash lsl 4) lxor 0x2a091f0c
 
290
  and create node1 hash = create_node (HyperbolicCosine node1) hash
 
291
  in NodeSet.create 101 equal hash create
 
292
 
 
293
let hyperbolicSineNodeSet =
 
294
  let equal node1 node = match node.nature with
 
295
    | HyperbolicSine node -> node == node1
 
296
    | _ -> invalid_arg "Argument mismatch."
 
297
  and hash node1 = (node1.hash lsl 5) lxor 0x24f002f1
 
298
  and create node1 hash = create_node (HyperbolicSine node1) hash
 
299
  in NodeSet.create 101 equal hash create
 
300
 
 
301
let hyperbolicTangentNodeSet =
 
302
  let equal node1 node = match node.nature with
 
303
    | HyperbolicTangent node -> node == node1
 
304
    | _ -> invalid_arg "Argument mismatch."
 
305
  and hash node1 = (node1.hash lsl 3) lxor 0x2a221c8
 
306
  and create node1 hash = create_node (HyperbolicTangent node1) hash
 
307
  in NodeSet.create 101 equal hash create
 
308
 
 
309
let ifNodeSet =
 
310
  let equal (node1, node2, node3) node = match node.nature with
 
311
    | If (testNode, alternativeNode1, alternativeNode2) ->
 
312
        testNode == node1 && alternativeNode1 == node2 &&
 
313
        alternativeNode2 == node3
 
314
    | _ -> invalid_arg "Argument mismatch."
 
315
  and hash (node1, node2, node3) =
 
316
    (node1.hash lsl 17) lxor (node2.hash lsl 5) lxor
 
317
    (node3.hash + 0x5d403a30)
 
318
  and create (node1, node2, node3) hash =
 
319
    create_node (If (node1, node2, node3)) hash
 
320
  in NodeSet.create 101 equal hash create
 
321
 
 
322
let logarithmNodeSet =
 
323
  let equal node1 node = match node.nature with
 
324
    | Logarithm node -> node == node1
 
325
    | _ -> invalid_arg "Argument mismatch."
 
326
  and hash node1 = (node1.hash lsl 2) lxor 0x11bf004
 
327
  and create node1 hash = create_node (Logarithm node1) hash
 
328
  in NodeSet.create 101 equal hash create
 
329
 
 
330
let multiplicationNodeSet =
 
331
  let equal nodeList node = match node.nature with
 
332
    | Multiplication nodes -> eq_list nodeList nodes
 
333
    | _ -> invalid_arg "Argument mismatch."
 
334
  and hash nodes =
 
335
    List.fold_left
 
336
      (fun sum elt -> (sum lsl 3) + elt.hash)
 
337
      0x25a50039
 
338
      nodes
 
339
  and create nodes hash = create_node (Multiplication nodes) hash
 
340
  in NodeSet.create 101 equal hash create
 
341
 
 
342
let numberNodeSet =
 
343
  let equal num node = match node.nature with
 
344
    | Number num' -> eq_num num' num
 
345
    | _ -> invalid_arg "Argument mismatch."
 
346
  and hash num = GraphNodeSet.hash num lxor 0x59710f0
 
347
  and create num hash =
 
348
    let rec node =
 
349
      {
 
350
        nature = Number num;
 
351
        sortingHash = -unique_integer ();
 
352
        (* The sorting hash is nagated to ensure that numbers appear
 
353
           at the first positions in commutative n-ary expressions.  *)
 
354
        hash = hash;
 
355
        count = !global_count;
 
356
        replacement = node
 
357
      }
 
358
    in node
 
359
  in NodeSet.create 101 equal hash create
 
360
 
 
361
let notNodeSet =
 
362
  let equal node1 node = match node.nature with
 
363
    | Not node -> node == node1
 
364
    | _ -> invalid_arg "Argument mismatch."
 
365
  and hash node1 = (node1.hash lsl 5) lxor 0x18a20a0
 
366
  and create node1 hash = create_node (Not node1) hash
 
367
  in NodeSet.create 101 equal hash create
 
368
 
 
369
let orNodeSet =
 
370
  let equal nodes node = match node.nature with
 
371
    | Or nodes' -> eq_list nodes nodes'
 
372
    | _ -> invalid_arg "Argument mismatch."
 
373
  and hash nodes =
 
374
    List.fold_left
 
375
      (fun sum elt -> (sum lsl 3) + elt.hash)
 
376
      0x4102f024
 
377
      nodes
 
378
  and create nodes hash = create_node (Or nodes) hash
 
379
  in NodeSet.create 101 equal hash create
 
380
 
 
381
let parameterNodeSet =
 
382
  let equal i node = match node.nature with
 
383
    | Parameter i' -> i' = i
 
384
    | _ -> invalid_arg "Argument mismatch."
 
385
  and hash i = GraphNodeSet.hash i lxor 0x709dc0
 
386
  and create i hash = create_node (Parameter i) hash
 
387
  in NodeSet.create 101 equal hash create
 
388
 
 
389
let partialDerivativeNodeSet =
 
390
  let equal (node1, node2) node = match node.nature with
 
391
    | PartialDerivative (variableNode, argumentNode) ->
 
392
        variableNode == node1 && argumentNode == node2
 
393
    | _ -> invalid_arg "Argument mismatch."
 
394
  and hash (node1, node2) =
 
395
    (node1.hash lsl 12) lxor (node2.hash + 0x2f301000)
 
396
  and create (node1, node2) hash =
 
397
    create_node (PartialDerivative (node1, node2)) hash
 
398
  in NodeSet.create 101 equal hash create
 
399
 
 
400
let rationalPowerNodeSet =
 
401
  let equal (node1, num) node = match node.nature with
 
402
    | RationalPower (argumentNode, num')  ->
 
403
        argumentNode == node1 && (eq_num num' num)
 
404
    | _ -> invalid_arg "Argument mismatch."
 
405
  and hash (node1, num) =
 
406
    (GraphNodeSet.hash num lsl 20) lxor (node1.hash + 0xd41000d)
 
407
  and create (node1, num) hash = create_node (RationalPower (node1, num)) hash
 
408
  in NodeSet.create 101 equal hash create
 
409
 
 
410
let signNodeSet =
 
411
  let equal node1 node = match node.nature with
 
412
    | Sign node -> node == node1
 
413
    | _ -> invalid_arg "Argument mismatch."
 
414
  and hash node1 = (node1.hash lsl 5) lxor 0x100050f0
 
415
  and create node1 hash = create_node (Sign node1) hash
 
416
  in NodeSet.create 101 equal hash create
 
417
 
 
418
let sineNodeSet =
 
419
  let equal node1 node = match node.nature with
 
420
    | Sine node -> node == node1
 
421
    | _ -> invalid_arg "Argument mismatch."
 
422
  and hash node1 = (node1.hash lsl 6) lxor 0x8a8f00
 
423
  and create node1 hash = create_node (Sine node1) hash
 
424
  in NodeSet.create 101 equal hash create
 
425
 
 
426
let tangentNodeSet =
 
427
  let equal node1 node = match node.nature with
 
428
    | Tangent node -> node == node1
 
429
    | _ -> invalid_arg "Argument mismatch."
 
430
  and hash node1 = (node1.hash lsl 8) lxor 0x655001c9
 
431
  and create node1 hash = create_node (Tangent node1) hash
 
432
  in NodeSet.create 101 equal hash create
 
433
 
 
434
let variableNodeSet =
 
435
  let equal i node = match node.nature with
 
436
    | Variable i' -> i' = i
 
437
    | _ -> invalid_arg "Argument mismatch."
 
438
  and hash i = GraphNodeSet.hash i lxor 0x2fb04900
 
439
  and create i hash = create_node (Variable i) hash
 
440
  in NodeSet.create 101 equal hash create
 
441
 
 
442
 
 
443
(* Node creation *)
 
444
 
 
445
let zero_num = Int 0
 
446
let one_num = Int 1
 
447
let two_num = Int 2
 
448
 
 
449
let minus_one = NodeSet.find_or_add (Int (-1)) numberNodeSet
 
450
let zero = NodeSet.find_or_add zero_num numberNodeSet
 
451
let one = NodeSet.find_or_add one_num numberNodeSet
 
452
let two = NodeSet.find_or_add two_num numberNodeSet
 
453
let ten = NodeSet.find_or_add (Int 10) numberNodeSet
 
454
let one_over_two = NodeSet.find_or_add (div_num (one_num) two_num) numberNodeSet
 
455
let minus_one_over_two =
 
456
  NodeSet.find_or_add (div_num (Int (-1)) two_num) numberNodeSet
 
457
let pi = NodeSet.find_or_add "3.14159265359" constantNodeSet
 
458
let pi_over_two =
 
459
  NodeSet.find_or_add (insert one_over_two [pi]) multiplicationNodeSet
 
460
let minus_pi_over_two =
 
461
  NodeSet.find_or_add (insert minus_one_over_two [pi]) multiplicationNodeSet
 
462
let e = NodeSet.find_or_add "2.71828182846" constantNodeSet
 
463
let false_value = create_node (BooleanValue false) 0
 
464
let true_value = create_node (BooleanValue true) 1
 
465
let time = create_node TimeVariable 0
 
466
 
 
467
let addition_neutral = zero
 
468
let multiplication_neutral = one
 
469
let and_neutral = true_value
 
470
let or_neutral = false_value
 
471
 
 
472
let create_addition = function
 
473
  | [] -> addition_neutral
 
474
  | [node] -> node
 
475
  | nodes -> NodeSet.find_or_add nodes additionNodeSet
 
476
 
 
477
let create_and = function
 
478
  | [] -> and_neutral
 
479
  | [node] -> node
 
480
  | nodes -> NodeSet.find_or_add nodes andNodeSet
 
481
 
 
482
let create_arcCosine node = NodeSet.find_or_add node arcCosineNodeSet
 
483
 
 
484
let create_arcHyperbolicCosine node =
 
485
  NodeSet.find_or_add node arcHyperbolicCosineNodeSet
 
486
 
 
487
let create_arcHyperbolicSine node =
 
488
  NodeSet.find_or_add node arcHyperbolicSineNodeSet
 
489
 
 
490
let create_arcHyperbolicTangent node =
 
491
  NodeSet.find_or_add node arcHyperbolicTangentNodeSet
 
492
 
 
493
let create_arcSine node = NodeSet.find_or_add node arcSineNodeSet
 
494
 
 
495
let create_arcTangent node = NodeSet.find_or_add node arcTangentNodeSet
 
496
 
 
497
let create_blackBox s nodes = NodeSet.find_or_add (s, nodes) blackBoxNodeSet
 
498
 
 
499
let create_booleanValue b = if b then true_value else false_value
 
500
 
 
501
let create_constant s = NodeSet.find_or_add s constantNodeSet
 
502
 
 
503
let create_cosine node = NodeSet.find_or_add node cosineNodeSet
 
504
 
 
505
let create_derivative node num =
 
506
  NodeSet.find_or_add (node, num) derivativeNodeSet
 
507
 
 
508
let create_discrete_variable i = NodeSet.find_or_add i discreteVariableNodeSet
 
509
 
 
510
let create_equality node node' =
 
511
  NodeSet.find_or_add (node, node') equalityNodeSet
 
512
 
 
513
let create_exponential node = NodeSet.find_or_add node exponentialNodeSet
 
514
 
 
515
let create_floor node =  NodeSet.find_or_add node floorNodeSet
 
516
 
 
517
let create_greater node node' = NodeSet.find_or_add (node, node') greaterNodeSet
 
518
 
 
519
let create_hyperbolicCosine node =
 
520
  NodeSet.find_or_add node hyperbolicCosineNodeSet
 
521
 
 
522
let create_hyperbolicSine node = NodeSet.find_or_add node hyperbolicSineNodeSet
 
523
 
 
524
let create_hyperbolicTangent node =
 
525
  NodeSet.find_or_add node hyperbolicTangentNodeSet
 
526
 
 
527
let create_if node node' node'' =
 
528
  NodeSet.find_or_add (node, node', node'') ifNodeSet
 
529
 
 
530
let create_logarithm node = NodeSet.find_or_add node logarithmNodeSet
 
531
 
 
532
let create_multiplication = function
 
533
  | [] -> multiplication_neutral
 
534
  | [node] -> node
 
535
  | nodes -> NodeSet.find_or_add nodes multiplicationNodeSet
 
536
 
 
537
let create_not node = NodeSet.find_or_add node notNodeSet
 
538
 
 
539
let create_number = function
 
540
  | Int 0 -> zero
 
541
  | Int 1 -> one
 
542
  | num -> NodeSet.find_or_add num numberNodeSet
 
543
 
 
544
let create_or = function
 
545
  | [] -> or_neutral
 
546
  | [node] -> node
 
547
  | nodes -> NodeSet.find_or_add nodes orNodeSet
 
548
 
 
549
let create_parameter i = NodeSet.find_or_add i parameterNodeSet
 
550
 
 
551
let create_partialDerivative node node' =
 
552
  NodeSet.find_or_add (node, node') partialDerivativeNodeSet
 
553
 
 
554
let create_rationalPower node num =
 
555
  NodeSet.find_or_add (node, num) rationalPowerNodeSet
 
556
 
 
557
let create_sign node = NodeSet.find_or_add node signNodeSet
 
558
 
 
559
let create_sine node = NodeSet.find_or_add node sineNodeSet
 
560
 
 
561
let create_tangent node = NodeSet.find_or_add node tangentNodeSet
 
562
 
 
563
let create_timeVariable () = time
 
564
 
 
565
let create_variable i = NodeSet.find_or_add i variableNodeSet
 
566
 
 
567
 
 
568
(* Reductions *)
 
569
 
 
570
let rec apply_if_possible create op node nodes =
 
571
  let rec apply_if_possible' = function
 
572
    | [] -> Some (create (insert node nodes))
 
573
    | node' :: nodes' ->
 
574
        begin match op node node' with
 
575
          | Some node'' ->
 
576
              apply_if_possible create op node'' (remove node' nodes)
 
577
          | None -> apply_if_possible' nodes'
 
578
        end
 
579
  in apply_if_possible' nodes
 
580
 
 
581
and symbolic_abs node =
 
582
  symbolic_if (symbolic_ge node zero) node (symbolic_minus node)
 
583
 
 
584
and symbolic_acos node =
 
585
  if node == minus_one then pi
 
586
  else if node == zero then pi_over_two
 
587
  else if node == one then zero
 
588
  else create_arcCosine node
 
589
 
 
590
and symbolic_acosh node =
 
591
  if node == one then zero
 
592
  else create_arcHyperbolicCosine node
 
593
 
 
594
and symbolic_add node node' = match symbolic_add_if_possible node node' with
 
595
  | Some node -> node
 
596
  | None -> create_addition (insert node [node'])
 
597
 
 
598
and symbolic_and node node' = match symbolic_and_if_possible node node' with
 
599
  | Some node -> node
 
600
  | None -> create_and (insert node [node'])
 
601
 
 
602
and symbolic_asin node =
 
603
  if node == minus_one then minus_pi_over_two
 
604
  else if node == zero then zero
 
605
  else if node == one then pi_over_two
 
606
  else create_arcSine node
 
607
 
 
608
and symbolic_asinh node =
 
609
  if node == zero then zero
 
610
  else create_arcHyperbolicSine node
 
611
 
 
612
and symbolic_atan node =
 
613
  if node == zero then zero
 
614
  else create_arcTangent node
 
615
 
 
616
and symbolic_atanh node =
 
617
  if node == zero then zero
 
618
  else create_arcHyperbolicTangent node
 
619
 
 
620
and symbolic_blackBox name nodes = create_blackBox name nodes
 
621
 
 
622
and symbolic_cos node =
 
623
  if node == zero then one
 
624
  else create_cosine node
 
625
 
 
626
and symbolic_cosh node =
 
627
  if node == zero then one
 
628
  else create_arcHyperbolicCosine node
 
629
 
 
630
and symbolic_derivative node' =
 
631
  let ( + ) = symbolic_add
 
632
  and ( - ) = symbolic_sub
 
633
  and ( * ) = symbolic_mult
 
634
  and ( / ) = symbolic_div
 
635
  and ( ** ) = symbolic_rationalPower
 
636
  in match node'.nature with
 
637
    | Number _ | Constant _ | DiscreteVariable _ | Floor _ | Parameter _ |
 
638
      Sign _ -> zero
 
639
    | BlackBox _ | PartialDerivative _| Variable _ ->
 
640
        create_derivative node' one_num
 
641
    | Addition nodes ->
 
642
        List.fold_left (fun sum elt -> symbolic_derivative elt + sum) zero nodes
 
643
    | ArcCosine node ->
 
644
        symbolic_derivative node * minus_one /
 
645
        symbolic_sqrt (one - node ** two_num)
 
646
    | ArcHyperbolicCosine node ->
 
647
        symbolic_derivative node / symbolic_sqrt (node ** two_num - one)
 
648
    | ArcHyperbolicSine node ->
 
649
        symbolic_derivative node / symbolic_sqrt (node ** two_num + one)
 
650
    | ArcHyperbolicTangent node ->
 
651
        symbolic_derivative node / (node ** two_num - one)
 
652
    | ArcSine node ->
 
653
        symbolic_derivative node / symbolic_sqrt (one - node ** two_num)
 
654
    | ArcTangent node -> symbolic_derivative node / (one + node ** two_num)
 
655
    | Cosine node ->
 
656
        symbolic_derivative node * symbolic_minus (symbolic_sin node)
 
657
    | Derivative (node, num) -> create_derivative node (succ_num num)
 
658
    | Exponential node -> symbolic_derivative node * symbolic_exp node
 
659
    | HyperbolicCosine node -> symbolic_derivative node * symbolic_sinh node
 
660
    | HyperbolicSine node -> symbolic_derivative node * symbolic_cosh node
 
661
    | HyperbolicTangent node ->
 
662
        symbolic_derivative node * (one - node' ** two_num)
 
663
    | If (node, node', node'') ->
 
664
        create_if node (symbolic_derivative node') (symbolic_derivative node'')
 
665
    | Logarithm node -> symbolic_derivative node / node
 
666
    | Multiplication [] -> zero
 
667
    | Multiplication [node] -> symbolic_derivative node
 
668
    | Multiplication (node :: nodes) ->
 
669
        let mult = create_multiplication nodes in
 
670
        symbolic_derivative node * mult + node * symbolic_derivative mult
 
671
    | RationalPower (node, num) ->
 
672
        symbolic_derivative node * create_number num * node ** pred_num num
 
673
    | Sine node -> symbolic_derivative node * symbolic_cos node
 
674
    | Tangent node -> symbolic_derivative node * (one + node' ** two_num)
 
675
    | TimeVariable -> one
 
676
    | And _ | BooleanValue _ | Equality _ | Not _ | Or _ | Greater _ ->
 
677
        invalid_arg "symbolic_derivative"
 
678
 
 
679
and symbolic_div node node' =
 
680
  if node' == zero then raise (Infinite_result "Division by zero.")
 
681
  else if node == node' then one
 
682
  else symbolic_mult node (symbolic_invert node')
 
683
 
 
684
and symbolic_eq node node' =
 
685
  if node == node' then true_value
 
686
  else match node.nature, node'.nature with
 
687
    | Number num, Number num' -> create_booleanValue (eq_num num num')
 
688
    | _ -> create_equality node' node
 
689
 
 
690
and symbolic_exp node =
 
691
  if node == zero then one
 
692
  else if node == one then e
 
693
  else create_exponential node
 
694
 
 
695
and symbolic_ge node node' =
 
696
  symbolic_or (symbolic_gt node node') (symbolic_eq node node')
 
697
 
 
698
and symbolic_gt node node' = match node.nature, node'.nature with
 
699
  | Number num, Number num' -> create_booleanValue (gt_num num num')
 
700
  | _ -> create_greater node node'
 
701
 
 
702
and symbolic_if node node' node'' = match node.nature with
 
703
  | BooleanValue b -> if b then node' else node''
 
704
  | Not bool -> symbolic_if bool node'' node'
 
705
  | _ -> create_if node node' node''
 
706
 
 
707
and symbolic_floor node = match node.nature with
 
708
  | Number num -> create_number (floor_num num)
 
709
  | Floor node' -> node
 
710
  | _ -> create_floor node
 
711
 
 
712
and symbolic_invert node =
 
713
  if node == zero then raise (Infinite_result "Division by zero.")
 
714
  else match node.nature with
 
715
    | Number num -> create_number (div_num (one_num) num)
 
716
    | Multiplication nodes ->
 
717
        create_multiplication (
 
718
          sort (List.map (fun elt -> symbolic_invert elt) nodes))
 
719
    | _ -> symbolic_power node minus_one
 
720
 
 
721
and symbolic_le node node' = symbolic_ge node' node
 
722
 
 
723
and symbolic_log node =
 
724
  if node == zero then raise (Infinite_result "Logarithm of zero.")
 
725
  else create_logarithm node
 
726
 
 
727
and symbolic_log10 node = symbolic_div (symbolic_log node) (symbolic_log ten)
 
728
 
 
729
and symbolic_lt node node' = symbolic_gt node' node
 
730
 
 
731
and symbolic_max node node' = symbolic_if (symbolic_gt node node') node node'
 
732
 
 
733
and symbolic_min node node' = symbolic_if (symbolic_gt node node') node' node
 
734
 
 
735
and symbolic_minus node =
 
736
  if node == zero then zero
 
737
  else match node.nature with
 
738
    | Number num -> create_number (minus_num num)
 
739
    | Addition nodes ->
 
740
        create_addition (
 
741
          sort (List.rev_map (fun elt -> symbolic_minus elt) nodes))
 
742
    | _ -> symbolic_mult minus_one node
 
743
 
 
744
and symbolic_mult node node' = match symbolic_mult_if_possible node node' with
 
745
  | Some node -> node
 
746
  | None -> create_multiplication (insert node [node'])
 
747
 
 
748
and symbolic_neq node node' = symbolic_not (symbolic_eq node node')
 
749
 
 
750
and symbolic_not node = match node.nature with
 
751
  | BooleanValue b -> create_booleanValue (not b)
 
752
  | Not bool -> bool
 
753
  | _ -> create_not node
 
754
 
 
755
and symbolic_or node node' = match symbolic_or_if_possible node node' with
 
756
  | Some node -> node
 
757
  | None -> create_or (insert node [node'])
 
758
 
 
759
and symbolic_partial_derivative var node' =
 
760
  let ( + ) = symbolic_add
 
761
  and ( - ) = symbolic_sub
 
762
  and ( * ) = symbolic_mult
 
763
  and ( / ) = symbolic_div
 
764
  and ( ** ) = symbolic_rationalPower in
 
765
  let rec partial_derivative node =
 
766
    if node == var then one
 
767
    else match node.nature with
 
768
      | Number _ | Constant _ | DiscreteVariable _ | Floor _ | Parameter _ |
 
769
        Sign _ | TimeVariable | Variable _ -> zero
 
770
      | BlackBox _ | Derivative _ | PartialDerivative _ ->
 
771
          create_partialDerivative var node
 
772
      | Addition nodes ->
 
773
          List.fold_left (fun sum elt -> partial_derivative elt + sum) zero nodes
 
774
      | ArcCosine node' ->
 
775
          partial_derivative node' * minus_one /
 
776
          symbolic_sqrt (one - node' ** two_num)
 
777
      | ArcHyperbolicCosine node' ->
 
778
          partial_derivative node' / symbolic_sqrt (node' ** two_num - one)
 
779
      | ArcHyperbolicSine node' ->
 
780
          partial_derivative node' / symbolic_sqrt (node' ** two_num + one)
 
781
      | ArcHyperbolicTangent node' ->
 
782
          partial_derivative node' / (node ** two_num - one)
 
783
      | ArcSine node' ->
 
784
          partial_derivative node' / symbolic_sqrt (one - node' ** two_num)
 
785
      | ArcTangent node' -> partial_derivative node' / (one + node' ** two_num)
 
786
      | Cosine node' ->
 
787
          partial_derivative node' * symbolic_minus (symbolic_sin node')
 
788
      | Exponential node' -> partial_derivative node' * symbolic_exp node'
 
789
      | HyperbolicCosine node' -> partial_derivative node' * symbolic_sinh node'
 
790
      | HyperbolicSine node' -> partial_derivative node' * symbolic_cosh node'
 
791
      | HyperbolicTangent node' ->
 
792
          partial_derivative node' * (one - node' ** two_num)
 
793
      | If (cond, node', node'') ->
 
794
          create_if cond (partial_derivative node') (partial_derivative node'')
 
795
      | Logarithm node' -> partial_derivative node' / node'
 
796
      | Multiplication [] -> zero
 
797
      | Multiplication [node'] -> partial_derivative node'
 
798
      | Multiplication (node' :: nodes) ->
 
799
          let mult = create_multiplication nodes in
 
800
          partial_derivative node' * mult + node' * partial_derivative mult
 
801
      | RationalPower (node', num) ->
 
802
          partial_derivative node' * create_number num * node' ** pred_num num
 
803
      | Sine node' -> partial_derivative node' * symbolic_cos node'
 
804
      | Tangent node' -> partial_derivative node' * (one + node ** two_num)
 
805
      | And _ | BooleanValue _ | Equality _ | Not _ | Or _ | Greater _ ->
 
806
          invalid_arg "partial_derivative : Invalid argument."
 
807
  in partial_derivative node'
 
808
 
 
809
and symbolic_power node node' = match node'.nature with
 
810
  | Number num' -> symbolic_rationalPower node num'
 
811
  | _ -> create_exponential (symbolic_mult node' (symbolic_log node))
 
812
 
 
813
and symbolic_rationalPower node num' =
 
814
  if node == zero && num' = zero_num then
 
815
    raise (Infinite_result "Zero raised to zero.")
 
816
  else if node == one || node == zero || num' = one_num then node
 
817
  else if num' = zero_num then one
 
818
  else match node.nature with
 
819
    | Number num when is_integer_num num' ->
 
820
        create_number (power_num num num')
 
821
    | RationalPower (node', num) ->
 
822
        symbolic_power node' (create_number (mult_num num num'))
 
823
    | _ -> create_rationalPower node num'
 
824
 
 
825
and symbolic_sgn node = match node.nature with
 
826
  | Number num -> create_number (Int (sign_num num))
 
827
  | _ -> create_sign node
 
828
 
 
829
and symbolic_sin node =
 
830
  if node == zero then zero
 
831
  else create_sine node
 
832
 
 
833
and symbolic_sinh node =
 
834
  if node == zero then zero
 
835
  else create_hyperbolicSine node
 
836
 
 
837
and symbolic_sqrt node = symbolic_power node one_over_two
 
838
 
 
839
and symbolic_sub node node' =
 
840
  if node' == zero then node
 
841
  else if node == node' then zero
 
842
  else symbolic_add node (symbolic_minus node')
 
843
 
 
844
and symbolic_tan node =
 
845
  if node == zero then zero
 
846
  else create_tangent node
 
847
 
 
848
and symbolic_tanh node =
 
849
  if node == zero then zero
 
850
  else create_hyperbolicTangent node
 
851
 
 
852
 
 
853
(* Intermediate functions *)
 
854
 
 
855
and symbolic_add_if_possible node node' =
 
856
  if node == zero then Some node'
 
857
  else if node' == zero then Some node
 
858
  else if node == node' then Some (create_multiplication (insert two [node]))
 
859
  else match node.nature, node'.nature with
 
860
    | Number num, Number num' -> Some (create_number (add_num num num'))
 
861
    | Number _, Addition nodes' ->
 
862
        add_number_to_addition_if_possible node nodes'
 
863
    | Multiplication _, Multiplication _ ->
 
864
        add_multiplication_to_multiplication_if_possible node node'
 
865
    | Multiplication _, Addition nodes' ->
 
866
        apply_if_possible create_addition symbolic_add_if_possible node nodes'
 
867
    | Multiplication _, _ ->
 
868
        add_expression_to_multiplication_if_possible node' node
 
869
    | Addition nodes, Number _ -> add_number_to_addition_if_possible node' nodes
 
870
    | Addition nodes, Multiplication _ ->
 
871
        apply_if_possible create_addition symbolic_add_if_possible node' nodes
 
872
    | Addition nodes, Addition _ ->
 
873
        Some (List.fold_left (fun sum elt -> symbolic_add elt sum) node' nodes)
 
874
    | Addition nodes, _ ->
 
875
        apply_if_possible create_addition symbolic_add_if_possible node' nodes
 
876
    | _, Multiplication _ ->
 
877
        add_expression_to_multiplication_if_possible node node'
 
878
    | _, Addition nodes' ->
 
879
        apply_if_possible create_addition symbolic_add_if_possible node nodes'
 
880
    | _ -> None
 
881
 
 
882
and add_number_to_addition_if_possible node nodes =
 
883
  match node.nature, nodes with
 
884
    | Number _, [] -> Some node
 
885
    | Number num, node' :: nodes' ->
 
886
        begin match node'.nature with
 
887
          | Number num' -> let sum = add_num num num' in
 
888
              if sum == zero_num then Some (create_addition nodes')
 
889
              else Some (create_addition (insert (create_number sum) nodes'))
 
890
          | _ -> Some (create_addition (insert node nodes))
 
891
        end
 
892
    | _ -> invalid_arg "First Argument must be a number node."
 
893
 
 
894
and add_factors_if_possible num nodes num' nodes' =
 
895
  if eq_list nodes nodes' then
 
896
    let sum = create_number (add_num num num') in
 
897
      if sum == zero then Some zero
 
898
      else Some (create_multiplication (insert sum nodes))
 
899
  else None
 
900
 
 
901
and add_multiplication_to_multiplication_if_possible node node' =
 
902
  match node.nature, node'.nature with
 
903
    | Multiplication nodes, Multiplication nodes' ->
 
904
        begin match nodes, nodes' with
 
905
          | [], _ -> symbolic_add_if_possible one node'
 
906
          | _, [] -> symbolic_add_if_possible one node
 
907
          | node :: nodes, node' :: nodes' ->
 
908
              begin match node.nature, node'.nature with
 
909
                | Number num, Number num' ->
 
910
                    add_factors_if_possible num nodes num' nodes'
 
911
                | Number num, _ ->
 
912
                    add_factors_if_possible num nodes one_num (node' :: nodes')
 
913
                | _, Number num' ->
 
914
                    add_factors_if_possible one_num (node :: nodes) num' nodes'
 
915
                | _ ->
 
916
                    add_factors_if_possible one_num nodes one_num nodes'
 
917
              end
 
918
        end
 
919
    | _ -> invalid_arg "Arguments must be multiplication nodes."
 
920
 
 
921
and add_expression_to_multiplication_if_possible node node' =
 
922
  match node'.nature with
 
923
    | Multiplication [] -> symbolic_add_if_possible one node
 
924
    | Multiplication (node' :: nodes') ->
 
925
        begin match node'.nature with
 
926
          | Number num' -> add_factors_if_possible one_num [node] num' nodes'
 
927
          | _ -> None
 
928
        end
 
929
    | _ -> invalid_arg "Second argument must be a multiplication node."
 
930
 
 
931
and symbolic_mult_if_possible node node' =
 
932
  if node == zero || node' == zero then Some zero
 
933
  else if node == one then Some node'
 
934
  else if node' == one then Some node
 
935
  else if node == node' then Some (symbolic_rationalPower node two_num)
 
936
  else match node.nature, node'.nature with
 
937
    | Number num, Number num' -> Some (create_number (mult_num num num'))
 
938
    | Number _, Addition nodes' ->
 
939
        Some (
 
940
          create_addition (
 
941
            sort (List.map (fun elt -> symbolic_mult node elt) nodes')))
 
942
    | Addition nodes, Number _ ->
 
943
        Some (
 
944
          create_addition (
 
945
            sort (List.map (fun elt -> symbolic_mult node' elt) nodes)))
 
946
    | Multiplication nodes, Multiplication _ ->
 
947
        Some (
 
948
          List.fold_left (fun prod elt -> symbolic_mult elt prod) node' nodes)
 
949
    | _, Multiplication nodes' ->
 
950
        apply_if_possible
 
951
          create_multiplication
 
952
          symbolic_mult_if_possible
 
953
          node
 
954
          nodes'
 
955
    | Multiplication nodes, _ ->
 
956
        apply_if_possible
 
957
          create_multiplication
 
958
          symbolic_mult_if_possible
 
959
          node'
 
960
          nodes
 
961
    | RationalPower _,RationalPower _ ->
 
962
        mult_power_by_power_if_possible node node'
 
963
    | RationalPower _, _ -> mult_expression_by_power_if_possible node' node
 
964
    | _, RationalPower _ -> mult_expression_by_power_if_possible node node'
 
965
    | _ -> None
 
966
 
 
967
and mult_expression_by_power_if_possible node node' = match node'.nature with
 
968
  | RationalPower (node', num') when node == node' ->
 
969
      Some (symbolic_rationalPower node (add_num one_num num'))
 
970
  | RationalPower _ -> None
 
971
  | _ -> invalid_arg "Second argument must be a power node."
 
972
 
 
973
and mult_power_by_power_if_possible node node' =
 
974
  match node.nature, node'.nature with
 
975
    | RationalPower (node, num), RationalPower (node', num')
 
976
      when node == node' ->
 
977
        Some (symbolic_rationalPower node (add_num num num'))
 
978
    | RationalPower _, RationalPower _ -> None
 
979
    | _ -> invalid_arg "Arguments must be power nodes."
 
980
 
 
981
and symbolic_and_if_possible node node' =
 
982
  if node == false_value || node' == false_value then Some false_value
 
983
  else if node == true_value then Some node'
 
984
  else if node' == true_value then Some node
 
985
  else if node == node' then Some node else
 
986
  match node.nature, node'.nature with
 
987
    | BooleanValue b, BooleanValue b' -> Some (create_booleanValue (b && b'))
 
988
    | Not bool, Not bool' -> Some (symbolic_not (symbolic_or bool bool'))
 
989
    | Not bool, _ when bool == node' -> Some false_value
 
990
    | _, Not bool' when node == bool' -> Some false_value
 
991
    | And nodes, And _ ->
 
992
        Some(List.fold_left (fun sum elt -> symbolic_and elt sum) node' nodes)
 
993
    | And nodes, _ ->
 
994
        apply_if_possible create_and symbolic_and_if_possible node' nodes
 
995
    | _, And nodes' ->
 
996
        apply_if_possible create_and symbolic_and_if_possible node nodes'
 
997
    | _ -> None
 
998
 
 
999
and symbolic_or_if_possible node node' =
 
1000
  if node == true_value || node' == true_value then Some true_value
 
1001
  else if node == false_value then Some node'
 
1002
  else if node' == false_value then Some node
 
1003
  else if node == node' then Some node else
 
1004
  match node.nature, node'.nature with
 
1005
    | BooleanValue b, BooleanValue b' -> Some (create_booleanValue (b || b'))
 
1006
    | Not bool, Not bool' -> Some (symbolic_not (symbolic_and bool bool'))
 
1007
    | Not bool, _ when bool == node' -> Some true_value
 
1008
    | _, Not bool' when node == bool' -> Some true_value
 
1009
    | Or nodes, Or _ ->
 
1010
        Some(List.fold_left (fun sum elt -> symbolic_or elt sum) node' nodes)
 
1011
    | Or nodes, _ ->
 
1012
        apply_if_possible create_or symbolic_or_if_possible node' nodes
 
1013
    | _, Or nodes' ->
 
1014
        apply_if_possible create_or symbolic_or_if_possible node nodes'
 
1015
    | _ -> None
 
1016
 
 
1017
 
 
1018
(* Symbolic n-ary function application *)
 
1019
 
 
1020
and apply_addition nodes =
 
1021
  List.fold_left (fun acc elt -> symbolic_add elt acc) addition_neutral nodes
 
1022
 
 
1023
and apply_and nodes =
 
1024
  List.fold_left (fun acc elt -> symbolic_and elt acc) and_neutral nodes
 
1025
 
 
1026
and apply_blackBox s nodes = symbolic_blackBox s nodes
 
1027
 
 
1028
and apply_max = function
 
1029
  | [] -> raise (Infinite_result "apply_max")
 
1030
  | node :: nodes ->
 
1031
      List.fold_left (fun acc elt -> symbolic_max elt acc) node nodes
 
1032
 
 
1033
and apply_min = function
 
1034
  | [] -> raise (Infinite_result "apply_min")
 
1035
  | node :: nodes ->
 
1036
      List.fold_left (fun acc elt -> symbolic_min elt acc) node nodes
 
1037
 
 
1038
and apply_multiplication nodes =
 
1039
  List.fold_left
 
1040
    (fun acc elt -> symbolic_mult elt acc)
 
1041
    multiplication_neutral
 
1042
    nodes
 
1043
 
 
1044
and apply_or nodes =
 
1045
  List.fold_left (fun acc elt -> symbolic_or elt acc) or_neutral nodes
 
1046
 
 
1047
 
 
1048
(* Input/output *)
 
1049
 
 
1050
and output out_channel node =
 
1051
  let mult_precedence = 50 in
 
1052
  let rec precedence node = match node.nature with
 
1053
    | Addition [] | And [] | BooleanValue _ | Constant _ | DiscreteVariable _ |
 
1054
      Multiplication [] | Or [] | Parameter _ | TimeVariable | Variable _ ->
 
1055
        1000
 
1056
    | ArcCosine _ | ArcHyperbolicCosine _ | ArcHyperbolicSine _ |
 
1057
      ArcHyperbolicTangent _ | ArcSine _ | ArcTangent _ | BlackBox _ |
 
1058
      Cosine _ | Derivative _ | Exponential _ | Floor _ | HyperbolicCosine _ |
 
1059
      HyperbolicSine _ | HyperbolicTangent _ | If _ | Logarithm _ | Not _ |
 
1060
      PartialDerivative _ | Sign _ | Sine _| Tangent _ -> 10000
 
1061
    | Addition _ -> 10
 
1062
    | And _ -> 5
 
1063
    | Equality _ -> 3
 
1064
    | Multiplication _ -> mult_precedence
 
1065
    | Number (Ratio _) -> mult_precedence
 
1066
    | Number num when lt_num num zero_num -> 75
 
1067
    | Number (Int _) | Number (Big_int _)  -> 1000
 
1068
    | Or _ -> 7
 
1069
    | RationalPower (_, num) when lt_num num zero_num -> mult_precedence
 
1070
    | RationalPower _ -> 100
 
1071
    | Greater _ -> 9
 
1072
  and output'' node = match node.nature with
 
1073
    | Addition [] -> output_char' '0'
 
1074
    | Addition nodes' ->
 
1075
      let not_negatives, negatives =
 
1076
        List.partition
 
1077
          (fun node -> match node.nature with
 
1078
            | Number num when lt_num num zero_num -> false
 
1079
            | Multiplication nodes ->
 
1080
                begin
 
1081
                  let not_reciprocals =
 
1082
                    List.filter
 
1083
                      (fun node -> match node.nature with
 
1084
                        | RationalPower (_, num) when lt_num num zero_num ->
 
1085
                            false
 
1086
                        | _ -> true)
 
1087
                      nodes
 
1088
                  in match not_reciprocals with
 
1089
                    | [] -> true
 
1090
                    | node' :: _ ->
 
1091
                        begin match node'.nature with
 
1092
                          | Number num when lt_num num zero_num -> false
 
1093
                          | _ -> true
 
1094
                        end
 
1095
                end
 
1096
            | _ -> true)
 
1097
          nodes'
 
1098
      in
 
1099
      begin match not_negatives with
 
1100
        | [] -> ()
 
1101
        | node' :: nodes' ->
 
1102
            output' (precedence node) node';
 
1103
            List.iter (fun elt -> output_string' " + ";
 
1104
            output' (precedence node) elt) nodes'
 
1105
      end;
 
1106
      begin match negatives with
 
1107
        | [] -> ()
 
1108
        | nodes' -> List.iter (output' (precedence node)) nodes'
 
1109
      end
 
1110
    | And [] -> output_string' "true"
 
1111
    | And (node' :: nodes') ->
 
1112
        output' (precedence node) node';
 
1113
        List.iter (fun elt -> output_string' " and ";
 
1114
        output' (precedence node) elt) nodes'
 
1115
    | ArcCosine node' -> output_string' "acos"; output' (precedence node) node'
 
1116
    | ArcHyperbolicCosine node' ->
 
1117
        output_string' "acosh"; output' (precedence node) node'
 
1118
    | ArcHyperbolicSine node' ->
 
1119
        output_string' "asinh"; output' (precedence node) node'
 
1120
    | ArcHyperbolicTangent node' ->
 
1121
        output_string' "atanh"; output' (precedence node) node'
 
1122
    | ArcSine node' -> output_string' "asin"; output' (precedence node) node'
 
1123
    | ArcTangent node' -> output_string' "atan"; output' (precedence node) node'
 
1124
    | BlackBox (name, node' :: nodes') ->
 
1125
      output_string' name; output_char' '('; output' 0 node';
 
1126
      List.iter (fun elt -> output_string' ", "; output' 0 elt) nodes';
 
1127
      output_char' ')'
 
1128
    | BlackBox _ -> invalid_arg "Invalid black box node"
 
1129
    | BooleanValue b -> output_string' (if b then "true" else "false")
 
1130
    | Constant s -> output_string' s
 
1131
    | Cosine node' -> output_string' "cos"; output' (precedence node) node'
 
1132
    | Derivative (node', num') ->
 
1133
        output_string' "der("; output' 0 node'; output_string' ", ";
 
1134
        output_string' (string_of_num num'); output_char' ')'
 
1135
    | Equality (node', node'') ->
 
1136
        output' (precedence node) node'; output_string' " = ";
 
1137
        output' (precedence node) node''
 
1138
    | Exponential node' -> output_string' "exp"; output' (precedence node) node'
 
1139
    | Floor node' -> output_string' "int"; output' (precedence node) node'
 
1140
    | HyperbolicCosine node' ->
 
1141
        output_string' "cosh"; output' (precedence node) node'
 
1142
    | HyperbolicSine node' ->
 
1143
        output_string' "sinh"; output' (precedence node) node'
 
1144
    | HyperbolicTangent node' ->
 
1145
        output_string' "tanh"; output' (precedence node) node'
 
1146
    | If (node', node'', node''') ->
 
1147
      output_string' "if("; output' 0 node';
 
1148
      output_string' ", "; output' 0 node'';
 
1149
      output_string' ", "; output' 0 node'''; output_char' ')'
 
1150
    | DiscreteVariable i -> output_string' "discrete"; output_int' i
 
1151
    | Logarithm node' -> output_string' "ln"; output' (precedence node) node'
 
1152
    | Multiplication [] -> output_char' '1'
 
1153
    | Multiplication nodes' ->
 
1154
      let not_reciprocals, reciprocals = List.fold_left
 
1155
        (fun (nodes, nodes') node -> match node.nature with
 
1156
          | Number (Ratio _ as num) ->
 
1157
            let ratio = ratio_of_num num in
 
1158
            let numerator = num_of_big_int (Ratio.numerator_ratio ratio)
 
1159
            and denominator = num_of_big_int (Ratio.denominator_ratio ratio) in
 
1160
            if eq_num numerator one_num then
 
1161
              nodes, (create_number denominator :: nodes')
 
1162
            else
 
1163
              (create_number numerator :: nodes),
 
1164
              (create_number denominator :: nodes')
 
1165
          | RationalPower (node'', num) when eq_num num (Int (-1)) ->
 
1166
              nodes, (node'' :: nodes')
 
1167
          | RationalPower (node'', num) when lt_num num zero_num ->
 
1168
              nodes, (create_rationalPower node'' (minus_num num) :: nodes')
 
1169
          | _ -> (node :: nodes), nodes')
 
1170
        ([], [])
 
1171
        nodes'
 
1172
      in
 
1173
      begin match List.rev not_reciprocals with
 
1174
        | [] -> output_char' '1'
 
1175
        | node' :: nodes' ->
 
1176
            begin match node'.nature with
 
1177
              | Number (Int -1) ->
 
1178
                output_char' '-';
 
1179
                begin match nodes' with
 
1180
                  | [] -> output_char' '1'
 
1181
                  | node' :: nodes' ->
 
1182
                      output' (precedence node) node';
 
1183
                      List.iter
 
1184
                        (fun elt ->
 
1185
                          output_string' " * "; output' (precedence node) elt)
 
1186
                        nodes'
 
1187
                end
 
1188
              | _ ->
 
1189
                output' (precedence node) node';
 
1190
                List.iter
 
1191
                  (fun elt ->
 
1192
                    output_string' " * "; output' (precedence node) elt)
 
1193
                  nodes'
 
1194
            end
 
1195
      end;
 
1196
      begin match reciprocals with
 
1197
        | [] -> ()
 
1198
        | [node'] -> output_string' " / "; output' (precedence node + 1) node'
 
1199
        | node' :: nodes' ->
 
1200
            output_string' " / (";
 
1201
            output' (precedence node) node';
 
1202
            List.iter
 
1203
              (fun elt -> output_string' " * "; output' (precedence node) elt)
 
1204
              nodes';
 
1205
            output_char' ')'
 
1206
      end
 
1207
    | Not node' -> output_string' "not"; output' (precedence node) node'
 
1208
    | Number num -> output_string' (string_of_num num)
 
1209
    | Or [] -> output_string' "false"
 
1210
    | Or (node' :: nodes') ->
 
1211
        output' (precedence node) node';
 
1212
        List.iter
 
1213
          (fun elt -> output_string' " or "; output' (precedence node) elt)
 
1214
          nodes'
 
1215
    | Parameter i ->
 
1216
        output_string' "parameter("; output_int' i; output_char' ')'
 
1217
    | PartialDerivative (node', node'') ->
 
1218
        output_string' "pder("; output' 0 node'';
 
1219
        output_string' ", "; output' 0 node'; output_char' ')'
 
1220
    | RationalPower (node', num) when ge_num num zero_num ->
 
1221
        output' (precedence node) node'; output_string' " ^ ";
 
1222
        begin match num with
 
1223
          | Int _ | Big_int _ -> output_string' (string_of_num num)
 
1224
          | Ratio _ ->
 
1225
              output_char' '('; output_string' (string_of_num num);
 
1226
              output_char' ')'
 
1227
        end
 
1228
    | RationalPower (node', num) when eq_num num (Int (-1)) ->
 
1229
        output_string' "1 / "; output' (mult_precedence + 1) node'
 
1230
    | RationalPower (node', num) ->
 
1231
        output_string' "1 / "; output' (precedence node) node';
 
1232
        output_string' " ^ ";
 
1233
        begin match num with
 
1234
          | Int _ | Big_int _ -> output_string' (string_of_num (minus_num num))
 
1235
          | Ratio _ ->
 
1236
              output_char' '('; output_string' (string_of_num (minus_num num));
 
1237
              output_char' ')'
 
1238
        end
 
1239
    | Sign node' -> output_string' "sgn"; output' (precedence node) node'
 
1240
    | Sine node' -> output_string' "sin"; output' (precedence node) node'
 
1241
    | Greater (node', node'') ->
 
1242
        output' (precedence node) node'; output_string' " > ";
 
1243
        output' (precedence node) node''
 
1244
    | Tangent node' -> output_string' "tan"; output' (precedence node) node'
 
1245
    | TimeVariable -> output_string' "time"
 
1246
    | Variable i -> output_string' "variable("; output_int' i; output_char' ')'
 
1247
  and output_char' c = output_char out_channel c
 
1248
  and output_int' i = output_string out_channel (string_of_int i)
 
1249
  and output_string' s = output_string out_channel s
 
1250
  and output' prec node =
 
1251
    if precedence node <= prec then begin
 
1252
      output_string' "(";  output'' node; output_string' ")"
 
1253
    end else output'' node
 
1254
  in output' 0 node
 
1255
 
 
1256
 
 
1257
(* Symbolic manipulation helpers *)
 
1258
 
 
1259
let rec exists p node =
 
1260
  p node || match node.nature with
 
1261
    | BooleanValue _  | Constant _ | DiscreteVariable _ | Number _ |
 
1262
      Parameter _ | TimeVariable | Variable _ -> false
 
1263
    | ArcCosine node | ArcHyperbolicCosine node |
 
1264
      ArcHyperbolicSine node | ArcHyperbolicTangent node | ArcSine node |
 
1265
      ArcTangent node | Cosine node | Derivative (node, _) |
 
1266
      Exponential node | Floor node | HyperbolicCosine node |
 
1267
      HyperbolicSine node | HyperbolicTangent node | Logarithm node |
 
1268
      Not node | RationalPower (node, _) | Sign node | Sine node |
 
1269
      Tangent node -> exists p node
 
1270
    | Equality (node1, node2) | Greater (node1, node2) |
 
1271
      PartialDerivative (node1, node2) -> exists p node1 || exists p node2
 
1272
    | If (node1, node2, node3) ->
 
1273
        exists p node1 || exists p node2 || exists p node3
 
1274
    | And nodes | Addition nodes | BlackBox (_, nodes) | Multiplication nodes |
 
1275
      Or nodes -> List.exists (exists p) nodes
 
1276
 
 
1277
let rec is_subnode_of node node' = exists (fun node -> node == node') node
 
1278
 
 
1279
let rec variables_of node = match node.nature with
 
1280
  | BooleanValue _  | Constant _ | DiscreteVariable _ | Number _ | Parameter _ |
 
1281
    TimeVariable -> []
 
1282
  | Variable _ -> [node]
 
1283
  | ArcCosine node | ArcHyperbolicCosine node |
 
1284
    ArcHyperbolicSine node | ArcHyperbolicTangent node | ArcSine node |
 
1285
    ArcTangent node | Cosine node | Derivative (node, _) |
 
1286
    Exponential node | Floor node | HyperbolicCosine node |
 
1287
    HyperbolicSine node | HyperbolicTangent node | Logarithm node |
 
1288
    Not node | RationalPower (node, _) | Sign node | Sine node |
 
1289
    Tangent node -> variables_of node
 
1290
  | Equality (node1, node2) | Greater (node1, node2) |
 
1291
    PartialDerivative (node1, node2) ->
 
1292
      union (variables_of node1) (variables_of node2)
 
1293
  | If (node1, node2, node3) ->
 
1294
      union
 
1295
        (variables_of node1)
 
1296
        (union (variables_of node2) (variables_of node3))
 
1297
  | And nodes | Addition nodes | BlackBox (_, nodes) | Multiplication nodes |
 
1298
    Or nodes ->
 
1299
      List.fold_left (fun acc node -> union (variables_of node) acc) [] nodes
 
1300
 
 
1301
let rec assignable_variables_of node = match node.nature with
 
1302
  | BooleanValue _  | Constant _ | DiscreteVariable _ | Number _ | Parameter _ |
 
1303
    TimeVariable -> []
 
1304
  | Variable _ -> [node]
 
1305
  | ArcCosine node | ArcHyperbolicCosine node |
 
1306
    ArcHyperbolicSine node | ArcHyperbolicTangent node | ArcSine node |
 
1307
    ArcTangent node | Cosine node | Derivative (node, _) |
 
1308
    Exponential node | Floor node | HyperbolicCosine node |
 
1309
    HyperbolicSine node | HyperbolicTangent node | Logarithm node |
 
1310
    RationalPower (node, _) | Sign node | Sine node | Tangent node ->
 
1311
      assignable_variables_of node
 
1312
  | Equality (node1, node2) | Greater (node1, node2) |
 
1313
    PartialDerivative (node1, node2) ->
 
1314
      union (assignable_variables_of node1) (assignable_variables_of node2)
 
1315
  | If (_, node1, node2) ->
 
1316
      union (* intersection is too pessimistic (since v.1.1.4. *)
 
1317
        (assignable_variables_of node1)
 
1318
        (assignable_variables_of node2)
 
1319
  | Addition nodes | BlackBox (_, nodes) | Multiplication nodes ->
 
1320
      List.fold_left
 
1321
        (fun acc node -> union (assignable_variables_of node) acc)
 
1322
        []
 
1323
        nodes
 
1324
  | And _ | Or _ | Not _ -> []
 
1325
 
 
1326
let rec derivatives_of node = match node.nature with
 
1327
  | BooleanValue _  | Constant _ | DiscreteVariable _ | Number _ | Parameter _ |
 
1328
    TimeVariable | Variable _ -> []
 
1329
  | ArcCosine node' | ArcHyperbolicCosine node' |
 
1330
    ArcHyperbolicSine node' | ArcHyperbolicTangent node' | ArcSine node' |
 
1331
    ArcTangent node' | Cosine node' | Exponential node' | Floor node' |
 
1332
    HyperbolicCosine node' | HyperbolicSine node' | HyperbolicTangent node' |
 
1333
    Logarithm node' | Not node' | RationalPower (node', _) | Sign node' |
 
1334
    Sine node' | Tangent node' -> derivatives_of node'
 
1335
  | Derivative _ -> [node]
 
1336
  | Equality (node1, node2) | Greater (node1, node2) | If (_, node1, node2) |
 
1337
    PartialDerivative (node1, node2) ->
 
1338
      union (derivatives_of node1) (derivatives_of node2)
 
1339
  | And nodes | Addition nodes | BlackBox (_, nodes) | Multiplication nodes |
 
1340
    Or nodes ->
 
1341
      List.fold_left (fun acc node -> union (derivatives_of node) acc) [] nodes
 
1342
 
 
1343
let rec invert_if_possible_with_respect_to node left right =
 
1344
  let not_null node = match node.nature with
 
1345
    | Constant _ -> true
 
1346
    | Number num -> num <>/ zero_num
 
1347
    | _ -> false
 
1348
  in
 
1349
  let invert_addition_if_possible nodes =
 
1350
    match List.partition (fun node' -> is_subnode_of node' node) nodes with
 
1351
      | [node'], nodes' -> Some (node', nodes')
 
1352
      | [], _ -> invalid_arg "invert_addition_if_possible"
 
1353
      | _ -> None
 
1354
  and invert_multiplication_if_possible nodes =
 
1355
    match List.partition (fun node' -> is_subnode_of node' node) nodes with
 
1356
      | [node'], nodes' when List.for_all not_null nodes' -> Some (node', nodes')
 
1357
      | [], _ -> invalid_arg "invert_multiplication_if_possible"
 
1358
      | _ -> None
 
1359
  in
 
1360
  if node == left then Some right
 
1361
  else match left.nature with
 
1362
    | BlackBox _ | Cosine _ | Derivative _ | Floor _ | HyperbolicCosine _ |
 
1363
      PartialDerivative _ | Sign _ | Sine _ | Tangent _ -> None
 
1364
    | Addition nodes ->
 
1365
        begin match invert_addition_if_possible nodes with
 
1366
          | None -> None
 
1367
          | Some (node', nodes') ->
 
1368
              invert_if_possible_with_respect_to
 
1369
                node
 
1370
                node'
 
1371
                (symbolic_sub right (create_addition (sort nodes')))
 
1372
        end
 
1373
    | ArcCosine node' ->
 
1374
        invert_if_possible_with_respect_to node node' (symbolic_cos right)
 
1375
    | ArcHyperbolicCosine node' ->
 
1376
        invert_if_possible_with_respect_to node node' (symbolic_cosh right)
 
1377
    | ArcHyperbolicSine node' ->
 
1378
        invert_if_possible_with_respect_to node node' (symbolic_sinh right)
 
1379
    | ArcHyperbolicTangent node' ->
 
1380
        invert_if_possible_with_respect_to node node' (symbolic_tanh right)
 
1381
    | ArcSine node' ->
 
1382
        invert_if_possible_with_respect_to node node' (symbolic_sin right)
 
1383
    | ArcTangent node' ->
 
1384
        invert_if_possible_with_respect_to node node' (symbolic_tan right)
 
1385
    | Exponential node' ->
 
1386
        invert_if_possible_with_respect_to node node' (symbolic_log right)
 
1387
    | HyperbolicSine node' ->
 
1388
        invert_if_possible_with_respect_to node node' (symbolic_asinh right)
 
1389
    | HyperbolicTangent node' ->
 
1390
        invert_if_possible_with_respect_to node node' (symbolic_atanh right)
 
1391
    | If (cond, node', node'') ->
 
1392
        begin try
 
1393
          let opt = invert_if_possible_with_respect_to node node' right in
 
1394
          try
 
1395
            let opt' = invert_if_possible_with_respect_to node node'' right in
 
1396
            match opt, opt' with
 
1397
              | None, _ | _, None -> None
 
1398
              | Some node, Some node' -> Some (create_if cond node node')
 
1399
          with
 
1400
            | Invalid_argument _ -> None
 
1401
        with
 
1402
          | Invalid_argument _ ->
 
1403
              begin
 
1404
                match invert_if_possible_with_respect_to node node'' right with
 
1405
                  | _ -> None
 
1406
              end
 
1407
        end
 
1408
    | Logarithm node' ->
 
1409
        invert_if_possible_with_respect_to node node' (symbolic_exp right)
 
1410
    | Multiplication nodes ->
 
1411
        begin match invert_multiplication_if_possible nodes with
 
1412
          | None -> None
 
1413
          | Some (node', nodes') ->
 
1414
              invert_if_possible_with_respect_to
 
1415
                node
 
1416
                node'
 
1417
                (symbolic_div right (create_multiplication (sort nodes')))
 
1418
        end
 
1419
    | RationalPower (node', num)
 
1420
      when is_integer_num num && eq_num (mod_num num two_num) zero_num -> None
 
1421
    | RationalPower (node', num)
 
1422
      when is_integer_num num ->
 
1423
        invert_if_possible_with_respect_to
 
1424
          node
 
1425
          node'
 
1426
          (symbolic_rationalPower right (minus_num num))
 
1427
    | RationalPower _ -> None
 
1428
    | And _ | Constant _ | BooleanValue _ | Equality _ | Greater _ |
 
1429
      DiscreteVariable _ | Not _ | Number _ | Or _ | Parameter _ |
 
1430
      TimeVariable | Variable _ ->
 
1431
        invalid_arg "invert_if_possible_with_respect_to"
 
1432
 
 
1433
let rec exists_except_in_conditions p node =
 
1434
  p node || match node.nature with
 
1435
    | BooleanValue _  | Constant _ | DiscreteVariable _ | Number _ |
 
1436
      Parameter _ | TimeVariable | Variable _ -> false
 
1437
    | ArcCosine node | ArcHyperbolicCosine node |
 
1438
      ArcHyperbolicSine node | ArcHyperbolicTangent node | ArcSine node |
 
1439
      ArcTangent node | Cosine node | Derivative (node, _) |
 
1440
      Exponential node | Floor node | HyperbolicCosine node |
 
1441
      HyperbolicSine node | HyperbolicTangent node | Logarithm node |
 
1442
      Not node | RationalPower (node, _) | Sign node | Sine node |
 
1443
      Tangent node -> exists_except_in_conditions p node
 
1444
    | Equality (node1, node2) | Greater (node1, node2) | If (_, node1, node2) |
 
1445
      PartialDerivative (node1, node2) ->
 
1446
        exists_except_in_conditions p node1 ||
 
1447
        exists_except_in_conditions p node2
 
1448
    | And nodes | Addition nodes | BlackBox (_, nodes) | Multiplication nodes |
 
1449
      Or nodes -> List.exists (exists_except_in_conditions p) nodes
 
1450
 
 
1451
let inversion_difficulty node left right =
 
1452
  let includes_derivative_of_node node' =
 
1453
    let is_derivative_of_node node' = match node'.nature with
 
1454
      | Derivative (node', _) when node' == node -> true
 
1455
      | _ -> false
 
1456
    in exists_except_in_conditions is_derivative_of_node node'
 
1457
  in
 
1458
  if includes_derivative_of_node left then 0
 
1459
  else
 
1460
    try match invert_if_possible_with_respect_to node left right with
 
1461
      | Some _ -> 1
 
1462
      | None -> 2
 
1463
    with
 
1464
      | Invalid_argument _ -> 3
 
1465
 
 
1466
let replace node node' node'' =
 
1467
  let rec rewrite node =
 
1468
    if node.count = !global_count then
 
1469
      node.replacement
 
1470
    else
 
1471
      let node' = replace' node in
 
1472
      node.count <- !global_count;
 
1473
      node.replacement <- node';
 
1474
      node'
 
1475
  and replace' node = match node.nature with
 
1476
    | Addition nodes -> apply_addition (List.rev_map rewrite nodes)
 
1477
    | And nodes -> apply_and (List.rev_map rewrite nodes)
 
1478
    | ArcCosine node -> symbolic_acos (rewrite node)
 
1479
    | ArcHyperbolicCosine node -> symbolic_acosh (rewrite node)
 
1480
    | ArcHyperbolicSine node -> symbolic_asinh (rewrite node)
 
1481
    | ArcHyperbolicTangent node -> symbolic_atanh (rewrite node)
 
1482
    | ArcSine node -> symbolic_asin (rewrite node)
 
1483
    | ArcTangent node -> symbolic_atan (rewrite node)
 
1484
    | BlackBox (s, nodes) -> apply_blackBox s (List.rev_map rewrite nodes)
 
1485
    | Cosine node -> symbolic_cos (rewrite node)
 
1486
    | Derivative (node, num) -> create_derivative (rewrite node) num
 
1487
    | Equality (node, node') -> symbolic_eq (rewrite node) (rewrite node')
 
1488
    | Exponential node -> symbolic_exp (rewrite node)
 
1489
    | Floor node -> symbolic_floor (rewrite node)
 
1490
    | Greater (node, node') -> symbolic_gt (rewrite node) (rewrite node')
 
1491
    | HyperbolicCosine node -> symbolic_cosh (rewrite node)
 
1492
    | HyperbolicSine node -> symbolic_sinh (rewrite node)
 
1493
    | HyperbolicTangent node -> symbolic_tanh (rewrite node)
 
1494
    | If (node, node', node'') ->
 
1495
        symbolic_if (rewrite node) (rewrite node') (rewrite node'')
 
1496
    | Logarithm node -> symbolic_log (rewrite node)
 
1497
    | Multiplication nodes -> apply_multiplication (List.rev_map rewrite nodes)
 
1498
    | Not node -> symbolic_not (rewrite node)
 
1499
    | Or nodes -> apply_or (List.rev_map rewrite nodes)
 
1500
    | PartialDerivative (node, node') ->
 
1501
        create_partialDerivative (rewrite node) (rewrite node')
 
1502
    | RationalPower (node, num) -> symbolic_rationalPower (rewrite node) num
 
1503
    | Sign node -> symbolic_sgn (rewrite node)
 
1504
    | Sine node -> symbolic_sin (rewrite node)
 
1505
    | Tangent node -> symbolic_tan (rewrite node)
 
1506
    | BooleanValue _ | Constant _ | DiscreteVariable _ | Number _ |
 
1507
      Parameter _ | TimeVariable | Variable _ -> node.replacement
 
1508
  in
 
1509
  incr global_count;
 
1510
  assert (!global_count <> 0);
 
1511
  node.count <- !global_count;
 
1512
  node.replacement <- node';
 
1513
  rewrite node''