Utilisation du parser Pratt pour les expressions mathématiques

pull/1/head
Jean-Christophe Jameux 4 years ago
parent 24783e8d32
commit 943590c669
  1. 9
      elm.json
  2. 53
      src/Couleur.elm
  3. 138
      src/Fraction.elm
  4. 4
      src/GenerateurDeProblemes.elm
  5. 164
      src/ParserArbre.elm
  6. 51
      src/ParserMaths.elm
  7. 196
      src/ParserMathsPratt.elm
  8. 61
      src/Sujet.elm
  9. 75
      src/Test.elm

@ -7,6 +7,7 @@
"dependencies": {
"direct": {
"avh4/elm-color": "1.0.0",
"dmy/elm-pratt-parser": "2.0.0",
"elm/browser": "1.0.2",
"elm/core": "1.0.5",
"elm/file": "1.0.5",
@ -19,7 +20,8 @@
"jxxcarlson/meenylatex": "14.1.1",
"lynn/elm-arithmetic": "3.0.0",
"mdgriffith/elm-ui": "1.1.8",
"noahzgordon/elm-color-extra": "1.0.2"
"noahzgordon/elm-color-extra": "1.0.2",
"stil4m/elm-syntax": "7.2.8"
},
"indirect": {
"Garados007/elm-svg-parser": "1.0.0",
@ -37,10 +39,13 @@
"elm-community/result-extra": "2.4.0",
"erlandsona/assoc-set": "1.1.0",
"fredcy/elm-parseint": "2.0.1",
"miniBill/elm-unicode": "1.0.2",
"pablohirafuji/elm-syntax-highlight": "3.4.1",
"pilatch/flip": "1.0.0",
"pzp1997/assoc-list": "1.0.0",
"skyqrose/assoc-list-extra": "1.0.0"
"rtfeldman/elm-hex": "1.0.0",
"skyqrose/assoc-list-extra": "1.0.0",
"stil4m/structured-writer": "1.0.3"
}
},
"test-dependencies": {

@ -1,53 +0,0 @@
module Couleur exposing (Couleur)
type alias Couleur =
{ rouge : Float
, vert : Float
, bleu : Float
}
plusSombre : Float -> Couleur -> Couleur
plusSombre taux { red, green, blue, alpha } =
if red < green && red < blue then
let
nouveauRouge =
red * taux
nouveauPasRouge =
nouveauRouge - red
in
{ red = nouveauRouge
, green = green + nouveauPasRouge
, blue = blue + nouveauPasRouge
, alpha = alpha
}
else if green < blue then
let
nouveauVert =
green * taux
nouveauPasVert =
nouveauVert - green
in
{ red = red + nouveauPasVert
, green = nouveauVert
, blue = blue + nouveauPasVert
, alpha = alpha
}
else
let
nouveauBleu =
blue * taux
nouveauPasBleu =
nouveauBleu - blue
in
{ red = red + nouveauPasBleu
, green = green + nouveauPasBleu
, blue = blue + nouveauBleu
, alpha = alpha
}

@ -2,19 +2,19 @@ module Fraction exposing
( Erreur
, Fraction
, Resultat
, add
, den
, div
, asciiMath
, denominateur
, difference
, estEntier
, exp
, frac
, inv
, mul
, neg
, num
, opp
, raw
, sub
, fraction
, inverse
, map2
, numerateur
, oppose
, produit
, quotient
, somme
, teX
)
@ -22,7 +22,7 @@ import Arithmetic exposing (gcd)
type alias Fraction =
{ num : Int, den : Int }
{ numerateur : Int, denominateur : Int }
type alias Resultat =
@ -33,8 +33,8 @@ type alias Erreur =
String
frac : Int -> Int -> Resultat
frac a b =
fraction : Int -> Int -> Resultat
fraction a b =
let
min =
1 - 2 ^ 31
@ -58,38 +58,38 @@ simplifier : Fraction -> Fraction
simplifier a =
let
pgcd =
gcd a.num a.den
gcd a.numerateur a.denominateur
sgnDuDen =
if a.den < 0 then
if a.denominateur < 0 then
-1
else
1
in
{ a
| num = sgnDuDen * (a.num // pgcd)
, den = sgnDuDen * (a.den // pgcd)
| numerateur = sgnDuDen * (a.numerateur // pgcd)
, denominateur = sgnDuDen * (a.denominateur // pgcd)
}
num a =
a.num
numerateur a =
a.numerateur
den a =
a.den
denominateur a =
a.denominateur
estEntier a =
a.den == 1
a.denominateur == 1
opp : (Fraction -> Fraction -> Resultat) -> Resultat -> Resultat -> Resultat
opp operation resultat1 resultat2 =
map2 : (Fraction -> Fraction -> Resultat) -> Resultat -> Resultat -> Resultat
map2 operation resultat1 resultat2 =
case ( resultat1, resultat2 ) of
( Ok fraction1, Ok fraction2 ) ->
operation fraction1 fraction2
( Ok fractiontion1, Ok fractiontion2 ) ->
operation fractiontion1 fractiontion2
( Err erreur, _ ) ->
Err erreur
@ -98,109 +98,109 @@ opp operation resultat1 resultat2 =
Err erreur
add : Fraction -> Fraction -> Resultat
add a b =
somme : Fraction -> Fraction -> Resultat
somme a b =
let
pgcd =
gcd a.den b.den
gcd a.denominateur b.denominateur
aDenBis =
a.den // pgcd
a.denominateur // pgcd
bDenBis =
b.den // pgcd
b.denominateur // pgcd
in
frac (a.num * bDenBis + b.num * aDenBis) (a.den * bDenBis)
fraction (a.numerateur * bDenBis + b.numerateur * aDenBis) (a.denominateur * bDenBis)
neg : Fraction -> Fraction
neg a =
Fraction -a.num a.den
oppose : Fraction -> Fraction
oppose a =
Fraction -a.numerateur a.denominateur
sub : Fraction -> Fraction -> Resultat
sub a b =
add a (neg b)
difference : Fraction -> Fraction -> Resultat
difference a b =
somme a (oppose b)
mul : Fraction -> Fraction -> Resultat
mul a b =
produit : Fraction -> Fraction -> Resultat
produit a b =
let
pgcd =
gcd a.num b.den
gcd a.numerateur b.denominateur
pgcdBis =
gcd b.num a.den
gcd b.numerateur a.denominateur
aNum =
a.num // pgcd
a.numerateur // pgcd
aDen =
a.den // pgcdBis
a.denominateur // pgcdBis
bNum =
b.num // pgcdBis
b.numerateur // pgcdBis
bDen =
b.den // pgcd
b.denominateur // pgcd
in
frac (aNum * bNum) (aDen * bDen)
fraction (aNum * bNum) (aDen * bDen)
inv : Fraction -> Resultat
inv a =
case a.num of
inverse : Fraction -> Resultat
inverse a =
case a.numerateur of
0 ->
Err "Division par zéro"
_ ->
Ok <| Fraction a.den a.num
Ok <| Fraction a.denominateur a.numerateur
div : Fraction -> Fraction -> Resultat
div a b =
Result.andThen (mul a) <| inv b
quotient : Fraction -> Fraction -> Resultat
quotient a b =
Result.andThen (produit a) <| inverse b
exp : Fraction -> Fraction -> Resultat
exp a b =
let
sgnDeA =
if a.num < 0 then
if a.numerateur < 0 then
-1
else
1
sgnDeB =
if b.num < 0 then
if b.numerateur < 0 then
-1
else
1
in
if b.den == 1 && b.num < 0 then
frac ((sgnDeA * a.den) ^ (sgnDeB * b.num)) ((sgnDeA * a.num) ^ (sgnDeB * b.num))
if b.denominateur == 1 && b.numerateur < 0 then
fraction ((sgnDeA * a.denominateur) ^ (sgnDeB * b.numerateur)) ((sgnDeA * a.numerateur) ^ (sgnDeB * b.numerateur))
else if b.den == 1 then
frac (a.num ^ b.num) (a.den ^ b.num)
else if b.denominateur == 1 then
fraction (a.numerateur ^ b.numerateur) (a.denominateur ^ b.numerateur)
else
Err "Extraction de racine impossible"
Err "L'extraction de racine n'est pas disponible pour les nombres écrits sous forme fractiontionnaire."
teX a =
case a.den of
case a.denominateur of
1 ->
String.fromInt a.num
String.fromInt a.numerateur
_ ->
if a.num < 0 then
"-\\frac{" ++ String.fromInt -a.num ++ "}{" ++ String.fromInt a.den ++ "}"
if a.numerateur < 0 then
"-\\fraction{" ++ String.fromInt -a.numerateur ++ "}{" ++ String.fromInt a.denominateur ++ "}"
else
"\\frac{" ++ String.fromInt a.num ++ "}{" ++ String.fromInt a.den ++ "}"
"\\fraction{" ++ String.fromInt a.numerateur ++ "}{" ++ String.fromInt a.denominateur ++ "}"
raw a =
"(" ++ String.fromInt a.num ++ "/" ++ String.fromInt a.den ++ ")"
asciiMath a =
"(" ++ String.fromInt a.numerateur ++ "/" ++ String.fromInt a.denominateur ++ ")"

@ -12,7 +12,7 @@ import Fraction as F exposing (Fraction)
import Html exposing (Attribute, Html, button, div, iframe, input, p, section, textarea)
import List as L
import Parser as P exposing (..)
import ParserMaths as PM
import ParserMathsPratt as PM
import Random
import Random.Extra
import Random.List
@ -568,7 +568,7 @@ variableAremplacer =
aRemplacer : Parser Aremplacer
aRemplacer =
succeed (\x y -> Aremplacer x (L.map (F.raw << PM.evaluerBis) y))
succeed (\x y -> Aremplacer x (L.map (F.asciiMath << PM.evaluerBis) y))
|. espaces
|= variable
{ start = Char.isAlpha

@ -1,164 +0,0 @@
module ParserArbre exposing (..)
import Parser exposing (..)
import Browser
import Html exposing (Html, button, div, text)
import Html.Events exposing (onClick)
import Maybe exposing (Maybe)
import Result exposing (Result)
-- MAIN
main =
Browser.sandbox { init = init, update = update, view = view }
-- MODEL
type alias Model = Int
init : Model
init =
0
-- UPDATE
type Msg
= Increment
| Decrement
update : Msg -> Model -> Model
update msg model =
case msg of
Increment ->
model + 1
Decrement ->
model - 1
-- VIEW
view : Model -> Html Msg
view model =
div [] [ text texte ]
{-
Sans le withIndent -1, les arbres sous-indentés sautes
-}
texte = voirArbresParses <| run (withIndent -1 arbres)
"""
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
"""
unArbre =
Arbre
[ Arbre []
, Arbre
[ Arbre []
]
]
voirArbresParses arbresParsesPotentiels =
case arbresParsesPotentiels of
Err erreurs -> deadEndsToStringBis erreurs
Ok arbresParses -> voirArbres arbresParses
deadEndsToStringBis errs =
errs
|> List.map voirErreur
|> String.concat
|> (++) "Il y a des problèmes aux endroits suivants :\n"
voirErreur err =
"Ligne : " ++ String.fromInt err.row
++ " | Colonne : " ++ String.fromInt err.col
type Arbre = Arbre (List Arbre)
voirArbre arbr =
case arbr of
Arbre [] -> "[]"
Arbre arbrs -> "[" ++ String.concat (List.map voirArbre arbrs) ++ "]"
voirArbres =
List.map voirArbre >> String.concat
{-| Ce parser change l'indentation courante, cré un arbre puis
y intègre ses branches grâce à une boucle
-}
arbre : Parser Arbre
arbre =
let
suite =
Debug.log "? :" <|
flip withIndent
<| succeed Arbre
|. symbol "*"
|= arbres
in
getCol
|> andThen suite
|> Debug.log "Arbre : "
flip f a b = f b a
arbres =
let
sousArbres arbrs =
let
boucle =
succeed ( \arbr -> Loop (arbr :: arbrs) )
|= arbre -- lazy (\_ -> arbre) semble inutile malgrè l'appel récursif...
fin =
map (\_ -> Done (List.reverse arbrs))
suite col_ind =
oneOf
[ succeed ()
|. end
|> fin
, if Tuple.first col_ind > Tuple.second col_ind then -- if col > ind
boucle
else
succeed ()
|> fin
]
in
succeed Tuple.pair
|. spaces
|= getCol
|= getIndent
|> andThen suite
in
loop [] sousArbres
|> Debug.log "Début de la boucle arbres : "

@ -1,6 +1,6 @@
module ParserMaths exposing (evaluer, evaluerBis, expr, montrerErreurs, parseMaths)
import Fraction as F exposing (Fraction, Resultat, frac, opp)
import Fraction as F exposing (Fraction, Resultat, fraction, map2)
import Maybe as M
import Parser exposing (..)
import Set
@ -40,7 +40,7 @@ evaluerBis : Expr -> Fraction
evaluerBis expression =
case evaluer expression of
Err _ ->
{ num = 666, den = 1 }
{ numerateur = 666, denominateur = 1 }
Ok a ->
a
@ -50,58 +50,33 @@ evaluer : Expr -> Resultat
evaluer expression =
case expression of
Add a b ->
opp F.add (evaluer a) (evaluer b)
map2 F.somme (evaluer a) (evaluer b)
Sub a b ->
opp F.sub (evaluer a) (evaluer b)
map2 F.difference (evaluer a) (evaluer b)
Mul a b ->
opp F.mul (evaluer a) (evaluer b)
map2 F.produit (evaluer a) (evaluer b)
Div a b ->
opp F.div (evaluer a) (evaluer b)
map2 F.quotient (evaluer a) (evaluer b)
Exp a b ->
opp F.exp (evaluer a) (evaluer b)
map2 F.exp (evaluer a) (evaluer b)
Neg a ->
Result.map F.neg (evaluer a)
Result.map F.oppose (evaluer a)
Grouping l ->
evaluer l
Entier n ->
F.frac n 1
F.fraction n 1
Poly a_i x ->
Err "Les polynômes ne sont pas encore pris en charge."
{--
appliquerAuResultat f a b =
case (a,b) of
(Ok aa, Ok bb) -> Ok <| f aa bb
(Err aa, _) -> Err aa
--}
{--
type Expr
= Const Fraction
| Var String
| Poly (List Fraction) String
| Exp Expr
| Ln Expr
| Sin Expr
| Cos Expr
| Prod Expr Expr
| Div Expr Expr
| Sum Expr Expr
| Dif Expr Expr
| Exp Expr Frac
| Opp Expr
--}
type Expr
= Add Expr Expr
| Sub Expr Expr
@ -137,13 +112,9 @@ type Operand
| Operand Operator Expr
{-
En quelque sorte, décurryfie une expression binaire
binary e_1 (Operand MulOp e_2) == Mul e_1 e_2
{-| En quelque sorte, décurryfie une expression binaire
binary e\_1 (Operand MulOp e\_2) == Mul e\_1 e\_2
-}
binary : Expr -> Operand -> Expr
binary a b =
case b of

@ -0,0 +1,196 @@
module ParserMathsPratt exposing
( Expr(..)
, evaluer
, evaluerBis
, expr
, montrerErreurs
, parseMaths
, resultatFractionnaire
)
import Fraction
import Maybe as M
import Parser exposing (..)
import Pratt exposing (constant, infixLeft, infixRight, literal, postfix, prefix)
import Set
type Expr
= Entier Int
| Decimal Float
| Oppose Expr
| Somme Expr Expr
| Difference Expr Expr
| Produit Expr Expr
| Quotient Expr Expr
| Reste Expr Expr
| Exp Expr Expr
| Cos Expr
| Sin Expr
| Tan Expr
| ArcCos Expr
| ArcSin Expr
| ArcTan Expr
| Log Expr
| Ln Expr
| Factorielle Expr
| Degre Expr
| Poly (List Expr) String
| E
| Pi
parseMaths : String -> Result (List DeadEnd) Expr
parseMaths source =
run expr source
montrerErreurs : String -> List DeadEnd -> String
montrerErreurs source errs =
case List.head errs of
Nothing ->
""
Just firstErr ->
source
++ "\n"
++ String.repeat (firstErr.col - 1) " "
++ "^"
++ "\nL'algorithme attendait :"
++ String.join
" ou "
(List.map montrerAttendu errs)
montrerAttendu : DeadEnd -> String
montrerAttendu err =
case err.problem of
ExpectingNumber ->
"un nombre entier"
ExpectingSymbol s ->
"un \"" ++ s ++ "\""
_ ->
"une expression"
evaluerBis : Expr -> Fraction.Fraction
evaluerBis expression =
case resultatFractionnaire expression of
Err _ ->
{ numerateur = 666, denominateur = 1 }
Ok a ->
a
evaluer =
resultatFractionnaire
resultatFractionnaire : Expr -> Fraction.Resultat
resultatFractionnaire expression =
let
f opperation a b =
Fraction.map2 opperation (resultatFractionnaire a) (resultatFractionnaire b)
in
case expression of
Somme a b ->
f Fraction.somme a b
Difference a b ->
f Fraction.difference a b
Produit a b ->
f Fraction.produit a b
Quotient a b ->
f Fraction.quotient a b
Exp a b ->
f Fraction.exp a b
Oppose a ->
Result.map Fraction.oppose (resultatFractionnaire a)
Entier n ->
Fraction.fraction n 1
Poly a_i x ->
Err "Les polynômes ne sont pas encore pris en charge."
_ ->
Err "BOOM"
expr : Parser Expr
expr =
succeed identity
|= mathExpression
mathExpression : Parser Expr
mathExpression =
Pratt.expression
{ oneOf =
[ constant (keyword "E") E
, constant (keyword "Pi") Pi
, literal (map Entier int)
, prefix 3 (symbol "-") Oppose
, expressionEntreParentheses
, prefix 3 (symbol "+") identity
, prefix 5 (keyword "Cos") Cos
, prefix 5 (keyword "Sin") Sin
, prefix 5 (keyword "Tan") Tan
, prefix 5 (keyword "ArcCos") ArcCos
, prefix 5 (keyword "ArcSin") ArcSin
, prefix 5 (keyword "ArcTan") ArcTan
, prefix 5 (keyword "Log") Log
, prefix 5 (keyword "Ln") Ln
]
, andThenOneOf =
[ infixLeft 1 (symbol "+") Somme
, infixLeft 1 (symbol "-") Difference
, infixLeft 2 (symbol "*") Produit
, infixLeft 2 (symbol "%") Reste
, infixLeft 2 (symbol "/") Quotient
, infixRight 4 (symbol "^") Exp
, postfix 6 (symbol "!") Factorielle
, postfix 6 (symbol "°") Degre
]
, spaces = espaces
}
espaces =
Parser.chompWhile <| (==) ' '
expressionEntreParentheses : Pratt.Config Expr -> Parser Expr
expressionEntreParentheses config =
succeed identity
|. symbol "("
|= Pratt.subExpression 0 config
|. symbol ")"
poly : Parser Expr
poly =
succeed Poly
|. keyword "Poly"
|. spaces
|= sequence
{ start = "["
, separator = ","
, end = "]"
, spaces = spaces
, item = lazy (\_ -> mathExpression)
, trailing = Forbidden
}
|. spaces
|= variable
{ start = \_ -> True
, inner = \_ -> False
, reserved = Set.fromList []
}

@ -0,0 +1,61 @@
module Sujet exposing (..)
type Bloc typeDeBloc etat exportabilite
= Bloc
{ entete : Macro
, contenu : List Bloc
, commentaire : Macro
}
-- Les différents types de blocs
type Simple
= Simple
type Qcm
= Qcm
type VraiFaux
= VraixFaux
type Aremplacer
= Aremplacer
type Tag
= Tag
-- Les blocs peuvent être complets ou incomplets
type Complet
= Complet
type Incomplet
= Incomplet
-- Les blocs peuvent être exportable (en QuizScan ou EvalBox) ou non
type NonExportable
= NonExportable
type ExportableEnQuizscanSeulement
= ExportableEnQuizscanSeulement
type Exportable
= Exportable

@ -4,7 +4,10 @@ import Browser
import Debug exposing (todo)
import Element exposing (..)
import Element.Input as Input
import Elm.Parser
import Html exposing (Html)
import Parser exposing ((|.), (|=), Parser, end, float, keyword, run, succeed, symbol)
import Pratt exposing (infixLeft, infixRight, literal, prefix)
import Svg exposing (circle, g, path, svg)
import Svg.Attributes as SvgA exposing (color, cx, cy, r, strokeWidth, viewBox, x, y)
@ -22,11 +25,11 @@ main =
type alias Model =
{ texte : String }
String
init =
{ texte = "" }
"2+5^(4/3),4"
@ -39,15 +42,79 @@ type Msg
update : Msg -> Model -> Model
update (NouveauTexte texte) model =
{ texte = texte }
texte
-- VIEW
view : Model -> Html Msg
view model =
layout [] <|
text <|
case run parser model of
Ok valeur ->
String.fromFloat valeur
Err _ ->
"BOOM"
mathExpression : Parser Float
mathExpression =
Pratt.expression
{ oneOf =
[ literal float
, prefix 3 (symbol "-") negate
, parenthesizedExpression
]
, andThenOneOf =
[ infixLeft 1 (symbol "+") (+)
, infixLeft 1 (symbol "-") (-)
, infixLeft 2 (symbol "*") (*)
, infixLeft 2 (symbol "/") (/)
, infixRight 4 (symbol "^") (^)
]
, spaces = Parser.spaces
}
parenthesizedExpression : Pratt.Config Float -> Parser Float
parenthesizedExpression config =
succeed identity
|. symbol "("
|= Pratt.subExpression 0 config
|. symbol ")"
parser : Parser Float
parser =
succeed List.sum
|= Parser.sequence
{ start = ""
, separator = ","
, end = ""
, spaces = espaces
, item = mathExpression
, trailing = Parser.Forbidden
}
|. end
espaces =
Parser.chompWhile <| (==) ' '
{--
run parser "-1*3--5+4/2^2" --> Ok ((-1*3)-(-5)+(4/(2^2)))
run parser "-1*3--5+4/2^2" --> Ok 3
run parser "((-1*3) - (-5) + (4 / (2^2)))" --> Ok 3
--}
viewOld : Model -> Html Msg
viewOld model =
layout [ width fill, height fill ] <|
column [ padding 100, centerX, centerY ]
[ html <|

Loading…
Cancel
Save