From 876e53428bff9b79d82a70f09cb3d554939b4182 Mon Sep 17 00:00:00 2001 From: osmarks Date: Sat, 24 Feb 2018 13:12:10 +0000 Subject: [PATCH] Completely redo everything and add partials --- elm-package.json | 6 ++-- src/Eval.elm | 92 ++++++++++++++++++++++++++++++++++++++++++++++++ src/Expr.elm | 46 +++++++++++------------- src/Main.elm | 80 +++++++---------------------------------- src/Stack.elm | 23 ++++++++++++ style.css | 4 +-- 6 files changed, 154 insertions(+), 97 deletions(-) create mode 100644 src/Eval.elm create mode 100644 src/Stack.elm diff --git a/elm-package.json b/elm-package.json index 9ccdb84..a471f68 100644 --- a/elm-package.json +++ b/elm-package.json @@ -8,10 +8,12 @@ ], "exposed-modules": [], "dependencies": { + "Bogdanp/elm-combine": "3.1.1 <= v < 4.0.0", + "elm-community/ratio": "1.1.0 <= v < 2.0.0", "elm-lang/core": "5.1.1 <= v < 6.0.0", "elm-lang/html": "2.0.0 <= v < 3.0.0", - "Bogdanp/elm-combine": "3.1.1 <= v < 4.0.0", - "mhoare/elm-stack": "3.1.1 <= v < 4.0.0" + "gilbertkennen/bigint": "1.0.1 <= v < 2.0.0", + "mgold/elm-nonempty-list": "3.1.0 <= v < 4.0.0" }, "elm-version": "0.18.0 <= v < 0.19.0" } diff --git a/src/Eval.elm b/src/Eval.elm new file mode 100644 index 0000000..5e781f0 --- /dev/null +++ b/src/Eval.elm @@ -0,0 +1,92 @@ +module Eval exposing (..) + +import Expr exposing (..) +import Ratio exposing (Rational(..)) +import Dict exposing (Dict(..)) +import List.Nonempty as Nonempty exposing (Nonempty(..)) +import Stack exposing (..) + +type Error = MathematicalImpossibility | StackUnderflow Int | OpNotFound OpName + +type alias Partial = (OpName, List Value, Int) + +type Value = + Rational Rational | Partial Partial + +evalGroup : List Expr -> Result Error (List Value) +evalGroup g = + List.foldl (\expr result -> Result.andThen (\stack -> evalRec expr stack) result) (Ok []) g + +-- If anything but a StackUnderflow results, just let it go through. +-- If StackUnderflow occurs, convert it to Partial and push the Partial to stack. +handleOpResult : OpName -> List Value -> Result Error (List Value) -> Result Error (List Value) +handleOpResult opname stack r = + case r of + Ok x -> r + Err e -> + case e of + StackUnderflow missing -> + [Partial (opname, stack, missing)] + |> Ok + _ -> r + +evalRec : Expr -> List Value -> Result Error (List Value) +evalRec e s = + case e of + Num x -> + Ratio.fromInt x + |> Rational + |> \v -> v::s + |> Ok + Group g -> + evalGroup g + |> Result.map (\groupStack -> groupStack ++ s) + Op o -> + case Dict.get o ops of + Just opF -> + opF s + |> handleOpResult o s + Nothing -> OpNotFound o |> Err + +eval : Expr -> Result Error (List Value) +eval e = + evalRec e [] + +type alias Op = List Value -> Result Error (List Value) + +ops : Dict OpName Op +ops = Dict.fromList [ + ("/", binaryOp Ratio.divide), + ("+", binaryOp Ratio.add), + ("*", binaryOp Ratio.multiply), + ("-", binaryOp Ratio.subtract) + ] + +getNums : List Value -> Int -> Result Int (List Value, Nonempty Ratio.Rational) +getNums stack qty = + let selectRationals = Nonempty.map (\v -> case v of + Rational r -> r + _ -> Ratio.fromInt 0) + in + Stack.pick (\v -> case v of + Rational r -> True + _ -> False) stack qty + |> Result.map (\(stack, nums) -> (stack, selectRationals nums)) + +binaryOp : (Rational -> Rational -> Rational) -> Op +binaryOp f stack = + getNums stack 2 + |> Result.mapError StackUnderflow + |> Debug.log "BINOP" + |> Result.map (\(stack, numbers) -> (f (Nonempty.get 0 numbers) (Nonempty.get 1 numbers) |> Rational)::stack) + +prettyPrintValue : Value -> String +prettyPrintValue v = case v of + Rational r -> Ratio.toFloat r |> toString + Partial (op, stack, missing) -> String.join " " <| ["Partial:", op, "["] ++ List.map prettyPrintValue stack ++ ["]", toString missing] + +prettyPrintError : Error -> String +prettyPrintError e = case e of + MathematicalImpossibility -> "Does not compute" + OpNotFound n -> String.concat ["Operator \"", n, "\" not found"] + StackUnderflow n -> String.join " " ["Stack underflowed by", toString n, "items"] \ No newline at end of file diff --git a/src/Expr.elm b/src/Expr.elm index 53427a6..3829644 100644 --- a/src/Expr.elm +++ b/src/Expr.elm @@ -1,52 +1,46 @@ -module Expr exposing (Expr(..), Op(..), parse) +module Expr exposing (Expr(..), OpName, parse) import Combine exposing (..) import Combine.Num as Num +import Combine.Char as Char -type Op - = Add - | Subtract - | Multiply - | Divide - | Exponent - | Range +type alias OpName = String type Expr - = Num Float - | Op Op + = Num Int + | Op OpName | Group (List Expr) num : Parser () Expr num = - (Num <$> Num.float <|> Num << toFloat <$> Num.int) - "expected a number (int or float)" + (Num <$> Num.int) + "expected a number (int)" -stringIs : String -> a -> Parser s a -stringIs str val = - string str *> succeed val +acceptableOperatorName : Parser () String +acceptableOperatorName = + regex "[A-Za-z\\^%*$£!@#~.,=+-_;:/\\\\]*" op : Parser () Expr op = - stringIs "+" Add - <|> stringIs "-" Subtract - <|> stringIs "*" Multiply - <|> stringIs "/" Divide - <|> stringIs "^" Exponent - <|> stringIs "range" Range + acceptableOperatorName |> map Op group : Parser () Expr group = - between (string "(") (string ")") (sepBy1 whitespace (lazy <| \_ -> parser)) -- Avoid bad recursion issues using lazy parser evaluation + parens (sepBy1 whitespace (lazy <| \_ -> parser)) -- Avoid "bad recursion" issues using lazy parser evaluation "expected a group (whitespace-separated expressions between brackets)" |> map Group parser : Parser () Expr parser = - (lazy <| \_ -> group) <|> op <|> num + (lazy <| \_ -> group) <|> num <|> op -parse : String -> Result (List String) Expr +convertErrorList : List String -> String +convertErrorList = + List.intersperse " or " >> String.concat + +parse : String -> Result String Expr parse = Combine.parse parser - >> Result.mapError (\(_, _, errorList) -> errorList) - >> Result.map (\(_, _, expr) -> expr) -- Convert errors/results to nicer format \ No newline at end of file + >> Result.mapError (\(_, _, errorList) -> convertErrorList errorList) -- Convert error data into only the error message + >> Result.map (\(_, _, data) -> data) -- Drop irrelevant parse data \ No newline at end of file diff --git a/src/Main.elm b/src/Main.elm index b3b2dc5..ee66eb7 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -4,14 +4,15 @@ import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Expr exposing (Expr(..), Op(..)) +import Expr exposing (Expr(..), OpName) +import Eval exposing (eval) -import Stack exposing (Stack(..)) +import Ratio main = Html.beginnerProgram { model = model, update = update, view = view } type alias Model = - { result : Result (List String) (List Float) + { result : Result String (List Eval.Value) , expression : String } @@ -28,16 +29,16 @@ update msg model = case msg of ExpressionTyped str -> Expr.parse ("(" ++ str ++ ")") -- wrap str in brackets so it's recognized as a group - |> Result.andThen eval -- Convert stack underflow errors into a list + |> Result.andThen (eval >> Result.mapError Eval.prettyPrintError) |> \r -> { model | result = r, expression = str } error : String -> Html a error err = div [class "error"] [text err] -stackItem : Float -> Html a +stackItem : Eval.Value -> Html a stackItem n = - let asString = toString n + let asString = Eval.prettyPrintValue n minWidth = toString (String.length asString) ++ "em" in div [class "item", style [("min-width", minWidth)]] [text asString] @@ -48,65 +49,10 @@ view model = Ok stack -> List.reverse stack -- Puts first items at the top, for nicer looks |> List.map stackItem - Err errors -> - List.map error errors + Err outputError -> + [error outputError] in div [class "rpncalc"] ( - [ input [onInput ExpressionTyped, value model.expression, class "exprinput"] [] - ] ++ calcOutput - ) - -listToStack : List a -> Stack a -listToStack = - List.foldr Stack.push Stack.initialise - -prependList : List a -> Stack a -> Stack a -prependList from to = - List.foldr Stack.push to from - -prepend : Stack a -> Stack a -> Stack a -prepend from to = - prependList (Stack.toList from) to - -type alias StackFunction = Stack Float -> Result String (Stack Float) - --- Runs a binary operation which returns a list on a stack -binListOutOp : (Float -> Float -> List Float) -> StackFunction -binListOutOp f s = - let - (maybeX, s1) = Stack.pop s - (maybeY, s2) = Stack.pop s1 - in Maybe.map2 (,) maybeX maybeY - |> Maybe.map (\(x, y) -> f y x) -- x and y swapped round - this makes "5 1 /" become 5 instead of 0.2. - |> Maybe.map (\r -> prependList r s2) - |> Result.fromMaybe "Stack underflow" - --- Runs a binary operation on a stack -binOp : (Float -> Float -> Float) -> StackFunction -binOp f = - binListOutOp (\x y -> f x y |> List.singleton) - -evalRec : Expr -> Stack Float -> Result String (Stack Float) -evalRec expr s = - case expr of - Group es -> - List.foldl (\expr s -> Result.andThen (evalRec expr) s) (Ok Stack.initialise) es - |> Result.map (\newStack -> prepend newStack s) -- prepend new stack's contents to old stack - Num n -> - Ok (Stack.push n s) - Op o -> - case o of - Add -> binOp (+) s - Subtract -> binOp (-) s - Multiply -> binOp (*) s - Divide -> binOp (/) s - Exponent -> binOp (^) s - Range -> - binListOutOp (\x y -> - List.range (floor x) (floor y) - |> List.map toFloat) s - -eval : Expr -> Result (List String) (List Float) -eval e = - evalRec e (Stack.initialise) - |> Result.map Stack.toList -- Convert stack to list - |> Result.mapError List.singleton -- Wrap possible stackoverflow error in list \ No newline at end of file + [ div [] calcOutput + , input [onInput ExpressionTyped, value model.expression, class "exprinput"] [] + ] + ) \ No newline at end of file diff --git a/src/Stack.elm b/src/Stack.elm new file mode 100644 index 0000000..a2e990f --- /dev/null +++ b/src/Stack.elm @@ -0,0 +1,23 @@ +-- Contains functions for use of a list as a stack, specifically for use in the calculator +module Stack exposing (..) + +import List.Nonempty as Nonempty exposing (Nonempty(..)) + +-- Gets the specified number of predicate-satisfying values from supplied stack. Returns new stack and values collected +pick : (a -> Bool) -> List a -> Int -> Result Int (List a, Nonempty a) +pick pred stack qty = + let pick curr (values, newStack, num) = + if pred curr then (curr::values, newStack, num + 1) + else (values, curr::newStack, num) + + foldF = \c (val, new, num) -> + if num < qty then pick c (val, new, num) + else (val, c::new, num) + (values, newStack, num) = List.foldl foldF ([], [], 0) stack + in + if num == qty then + Nonempty.fromList values + |> Result.fromMaybe qty + |> Result.map (\v -> (newStack, v)) + else + Err <| qty - num \ No newline at end of file diff --git a/style.css b/style.css index 3296f60..4315b85 100644 --- a/style.css +++ b/style.css @@ -9,14 +9,14 @@ width: 10vw; height: 10vw; border: 1px solid black; - margin-bottom: -1px; + margin-top: -1px; display: flex; justify-content: center; align-items: center; } .exprinput { - margin-bottom: 1vh; + margin-top: 1vh; width: 100%; font-size: 1.2em; } \ No newline at end of file