atom module with rational and imaginary types and operations

3 files changed, 45 insertions, 196 deletions

diff --git a/src/atom.hs b/src/atom.hs
new file mode 100644
index 0000000..d01b157
--- /dev/null
+++ b/src/atom.hs
@@ -0,0 +1,45 @@
+module Atom where
+
+
+data Atom
+    = ARational Float
+    | AImaginary Float
+
+infixl 6 +?
+(+?) :: Atom -> Atom -> Maybe Atom
+(ARational a) +? (ARational b) = Just $ ARational (a + b)
+(AImaginary a) +? (AImaginary b) = Just $ AImaginary (a + b)
+_ +? _ = Nothing
+
+infixl 6 -?
+(-?) :: Atom -> Atom -> Maybe Atom
+(ARational a) -? (ARational b) = Just $ ARational (a - b)
+(AImaginary a) -? (AImaginary b) = Just $ AImaginary (a - b)
+_ -? _ = Nothing
+
+infixl 7 *?
+(*?) :: Atom -> Atom -> Maybe Atom
+(ARational a) *? (ARational b) = Just $ ARational (a * b)
+(ARational a) *? (AImaginary b) = Just $ AImaginary (a * b)
+(AImaginary a) *? (AImaginary b) = (AImaginary (a * b)) ^? ARational 2
+_ *? _ = Nothing
+
+infixl 7 /?
+(/?) :: Atom -> Atom -> Maybe Atom
+_ /? (ARational 0) = Nothing
+(ARational a) /? (ARational b) = Just $ ARational (a / b)
+_ /? _ = Nothing
+
+infixr 8 ^?
+(^?) :: Atom -> Atom -> Maybe Atom
+(ARational a) ^? (ARational b) = Just $ ARational (a ** b)
+(AImaginary a) ^? (ARational 0) = Just $ ARational a
+(AImaginary a) ^? (ARational 1) = Just $ AImaginary a
+(AImaginary a) ^? (ARational 2) = Just $ ARational (-a)
+(AImaginary a) ^? (ARational 3) = Just $ AImaginary (-a)
+(AImaginary a) ^? (ARational b) = AImaginary a ^? (ARational (b - 4))
+_ ^? _ = Nothing
+
+instance Show Atom where
+    show (ARational r) = show r
+    show (AImaginary i) = show i ++ "i"
diff --git a/src/expr.hs b/src/expr.hs
deleted file mode 100644
index c69948e..0000000
--- a/src/expr.hs
+++ /dev/null
@@ -1,189 +0,0 @@
-module Expr where
-
-import Data.List
-
-type Label = String
-
-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
-
--- class ExpressionNum where
---     evalNum :: ExpressionNum a, Num a => Context a -> Maybe a
---     evalNum (Context c n) = eval n
-
-
--- leaf type
-newtype Rational  = Float deriving (Expression)
-newtype Imaginary = Float deriving (Expression)
-newtype Matrix a  = [MatrixRow a]
-type MatrixRow a  = [a]
-type Var          = Label
-
--- recursive types
-data Func a = Func
-    { name     :: Label
-    , argument :: a
-    }
-
-class MaybeNum where
-    (+) :: 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
-
-    (^) :: 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)
-
diff --git a/src/matrix.hs b/src/matrix.hs
index 38780bb..7de634b 100644
--- a/src/matrix.hs
+++ b/src/matrix.hs
@@ -1,10 +1,3 @@
 module Matrix where
 
--- import Data.List
 
--- newtype Matrix a = Matrix { getMatrix :: [MatrixRow a] }
--- type MatrixRow a = [a]
-
--- instance Show a => Show (Matrix a) where
---     show (Matrix m) = intercalate "\n" (map showLine m)
---         where showLine l = "[ " ++ intercalate " , " (map show l) ++ " ]"