Add RationalOrder type
parent
b6e181237f
commit
d40af28b38
1
elm.json
1
elm.json
|
|
@ -33,6 +33,7 @@
|
|||
"elm/core": "1.0.0 <= v < 2.0.0",
|
||||
"elm/json": "1.0.0 <= v < 2.0.0",
|
||||
"elm/time": "1.0.0 <= v < 2.0.0",
|
||||
"micahhahn/elm-safe-recursion": "2.0.0 <= v < 3.0.0",
|
||||
"miniBill/elm-fast-dict": "1.0.0 <= v < 2.0.0"
|
||||
},
|
||||
"test-dependencies": {
|
||||
|
|
|
|||
|
|
@ -0,0 +1,138 @@
|
|||
module Internal.Tools.RationalOrder exposing (..)
|
||||
{-| # Rational order
|
||||
|
||||
The rational order module simulates the properties of the order of rational
|
||||
numbers: all values have a clear direct ordering, but one can always gain a
|
||||
new number in-between two existing numbers.
|
||||
|
||||
While this property is similarly achievable with floats, the Float type has a
|
||||
precision limit and it is therefor more desirable to achieve the same property
|
||||
using an Elm type that uses Int types for comparison.
|
||||
|
||||
Given the design of the order, the best case comparison design is O(1), and the
|
||||
worst case comparison is O(log(n)). The worst case relies on recursively
|
||||
creating two values a and b, create two new numbers in-between, and repeat.
|
||||
-}
|
||||
|
||||
import Recursion exposing (base, recurse, recurseThen)
|
||||
|
||||
{-| The RationalOrder consists of two items: a number for ordering and a
|
||||
tie-breaking next RationalOrder type for when two RationalOrders have the same
|
||||
number.
|
||||
|
||||
When the next RationalOrder is Nothing, it should be considered -infinite.
|
||||
-}
|
||||
type RationalOrder
|
||||
= With Int (Maybe RationalOrder)
|
||||
|
||||
{-| Find a new value that comes after a given value. For optimization reasons,
|
||||
this will find the nearest number at the highest level.
|
||||
-}
|
||||
after : RationalOrder -> RationalOrder
|
||||
after (With i _) =
|
||||
With (i + 1) Nothing
|
||||
|
||||
{-| Find a new value that comes before a given value. For optimization reasons,
|
||||
this will find the nearest number at the highest level.
|
||||
-}
|
||||
before : RationalOrder -> RationalOrder
|
||||
before (With i _) =
|
||||
With (i - 1) Nothing
|
||||
|
||||
{-| Find a new value in-between two existing values. The inputs don't need to be
|
||||
ordered.
|
||||
-}
|
||||
between : RationalOrder -> RationalOrder -> RationalOrder
|
||||
between x y =
|
||||
Recursion.runRecursion
|
||||
(\orders ->
|
||||
case orders of
|
||||
( Nothing, Nothing ) ->
|
||||
base (With 0 Nothing)
|
||||
|
||||
( Just o1, Nothing ) ->
|
||||
base (before o1)
|
||||
|
||||
( Nothing, Just o2 ) ->
|
||||
base (before o2)
|
||||
|
||||
( Just ((With i1 n1) as o1), Just ((With i2 n2) as o2) ) ->
|
||||
case Basics.compare i1 i2 of
|
||||
EQ ->
|
||||
recurseThen ( n1, n2 )
|
||||
( base << With i1 << Maybe.Just )
|
||||
|
||||
LT ->
|
||||
case compare (after o1) o2 of
|
||||
LT ->
|
||||
base (after o1)
|
||||
|
||||
_ ->
|
||||
Maybe.map after n1
|
||||
|> Maybe.withDefault (With 0 Nothing)
|
||||
|> Maybe.Just
|
||||
|> With i1
|
||||
|> base
|
||||
|
||||
GT ->
|
||||
case compare (after o2) o1 of
|
||||
LT ->
|
||||
base (after o2)
|
||||
|
||||
_ ->
|
||||
Maybe.map after n2
|
||||
|> Maybe.withDefault (With 0 Nothing)
|
||||
|> Maybe.Just
|
||||
|> With i2
|
||||
|> base
|
||||
)
|
||||
( Just x, Just y )
|
||||
|
||||
compare : RationalOrder -> RationalOrder -> Basics.Order
|
||||
compare x y =
|
||||
Recursion.runRecursion
|
||||
(\( With i1 n1, With i2 n2 ) ->
|
||||
case (Basics.compare i1 i2, n1, n2 ) of
|
||||
( EQ, Just o1, Just o2 ) ->
|
||||
recurse ( o1, o2 )
|
||||
|
||||
( EQ, Just _, Nothing ) ->
|
||||
base GT
|
||||
|
||||
( EQ, Nothing, Just _ ) ->
|
||||
base LT
|
||||
|
||||
( EQ, Nothing, Nothing ) ->
|
||||
base EQ
|
||||
|
||||
( LT, _, _ ) ->
|
||||
base LT
|
||||
|
||||
( GT, _, _ ) ->
|
||||
base GT
|
||||
)
|
||||
( x, y )
|
||||
|
||||
fromList : List Int -> Maybe RationalOrder
|
||||
fromList =
|
||||
Recursion.runRecursion
|
||||
(\items ->
|
||||
case items of
|
||||
[] ->
|
||||
base Nothing
|
||||
|
||||
head :: tail ->
|
||||
recurseThen tail (With head >> Maybe.Just >> base)
|
||||
)
|
||||
|
||||
toList : RationalOrder -> List Int
|
||||
toList =
|
||||
Recursion.runRecursion
|
||||
(\(With i next) ->
|
||||
case next of
|
||||
Nothing ->
|
||||
base [ i ]
|
||||
|
||||
Just n ->
|
||||
recurseThen n ((::) i >> base)
|
||||
)
|
||||
|
|
@ -0,0 +1,223 @@
|
|||
module Test.Tools.RationalOrder exposing (..)
|
||||
|
||||
import Test exposing (..)
|
||||
import Fuzz exposing (Fuzzer)
|
||||
import Expect
|
||||
import Internal.Tools.RationalOrder as RO exposing (RationalOrder(..))
|
||||
|
||||
fuzzer : Fuzzer RationalOrder
|
||||
fuzzer =
|
||||
Fuzz.map2 With Fuzz.int (Fuzz.lazy (\_ -> Fuzz.maybe fuzzer))
|
||||
|
||||
twoUnequal : Fuzzer (RationalOrder, RationalOrder)
|
||||
twoUnequal =
|
||||
fuzzer
|
||||
|> Fuzz.andThen
|
||||
(\o ->
|
||||
Fuzz.map2
|
||||
(\o1 o2 ->
|
||||
if RO.compare o1 o2 == LT then
|
||||
( o1, o2 )
|
||||
else
|
||||
( o2, o1 )
|
||||
)
|
||||
(Fuzz.constant o)
|
||||
(Fuzz.filter ((/=) o) fuzzer)
|
||||
)
|
||||
|
||||
suite : Test
|
||||
suite =
|
||||
describe "RationalOrder"
|
||||
[ describe "Semantic truths"
|
||||
[ describe "After is always greater"
|
||||
[ fuzz fuzzer "Forwards"
|
||||
(\o ->
|
||||
Expect.equal LT (RO.compare o (RO.after o))
|
||||
)
|
||||
, fuzz fuzzer "Backwards"
|
||||
(\o ->
|
||||
Expect.equal GT (RO.compare (RO.after o) o)
|
||||
)
|
||||
]
|
||||
, describe "Before is always lesser"
|
||||
[ fuzz fuzzer "Forwards"
|
||||
(\o ->
|
||||
Expect.equal GT (RO.compare o (RO.before o))
|
||||
)
|
||||
, fuzz fuzzer "Backwards"
|
||||
(\o ->
|
||||
Expect.equal LT (RO.compare (RO.before o) o)
|
||||
)
|
||||
]
|
||||
, describe "Two unequal == two unequal"
|
||||
[ fuzz twoUnequal "Forwards"
|
||||
(\(small, big) ->
|
||||
Expect.equal LT (RO.compare small big)
|
||||
)
|
||||
, fuzz twoUnequal "Backwards"
|
||||
(\(small, big) ->
|
||||
Expect.equal GT (RO.compare big small)
|
||||
)
|
||||
]
|
||||
, describe "compare"
|
||||
[ fuzz2 fuzzer fuzzer "EQ iff same value"
|
||||
(\o1 o2 ->
|
||||
Expect.equal
|
||||
(o1 == o2)
|
||||
(RO.compare o1 o2 == EQ)
|
||||
)
|
||||
, fuzz2 fuzzer fuzzer "LT iff opposite GT"
|
||||
(\o1 o2 ->
|
||||
Expect.equal
|
||||
(RO.compare o1 o2 == LT)
|
||||
(RO.compare o2 o1 == GT)
|
||||
)
|
||||
]
|
||||
, describe "Between is always between"
|
||||
[ fuzz twoUnequal "Less than first - forwards"
|
||||
(\(small, big) ->
|
||||
(RO.between small big)
|
||||
|> RO.compare small
|
||||
|> Expect.equal LT
|
||||
)
|
||||
, fuzz twoUnequal "Less than first - backwards"
|
||||
(\(small, big) ->
|
||||
small
|
||||
|> RO.compare (RO.between small big)
|
||||
|> Expect.equal GT
|
||||
)
|
||||
, fuzz twoUnequal "Less than second - forwards"
|
||||
(\(small, big) ->
|
||||
RO.between small big
|
||||
|> RO.compare big
|
||||
|> Expect.equal GT
|
||||
)
|
||||
, fuzz twoUnequal "Less than second - backwards"
|
||||
(\(small, big) ->
|
||||
big
|
||||
|> RO.compare (RO.between small big)
|
||||
|> Expect.equal LT
|
||||
)
|
||||
]
|
||||
]
|
||||
, describe "Between creates between"
|
||||
[ test "With 0 Nothing <--> With 1 Nothing"
|
||||
(\() ->
|
||||
RO.between (With 0 Nothing) (With 1 Nothing)
|
||||
|> Expect.equal (With 0 (Just (With 0 Nothing)))
|
||||
)
|
||||
, test "With 1 Nothing <--> With 0 Nothing"
|
||||
(\() ->
|
||||
RO.between (With 1 Nothing) (With 0 Nothing)
|
||||
|> Expect.equal (With 0 (Just (With 0 Nothing)))
|
||||
)
|
||||
, test "With 0 is filled between With 1 Nothing"
|
||||
(\() ->
|
||||
With 0 Nothing
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> Expect.equal (With 0 (Just (With 5 Nothing)))
|
||||
)
|
||||
, test "Will start counting high level as soon as possible"
|
||||
(\() ->
|
||||
With 0 Nothing
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 5 Nothing)
|
||||
|> RO.between (With 5 Nothing)
|
||||
|> Expect.equal (With 2 Nothing)
|
||||
)
|
||||
, test "Will start counting high level, then return lower level"
|
||||
(\() ->
|
||||
With 0 Nothing
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 1 Nothing)
|
||||
|> RO.between (With 5 Nothing)
|
||||
|> RO.between (With 5 Nothing)
|
||||
|> RO.between (With 5 Nothing)
|
||||
|> RO.between (With 5 Nothing)
|
||||
|> RO.between (With 5 Nothing)
|
||||
|> RO.between (With 5 Nothing)
|
||||
|> RO.between (With 5 Nothing)
|
||||
|> RO.between (With 5 Nothing)
|
||||
|> RO.between (With 5 Nothing)
|
||||
|> RO.between (With 5 Nothing)
|
||||
|> RO.between (With 5 Nothing)
|
||||
|> Expect.equal (With 4 (Just (With 6 Nothing)))
|
||||
)
|
||||
, fuzz2 fuzzer fuzzer "Between is commutative"
|
||||
(\o1 o2 ->
|
||||
Expect.equal (RO.between o1 o2) (RO.between o2 o1)
|
||||
)
|
||||
]
|
||||
, describe "After"
|
||||
[ fuzz Fuzz.int "One more - level 1"
|
||||
(\a ->
|
||||
Expect.equal
|
||||
( RO.after <| With a Nothing )
|
||||
( With (a + 1) Nothing)
|
||||
)
|
||||
, fuzz2 Fuzz.int Fuzz.int "One more - level 2"
|
||||
(\a b ->
|
||||
Expect.equal
|
||||
( RO.after <| With a <| Just <| With b Nothing )
|
||||
( With (a + 1) Nothing)
|
||||
)
|
||||
, fuzz3 Fuzz.int Fuzz.int Fuzz.int "One more - level 3"
|
||||
(\a b c ->
|
||||
Expect.equal
|
||||
( RO.after <| With a <| Just <| With b <| Just <| With c Nothing )
|
||||
( With (a + 1) Nothing)
|
||||
)
|
||||
]
|
||||
, describe "Before"
|
||||
[ fuzz Fuzz.int "One less - level 1"
|
||||
(\a ->
|
||||
Expect.equal
|
||||
( RO.before <| With a Nothing )
|
||||
( With (a - 1) Nothing)
|
||||
)
|
||||
, fuzz2 Fuzz.int Fuzz.int "One less - level 2"
|
||||
(\a b ->
|
||||
Expect.equal
|
||||
( RO.before <| With a <| Just <| With b Nothing )
|
||||
( With (a - 1) Nothing)
|
||||
)
|
||||
, fuzz3 Fuzz.int Fuzz.int Fuzz.int "One less - level 3"
|
||||
(\a b c ->
|
||||
Expect.equal
|
||||
( RO.before <| With a <| Just <| With b <| Just <| With c Nothing )
|
||||
( With (a - 1) Nothing)
|
||||
)
|
||||
]
|
||||
, describe "Compare vs. list compare"
|
||||
[ fuzz2
|
||||
(Fuzz.listOfLengthBetween 1 32 Fuzz.int)
|
||||
(Fuzz.listOfLengthBetween 1 32 Fuzz.int)
|
||||
"Compares the same between normal lists and orders"
|
||||
(\l1 l2 ->
|
||||
Expect.equal
|
||||
( Just <| Basics.compare l1 l2 )
|
||||
( Maybe.map2 RO.compare (RO.fromList l1) (RO.fromList l2))
|
||||
)
|
||||
, fuzz2 fuzzer fuzzer "Compares the same when converted to list"
|
||||
(\o1 o2 ->
|
||||
Expect.equal
|
||||
( RO.compare o1 o2 )
|
||||
( Basics.compare (RO.toList o1) (RO.toList o2) )
|
||||
)
|
||||
]
|
||||
]
|
||||
|
||||
Loading…
Reference in New Issue