Draft expr compatibility

1 files changed, 177 insertions, 29 deletions

diff --git a/src/expr.hs b/src/expr.hs
index ccc0e36..c69948e 100644
--- a/src/expr.hs
+++ b/src/expr.hs
@@ -1,41 +1,189 @@
 module Expr where
 
-import Imag
-import Matrix
+import Data.List
 
--- data X = Expr | Imag | Matrix
+type Label = String
 
--- class ExprElement where
---     subExpr :: ExprElement a => a -> a
---     composed :: ExprElement a -> a -> (a, a)
+class Expression where
+    eval :: Expression a => a -> Maybe a
+    eval (Context _ e) = Just e
+    interpret :: Context a -> a
+    reduce :: Expression a => a -> a
+    reduce e = e
 
-data AExpr  = AExpr Term AExpr   | AExprSingle Term
-data Term   = Term Factor Term   | TermSingle Factor
-data Factor = Factor Base Factor | FactorSingle Base
-data Base   = Base AExpr         | BaseSingle Expr
+-- class ExpressionNum where
+--     evalNum :: ExpressionNum a, Num a => Context a -> Maybe a
+--     evalNum (Context c n) = eval n
 
-data Expr   = ExprF Float | ExprI Imag | ExprM (Matrix AExpr)
 
-instance Show AExpr where
-    show (AExprSingle t) = show t
-    show (AExpr t e) = show t ++ " + " ++ show e
+-- leaf type
+newtype Rational  = Float deriving (Expression)
+newtype Imaginary = Float deriving (Expression)
+newtype Matrix a  = [MatrixRow a]
+type MatrixRow a  = [a]
+type Var          = Label
 
-instance Show Term where
-    show (TermSingle f) = show f
-    show (Term f t) = show f ++ " * " ++ show t
+-- recursive types
+data Func a = Func
+    { name     :: Label
+    , argument :: a
+    }
 
-instance Show Factor where
-    show (FactorSingle b) = show b
-    show (Factor b f) = show b ++ " ^ " ++ show f
+class MaybeNum where
+    (+) :: a -> b -> Maybe c
+    _ + _  = Nothing
 
-instance Show Base where
-    show (BaseSingle x) = show x
-    show (Base e) = "(" ++ show e ++ ")"
+    (-) :: a -> b -> Maybe c
+    _ - _  = Nothing
 
-instance Show Expr where
-    show (ExprF f) = show f
-    show (ExprI i) = show i
-    show (ExprM m) = show m
+    (*) :: a -> b -> Maybe c
+    _ * _  = Nothing
+
+    (/) :: a -> b -> Maybe c
+    _ / _  = Nothing
+
+    (%) :: a -> b -> Maybe c
+    _ % _  = Nothing
+
+    (^) :: a -> b -> Maybe c
+    _ ^ _  = Nothing
+
+    (**) :: a -> b -> Maybe c
+    _ ** _  = Nothing
+
+
+instance MaybeNum Rational where
+    (Rational a) + (Rational b) = Just (a + b)
+    (Rational a) + (Imaginary b) = Just (Complex a b)
+
+    (Rational a) - (Rational b) = Just (a - b)
+    (Rational a) - (Imaginary b) = Just (Complex a (-b))
+
+    (Rational a) * (Rational b) = Just (a * b)
+    (Rational a) * (Imaginary b)     = Just (Imag (a * b))
+    (Rational a) * (Matrix b)   = Just (fmap (a*) b)
+
+    _ / (Rational 0) = Nothing
+    (Rational a) / (Rational b) = Just (a * b)
+    -- x / yi possible?
+
+    -- (Rational a) % (Rational b)  = Nothing
+
+    (Rational a) ^ (Rational b) = Just (a ^ b)
+
+instance MaybeNum Imaginary where
+    (Imaginary a) + (Imaginary b) = Just $ Imaginary (a + b)
+    (Imaginary a) + (Rational b) = Just (Complex b a)
+
+    (Imaginary a) - (Imaginary b) = Just $ Imaginary (a - b)
+    (Imaginary a) - (Rational b) = Just $ Complex (-b) a
+
+    (Imaginary a) * (Imaginary b) = Just $ Imaginary (a * b)
+
+    (Imaginary a) ^ (Rational 0) = Just $ Rational a
+    (Imaginary a) ^ (Rational 1) = Just $ Imaginary a
+    (Imaginary a) ^ (Rational 2) = Just $ Rational (-a)
+    (Imaginary a) ^ (Rational 3) = Just $ Imaginary (-a)
+    (Imaginary a) ^ (Rational b) = Just $ a ^ (b - 4)
+
+instance MaybeNum Matrix where
+    (Matrix a) + (Matrix b) = if shape a == shape b then Just $ (+) <$> a <*> b
+                                                    else Nothing
+    (Matrix a) - (Matrix b) = if shape a == shape b then Just $ (-) <$> a <*> b
+                                                    else Nothing
+    (Matrix a) * (Rational b) = Just $ fmap (*b) a
+    (Matrix a) / (Rational b) = Just $ fmap (/b) a
+
+    (Matrix a) ^ (Rational 1) = Just a
+    (Matrix a) ^ (Rational b) = if isSquare a then a ** (a ^ (b - 1))
+                                              else Nothing
+
+    (Matrix a) ** (Matrix b) = undefined
+
+
+data (Evaluable a, MaybeNum b) => Ast a b = Operation a (Ast a b) (Ast a b) | Operand b
+
+instance Functor Ast where
+    fmap f (Operation op l r) = Operation op (fmap f l) (fmap f r)
+    fmap f (Operand x) = Operand (f x)
+
+--
+-- data BinExpr a a = BinExpr a a | BinEmpty
+-- data Sum    = Sum    Term   Sum    | SumSingle    Term
+-- data Term   = Term   Factor Term   | TermSingle   Factor
+-- data Factor = Factor Base   Factor | FactorSingle Base
+-- data Base   = Base   Expr          | BaseSingle   Expr
+
+-- data X a = X a X | XSingle a
+
+
+
+-- data Sum a = Sum a a
+
+-- instance Expression a, Num a => Expression (Sum a) where
+--     eval (Context c (Sum x y)) = (+) <$> eval (Context c x) <*> eval (Context c y)
+--
+-- data Multiplication a = Multiplication a a
+-- instance Expression a, Num a => Expression (Multiplication a) where
+--     eval (Context c (Multiplication x y)) = (*) <$> eval (Context c x) <*> eval (Context c y)
+
+Bin b => b a  (a -> a -> a) -> a
+x f = f <$> eval fst x <*> eval snd x
+
+-- dot :: Matrix a -> Matrix a -> a
+
+-- evalNum :: Num a => (a -> a -> a) -> b a -> b a -> Maybe a
+-- evalNum f x y = f <$> eval x <*> eval y
+
+
+-- data FuncExpr = FuncExpr
+--     { getName :: String
+--     , getParam :: Expr
+--     }
+
+-- data Expr
+--     = ExprR Real
+--     | ExprI Imag
+--     | ExprM (Matrix Expr)
+--     | ExprV Var
+--     | ExprF FuncEval
+
+
+data FuncDecl = FuncDecl
+    { getName :: String
+    , getArg :: String
+    , getContent :: Expr
+    }
+
+instance Show a => Show (Matrix a) where
+    show (Matrix m) = intercalate "\n" (map showLine m)
+        where showLine l = "[ " ++ intercalate " , " (map show l) ++ " ]"
+
+instance Show Imag where
+    show (Imag i) = show i ++ "i"
+
+-- instance Show AExpr where
+--     show (AExprSingle t) = show t
+--     show (AExpr t e) = show t ++ " + " ++ show e
+--
+-- instance Show Term where
+--     show (TermSingle f) = show f
+--     show (Term f t) = show f ++ " * " ++ show t
+--
+-- instance Show Factor where
+--     show (FactorSingle b) = show b
+--     show (Factor b f) = show b ++ " ^ " ++ show f
+--
+-- instance Show Base where
+--     show (BaseSingle x) = show x
+--     show (Base e) = "(" ++ show e ++ ")"
+--
+-- instance Show FuncExpr where
+--     show (FuncExpr name arg) = (init $ tail (show name)) ++ "(" ++ (show arg) ++ ")"
+--
+-- instance Show Expr where
+--     show (ExprR r) = show r
+--     show (ExprI i) = show i
+--     show (ExprM m) = show m
+--     show (ExprV v) = init $ tail (show v)
 
--- eval :: Expr -> Float
--- eval