aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile2
-rw-r--r--manifest (renamed from src/manifest)0
-rw-r--r--src/Assignment.hs (renamed from src/assignment.hs)0
-rw-r--r--src/Expr.hs98
-rw-r--r--src/Polynomial.hs87
-rw-r--r--src/Statement.hs (renamed from src/statement.hs)0
-rw-r--r--src/atom.hs49
-rw-r--r--src/expr.hs43
-rw-r--r--src/main.hs25
-rw-r--r--src/parser/Assignment.hs (renamed from src/parser/assignment.hs)0
-rw-r--r--src/parser/Core.hs (renamed from src/parser/core.hs)5
-rw-r--r--src/parser/Expr.hs (renamed from src/parser/expr.hs)29
-rw-r--r--src/parser/Statement.hs (renamed from src/parser/statement.hs)0
-rw-r--r--src/polynomial.hs95
14 files changed, 227 insertions, 206 deletions
diff --git a/Makefile b/Makefile
index f4fba56..9e004de 100644
--- a/Makefile
+++ b/Makefile
@@ -21,7 +21,7 @@ SRC = $(shell find $(SRC_DIR) -type f -name "*.hs")
all: $(NAME)
$(NAME): $(SRC)
- $(CC) --make -outputdir $(BUILD_DIR) -o $(NAME) $(SRC)
+ $(CC) -dynamic --make -outputdir $(BUILD_DIR) -o $(NAME) $(SRC)
clean:
$(RM) $(BUILD_DIR)/*.o $(BUILD_DIR)/*.hi
diff --git a/src/manifest b/manifest
index 7216fa7..7216fa7 100644
--- a/src/manifest
+++ b/manifest
diff --git a/src/assignment.hs b/src/Assignment.hs
index c086280..c086280 100644
--- a/src/assignment.hs
+++ b/src/Assignment.hs
diff --git a/src/Expr.hs b/src/Expr.hs
new file mode 100644
index 0000000..e3d8aef
--- /dev/null
+++ b/src/Expr.hs
@@ -0,0 +1,98 @@
+module Expr where
+
+import Data.List
+
+
+data Atom
+ = Rational Float
+ | Imaginary Float
+ | Matrix [[Expr]]
+
+data Expr
+ = EAtom Atom
+ | Add Expr Expr
+ | Sub Expr Expr
+ | Mul Expr Expr
+ | Div Expr Expr
+ | Mod Expr Expr
+ | Exp Expr Expr
+ | Dot Expr Expr
+ | Variable String
+ | Function String Expr
+
+eval :: Expr -> Maybe Atom
+eval (EAtom a) = Just a
+eval (Add e1 e2) = evalInfix e1 e2 (+?)
+eval (Sub e1 e2) = evalInfix e1 e2 (-?)
+eval (Mul e1 e2) = evalInfix e1 e2 (*?)
+eval (Div e1 e2) = evalInfix e1 e2 (/?)
+eval (Mod e1 e2) = evalInfix e1 e2 (%?)
+eval (Exp e1 e2) = evalInfix e1 e2 (^?)
+eval (Dot e1 e2) = evalInfix e1 e2 (**?)
+eval _ = Nothing
+
+evalInfix :: Expr -> Expr -> (Atom -> Atom -> Maybe Atom) -> Maybe Atom
+evalInfix e1 e2 f = do a <- eval e1
+ b <- eval e2
+ f a b
+
+infixl 6 +?
+(+?) :: Atom -> Atom -> Maybe Atom
+(Rational a) +? (Rational b) = Just $ Rational (a + b)
+(Imaginary a) +? (Imaginary b) = Just $ Imaginary (a + b)
+_ +? _ = Nothing
+
+infixl 6 -?
+(-?) :: Atom -> Atom -> Maybe Atom
+(Rational a) -? (Rational b) = Just $ Rational (a - b)
+(Imaginary a) -? (Imaginary b) = Just $ Imaginary (a - b)
+_ -? _ = Nothing
+
+infixl 7 *?
+(*?) :: Atom -> Atom -> Maybe Atom
+(Rational a) *? (Rational b) = Just $ Rational (a * b)
+(Rational a) *? (Imaginary b) = Just $ Imaginary (a * b)
+(Imaginary a) *? (Imaginary b) = (Imaginary (a * b)) ^? Rational 2
+_ *? _ = Nothing
+
+infixl 7 /?
+(/?) :: Atom -> Atom -> Maybe Atom
+_ /? (Rational 0) = Nothing
+(Rational a) /? (Rational b) = Just $ Rational (a / b)
+_ /? _ = Nothing
+
+infixl 7 %?
+(%?) :: Atom -> Atom -> Maybe Atom
+_ %? _ = Nothing
+
+infixr 8 ^?
+(^?) :: Atom -> Atom -> Maybe Atom
+(Rational a) ^? (Rational b) = Just $ Rational (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) = Imaginary a ^? (Rational (b - 4))
+_ ^? _ = Nothing
+
+infixr 8 **?
+(**?) :: Atom -> Atom -> Maybe Atom
+_ **? _ = Nothing
+
+instance Show Expr where
+ show (EAtom a) = show a
+ show (Add e1 e2) = show e1 ++ " + " ++ show e2
+ show (Sub e1 e2) = show e1 ++ " - " ++ show e2
+ show (Mul e1 e2) = show e1 ++ " * " ++ show e2
+ show (Div e1 e2) = show e1 ++ " / " ++ show e2
+ show (Mod e1 e2) = show e1 ++ " % " ++ show e2
+ show (Exp e1 e2) = show e1 ++ " ^ " ++ show e2
+ show (Dot e1 e2) = show e1 ++ " ** " ++ show e2
+ show (Variable name) = name
+ show (Function name e) = name ++ "(" ++ show e ++ ")"
+
+instance Show Atom where
+ show (Rational r) = show r
+ show (Imaginary i) = show i ++ "i"
+ show (Matrix m) = intercalate "\n" (map showRow m)
+ where showRow r = "[ " ++ intercalate ", " (map show r) ++ " ]"
diff --git a/src/Polynomial.hs b/src/Polynomial.hs
new file mode 100644
index 0000000..cd0da4f
--- /dev/null
+++ b/src/Polynomial.hs
@@ -0,0 +1,87 @@
+module Polynomial where
+
+-- import Data.List
+--
+--
+-- data Equation = Equation { left :: Polynomial, right :: Polynomial }
+-- type Polynomial = [Term]
+-- data Term = Term { coefficient :: Float, exponent :: Int }
+--
+-- instance Eq Term where
+-- (Term _ e1) == (Term _ e2) = e1 == e2
+--
+-- instance Ord Term where
+-- compare (Term _ e1) (Term _ e2) = compare e1 e2
+--
+-- instance Show Term where
+-- show (Term 0 e) = ""
+-- show (Term c 0) = show (round c)
+-- show (Term c e) = show (round c) ++ " * X^" ++ show e
+--
+-- instance Show Equation where
+-- show (Equation l r) = showPolynomial (filterNull l)
+-- ++ " = "
+-- ++ showPolynomial (filterNull r)
+-- where showPolynomial [] = "0"
+-- showPolynomial p = dropWhile (`elem` " +") $ foldl f "" (map show p)
+-- where f s "" = s
+-- f s (c:cs)
+-- | c == '-' = s ++ " - " ++ cs
+-- | otherwise = s ++ " + " ++ (c:cs)
+--
+--
+-- filterNull :: Polynomial -> Polynomial
+-- filterNull = filter (\t -> coefficient t /= 0)
+--
+-- equationMap :: (Polynomial -> Polynomial) -> Equation -> Equation
+-- equationMap f (Equation l r) = Equation (f l) (f r)
+--
+-- degree :: Polynomial -> Int
+-- degree [] = 0
+-- degree p = Equation.exponent (maximum p)
+--
+-- reduce :: Equation -> Equation
+-- reduce equ = Equation (merge (left stdForm) (right stdForm)) []
+-- where stdForm = equationMap (\a -> (reducePolynomial $ sort a)) equ
+-- merge [] rs = rs
+-- merge ls [] = ls
+-- merge (l:ls) (r:rs)
+-- | l == r = (subTerm l r) : merge ls rs
+-- | l < r = l : merge ls (r:rs)
+-- | r < l = r : merge (l:ls) rs
+-- where subTerm (Term c1 e) (Term c2 _) = Term (c1 - c2) e
+-- reducePolynomial [] = []
+-- reducePolynomial [t] = [t]
+-- reducePolynomial (t1:t2:ts)
+-- | t1 == t2 = (addTerm t1 t2) : reducePolynomial ts
+-- | otherwise = t1 : reducePolynomial (t2:ts)
+-- where addTerm (Term c1 e) (Term c2 _) = Term (c1 + c2) e
+--
+-- solveDegree2 :: Float -> Float -> Float -> [Float]
+-- solveDegree2 a b c
+-- | phi < 0 = []
+-- | phi == 0 = [(-b) / (2.0 * a)]
+-- | phi > 0 = [ (-b + mySqrt phi) / (2.0 * a) -- not alowed
+-- , (-b - mySqrt phi) / (2.0 * a)
+-- ]
+-- where phi = b * b - 4.0 * a * c
+--
+-- solveDegree1 :: Float -> Float -> Float
+-- solveDegree1 b c = -c / b
+--
+-- solve :: Polynomial -> [Float]
+-- solve [t0] = []
+-- solve [t0, t1] = [solveDegree1 (coefficient t1) (coefficient t0)]
+-- solve [t0, t1, t2] = solveDegree2 (coefficient t2) (coefficient t1) (coefficient t0)
+-- solve _ = undefined
+--
+-- mySqrt :: Float -> Float
+-- mySqrt n
+-- | n < 0 = undefined
+-- | otherwise = mySqrt' (n / 2)
+-- where mySqrt' x = if abs (x * x - n) < 0.01
+-- then x
+-- else mySqrt' xn
+-- where xn = b - (a * a) / (2 * b)
+-- where a = (n - x * x) / (2 * x)
+-- b = x + a
diff --git a/src/statement.hs b/src/Statement.hs
index 75dfdb4..75dfdb4 100644
--- a/src/statement.hs
+++ b/src/Statement.hs
diff --git a/src/atom.hs b/src/atom.hs
deleted file mode 100644
index 5f1b42c..0000000
--- a/src/atom.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-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
-
-infixl 7 %?
-(%?) :: Atom -> Atom -> Maybe Atom
-_ %? _ = 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 e6f1f25..0000000
--- a/src/expr.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-module Expr where
-
-import Atom
-
-
-data Expr
- = EAtom Atom
- | Add Expr Expr
- | Sub Expr Expr
- | Mul Expr Expr
- | Div Expr Expr
- | Mod Expr Expr
- | Exp Expr Expr
- | Variable String
- | Function String Expr
-
-
-
-eval :: Expr -> Maybe Atom
-eval (EAtom a) = Just a
-eval (Add e1 e2) = evalInfix e1 e2 (+?)
-eval (Sub e1 e2) = evalInfix e1 e2 (-?)
-eval (Mul e1 e2) = evalInfix e1 e2 (*?)
-eval (Div e1 e2) = evalInfix e1 e2 (/?)
-eval (Mod e1 e2) = evalInfix e1 e2 (%?)
-eval (Exp e1 e2) = evalInfix e1 e2 (^?)
-eval _ = Nothing
-
-evalInfix :: Expr -> Expr -> (Atom -> Atom -> Maybe Atom) -> Maybe Atom
-evalInfix e1 e2 f = do a <- eval e1
- b <- eval e2
- f a b
-
-instance Show Expr where
- show (EAtom a) = show a
- show (Add e1 e2) = show e1 ++ " + " ++ show e2
- show (Sub e1 e2) = show e1 ++ " - " ++ show e2
- show (Mul e1 e2) = show e1 ++ " * " ++ show e2
- show (Div e1 e2) = show e1 ++ " / " ++ show e2
- show (Mod e1 e2) = show e1 ++ " % " ++ show e2
- show (Exp e1 e2) = show e1 ++ " ^ " ++ show e2
- show (Variable name) = name
- show (Function name e) = name ++ "(" ++ show e ++ ")"
diff --git a/src/main.hs b/src/main.hs
new file mode 100644
index 0000000..34a190a
--- /dev/null
+++ b/src/main.hs
@@ -0,0 +1,25 @@
+import System.IO
+import Statement
+import Parser.Statement
+import Parser.Core
+
+
+main = do
+ line <- prompt
+ loop line
+
+loop :: String -> IO ()
+loop "exit" = return ()
+loop line = do s <- parseIO line
+ putStrLn $ show s
+ main
+
+prompt :: IO String
+prompt = do putStr "> "
+ hFlush stdout
+ getLine
+
+parseIO :: String -> IO Statement
+parseIO input = case parseStrict statementP input of
+ Nothing -> fail "Couldn't parse input"
+ Just s -> return s
diff --git a/src/parser/assignment.hs b/src/parser/Assignment.hs
index bb782f5..bb782f5 100644
--- a/src/parser/assignment.hs
+++ b/src/parser/Assignment.hs
diff --git a/src/parser/core.hs b/src/parser/Core.hs
index b622634..b22bcf4 100644
--- a/src/parser/core.hs
+++ b/src/parser/Core.hs
@@ -50,8 +50,9 @@ satisfyChar f = Parser p
p (c:cs) = if f c then Just (c, cs)
else Nothing
--- sepBy :: Parser b -> Parser a -> Parser [a]
--- sepBy sep x = (:) <$> x <*> (many (sep *> x))
+sepBy :: Parser b -> Parser a -> Parser [a]
+sepBy sep x = (:) <$> x <*> (many (sep *> x))
+
-- sepByMap :: (b -> a -> a) -> Parser b -> Parser a -> Parser [a]
-- sepByMap f sep x = (:) <$> x <*> (many (f <$> sep <*> x))
diff --git a/src/parser/expr.hs b/src/parser/Expr.hs
index b84362d..5ba4be7 100644
--- a/src/parser/expr.hs
+++ b/src/parser/Expr.hs
@@ -3,30 +3,31 @@ module Parser.Expr where
import Control.Applicative
import Parser.Core
-import Atom
import Expr
imaginaryP :: Parser Atom
-imaginaryP = AImaginary <$> (floatP <* char 'i')
+imaginaryP = Imaginary <$> (floatP <* char 'i')
rationalP :: Parser Atom
-rationalP = ARational <$> floatP
+rationalP = Rational <$> floatP
-termOpP :: Parser (Expr -> Expr -> Expr)
-termOpP = infixOp "+" Add <|> infixOp "-" Sub
-
-factorOpP :: Parser (Expr -> Expr -> Expr)
-factorOpP = infixOp "*" Mul <|> infixOp "/" Div <|> infixOp "%" Mod
-
-expOpP :: Parser (Expr -> Expr -> Expr)
-expOpP = infixOp "^" Exp
+matrixP :: Parser Atom
+matrixP = Matrix <$> (char '[' *> sepBy (char ';') matrixRowP <* char ']')
+ where matrixRowP = char '[' *> sepBy (char ',') exprP <* char ']'
exprP :: Parser Expr
exprP = termP `chainl1` termOpP
+ where termOpP = infixOp "+" Add <|> infixOp "-" Sub
termP :: Parser Expr
termP = factorP `chainl1` factorOpP
+ where factorOpP = infixOp "**" Dot <|> infixOp "*" Mul <|> infixOp "/" Div <|> infixOp "%" Mod
+
+factorP :: Parser Expr
+factorP = endpointP `chainl1` expOpP
+ where expOpP = infixOp "^" Exp
+ endpointP = parenthesisExprP <|> (EAtom <$> atomP) <|> functionP <|> variableP
variableP :: Parser Expr
variableP = Variable <$> alphaStringP
@@ -34,12 +35,8 @@ variableP = Variable <$> alphaStringP
functionP :: Parser Expr
functionP = Function <$> alphaStringP <*> parenthesisExprP
-factorP :: Parser Expr
-factorP = endpointP `chainl1` expOpP
- where endpointP = parenthesisExprP <|> (EAtom <$> atomP) <|> functionP <|> variableP
-
parenthesisExprP :: Parser Expr
parenthesisExprP = parenthesize exprP
atomP :: Parser Atom
-atomP = imaginaryP <|> rationalP
+atomP = imaginaryP <|> rationalP <|> matrixP
diff --git a/src/parser/statement.hs b/src/parser/Statement.hs
index 74f7f01..74f7f01 100644
--- a/src/parser/statement.hs
+++ b/src/parser/Statement.hs
diff --git a/src/polynomial.hs b/src/polynomial.hs
deleted file mode 100644
index f332131..0000000
--- a/src/polynomial.hs
+++ /dev/null
@@ -1,95 +0,0 @@
-module Equation
-( Equation (..)
-, Polynomial
-, Term (..)
-, degree
-, reduce
-, solve
-, filterNull
-) where
-
-import Data.List
-
-
-data Equation = Equation { left :: Polynomial, right :: Polynomial }
-type Polynomial = [Term]
-data Term = Term { coefficient :: Float, exponent :: Int }
-
-instance Eq Term where
- (Term _ e1) == (Term _ e2) = e1 == e2
-
-instance Ord Term where
- compare (Term _ e1) (Term _ e2) = compare e1 e2
-
-instance Show Term where
- show (Term 0 e) = ""
- show (Term c 0) = show (round c)
- show (Term c e) = show (round c) ++ " * X^" ++ show e
-
-instance Show Equation where
- show (Equation l r) = showPolynomial (filterNull l)
- ++ " = "
- ++ showPolynomial (filterNull r)
- where showPolynomial [] = "0"
- showPolynomial p = dropWhile (`elem` " +") $ foldl f "" (map show p)
- where f s "" = s
- f s (c:cs)
- | c == '-' = s ++ " - " ++ cs
- | otherwise = s ++ " + " ++ (c:cs)
-
-
-filterNull :: Polynomial -> Polynomial
-filterNull = filter (\t -> coefficient t /= 0)
-
-equationMap :: (Polynomial -> Polynomial) -> Equation -> Equation
-equationMap f (Equation l r) = Equation (f l) (f r)
-
-degree :: Polynomial -> Int
-degree [] = 0
-degree p = Equation.exponent (maximum p)
-
-reduce :: Equation -> Equation
-reduce equ = Equation (merge (left stdForm) (right stdForm)) []
- where stdForm = equationMap (\a -> (reducePolynomial $ sort a)) equ
- merge [] rs = rs
- merge ls [] = ls
- merge (l:ls) (r:rs)
- | l == r = (subTerm l r) : merge ls rs
- | l < r = l : merge ls (r:rs)
- | r < l = r : merge (l:ls) rs
- where subTerm (Term c1 e) (Term c2 _) = Term (c1 - c2) e
- reducePolynomial [] = []
- reducePolynomial [t] = [t]
- reducePolynomial (t1:t2:ts)
- | t1 == t2 = (addTerm t1 t2) : reducePolynomial ts
- | otherwise = t1 : reducePolynomial (t2:ts)
- where addTerm (Term c1 e) (Term c2 _) = Term (c1 + c2) e
-
-solveDegree2 :: Float -> Float -> Float -> [Float]
-solveDegree2 a b c
- | phi < 0 = []
- | phi == 0 = [(-b) / (2.0 * a)]
- | phi > 0 = [ (-b + mySqrt phi) / (2.0 * a) -- not alowed
- , (-b - mySqrt phi) / (2.0 * a)
- ]
- where phi = b * b - 4.0 * a * c
-
-solveDegree1 :: Float -> Float -> Float
-solveDegree1 b c = -c / b
-
-solve :: Polynomial -> [Float]
-solve [t0] = []
-solve [t0, t1] = [solveDegree1 (coefficient t1) (coefficient t0)]
-solve [t0, t1, t2] = solveDegree2 (coefficient t2) (coefficient t1) (coefficient t0)
-solve _ = undefined
-
-mySqrt :: Float -> Float
-mySqrt n
- | n < 0 = undefined
- | otherwise = mySqrt' (n / 2)
- where mySqrt' x = if abs (x * x - n) < 0.01
- then x
- else mySqrt' xn
- where xn = b - (a * a) / (2 * b)
- where a = (n - x * x) / (2 * x)
- b = x + a
generated by cgit (git 2.34.1) at 2026-05-16 00:35:42 +0000