Make it actually work
This commit is contained in:
parent
876e53428b
commit
778ca0a2b7
@ -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"
|
||||
|
||||
100
src/Eval.elm
100
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"]
|
||||
eval : Context -> Expr -> Result Error (List Value)
|
||||
eval ctx e =
|
||||
evalRec ctx e []
|
||||
15
src/Expr.elm
15
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 =
|
||||
|
||||
121
src/Main.elm
121
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)
|
||||
]
|
||||
)
|
||||
337
src/Numerics.elm
Normal file
337
src/Numerics.elm
Normal 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
169
src/Ops.elm
Normal 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)
|
||||
@ -21,3 +21,7 @@ pick pred stack qty =
|
||||
|> Result.map (\v -> (newStack, v))
|
||||
else
|
||||
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
11
src/Util.elm
Normal 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
|
||||
74
style.css
74
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;
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user