Make it actually work
This commit is contained in:
		| @@ -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; | ||||
| } | ||||
		Reference in New Issue
	
	Block a user