Completely redo everything and add partials
This commit is contained in:
parent
8c10af72a4
commit
876e53428b
|
@ -8,10 +8,12 @@
|
||||||
],
|
],
|
||||||
"exposed-modules": [],
|
"exposed-modules": [],
|
||||||
"dependencies": {
|
"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/core": "5.1.1 <= v < 6.0.0",
|
||||||
"elm-lang/html": "2.0.0 <= v < 3.0.0",
|
"elm-lang/html": "2.0.0 <= v < 3.0.0",
|
||||||
"Bogdanp/elm-combine": "3.1.1 <= v < 4.0.0",
|
"gilbertkennen/bigint": "1.0.1 <= v < 2.0.0",
|
||||||
"mhoare/elm-stack": "3.1.1 <= v < 4.0.0"
|
"mgold/elm-nonempty-list": "3.1.0 <= v < 4.0.0"
|
||||||
},
|
},
|
||||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||||
}
|
}
|
||||||
|
|
|
@ -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"]
|
46
src/Expr.elm
46
src/Expr.elm
|
@ -1,52 +1,46 @@
|
||||||
module Expr exposing (Expr(..), Op(..), parse)
|
module Expr exposing (Expr(..), OpName, parse)
|
||||||
|
|
||||||
import Combine exposing (..)
|
import Combine exposing (..)
|
||||||
import Combine.Num as Num
|
import Combine.Num as Num
|
||||||
|
import Combine.Char as Char
|
||||||
|
|
||||||
type Op
|
type alias OpName = String
|
||||||
= Add
|
|
||||||
| Subtract
|
|
||||||
| Multiply
|
|
||||||
| Divide
|
|
||||||
| Exponent
|
|
||||||
| Range
|
|
||||||
|
|
||||||
type Expr
|
type Expr
|
||||||
= Num Float
|
= Num Int
|
||||||
| Op Op
|
| Op OpName
|
||||||
| Group (List Expr)
|
| Group (List Expr)
|
||||||
|
|
||||||
num : Parser () Expr
|
num : Parser () Expr
|
||||||
num =
|
num =
|
||||||
(Num <$> Num.float <|> Num << toFloat <$> Num.int)
|
(Num <$> Num.int)
|
||||||
<?> "expected a number (int or float)"
|
<?> "expected a number (int)"
|
||||||
|
|
||||||
stringIs : String -> a -> Parser s a
|
acceptableOperatorName : Parser () String
|
||||||
stringIs str val =
|
acceptableOperatorName =
|
||||||
string str *> succeed val
|
regex "[A-Za-z\\^%*$£!@#~.,=+-_;:/\\\\]*"
|
||||||
|
|
||||||
op : Parser () Expr
|
op : Parser () Expr
|
||||||
op =
|
op =
|
||||||
stringIs "+" Add
|
acceptableOperatorName
|
||||||
<|> stringIs "-" Subtract
|
|
||||||
<|> stringIs "*" Multiply
|
|
||||||
<|> stringIs "/" Divide
|
|
||||||
<|> stringIs "^" Exponent
|
|
||||||
<|> stringIs "range" Range
|
|
||||||
|> map Op
|
|> map Op
|
||||||
|
|
||||||
group : Parser () Expr
|
group : Parser () Expr
|
||||||
group =
|
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)"
|
<?> "expected a group (whitespace-separated expressions between brackets)"
|
||||||
|> map Group
|
|> map Group
|
||||||
|
|
||||||
parser : Parser () Expr
|
parser : Parser () Expr
|
||||||
parser =
|
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 =
|
parse =
|
||||||
Combine.parse parser
|
Combine.parse parser
|
||||||
>> Result.mapError (\(_, _, errorList) -> errorList)
|
>> Result.mapError (\(_, _, errorList) -> convertErrorList errorList) -- Convert error data into only the error message
|
||||||
>> Result.map (\(_, _, expr) -> expr) -- Convert errors/results to nicer format
|
>> Result.map (\(_, _, data) -> data) -- Drop irrelevant parse data
|
80
src/Main.elm
80
src/Main.elm
|
@ -4,14 +4,15 @@ import Html exposing (..)
|
||||||
import Html.Attributes exposing (..)
|
import Html.Attributes exposing (..)
|
||||||
import Html.Events 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 }
|
main = Html.beginnerProgram { model = model, update = update, view = view }
|
||||||
|
|
||||||
type alias Model =
|
type alias Model =
|
||||||
{ result : Result (List String) (List Float)
|
{ result : Result String (List Eval.Value)
|
||||||
, expression : String
|
, expression : String
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -28,16 +29,16 @@ update msg model =
|
||||||
case msg of
|
case msg of
|
||||||
ExpressionTyped str ->
|
ExpressionTyped str ->
|
||||||
Expr.parse ("(" ++ str ++ ")") -- wrap str in brackets so it's recognized as a group
|
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 }
|
|> \r -> { model | result = r, expression = str }
|
||||||
|
|
||||||
error : String -> Html a
|
error : String -> Html a
|
||||||
error err =
|
error err =
|
||||||
div [class "error"] [text err]
|
div [class "error"] [text err]
|
||||||
|
|
||||||
stackItem : Float -> Html a
|
stackItem : Eval.Value -> Html a
|
||||||
stackItem n =
|
stackItem n =
|
||||||
let asString = toString n
|
let asString = Eval.prettyPrintValue n
|
||||||
minWidth = toString (String.length asString) ++ "em"
|
minWidth = toString (String.length asString) ++ "em"
|
||||||
in div [class "item", style [("min-width", minWidth)]] [text asString]
|
in div [class "item", style [("min-width", minWidth)]] [text asString]
|
||||||
|
|
||||||
|
@ -48,65 +49,10 @@ view model =
|
||||||
Ok stack ->
|
Ok stack ->
|
||||||
List.reverse stack -- Puts first items at the top, for nicer looks
|
List.reverse stack -- Puts first items at the top, for nicer looks
|
||||||
|> List.map stackItem
|
|> List.map stackItem
|
||||||
Err errors ->
|
Err outputError ->
|
||||||
List.map error errors
|
[error outputError]
|
||||||
in div [class "rpncalc"] (
|
in div [class "rpncalc"] (
|
||||||
[ input [onInput ExpressionTyped, value model.expression, class "exprinput"] []
|
[ div [] calcOutput
|
||||||
] ++ calcOutput
|
, input [onInput ExpressionTyped, value model.expression, class "exprinput"] []
|
||||||
)
|
]
|
||||||
|
)
|
||||||
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
|
|
|
@ -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
|
|
@ -9,14 +9,14 @@
|
||||||
width: 10vw;
|
width: 10vw;
|
||||||
height: 10vw;
|
height: 10vw;
|
||||||
border: 1px solid black;
|
border: 1px solid black;
|
||||||
margin-bottom: -1px;
|
margin-top: -1px;
|
||||||
display: flex;
|
display: flex;
|
||||||
justify-content: center;
|
justify-content: center;
|
||||||
align-items: center;
|
align-items: center;
|
||||||
}
|
}
|
||||||
|
|
||||||
.exprinput {
|
.exprinput {
|
||||||
margin-bottom: 1vh;
|
margin-top: 1vh;
|
||||||
width: 100%;
|
width: 100%;
|
||||||
font-size: 1.2em;
|
font-size: 1.2em;
|
||||||
}
|
}
|
Loading…
Reference in New Issue