Ugly and not working function value reduction, main evaluation refactoringHEADmaster

1 files changed, 67 insertions, 54 deletions

diff --git a/src/Expr.hs b/src/Expr.hs
index 93828d9..e2cd256 100644
--- a/src/Expr.hs
+++ b/src/Expr.hs
@@ -4,25 +4,6 @@ import           Control.Monad
 import           Data.List
 import qualified Data.Map      as M
 
--- data Operand
---     = Rational Float
---     | Complex Float Float
---     | Matrix [[Operand]]
---
---
--- data (Operable a, Operable b) => Operator a b
---     = Add a b
---     | Sub a b
---     | Mul a b
---     | Div a b
---     | Mod a b
---     | Exp a b
---     | Dot a b
---
--- data Label
---     = Variable String
---     | Function String Expr
-
 data Expr
     = Rational Float  -- values
     | Complex Float Float
@@ -61,47 +42,48 @@ isLitteral (Rational _)  = True
 isLitteral (Complex _ _) = True
 isLitteral _             = False
 
+isIgnored :: Expr -> Bool
+isIgnored (Variable _) = True
+-- isIgnored (Function _ _) = True
+isIgnored (Add _ _) = True
+isIgnored (Sub _ _) = True
+isIgnored (Mul _ _) = True
+isIgnored (Div _ _) = True
+isIgnored (Mod _ _) = True
+isIgnored (Exp _ _) = True
+isIgnored (Dot _ _) = True
+isIgnored _ = False
+
 -------------------------------------------------------------------------------
 -- Operators
 -------------------------------------------------------------------------------
 
 add :: Expr -> Expr -> Maybe Expr
-
 add (Rational a)    (Rational b)    = Just $ Rational (a + b)
 add (Rational a)    (Complex br bi) = Just $ Complex (br + a) bi
-
 add (Complex ar ai) (Complex br bi) = Just $ Complex (ar + br) (ai + bi)
 add (Complex ar ai) (Rational b)    = Just $ Complex (ar + b) ai
-
-add _ _                             = Nothing
-
+add a b                   = ignoreCheck a b Add
 
 sub :: Expr -> Expr -> Maybe Expr
 sub a b = add a =<< Rational (-1) `mul` b
 
-
 mul :: Expr -> Expr -> Maybe Expr
 mul (Rational a) (Rational b)     = Just $ Rational (a * b)
 mul (Rational a) (Complex br bi)  = Just $ Complex (a * br) (a * bi)
-
-
-mul _ _                           = Nothing
-
+mul a b                   = ignoreCheck a b Mul
 
 div :: Expr -> Expr -> Maybe Expr
 div _ (Rational 0)  = Nothing
 div _ (Complex 0 0) = Nothing
 div a b             = mul a =<< b `Expr.exp` Rational (-1)
 
-
 mod :: Expr -> Expr -> Maybe Expr
-mod _ _ = Nothing
-
+mod a b                   = ignoreCheck a b Mod
 
 exp :: Expr -> Expr -> Maybe Expr
 exp (Rational a)  (Rational b) = Just $ Rational (a ** b)
-exp _ _ = Nothing
-
+exp a b                   = ignoreCheck a b Exp
 
 dot :: Expr -> Expr -> Maybe Expr
 dot (Matrix a) (Matrix b)
@@ -113,7 +95,13 @@ dot (Matrix a) (Matrix b)
           dotProd :: [Expr] -> [Expr] -> Maybe Expr
           dotProd r c = foldM add (Rational 0) =<< zipWithM mul r c
 
-dot _ _                   = Nothing
+dot a b                   = ignoreCheck a b Dot
+
+
+ignoreCheck :: Expr -> Expr -> (Expr -> Expr -> Expr) -> Maybe Expr
+ignoreCheck a b constructor
+    | isIgnored a || isIgnored b = Just $ constructor a b
+    | otherwise = Nothing
 
 
 -------------------------------------------------------------------------------
@@ -125,32 +113,57 @@ data Context = Context { variables :: LabelMap Expr
                        , functions :: LabelMap (String, Expr)
                        }
 
-eval :: Expr -> Context -> Maybe Expr
-
-eval (Add e1 e2) c = evalInfix e1 e2 add c
-eval (Sub e1 e2) c = evalInfix e1 e2 sub c
-eval (Mul e1 e2) c = evalInfix e1 e2 mul c
-eval (Div e1 e2) c = evalInfix e1 e2 Expr.div c
-eval (Mod e1 e2) c = evalInfix e1 e2 Expr.mod c
-eval (Exp e1 e2) c = evalInfix e1 e2 Expr.exp c
-eval (Dot e1 e2) c = evalInfix e1 e2 dot c
+evalIgnored :: Expr -> Context -> String -> Maybe Expr
 
-eval (Variable name) c = name `M.lookup` (variables c) >>= (\e -> eval e c)
+evalIgnored (Variable name) c i
+    | name == i = Just $ Variable name
+    | otherwise = name `M.lookup` (variables c) >>= (\e -> evalIgnored e c i)
 
-eval (Function name e) (Context vars funcs) =
-    do arg <- eval e (Context vars funcs)
+evalIgnored (Function name e) (Context vars funcs) i =
+    do arg <- evalIgnored e (Context vars funcs) i
        (argName, functionExpr) <- name `M.lookup` funcs
        let localVars = M.insert argName arg vars
-       eval functionExpr (Context localVars funcs)
+       evalIgnored functionExpr (Context localVars funcs) i
+
+evalIgnored (Matrix m) c i = Matrix <$> mapM (mapM (\e -> evalIgnored e c i)) m
 
-eval (Matrix m) c = Matrix <$> mapM (mapM (\e -> eval e c)) m
+evalIgnored (Add e1 e2) c i = evalIgnoredInfix e1 e2 Add add c i
+evalIgnored (Sub e1 e2) c i = evalIgnoredInfix e1 e2 Sub sub c i
+evalIgnored (Mul e1 e2) c i = evalIgnoredInfix e1 e2 Mul mul c i
+evalIgnored (Div e1 e2) c i = evalIgnoredInfix e1 e2 Div Expr.div c i
+evalIgnored (Mod e1 e2) c i = evalIgnoredInfix e1 e2 Mod Expr.mod c i
+evalIgnored (Exp e1 e2) c i = evalIgnoredInfix e1 e2 Exp Expr.exp c i
+evalIgnored (Dot e1 e2) c i = evalIgnoredInfix e1 e2 Dot dot c i
 
-eval x _
+evalIgnored x _ _
     | isLitteral x = Just x
     | otherwise    = Nothing
 
 
-evalInfix :: Expr -> Expr -> (Expr -> Expr -> Maybe Expr) -> Context -> Maybe Expr
-evalInfix e1 e2 f c = do a <- eval e1 c
-                         b <- eval e2 c
-                         f a b
+evalIgnoredInfix :: Expr -> Expr ->
+        (Expr -> Expr -> Expr) ->
+        (Expr -> Expr -> Maybe Expr) ->
+        Context -> String -> Maybe Expr
+evalIgnoredInfix e1 e2 cons f c i
+
+    | isVariable e1 && varName e1 == i && isVariable e2 && varName e2 == i = Just $ cons e1 e2
+
+    | isVariable e1 && varName e1 == i = evalIgnored e2 c i >>= (\x -> Just $ cons e1 x)
+
+    | isVariable e2 && varName e2 == i = evalIgnored e1 c i >>= (\x -> Just $ cons x e2)
+
+    | otherwise = do a <- evalIgnored e1 c i
+                     b <- evalIgnored e2 c i
+                     f a b
+    where varName (Variable name) = name
+          varName _ = ""
+          isVariable (Variable _) = True
+          isVariable _ = False
+
+
+-- bubbleVariable :: String -> Expr -> Expr -- with tree rotation
+-- bubbleVariable i (Add l r)
+
+
+eval :: Expr -> Context -> Maybe Expr
+eval e c = evalIgnored e c ""