aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/atom.hs45
-rw-r--r--src/expr.hs189
-rw-r--r--src/matrix.hs7
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) ++ " ]"
generated by cgit (git 2.34.1) at 2026-05-16 07:03:36 +0000