From dbbc2f6798ba77d2ea7d9cce91d3bd1879e467a2 Mon Sep 17 00:00:00 2001 From: Charles Date: Tue, 10 Mar 2020 17:19:53 +0100 Subject: Initial commit based on computorv1 --- .gitignore | 3 ++ Makefile | 32 ++++++++++++++++++ README.md | 3 ++ src/equation.hs | 95 +++++++++++++++++++++++++++++++++++++++++++++++++++++ src/parser.hs | 99 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ subject.pdf | Bin 0 -> 1437235 bytes 6 files changed, 232 insertions(+) create mode 100644 .gitignore create mode 100644 Makefile create mode 100644 README.md create mode 100644 src/equation.hs create mode 100644 src/parser.hs create mode 100644 subject.pdf diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5a83176 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*.o +*.hi +computorv2 diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..f4fba56 --- /dev/null +++ b/Makefile @@ -0,0 +1,32 @@ +# **************************************************************************** # +# # +# ::: :::::::: # +# Makefile :+: :+: :+: # +# +:+ +:+ +:+ # +# By: cacharle +#+ +:+ +#+ # +# +#+#+#+#+#+ +#+ # +# Created: 2020/02/29 11:54:31 by cacharle #+# #+# # +# Updated: 2020/02/29 12:01:42 by cacharle ### ########.fr # +# # +# **************************************************************************** # + +CC = ghc + +SRC_DIR = src +BUILD_DIR = build +NAME = computorv2 + +SRC = $(shell find $(SRC_DIR) -type f -name "*.hs") + +all: $(NAME) + +$(NAME): $(SRC) + $(CC) --make -outputdir $(BUILD_DIR) -o $(NAME) $(SRC) + +clean: + $(RM) $(BUILD_DIR)/*.o $(BUILD_DIR)/*.hi + +fclean: clean + $(RM) $(NAME) + +re: fclean all diff --git a/README.md b/README.md new file mode 100644 index 0000000..eb7f2b7 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# computorv2 + +computorv2 project of school 42 diff --git a/src/equation.hs b/src/equation.hs new file mode 100644 index 0000000..f332131 --- /dev/null +++ b/src/equation.hs @@ -0,0 +1,95 @@ +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 diff --git a/src/parser.hs b/src/parser.hs new file mode 100644 index 0000000..d523001 --- /dev/null +++ b/src/parser.hs @@ -0,0 +1,99 @@ +module Parser +( parse +, equationP +) where + +import Control.Applicative +import Control.Monad +import Data.Char + +import Equation + + +newtype Parser a = Parser (String -> Maybe (a, String)) + +parse :: Parser a -> String -> Maybe (a, String) +parse (Parser p) input = p input + +instance Functor Parser where + -- fmap :: (a -> b) -> Parser a -> Parser b + fmap f (Parser p) = Parser new_p + where new_p s = do + (x, s') <- p s + return (f x, s') + +instance Applicative Parser where + -- pure :: a -> Parser a + pure x = Parser (\s -> Just (x, s)) + -- (<*>) :: Parser (a -> b) -> Parser a -> Parser b + (Parser p1) <*> (Parser p2) = Parser new_p + where new_p s = do + (f, s') <- p1 s + (x, s'') <- p2 s' + return (f x, s'') + +instance Alternative Parser where + -- empty :: Parser a + empty = Parser (\_ -> Nothing) + -- (<|>) :: Parser a -> Parser a -> Parser a + (Parser p1) <|> (Parser p2) = Parser new_p + where new_p s = p1 s <|> p2 s + + +satisfy :: (Char -> Bool) -> Parser Char +satisfy f = Parser p + where p [] = Nothing + p (c:cs) = if f c then Just (c, cs) + else Nothing + +charP :: Char -> Parser Char +charP c = satisfy (c ==) + +digitsP :: Parser String +digitsP = some (satisfy isDigit) -- at least one digit to avoid read exception + +spacesP :: Parser String +spacesP = many (satisfy isSpace) + +sepBy :: Parser b -> Parser a -> Parser [a] +sepBy sep x = many (sep *> x) + +naturalP :: Parser Int +naturalP = read <$> digitsP + +floatPositiveP :: Parser Float +floatPositiveP = (f <$> digitsP <*> charP '.' <*> digitsP) <|> (read <$> digitsP) + where f pos dot dec = read $ pos ++ [dot] ++ dec + +-- Equation parsers + +unsignedTermP :: Parser Term +unsignedTermP = fullP <|> varExpP <|> varConstP <|> constP + where + -- 1 * X ^ 1 + fullP = (\c e -> Term c e) <$> floatPositiveP <* mulP <* varP <* expP <*> naturalP + -- X ^ 1 + varExpP = (\e -> Term 1 e) <$> (varP *> expP *> naturalP) + -- 1 * X + varConstP = (\c -> Term c 1) <$> floatPositiveP <* mulP <* varP + -- 1 + constP = (\c -> Term c 0) <$> floatPositiveP + + mulP = spacesP *> charP '*' *> spacesP + varP = spacesP *> charP 'X' *> spacesP + expP = spacesP *> charP '^' *> spacesP + +signedTermP :: Parser Term +signedTermP = signF <$> signP <* spacesP <*> unsignedTermP + where signP = charP '-' <|> charP '+' + signF '-' (Term c e) = Term (-c) e + signF _ t = t + +polynomialP :: Parser Polynomial +polynomialP = (:) <$> firstTermP <* spacesP <*> (sepBy spacesP signedTermP) + where firstTermP = signedTermP <|> unsignedTermP + +equationP :: Parser Equation +equationP = (\l r -> Equation l r) + <$> polynomialP + <*> (spacesP *> charP '=' *> spacesP *> polynomialP) diff --git a/subject.pdf b/subject.pdf new file mode 100644 index 0000000..bafd14d Binary files /dev/null and b/subject.pdf differ -- cgit