Simplification d'expression arithmétique en OCAML

Le problème exposé dans ce sujet a été résolu.

Bonjour,

Codant actuellement un programme en caml permettant de faire du calcul formel, je bloque au niveau de la simplification des expressions.

Tout d’abord, j’ai créer un parser et un lexer afin de transformé les saisies utilisateurs en tokens. Voici le code du 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 PLUS MINUS
%left TIMES DIV
%left COS SIN SQRT EXP LN
%type <Function.formel> main
%start main
%%

main:
    expr EOL                    { $1 }
;

expr:
    |   FLOAT                   { flt $1 }
    |   VAR                     { puis (var $1) (flt 1.) }
    |   FLOAT VAR               { var $2 }
    |   LPAR expr RPAR          { $2 }
    |   expr PLUS expr          { add $1 $3 }
    |   PLUS expr               { pos $2 }
    |   MINUS expr              { neg $2 }
    |   expr MINUS expr         { sub $1 $3 }
    |   expr TIMES expr         { mul $1 $3 }
    |   expr DIV expr           { div $1 $3 }
    |   COS expr                { cos $2 }
    |   FLOAT COS expr          { mul (flt $1) (cos $3) }
    |   SIN expr                { sin $2 }
    |   FLOAT SIN expr          { mul (flt $1) (sin $3) }
    |   SQRT expr               { sqrt $2 }
    |   LN expr                 { lnp $2 }
    |   EXP expr                { exp $2 }
;

Et celui du 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 }
  | "cos"               { COS }
  | "sin"               { SIN }
  | "sqrt"              { SQRT }
  | "ln"                { LN }
  | "exp"               { EXP }
  | ['a'-'z']+ as lxm   { VAR (lxm) }
  | eof                 { raise Eof }

Les fonctions saisies par l’utilisateurs sont stockées sous forme d’arbre, dans le type formel, dont voici la définition :

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

Par exemple, la fonction : f(x) = x*x*x sera stockés sous la forme : Mul (Puis (Var "x", Float 1.), Mul (Puis (Var "x", Float 1.), Puis (Var "x", Float 1.)))

Mon objectif, et là où je bloque, serais de transformer cette fonction de manière à ce qu’elle soit représentée de la manière suivante : Puis (Var "x", Float 3.)

let rec simplify f =
    let rec is_zero f =
        match f with
            | Float f when f = 0. -> true
            | Float f -> false
            | Var x -> false
            | Add (f, g) -> is_zero f && is_zero g
            | Sub (f, g) -> is_zero f && is_zero g
            | Mul (f, g) -> is_zero f || is_zero g
            | Div (f, g) -> is_zero f
            | _ -> false
    in
    let rec simplify_zero f =
        match f with
            | Float f -> Float f
            | Var x -> Var x
            | Add (f, g) -> begin
                                if is_zero f && is_zero g
                                then Float 0.
                                else if is_zero f && is_zero g == false
                                then simplify_zero g
                                else if is_zero f == false && is_zero g
                                then simplify_zero f
                                else Add (simplify_zero f, simplify_zero g)
                            end
            | Sub (f, g) -> begin
                                if is_zero f && is_zero g
                                then Float 0.
                                else if is_zero f && is_zero g == false
                                then simplify_zero g
                                else if is_zero f == false && is_zero g
                                then simplify_zero f
                                else Sub (simplify_zero f, simplify_zero g)
                            end
            | Mul (f, g) -> begin
                                if is_zero f || is_zero g
                                then Float 0.
                                else Mul (simplify_zero f, simplify_zero g)
                            end
            | Div (f, g) -> begin
                                if is_zero f
                                then Float 0.
                                else Div (simplify_zero f, simplify_zero g)
                            end
            | Puis (f, g) -> begin
                                if is_zero f
                                then Float 0.
                                else if is_zero g
                                then Float 1.
                                else Puis (simplify_zero f, simplify_zero g)
                            end
            | Cos f -> Cos (simplify_zero f)
            | Sin f -> Sin (simplify_zero f)
    in
    let rec exist_var f =
        match f with
            | Float f -> false
            | Var x -> true
            | Mul (f, g) -> exist_var f || exist_var g
            | Add (f, g) -> exist_var f || exist_var g
    in
    let rec simplify_op f =
        match f with
            | Float f -> Float f
            | Var x -> Var x
            | Mul (f, g) -> simplify_mul (Mul (simplify_op f, simplify_op g))
            | Add (f, g) -> simplify_add (Add (simplify_op f, simplify_op g))
            | Sub (f, g) -> simplify_sub (Sub (simplify_op f, simplify_op g))
            | Puis (f, g) -> simplify_puis (Puis (simplify_op f, simplify_op g))
            | Cos f -> Cos (simplify_op f)
            | Sin f -> Sin (simplify_op f)
    and
    simplify_add f =
        match f with
            | Add (Float f, Float g) -> Float (f +. g)
            | Add (Var x, Var y) -> Mul (Float 2., Var x)
            | Add (f, g) -> Add (simplify_op f, simplify_op g)
    and
    simplify_sub f =
        match f with
            | Sub (Float f, Float g) -> Float (f -. g)
            | Sub (Var x, Var y) -> Float 0.
            | Sub (f, g) -> Sub (simplify_op f, simplify_op g)
    and
    simplify_mul f =
        match f with
            | Mul (Float f, Float g) -> Float (f *. g)
            | Mul (f, g) -> Mul (simplify_op f, simplify_op g)
    and
    simplify_puis f =
        match f with
            | Puis (Float f, g) -> Puis (Float f, simplify_op g)
            | Puis (f, g) -> Puis (simplify_op f, simplify_op g)
    in
simplify_zero (simplify_op f)

La fonction simplify permet de 1) faire les opération +, - et *, et 2) permet de supprimer les 0 en trop (comme 0+3 ou 0*x). Les pattern matching de cette fonction ne sont pas encore exhaustif. J’aimerais améliorer cette fonction afin qu’elle puisse puisse factoriser les puissance ensemble, comme j’ai indiqué dans l’exemple au dessus.

Cela fait 2 jours que je bloque sur ce problème. J’ai fait plusieurs tests en vain, mais je tourne toujours entre appel récursif infini et résultat non voulu.

Bonne journée !

Comme parseur tu devrais utiliser Menhir plutôt que Yacc, ça ressemble beaucoup (tu peux garder tes habitudes) mais ça permet d’écrire des grammaires plus flexibles et plus lisibles.

Pour la simplification, je pense que tu fais trop compliqué. Regarde les équations au sujet de l’addition par exemple:

0+x=x=x+00 + x \quad = \quad x \quad = \quad x + 0

Ces deux égalités permettent de prouver que x+(0+0)x + (0 + 0) ou bien encore 0+(x+0)0 + (x + 0) sont égales à xx, en particulier on n’a jamais eu besoin d’un résultat sur 0+00 + 0 pour cela.

Pour transformer cela en un programme, il faut "orienter" ces équations en une règle de récriture, quelque chose de directif qui dit "si je vois A, je le transforme en B" (l’équation de base va dans les deux sens, mais si tu passes ton temps à transformer dans un sens puis dans l’autre tu n’avances pas). L’idée naturelle c’est d’essayer de transformer le "gros terme" (par exemple 0+x0 + x) en le "petit terme" (xx), mais parfois il faut faire plus malin (par exemple pour (a+b)c=ac+bc(a + b) * c = a*c + b*c).

Donc tu te retrouves avec les règles de récriture suivantes:

0+xxx+0x0+x \longrightarrow x \qquad x+0 \longrightarrow x

Si tu réfléchis, tu peux voir que si tu appliques ces règles à l’infini (y compris en profondeur, sur des sous-termes), tu vas forcément finir par arriver à un terme qu’on ne peut plus simplifier, qui est donc "maximalement simplifié". (En particulier, il n’est pas possible de continuer à simplifier à l’infini, sans jamais s’arrêter, et avec à chaque fois des termes différents.)

Maintenant, la question c’est comment transformer ces règles de récriture en code. Dans le cas général, tu peux faire quelque chose comme cela:

let rec simplify e =
  let e' = simp e in
  if e' = e then e' else simplify e
and simp e = function
  | Add (Float 0., x) -> simp x
  | Add (x, Float 0.) -> simp x
  | Add (a, b) -> Add (simp a, simp b)

donc simp fait une ou plusieurs simplifications, et simplify est une boucle qui dit: tant que le résultat de simp a changé, on a réussi à simplifier plus, on regarde si de nouvelles simplifications se sont débloquées.

+2 -0

Bonjour !

Merci beaucoup pour ton aide ! Je me renseignerais a propos de Menhir, merci du conseil !

Voici la fonction que j’ai créer sur ton modèle, qui fonctionne dans les cas que j’ai testé.

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
            | Add (Float 0., f) -> simp f
            | Add (f, Float 0.) -> simp f
            | Add (Float f1, Float f2) -> Float (f1 +. f2)
            | Add (f, Mul (Float f1, g)) when f = g -> simp (Mul (Float (f1 +. 1.), f))
            | Add (f, Mul (g, Float f1)) when f = g -> simp (Mul (Float (f1 +. 1.), f))
            | Add (Mul (Float f1, f), g) when f = g -> simp (Mul (Float (f1 +. 1.), f))
            | Add (Mul (f, Float f1), g) when f = g -> simp (Mul (Float (f1 +. 1.), f))
            | Add (f, g) when f = g -> simp (Mul (Float 2., f))
            | Add (f, g) -> Add (simp f, simp g)
            | Sub (Float 0., f) -> simp (Mul (Float (-1.), f))
            | Sub (f, Float 0.) -> simp f
            | Sub (Float f1, Float f2) -> Float (f1 -. f2)
            | Sub (f, g) when f = g -> Float 0.
            | Sub (f, g) -> Sub (simp f, simp g)
            | Div (Float 0., f) -> Float 0.
            | Div (f, Float 1.) -> simp f
            | Div (Float f1, Float f2) -> Float (f1 /. f2)
            | Div (f, g) when f = g -> Float 1.
            | Div (f, g) -> Div (simp f, simp g)
            | Mul (Float 1., f) -> simp f
            | Mul (f, Float 1.) -> simp f
            | Mul (Float 0., f) -> Float 0.
            | Mul (f, Float 0.) -> Float 0.
            | Mul (Float f1, Float f2) -> Float (f1 *. f2)
            | Mul (Puis (f, g), h) when f = h -> Puis (simp f, simp (Add (g, Float 1.)))
            | Mul (f, g) when f = g -> simp (Puis (simp f, Float 2.))
            | Mul (f, g) -> Mul (simp f, simp g)
            | Puis (f, Float 0.) -> Float 1.
            | Puis (Float 0., f) -> Float 0.
            | 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)

Mais j’y vois encore deux inconvénients :

1) Lorsque j’effectue une égalité du type

when f = g

Cette égalité renvoie vrai ssi les deux fonction f et g ont exactement la même structure. Mais je pense que cela renverra faux si f = Var "x" et g = Mul (Float 1., Var "x"), alors que x=1×xx = 1 \times x

J’ai penser a écrire :

when simp f = simp g

Mais cela fera surement des appel récursifs infini … je me trompe ?

2) Je dois encore rajouter la transformation : f×gf×g-f \times -g \rightarrow f \times g que encore j’ai du mal a formalisée

De plus, tu m’a parler de coder la transformation : (a+b)×ca×c+b×c(a+b) \times c \rightarrow a \times c + b \times c Mais je ne vois pas ce que cela apporterais de plus pour faire la simplification que j’aimerais effectuer … Peut etre que j’ai mal compris quelque chose ?

+0 -0

Sur le point (1), as-tu testé (1 * x) * x pour vérifier que ça se simplifiait bien en x^2 ? Pourquoi, alors que comme tu le dis when (1 * x) = x renvoie false?

Sur le point (2), je ne sais pas quelles simplifications tu veux effectuer, donc je ne peux pas dire si celle-ci est utile. Elle est utilisée souvent pour simplifier les opérations sur les polynômes. C’était un exemple pour dire que les règles de récriture ne sont pas toujours orientées en fonction de la taille des termes, et que dans ces cas il est plus difficile de s’assurer qu’on ne boucle pas à l’infini.

Bonjour,

Oui j’ai bien tester (1×x)×x(1 \times x ) \times x qui se simplifie en x2x^2 !

J’ai évoquer le problème du when car

when (Var "x" = Mul (Float 1., Var "x"))

renvoie false.

Je me demandais si cela posait soucis dans un cas comme : 1+1×x1 + 1 \times x, ou comme celui que tu as proposé. Mais dans les deux cas, le bon résultat est affiché … Je dois chercher un problème là où il n’y en a pas !

Merci beaucoup de ton aide en tout cas !

Connectez-vous pour pouvoir poster un message.
Connexion

Pas encore membre ?

Créez un compte en une minute pour profiter pleinement de toutes les fonctionnalités de Zeste de Savoir. Ici, tout est gratuit et sans publicité.
Créer un compte