Make it actually work

This commit is contained in:
osmarks 2018-03-15 17:40:44 +00:00
parent 876e53428b
commit 778ca0a2b7
9 changed files with 747 additions and 90 deletions

View File

@ -9,10 +9,12 @@
"exposed-modules": [], "exposed-modules": [],
"dependencies": { "dependencies": {
"Bogdanp/elm-combine": "3.1.1 <= v < 4.0.0", "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/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",
"fiatjaf/hashbow-elm": "1.0.0 <= v < 2.0.0",
"gilbertkennen/bigint": "1.0.1 <= 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" "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"

View File

@ -1,25 +1,33 @@
module Eval exposing (..) module Eval exposing (..)
import Expr exposing (..) import Expr exposing (..)
import Ratio exposing (Rational(..)) import Numerics exposing (Rational(..))
import Dict exposing (Dict(..)) import Dict exposing (Dict(..))
import List.Nonempty as Nonempty exposing (Nonempty(..)) import Util exposing (..)
import Stack 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 = type Value =
Rational Rational | Partial Partial Rational Rational | Partial Partial
evalGroup : List Expr -> Result Error (List Value) type Context = Context (Dict String Op) Int
evalGroup g = type alias Op = Context -> List Value -> Result Error (List Value)
List.foldl (\expr result -> Result.andThen (\stack -> evalRec expr stack) result) (Ok []) g
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 anything but a StackUnderflow results, just let it go through.
-- If StackUnderflow occurs, convert it to Partial and push the Partial to stack. -- 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 = handleOpResult opname stack r =
case r of case r of
Ok x -> r Ok x -> r
@ -30,63 +38,33 @@ handleOpResult opname stack r =
|> Ok |> Ok
_ -> r _ -> r
evalRec : Expr -> List Value -> Result Error (List Value) runOp : Context -> String -> List Value -> Result Error (List Value)
evalRec e s = 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 case e of
Num x -> Float x ->
Ratio.fromInt x floatToRatio (getFlopControl ctx) x
|> Rational
|> \v -> v::s
|> Ok
Int x ->
Numerics.fromInt x
|> Rational |> Rational
|> \v -> v::s |> \v -> v::s
|> Ok |> Ok
Group g -> Group g ->
evalGroup g evalGroup ctx g
|> Result.map (\groupStack -> groupStack ++ s) |> Result.map (\groupStack -> groupStack ++ s)
Op o -> Op o ->
case Dict.get o ops of runOp ctx o s
Just opF ->
opF s
|> handleOpResult o s
Nothing -> OpNotFound o |> Err
eval : Expr -> Result Error (List Value) eval : Context -> Expr -> Result Error (List Value)
eval e = eval ctx e =
evalRec e [] evalRec ctx 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"]

View File

@ -1,20 +1,19 @@
module Expr exposing (Expr(..), OpName, parse) module Expr exposing (Expr(..), parse)
import Combine exposing (..) import Combine exposing (..)
import Combine.Num as Num import Combine.Num as Num
import Combine.Char as Char import BigInt exposing (..)
type alias OpName = String
type Expr type Expr
= Num Int = Float Float
| Op OpName | Int BigInt
| Op String
| Group (List Expr) | Group (List Expr)
num : Parser () Expr num : Parser () Expr
num = num =
(Num <$> Num.int) (Float <$> Num.float) <|> (Int << Maybe.withDefault (BigInt.fromInt 0) << BigInt.fromString <$> regex "\\d+")
<?> "expected a number (int)" <?> "expected a number (float or int)"
acceptableOperatorName : Parser () String acceptableOperatorName : Parser () String
acceptableOperatorName = acceptableOperatorName =

View File

@ -3,56 +3,143 @@ module Main exposing (..)
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (..) import Html.Events exposing (..)
import Kintail.InputWidget as Input
import Hashbow
import Expr exposing (Expr(..), OpName) import Expr exposing (Expr(..))
import Eval exposing (eval) 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 } main = Html.beginnerProgram { model = model, update = update, view = view }
type OutputConf = Float | FormattedRational
type alias Model = type alias Model =
{ result : Result String (List Eval.Value) { result : Result Error (List Eval.Value)
, expression : String , expression : String
, outputSetting : OutputConf
, floatingPointControl : Float
} }
model : Model model : Model
model = model =
{ result = Ok [] { result = Ok []
, expression = "" , 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 -> Model
update msg model = 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 >> Result.mapError Eval.prettyPrintError) |> Result.mapError ParseError
|> Result.andThen (eval (Eval.Context calcOps <| toFlopControl model.floatingPointControl))
|> \r -> { model | result = r, expression = str } |> \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 = 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 -- Renders a Value as an item in a stack
stackItem n = stackItem : OutputConf -> Eval.Value -> Html a
let asString = Eval.prettyPrintValue n stackItem conf v =
minWidth = toString (String.length asString) ++ "em" let
in div [class "item", style [("min-width", minWidth)]] [text asString] 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 -> Html Msg
view model = view model =
let calcOutput = let stack =
case model.result of case model.result of
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 model.outputSetting)
Err outputError -> Err outputError ->
[error outputError] [error outputError]
in div [class "rpncalc"] ( in div [class "rpncalc"] (
[ div [] calcOutput [ div [class "stack"] stack
, input [onInput ExpressionTyped, value model.expression, class "exprinput"] [] , 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)
] ]
) )

337
src/Numerics.elm Normal file
View File

@ -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))

169
src/Ops.elm Normal file
View File

@ -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)

View File

@ -21,3 +21,7 @@ pick pred stack qty =
|> Result.map (\v -> (newStack, v)) |> Result.map (\v -> (newStack, v))
else else
Err <| qty - num Err <| qty - num
pop : List a -> Maybe (a, List a)
pop l =
List.head l |> Maybe.map (\h -> (h, List.tail l |> Maybe.withDefault []))

11
src/Util.elm Normal file
View File

@ -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

View File

@ -6,8 +6,8 @@
} }
.item { .item {
width: 10vw; min-width: 10em;
height: 10vw; min-height: 10em;
border: 1px solid black; border: 1px solid black;
margin-top: -1px; margin-top: -1px;
display: flex; display: flex;
@ -15,8 +15,78 @@
align-items: center; 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 { .exprinput {
margin-top: 1vh; margin-top: 1vh;
width: 100%; width: 100%;
font-size: 1.2em; 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;
}