Simplify equations for a computer algebric system in ocaml - ocaml

Question

IHello! I'm currently trying to code in ocaml a programm to draw a function which was write by the user.
To do that, I'm parsing the input, I'm tranforming the input into a data structure.
I'm currently trying to create an ocaml function to simplify at maximum this input.
For example, x*x - x*x will simplify in 0
Here is my parser :
%{
open Function
%}
%token <float> FLOAT
%token <string> VAR
%token COS SIN SQRT EXP LN PUIS
%token PLUS MINUS TIMES DIV
%token LPAR RPAR
%token EOL
%left LPAR RPAR
%left COS SIN SQRT EXP LN
%left PLUS MINUS
%left TIMES DIV
%left PUIS
%type <Function.formel> main
%start main
%%
main:
expr EOL { $1 }
;
expr:
| FLOAT { flt $1 }
| VAR { var $1 }
| FLOAT VAR { mul (flt $1) (var $2) }
| LPAR expr RPAR { $2 }
| expr TIMES expr { mul $1 $3 }
| expr DIV expr { div $1 $3 }
| expr PLUS expr { add $1 $3 }
| expr MINUS expr { sub $1 $3 }
| expr PUIS expr { puis $1 $3 }
| COS LPAR expr RPAR { cos $3 }
| PLUS expr { pos $2 }
| MINUS expr { neg $2 }
| FLOAT COS LPAR expr RPAR { mul (flt $1) (cos $4) }
| SIN LPAR expr RPAR { sin $3 }
| FLOAT SIN LPAR expr RPAR { mul (flt $1) (sin $4) }
| SQRT LPAR expr RPAR { sqrt $3 }
| LN LPAR expr RPAR { lnp $3 }
| EXP LPAR expr RPAR { expo $3 }
;
Here is my lexer :
{
open Parser
exception Eof
}
rule token = parse
| [' ' '\t'] { token lexbuf }
| ['\n'] { EOL }
| ['0'-'9']+ as lxm { FLOAT (float_of_string lxm) }
| '+' { PLUS }
| '-' { MINUS }
| '*' { TIMES }
| '/' { DIV }
| '(' { LPAR }
| ')' { RPAR }
| '^' { PUIS }
| "cos" { COS }
| "sin" { SIN }
| "sqrt" { SQRT }
| "ln" { LN }
| "exp" { EXP }
| ['a'-'z']+ as lxm { VAR (lxm) }
| eof { raise Eof }
I think my parser and my lexer are good.
Then, I'm using a tree to store the function :
type formel =
| Float of float
| Var of string
| Add of formel * formel
| Sub of formel * formel
| Mul of formel * formel
| Div of formel * formel
| Ln of formel
| Cos of formel
| Sin of formel
| Puis of formel * formel
| Sqrt of formel
| Exp of formel
let flt f = Float f
let add e1 e2 = Add (e1, e2)
let sub e1 e2 = Sub (e1, e2)
let mul e1 e2 = Mul (e1, e2)
let div e1 e2 = Div (e1, e2)
let puis e1 e2 = Puis (e1, e2)
let neg e = Mul (Float (-1.), e)
let pos e = Mul (Float 1., e)
let cos e = Cos e
let sin e = Sin e
let var v = Var v
let sqrt e = Sqrt e
let expo e = Exp e
let lnp e = Ln e
And here is the difficulty where I am : the creation of a function to simplify.
let rec simplify f =
let f_simplify = simp f in
if f_simplify = f
then f_simplify
else simplify f_simplify
and simp f =
match f with
| Float f -> Float f
| Var x -> Var x
(* 0 + x -> x *)
| Add (Float 0., f) -> simp f
(* x + 0 -> x *)
| Add (f, Float 0.) -> simp f
(* f1 + f2-> calcul (f1 + f2) *)
| Add (Float f1, Float f2) -> Float (f1 +. f2)
(* x + x -> 2 * x *)
| Add (f, g) when f = g -> simp (Mul (Float 2., simp f))
(* f1 * x + x -> (f1 + 1) * x *)
| Add (Mul (Float f1, f), g) when f = g -> simp (Mul (Float (f1 +. 1.), simp f))
(* x + f1 * x -> (f1 + 1) * x *)
| Add (f, Mul (Float f1, g)) when f = g -> simp (Mul (Float (f1 +. 1.), simp f))
(* x * f1 + x -> (f1 + 1) * x *)
| Add (Mul (f, Float f1), g) when f = g -> simp (Mul (Float (f1 +. 1.), simp f))
(* x + x * f1 -> (f1 + 1) * x *)
| Add (f, Mul (g, Float f1)) when f = g -> simp (Mul (Float (f1 +. 1.), simp f))
(* f1 * x + f2 * x -> (f1 + f2) * x *)
| Add (Mul (Float f1, f), Mul (Float f2, g)) when f = g -> simp (Mul (Float (f1 +. f2), simp f))
(* x * f1 + f2 * x -> (f1 + f2) * x *)
| Add (Mul (f, Float f1), Mul (Float f2, g)) when f = g -> simp (Mul (Float (f1 +. f2), simp f))
(* f1 * x + x * f2 -> (f1 + f2) * x *)
| Add (Mul (Float f1, f), Mul (g, Float f2)) when f = g -> simp (Mul (Float (f1 +. f2), simp f))
(* x * f1 + x * f2 -> (f1 + f2) * x *)
| Add (Mul (f, Float f1), Mul (g, Float f2)) when f = g -> simp (Mul (Float (f1 +. f2), simp f))
| Add (f, g) -> Add (simp f, simp g)
(* 0 - x -> - x *)
| Sub (Float 0., f) -> simp (Mul (Float (-1.), simp f))
(* x - 0 -> x *)
| Sub (f, Float 0.) -> simp f
(* f1 - f2 -> calcul (f1 - f2) *)
| Sub (Float f1, Float f2) -> Float (f1 -. f2)
(* f1 * x + x -> (f1 + 1) * x *)
| Sub (f, g) when f = g -> Float 0.
| Sub (f, g) -> Sub (simp f, simp g)
(* 0 / x -> 0 *)
| Div (Float 0., f) -> Float 0.
(* x / 1 -> x *)
| Div (f, Float 1.) -> simp f
(* f1 / f2 -> calcul (f1 / f2) *)
| Div (Float f1, Float f2) -> Float (f1 /. f2)
(* x / x -> 1 *)
| Div (f, g) when f = g -> Float 1.
| Div (f, g) -> Div (simp f, simp g)
(* 1 * x -> x *)
| Mul (Float 1., f) -> simp f
(* x * 1 -> x *)
| Mul (f, Float 1.) -> simp f
(* 0 * x -> 0 *)
| Mul (Float 0., f) -> Float 0.
(* x * 0 -> 0 *)
| Mul (f, Float 0.) -> Float 0.
(* f1 * f2 -> calcul (f1 * f2) *)
| Mul (Float f1, Float f2) -> Float (f1 *. f2)
(* x * x -> x ^ 2 *)
| Mul (f, g) when f = g -> simp (Puis (simp f, Float 2.))
(* x ^ a * x -> x ^ (a + 1) *)
| Mul (Puis (f, g), h) when f = h -> Puis (simp f, simp (Add (simp g, Float 1.)))
(* (f1 * x) * f2 -> (f1 * f2) * x *)
| Mul (Mul (Float f1, f), Float f2) -> simp (Mul (Float (f1 *. f2), simp f))
(* f1 * (f2 * x) -> (f1 * f2) * x *)
| Mul (Float f1, Mul (Float f2, f)) -> simp (Mul (Float (f1 *. f2), simp f))
(* (x * f1) * f2 -> (f1 * f2) * x *)
| Mul (Mul (f, Float f1), Float f2) -> simp (Mul (Float (f1 *. f2), simp f))
(* f1 * (x * f2) -> (f1 * f2) * x *)
| Mul (Float f1, Mul (f, Float f2)) -> simp (Mul (Float (f1 *. f2), simp f))
| Mul (f, g) -> Mul (simp f, simp g)
(* x ^ 0 -> 1 *)
| Puis (f, Float 0.) -> Float 1.
(* 0 ^ x -> 0 *)
| Puis (Float 0., f) -> Float 0.
(* x ^ 1 -> x *)
| Puis (f, Float 1.) -> simp f
| Puis (f, g) -> Puis (simp f, simp g)
| Ln f -> Ln (simp f)
| Cos f -> Cos (simp f)
| Sin f -> Sin (simp f)
| Sqrt f -> Sqrt (simp f)
| Exp f -> Exp (simp f)
Here is my problem :
For simple function as x*x + x*x, this function works.
But if I enter the function : 2 + x*x - x*x, there is no simplification done. The result is : 2 + x^2 - x^2
I have no idea how I can fix this problem, I'm on it since 3 days.
I hope everything is clear, and someone can give me some tips !
Have a great day !

Answer 1

The problem is in two folds:
If you draw out the tree, you will see that subtree is not equal.
You do it in the top-down manner. Normally, a simplification should be done bottom up( from higher to lower precedence e.g. 2+x*x+x*x ==> 2+x^2+x^2 ==> 2+2x^2 )
Your equation is of this tree:
- : formel =
Sub (Add (Float 2., Mul (Var "x", Var "x")), Mul (Var "x", Var "x"))
Let's follows the execution sequences:
it matches Sub (f, g) -> Sub (simp f, simp g)
with
f = Add (Float 2., Mul (Var "x", Var "x"))
g = Mul (Var "x", Var "x")
from (1) it executes simp f, hence matches Add (f, g) -> Add (simp f, simp g)
2.1. it matches Float(2.) with Float f -> Float f
2.2. it matches Mul(Var("x"),Var("x")) with Mul (f, g) when f = g -> simp (Puis (simp f, Float 2.))
it continues on simp g, hence matches Mul (f, g) when f = g -> simp (Puis (simp f, Float 2.))
That's why you got the result of:
Sub (Add (Float 2., Puis (Var "x", Float 2.)), Puis (Var "x", Float 2.))
(2 + x^2 - x^2)
because the left(2 + x^2) and right(x^2) subtrees aren't equal.
To solve problem (1)
One idea is to add commutative property of addition rules and transform it to a list of same precedences. For example,
Sub(f,Add(g,h)) -> [Plus(f),Minus(g),Minus(h)]
with this you can identify the same subtrees and eliminate them.
To solve problem (2)
You need to simplify based on the precedence of operators, e.g. x*x becomes x^2 before x+x is simplified to 2x. This can be done by altering to code to run parsing multiple times. Each time that subtree has changed, rerun the simplification on the upper tree.
Another idea is to archive it through Unification & substitution technique. I haven't thought it through. But it quite convincing that's doable.