From 3bfad391d39d2c23cc01ca4c5ef5faa28575a346 Mon Sep 17 00:00:00 2001 From: Charles Date: Mon, 9 Mar 2020 19:51:28 +0100 Subject: Argument Checking, equation evaluation --- src/equation.hs | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/main.hs | 67 +++++++++++++++++++++++---------------------------------- src/parser.hs | 6 +++--- 3 files changed, 94 insertions(+), 43 deletions(-) create mode 100644 src/equation.hs (limited to 'src') 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) -- cgit