From 778ca0a2b7ed6b70ae1a4595ef2a06cc3f5bb3ef Mon Sep 17 00:00:00 2001 From: osmarks Date: Thu, 15 Mar 2018 17:40:44 +0000 Subject: [PATCH] Make it actually work --- elm-package.json | 4 +- src/Eval.elm | 100 ++++++-------- src/Expr.elm | 15 +-- src/Main.elm | 121 ++++++++++++++--- src/Numerics.elm | 337 +++++++++++++++++++++++++++++++++++++++++++++++ src/Ops.elm | 169 ++++++++++++++++++++++++ src/Stack.elm | 6 +- src/Util.elm | 11 ++ style.css | 74 ++++++++++- 9 files changed, 747 insertions(+), 90 deletions(-) create mode 100644 src/Numerics.elm create mode 100644 src/Ops.elm create mode 100644 src/Util.elm diff --git a/elm-package.json b/elm-package.json index a471f68..d827ffc 100644 --- a/elm-package.json +++ b/elm-package.json @@ -9,10 +9,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-community/list-split": "1.0.2 <= v < 2.0.0", "elm-lang/core": "5.1.1 <= v < 6.0.0", "elm-lang/html": "2.0.0 <= v < 3.0.0", + "fiatjaf/hashbow-elm": "1.0.0 <= v < 2.0.0", "gilbertkennen/bigint": "1.0.1 <= v < 2.0.0", + "kintail/input-widget": "1.0.6 <= 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 index 5e781f0..40c4adc 100644 --- a/src/Eval.elm +++ b/src/Eval.elm @@ -1,25 +1,33 @@ module Eval exposing (..) import Expr exposing (..) -import Ratio exposing (Rational(..)) +import Numerics exposing (Rational(..)) import Dict exposing (Dict(..)) -import List.Nonempty as Nonempty exposing (Nonempty(..)) -import Stack exposing (..) +import Util exposing (..) -type Error = MathematicalImpossibility | StackUnderflow Int | OpNotFound OpName +type Error = MathematicalImpossibility | StackUnderflow Int | OpNotFound String | ParseError String -type alias Partial = (OpName, List Value, Int) +type alias Partial = (String, 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 +type Context = Context (Dict String Op) Int +type alias Op = Context -> List Value -> Result Error (List Value) + +getOps : Context -> Dict String Op +getOps (Context o _) = o + +getFlopControl : Context -> Int +getFlopControl (Context _ f) = f + +evalGroup : Context -> List Expr -> Result Error (List Value) +evalGroup ctx g = + List.foldl (\expr result -> Result.andThen (\stack -> evalRec ctx 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 : String -> List Value -> Result Error (List Value) -> Result Error (List Value) handleOpResult opname stack r = case r of Ok x -> r @@ -30,63 +38,33 @@ handleOpResult opname stack r = |> Ok _ -> r -evalRec : Expr -> List Value -> Result Error (List Value) -evalRec e s = +runOp : Context -> String -> List Value -> Result Error (List Value) +runOp ctx name stack = + case Dict.get name (getOps ctx) of + Just opF -> + opF ctx stack + |> handleOpResult name stack + Nothing -> OpNotFound name |> Err + +evalRec : Context -> Expr -> List Value -> Result Error (List Value) +evalRec ctx e s = case e of - Num x -> - Ratio.fromInt x + Float x -> + floatToRatio (getFlopControl ctx) x + |> Rational + |> \v -> v::s + |> Ok + Int x -> + Numerics.fromInt x |> Rational |> \v -> v::s |> Ok Group g -> - evalGroup g + evalGroup ctx 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 + runOp ctx o s -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 +eval : Context -> Expr -> Result Error (List Value) +eval ctx e = + evalRec ctx e [] \ No newline at end of file diff --git a/src/Expr.elm b/src/Expr.elm index 3829644..afb1b38 100644 --- a/src/Expr.elm +++ b/src/Expr.elm @@ -1,20 +1,19 @@ -module Expr exposing (Expr(..), OpName, parse) +module Expr exposing (Expr(..), parse) import Combine exposing (..) import Combine.Num as Num -import Combine.Char as Char - -type alias OpName = String +import BigInt exposing (..) type Expr - = Num Int - | Op OpName + = Float Float + | Int BigInt + | Op String | Group (List Expr) num : Parser () Expr num = - (Num <$> Num.int) - "expected a number (int)" + (Float <$> Num.float) <|> (Int << Maybe.withDefault (BigInt.fromInt 0) << BigInt.fromString <$> regex "\\d+") + "expected a number (float or int)" acceptableOperatorName : Parser () String acceptableOperatorName = diff --git a/src/Main.elm b/src/Main.elm index ee66eb7..091cac0 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -3,56 +3,143 @@ module Main exposing (..) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) +import Kintail.InputWidget as Input +import Hashbow -import Expr exposing (Expr(..), OpName) -import Eval exposing (eval) +import Expr exposing (Expr(..)) +import Eval exposing (eval, Error(..), Value(..)) +import Ops exposing (calcOps, opDocs) -import Ratio +import Numerics +import BigInt +import Dict exposing (Dict(..)) main = Html.beginnerProgram { model = model, update = update, view = view } +type OutputConf = Float | FormattedRational + type alias Model = - { result : Result String (List Eval.Value) + { result : Result Error (List Eval.Value) , expression : String + , outputSetting : OutputConf + , floatingPointControl : Float } model : Model model = { result = Ok [] , expression = "" + , outputSetting = FormattedRational + , floatingPointControl = 6 } -type Msg = ExpressionTyped String +type Msg = ExpressionTyped String | SwitchOutputConf OutputConf | AdjustFloatingPointControl Float + +-- Converts the slider input to an int suitable for use as the floating point accuracy/precision setting +toFlopControl : Float -> Int +toFlopControl f = + 10 ^ f |> floor update : Msg -> Model -> Model 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 >> Result.mapError Eval.prettyPrintError) + |> Result.mapError ParseError + |> Result.andThen (eval (Eval.Context calcOps <| toFlopControl model.floatingPointControl)) |> \r -> { model | result = r, expression = str } + SwitchOutputConf c -> + { model | outputSetting = c } + AdjustFloatingPointControl f -> + { model | floatingPointControl = f } -error : String -> Html a +-- Pretty-print an Error +error : Error -> Html a error err = - div [class "error"] [text err] + let + prettyPrint e = + case e of + MathematicalImpossibility -> "Does not compute" + OpNotFound o -> String.join " " ["Operator not found: ", o] + StackUnderflow x -> String.join " " ["Stack underflowed by", toString x, "items"] + ParseError e -> String.join " " ["Parse error:", e] + in + div [class "error"] [text <| prettyPrint err] -stackItem : Eval.Value -> Html a -stackItem n = - let asString = Eval.prettyPrintValue n - minWidth = toString (String.length asString) ++ "em" - in div [class "item", style [("min-width", minWidth)]] [text asString] +-- Renders a Value as an item in a stack +stackItem : OutputConf -> Eval.Value -> Html a +stackItem conf v = + let + anyText = toString >> text + bigintText = BigInt.toString >> text + center = List.singleton >> div [class "horizontal-center"] + displayFormattedRational r = + [ center <| bigintText <| Numerics.numerator r ] ++ + if Numerics.denominator r /= BigInt.fromInt 1 then + [ hr [] [] + , center <| bigintText <| Numerics.denominator r + ] + else [] + + inner = case v of + Rational r -> case conf of + FormattedRational -> [div [class "formatted-rational"] <| displayFormattedRational r] + Float -> [anyText <| Numerics.toFloat r] + Partial (op, stack, needs) -> + [div [class "partial"] + [ div [class "partial-op"] [text op] + , div [class "partial-missing"] [text <| String.join " " ["Missing", toString needs, "values"]] + , div [class "partial-stack"] <| List.map (stackItem conf) stack + ]] + in + div [class "item"] inner + +-- The controls for number formatting +formatControl : OutputConf -> Html OutputConf +formatControl c = + let + radioButton txt msg = label [] [Input.radioButton [] msg c, text txt] + in + div [] + [ radioButton "Rational (formatted)" FormattedRational + , br [] [] + , radioButton "Decimal (via floating point, may break)" Float + ] + +floatingPointControl : Float -> Html Float +floatingPointControl f = + let + slider = Input.slider [class "float-slider"] { min = 1, max = 12, step = 0.5 } f + in + label [class "float-slider-label"] [slider, text "Floating Point Accuracy/Precision Adjuster"] + +displayDocs : Dict String String -> List (Html a) +displayDocs docs = + let + docsL = Dict.toList docs + entry (op, desc) = div [class "op"] + [ span [class "op-name", style [("background-color", Hashbow.hashbow op)]] [text op] + , span [class "op-desc"] [text desc] + ] + in + List.map entry docsL view : Model -> Html Msg view model = - let calcOutput = + let stack = case model.result of Ok stack -> List.reverse stack -- Puts first items at the top, for nicer looks - |> List.map stackItem + |> List.map (stackItem model.outputSetting) Err outputError -> [error outputError] in div [class "rpncalc"] ( - [ div [] calcOutput - , input [onInput ExpressionTyped, value model.expression, class "exprinput"] [] + [ div [class "stack"] stack + , input [onInput ExpressionTyped, value model.expression, class "exprinput", autofocus True, placeholder "Expression"] [] + , div [class "config-panel"] + [ formatControl model.outputSetting |> Html.map SwitchOutputConf + , floatingPointControl model.floatingPointControl |> Html.map AdjustFloatingPointControl + ] + , div [class "docs"] (displayDocs Ops.opDocs) ] ) \ No newline at end of file diff --git a/src/Numerics.elm b/src/Numerics.elm new file mode 100644 index 0000000..141a1cd --- /dev/null +++ b/src/Numerics.elm @@ -0,0 +1,337 @@ +module Numerics + exposing + ( gcd + , add + , subtract + , multiply + , multiplyByInt + , divide + , divideByInt + , divideIntBy + , negate + , invert + , Rational + , over + , denominator + , numerator + , split + , toFloat + , fromInt + , eq + , ne + , gt + , lt + , ge + , le + , compare + , max + , min + , isZero + , isInfinite + , round + , floor + , ceiling + , truncate + , bigintToFloat + ) + +{-| A simple module providing a ratio type for rational numbers + +# Types +@docs Rational + +# Construction +@docs over, fromInt + +# Comparison +@docs eq, ne, gt, lt, ge, le, max, min, compare + +# Mathematics +@docs add, subtract, multiply, multiplyByInt +@docs divide, divideByInt, divideIntBy, negate +@docs isZero, isInfinite, round, floor, ceiling, truncate + +# Elimination +@docs numerator, denominator, split + +# Utils +@docs gcd, invert, toFloat + +-} + +import Basics exposing (..) +import BigInt exposing (..) + +{-| "Arbitrary" (up to `max_int` size) precision fractional numbers. Think of + it as the length of a rigid bar that you've constructed from a bunch of + initial bars of the same fixed length + by the operations of gluing bars together and shrinking a + given bar so that an integer number of copies of it glues together to + make another given bar. + +-} +type Rational + = Rational BigInt BigInt + + +{-| The biggest number that divides both arguments (the greatest common divisor). +-} +gcd : BigInt -> BigInt -> BigInt +gcd a b = + if b == BigInt.fromInt 0 then + a + else + gcd b (BigInt.mod a b) + +{- Normalisation of rationals with negative denominators + + Rational 1 (-3) becomes Rational (-1) 3 + + Rational (-1) (-3) becomes Rational 1 3 +-} + + +normalize (Rational p q) = + let + k = BigInt.mul + (gcd p q) + (if BigInt.lt q (BigInt.fromInt 0) then + BigInt.fromInt -1 + else + BigInt.fromInt 1 + ) + in + Rational (BigInt.div p k) (BigInt.div q k) + + + +{- Add or subtract two rationals :- + f can be (+) or (-) +-} + + +addsub : (BigInt -> BigInt -> BigInt) -> Rational -> Rational -> Rational +addsub f (Rational a b) (Rational c d) = + normalize (Rational (f (BigInt.mul a d) (BigInt.mul b c)) (BigInt.mul b d)) + + +{-| Addition. It's like gluing together two bars of the given lengths. +-} +add : Rational -> Rational -> Rational +add = + addsub BigInt.add + + +{-| subtraction. Is it like ungluing two bars of the given lengths? +-} +subtract : Rational -> Rational -> Rational +subtract = + addsub BigInt.sub + + +{-| Mulitplication. `mulitply x (c / d)` is the length of the bar that you'd get + if you glued `c` copies of a bar of length `x` end-to-end and then shrunk it + down enough so that `d` copies of the shrunken bar would fit in the big + glued bar. +-} +multiply : Rational -> Rational -> Rational +multiply (Rational a b) (Rational c d) = + normalize (Rational (BigInt.mul a c) (BigInt.mul b d)) + + +{-| Multiply a rational by an BigInt +-} +multiplyByInt : Rational -> BigInt -> Rational +multiplyByInt (Rational a b) i = + normalize (Rational (BigInt.mul a i) b) + + +{-| Divide two rationals +-} +divide : Rational -> Rational -> Rational +divide r (Rational c d) = + multiply r (Rational d c) + + +{-| Divide a rational by an BigInt +-} +divideByInt : Rational -> BigInt -> Rational +divideByInt r i = + normalize (divide r (fromInt i)) + + +{-| Divide an BigInt by a rational +-} +divideIntBy : BigInt -> Rational -> Rational +divideIntBy i r = + normalize (divide (fromInt i) r) + + + +{- This implementation gives the wrong precedence + divideByInt r i = + normalize (multiplyByInt (invert r) i) +-} + + +{-| multiplication by `-1`. +-} +negate : Rational -> Rational +negate (Rational a b) = + Rational (BigInt.negate a) b + + +{-| invert the rational. r becomes 1/r. +-} +invert : Rational -> Rational +invert (Rational a b) = + normalize (Rational b a) + + +{-| `over x y` is like `x / y`. +-} +over : BigInt -> BigInt -> Rational +over x y = + if (BigInt.lt y <| BigInt.fromInt 0) then + normalize (Rational (BigInt.negate x) (BigInt.negate y)) + else + normalize (Rational x y) + + +{-| `fromInt x = over x 1` +-} +fromInt : BigInt -> Rational +fromInt x = + over x (BigInt.fromInt 1) + + +{-| -} +numerator : Rational -> BigInt +numerator (Rational a _) = + a + + +{-| -} +denominator : Rational -> BigInt +denominator (Rational _ b) = + b + + +{-| `split x = (numerator x, denominator x)` +-} +split : Rational -> ( BigInt, BigInt ) +split (Rational a b) = + ( a, b ) + +bigintToFloat : BigInt -> Float +bigintToFloat b = + let res = BigInt.toString b |> String.toInt + in case res of + Ok x -> Basics.toFloat x + Err e -> 0 + +{-| -} +toFloat : Rational -> Float +toFloat (Rational a b) = + bigintToFloat a / bigintToFloat b + + +{-| -} +eq : Rational -> Rational -> Bool +eq a b = + rel (==) a b + + +{-| -} +ne : Rational -> Rational -> Bool +ne a b = + rel (/=) a b + + +{-| -} +gt : Rational -> Rational -> Bool +gt a b = + rel BigInt.gt a b + + +{-| -} +lt : Rational -> Rational -> Bool +lt a b = + rel BigInt.lt a b + + +{-| -} +ge : Rational -> Rational -> Bool +ge a b = + rel BigInt.gte a b + + +{-| -} +le : Rational -> Rational -> Bool +le a b = + rel BigInt.lte a b + + +{-| -} +compare : Rational -> Rational -> Order +compare a b = + Basics.compare (toFloat a) (toFloat b) + + +{-| -} +max : Rational -> Rational -> Rational +max a b = + if gt a b then + a + else + b + + +{-| -} +min : Rational -> Rational -> Rational +min a b = + if lt a b then + a + else + b + + +{-| -} +isZero : Rational -> Bool +isZero r = + (BigInt.fromInt 0) == (numerator r) + + +{-| -} +isInfinite : Rational -> Bool +isInfinite r = + (BigInt.fromInt 0) == (denominator r) + + +{-| -} +round : Rational -> Int +round = + toFloat >> Basics.round + + +{-| -} +floor : Rational -> Int +floor = + toFloat >> Basics.floor + + +{-| -} +ceiling : Rational -> Int +ceiling = + toFloat >> Basics.ceiling + + +{-| -} +truncate : Rational -> Int +truncate = + toFloat >> Basics.truncate + + +rel : (BigInt -> BigInt -> Bool) -> Rational -> Rational -> Bool +rel relop a b = + relop (BigInt.mul (numerator a) (denominator b)) (BigInt.mul (numerator b) (denominator a)) diff --git a/src/Ops.elm b/src/Ops.elm new file mode 100644 index 0000000..b4ceb9d --- /dev/null +++ b/src/Ops.elm @@ -0,0 +1,169 @@ +module Ops exposing (calcOps, opDocs) + +import Numerics exposing (Rational(..)) +import Dict exposing (Dict(..)) +import List.Nonempty as Nonempty exposing (Nonempty(..)) +import Stack exposing (..) +import Eval exposing (Partial, Value(..), Error(..), Op, evalRec, getOps, Context(..), getFlopControl) +import Util exposing (..) +import BigInt exposing (..) +import List.Split as Split + +calcOps : Dict String Op +calcOps = Dict.fromList + [ ("/", binaryRationalOp Numerics.divide) + , ("+", binaryRationalOp Numerics.add) + , ("*", binaryRationalOp Numerics.multiply) + , ("-", binaryRationalOp Numerics.subtract) + , ("neg", unaryRationalOp Numerics.negate) + , ("inv", unaryRationalOp Numerics.invert) + , ("sqrt", unaryFloatOp sqrt) + , ("^", binaryFloatOp (^)) + , ("nth", binaryFloatOp (\x y -> x ^ (1 / y))) + , ("constant.pi", floatConstant pi) + , ("constant.e", floatConstant e) + , ("constant.phi", floatConstant 1.618033988749894848204586834) + , ("run", runPartial) + , ("map", map) + , ("dup", duplicate) + , ("drp", drop) + , ("fld", fold) + , ("ran", range) + , ("y", y) + ] + +opDocs : Dict String String +opDocs = Dict.fromList + [ ("Partial (type)", "Generated when an op would otherwise stack-underflow; the op's name, a capture of the current stack, and the amount of values needed to evaluate.") + , ("Rational (type)", "Basically a fraction. These are used internally for almost all computation.") + , ("Floating Point Accuracy/Precision Adjuster", "This controls the balance between precision and accuracy with floating point conversion. If it is too high, big numbers run through floating-point functions or entered will produce crazy results.") + , ("+", "What do YOU think?") + , ("-", "Destroys the universe.") + , ("/", "Divides x by y.") + , ("*", "Multiplies x by y.") + , ("neg", "Negates x (-x).") + , ("inv", "Reciprocal (1 x /).") + , ("sqrt", "Square root (x 0.5 ^). Uses floats.") + , ("^", "Exponent (x to the power of y). Uses floats.") + , ("nth", "Y-th root of X (x y inv ^). Uses floats") + , ("constant.pi", "π, the ratio of a circle's circumference to its diameter.") + , ("constant.e", "Euler's constant, bizarrely common in lots of maths.") + , ("constant.phi", "The Golden Ratio (1 5 sqrt + 2 /) - also turns up a lot.") + , ("run", "Uses the current stack to attempt to evaluate a Partial.") + , ("map", "Runs a Partial over all other values in the stack.") + , ("dup", "Copies the top item on the stack.") + , ("drp", "Deletes the top item on the stack.") + , ("fld", "Works through the stack top-to-bottom, using a Partial to combine each value it encounters with its accumulator. It returns the accumulator when done.") + , ("ran", "Puts onto the stack all numbers between x and y - inclusive. Uses floats.") + ] + +getNums : List Value -> Int -> Result Error (List Value, Nonempty Numerics.Rational) +getNums stack qty = + let selectRationals = Nonempty.map (\v -> case v of + Rational r -> r + _ -> Numerics.fromInt <| BigInt.fromInt 0) + in + Stack.pick (\v -> case v of + Rational r -> True + _ -> False) stack qty + |> Result.map (\(stack, nums) -> (stack, selectRationals nums)) + |> Result.mapError StackUnderflow + +binaryOp : (Rational -> a) -> (a -> Rational) -> (a -> a -> a) -> Op +binaryOp fromRat toRat f _ stack = + getNums stack 2 + |> Result.map (\(stack, numbers) -> (f (Nonempty.get 0 numbers |> fromRat) (Nonempty.get 1 numbers |> fromRat) |> toRat |> Rational)::stack) + +binaryRationalOp : (Rational -> Rational -> Rational) -> Op +binaryRationalOp = + binaryOp identity identity + +binaryFloatOp : (Float -> Float -> Float) -> Op +binaryFloatOp f ctx = + binaryOp Numerics.toFloat (floatToRatio (getFlopControl ctx)) f ctx + +unaryOp : (Rational -> a) -> (a -> Rational) -> (a -> a) -> Op +unaryOp fromRat toRat f _ stack = + getNums stack 1 + |> Result.map (\(stack, numbers) -> (f (Nonempty.head numbers |> fromRat) |> toRat |> Rational)::stack) + +unaryRationalOp : (Rational -> Rational) -> Op +unaryRationalOp = + unaryOp identity identity + +unaryFloatOp : (Float -> Float) -> Op +unaryFloatOp f ctx = + unaryOp Numerics.toFloat (floatToRatio (getFlopControl ctx)) f ctx + +constant : (a -> Rational) -> a -> Op +constant conv x _ stack = (Rational (conv x))::stack |> Ok + +rationalConstant : Rational -> Op +rationalConstant = + constant identity + +floatConstant : Float -> Op +floatConstant x ctx = constant (floatToRatio (getFlopControl ctx)) x ctx + +filterPartial : Value -> Bool +filterPartial v = case v of + Partial _ -> True + _ -> False + +partialFunction : (List Value -> Context -> Partial -> Result Error (List Value)) -> Op +partialFunction f ctx stack = + Stack.pick filterPartial stack 1 + |> \res -> case res of + Ok (stack, partial) -> case Nonempty.head partial of + Partial p -> + f stack ctx p + _ -> Ok stack + Err e -> StackUnderflow e |> Err + +runPartial : Op +runPartial = + partialFunction (\stack ctx (op, capturedStack, _) -> Eval.runOp ctx op (capturedStack ++ stack)) + +map : Op +map = + partialFunction <| \stack ctx (op, captured, needs) -> + Split.chunksOfLeft needs stack + |> List.map (\args -> Eval.runOp ctx op (args ++ captured)) + |> List.foldl (\output result -> case output of + Ok newStack -> Result.map (\s -> newStack ++ s) result + Err e -> Err e + ) (Ok []) + +duplicate : Op +duplicate ctx stack = + List.head stack + |> Result.fromMaybe (StackUnderflow 1) + |> Result.map (\head -> head::stack) + +drop : Op +drop ctx stack = + Stack.pop stack + |> Result.fromMaybe (StackUnderflow 1) + |> Result.map (\(head, stack) -> stack) + +fold : Op +fold = + partialFunction <| \stack ctx (op, captured, needs) -> + Stack.pop stack + |> Result.fromMaybe (StackUnderflow 1) + |> Result.andThen (\(start, newStack) -> + List.foldl (\x res -> Result.andThen (\accStack -> Eval.runOp ctx op (x::accStack)) res) (Ok [start]) newStack) + +range : Op +range ctx stack = + let + get ix v = Nonempty.get ix v |> Numerics.floor + in + getNums stack 2 + |> Result.map ( + \(newStack, values) -> List.range (get 0 values) (get 1 values) |> List.map (BigInt.fromInt >> Numerics.fromInt >> Rational)) + +y : Op +y = + partialFunction <| \stack ctx (op, captured, needs) -> + Eval.runOp ctx op (Partial ("y", [Partial (op, captured, needs)], 1)::stack) \ No newline at end of file diff --git a/src/Stack.elm b/src/Stack.elm index a2e990f..182e62b 100644 --- a/src/Stack.elm +++ b/src/Stack.elm @@ -20,4 +20,8 @@ pick pred stack qty = |> Result.fromMaybe qty |> Result.map (\v -> (newStack, v)) else - Err <| qty - num \ No newline at end of file + Err <| qty - num + +pop : List a -> Maybe (a, List a) +pop l = + List.head l |> Maybe.map (\h -> (h, List.tail l |> Maybe.withDefault [])) \ No newline at end of file diff --git a/src/Util.elm b/src/Util.elm new file mode 100644 index 0000000..69f099f --- /dev/null +++ b/src/Util.elm @@ -0,0 +1,11 @@ +module Util exposing (..) + +import Numerics exposing (Rational(..)) +import BigInt exposing (BigInt(..)) + +floatToRatio : Int -> Float -> Rational +floatToRatio accuracy f = + let + acc = BigInt.fromInt accuracy + in + Numerics.over (f * Numerics.bigintToFloat acc |> floor |> BigInt.fromInt) acc \ No newline at end of file diff --git a/style.css b/style.css index 4315b85..114dbd3 100644 --- a/style.css +++ b/style.css @@ -6,8 +6,8 @@ } .item { - width: 10vw; - height: 10vw; + min-width: 10em; + min-height: 10em; border: 1px solid black; margin-top: -1px; display: flex; @@ -15,8 +15,78 @@ align-items: center; } +.float-slider { + border: 1px solid lightgray; + margin-left: 0.2em; + margin-right: 0.2em; +} + +.float-slider-label { + display: flex; + align-items: center; +} + +.partial { + text-align: center; + padding: 1em; +} + +.horizontal-center { + display: flex; + justify-content: center; +} + +.partial-stack { + font-size: 0.8em; + padding: 1em; +} + +.formatted-rational { + width: 33%; +} + +hr { + width: 100%; +} + .exprinput { margin-top: 1vh; width: 100%; font-size: 1.2em; +} + +.config-panel { + background: lightgray; + padding: 1em; + margin-top: 1em; +} + +.docs { + text-align: left; + width: 100%; + display: flex; + justify-content: space-around; + margin-top: 3em; + flex-wrap: wrap; +} + +.op { + background: #8cb7c6; + display: flex; + align-items: center; + margin: 1em; + max-width: 40vw; +} + +.op-desc { + padding: 1em; +} + +.op-name { + height: 100%; + display: flex; + align-items: center; + justify-content: center; + padding-left: 1em; + padding-right: 1em; } \ No newline at end of file