Argument Checking, equation evaluation

3 files changed, 94 insertions, 43 deletions

diff --git a/src/equation.hs b/src/equation.hs
new file mode 100644
index 0000000..019701f
--- /dev/null
+++ b/src/equation.hs
@@ -0,0 +1,64 @@
+module Equation where
+
+import Numeric.Natural
+import Data.List
+
+
+data Equation = Equation { left :: Polynomial, right :: Polynomial }
+type Polynomial = [Term]
+data Term = Term { coefficient :: Float, exponent :: Natural }
+
+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 c e) = show c ++ " * X^" ++ show e
+
+instance Show Equation where
+    show (Equation l r) = showPolynomial l ++ " = " ++ showPolynomial r
+        where showPolynomial [] = "0"
+              showPolynomial p  = intercalate " + " (map show p)
+
+equationMap :: (Polynomial -> Polynomial) -> Equation -> Equation
+equationMap f (Equation l r) = Equation (f l) (f r)
+
+degree :: Polynomial -> Natural
+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 + sqrt phi) / (2.0 * a)
+                  , (-b - sqrt phi) / (2.0 * a)
+                  ]
+    where phi = b ^ 2 - 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
diff --git a/src/main.hs b/src/main.hs
index c327d2b..4b365a2 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -1,45 +1,32 @@
 import System.Environment
-import Data.Char
+import Data.List
 
-data TokenType = Number | Add | Sub | Mul | Exp | Equal deriving (Show)
-data Token = Token TokenType Float deriving (Show)
+import Parser
+import Equation
 
+main :: IO ()
 main = do
     args <- getArgs
-    -- putStr $ show args
-    let l = lexer $ (head args)
-    putStrLn $ show l
-
-
-lexer :: String -> [Token]
-lexer "" = []
-lexer (c:rest)
-    | c == ' ' = lexer rest
-    | isDigit c = (Token Number (read (isolateFloat (c:rest)) :: Float)) : lexer (afterFloat (c:rest))
-    | c == '+' = (Token Add 0.0) : lexer rest
-    | c == '-' = (Token Sub 0.0) : lexer rest
-    | c == '*' = (Token Mul 0.0) : lexer rest
-    | c == '^' = (Token Exp 0.0) : lexer rest
-    | c == '=' = (Token Equal 0.0) : lexer rest
-
-    where isolateFloat :: String -> String
-          isolateFloat "" = ""
-          isolateFloat (c:cs)
-            | isDigit c = c : isolateFloat cs
-            | c == '.' = c : isolateFloat cs
-            | otherwise = ""
-
-          afterFloat :: String -> String
-          afterFloat "" = ""
-          afterFloat (c:cs)
-            | isDigit c = afterFloat cs
-            | c == '.' = afterFloat cs
-            | otherwise = (c:cs)
-
-
--- parse :: Lexing -> SyntaxTree
--- parse s = 2
---
---
--- eval :: SyntaxTree -> Maybe [Float]
--- eval _ = 0.0
+    checkArgs args
+    equ <- checkParsing (head args)
+    let reduced = reduce equ
+    putStrLn $ "Reduced From: " ++ show reduced
+    putSolutions (left reduced)
+
+
+checkArgs :: [String] -> IO ()
+checkArgs args
+    | length args == 0 = fail "Usage ./computor equation"
+    | length args > 1  = fail "Too many arguments"
+    | otherwise        = return ()
+
+checkParsing :: String -> IO Equation
+checkParsing input = case parse Parser.equationP input
+                        of Nothing        -> fail "Couldnt parse equation"
+                           Just (equ, "") -> return equ
+                           Just (_, s)    -> fail "Couldnt parse equation yo"
+
+putSolutions :: Polynomial -> IO ()
+putSolutions p
+    | degree p > 2 = fail "The polynomial degree is strictly greater then 2, can't solve."
+    | otherwise    = putStr $ intercalate "\n" (map show (solve p))
diff --git a/src/parser.hs b/src/parser.hs
index 7929c26..df0ac10 100644
--- a/src/parser.hs
+++ b/src/parser.hs
@@ -5,6 +5,8 @@ import Control.Monad
 import Data.Char
 import Numeric.Natural
 
+import Equation
+
 
 newtype Parser a = Parser (String -> Maybe (a, String))
 
@@ -49,10 +51,8 @@ sepBy :: Parser a -> Parser b -> Parser [a]
 sepBy x sep = ((:) <$> x <*> many (sep *> x)) <|> pure []
 
 
+-- Equation parsers
 -- 1 * X^0 + 2 * X^1 + 1 * 3 * X^2 = 0
-data Equation = Equation { left :: Polynomial, right :: Polynomial } deriving (Show)
-type Polynomial = [Term]
-data Term = Term { coefficient :: Float, exponent :: Natural } deriving (Show)
 
 coefficientP :: Parser Float
 coefficientP = read <$> (floatP <|> digitsP)