Fix RationalOrder formatting

pull/17/head
Bram 2024-02-15 13:20:25 +01:00
parent 7acae258ed
commit 1940b1d51f
2 changed files with 128 additions and 82 deletions

View File

@ -1,5 +1,9 @@
module Internal.Tools.RationalOrder exposing (..)
{-| # Rational order
{-|
# 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
@ -12,19 +16,23 @@ 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.
-}
@ -32,6 +40,7 @@ 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.
-}
@ -39,6 +48,7 @@ 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.
-}
@ -60,7 +70,7 @@ between x y =
case Basics.compare i1 i2 of
EQ ->
recurseThen ( n1, n2 )
( base << With i1 << Maybe.Just )
(base << With i1 << Maybe.Just)
LT ->
case compare (after o1) o2 of
@ -88,11 +98,12 @@ between x y =
)
( 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
case ( Basics.compare i1 i2, n1, n2 ) of
( EQ, Just o1, Just o2 ) ->
recurse ( o1, o2 )
@ -113,6 +124,7 @@ compare x y =
)
( x, y )
fromList : List Int -> Maybe RationalOrder
fromList =
Recursion.runRecursion
@ -125,6 +137,7 @@ fromList =
recurseThen tail (With head >> Maybe.Just >> base)
)
toList : RationalOrder -> List Int
toList =
Recursion.runRecursion

View File

@ -1,15 +1,17 @@
module Test.Tools.RationalOrder exposing (..)
import Test exposing (..)
import Fuzz exposing (Fuzzer)
import Expect
import Fuzz exposing (Fuzzer)
import Internal.Tools.RationalOrder as RO exposing (RationalOrder(..))
import Test exposing (..)
fuzzer : Fuzzer RationalOrder
fuzzer =
Fuzz.map2 With Fuzz.int (Fuzz.lazy (\_ -> Fuzz.maybe fuzzer))
twoUnequal : Fuzzer (RationalOrder, RationalOrder)
twoUnequal : Fuzzer ( RationalOrder, RationalOrder )
twoUnequal =
fuzzer
|> Fuzz.andThen
@ -18,6 +20,7 @@ twoUnequal =
(\o1 o2 ->
if RO.compare o1 o2 == LT then
( o1, o2 )
else
( o2, o1 )
)
@ -25,81 +28,96 @@ twoUnequal =
(Fuzz.filter ((/=) o) fuzzer)
)
suite : Test
suite =
describe "RationalOrder"
[ describe "Semantic truths"
[ describe "After is always greater"
[ fuzz fuzzer "Forwards"
[ fuzz fuzzer
"Forwards"
(\o ->
Expect.equal LT (RO.compare o (RO.after o))
)
, fuzz fuzzer "Backwards"
, fuzz fuzzer
"Backwards"
(\o ->
Expect.equal GT (RO.compare (RO.after o) o)
)
]
, describe "Before is always lesser"
[ fuzz fuzzer "Forwards"
[ fuzz fuzzer
"Forwards"
(\o ->
Expect.equal GT (RO.compare o (RO.before o))
)
, fuzz fuzzer "Backwards"
, fuzz fuzzer
"Backwards"
(\o ->
Expect.equal LT (RO.compare (RO.before o) o)
)
]
, describe "Two unequal == two unequal"
[ fuzz twoUnequal "Forwards"
(\(small, big) ->
[ fuzz twoUnequal
"Forwards"
(\( small, big ) ->
Expect.equal LT (RO.compare small big)
)
, fuzz twoUnequal "Backwards"
(\(small, big) ->
, fuzz twoUnequal
"Backwards"
(\( small, big ) ->
Expect.equal GT (RO.compare big small)
)
]
, describe "compare"
[ fuzz2 fuzzer fuzzer "EQ iff same value"
[ 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"
, 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 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"
(\() ->
@ -157,49 +175,63 @@ suite =
|> RO.between (With 5 Nothing)
|> Expect.equal (With 4 (Just (With 6 Nothing)))
)
, fuzz2 fuzzer fuzzer "Between is commutative"
, 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"
[ fuzz Fuzz.int
"One more - level 1"
(\a ->
Expect.equal
( RO.after <| With a Nothing )
( With (a + 1) Nothing)
(RO.after <| With a Nothing)
(With (a + 1) Nothing)
)
, fuzz2 Fuzz.int Fuzz.int "One more - level 2"
, 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)
(RO.after <| With a <| Just <| With b Nothing)
(With (a + 1) Nothing)
)
, fuzz3 Fuzz.int Fuzz.int Fuzz.int "One more - level 3"
, 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)
(RO.after <| With a <| Just <| With b <| Just <| With c Nothing)
(With (a + 1) Nothing)
)
]
, describe "Before"
[ fuzz Fuzz.int "One less - level 1"
[ fuzz Fuzz.int
"One less - level 1"
(\a ->
Expect.equal
( RO.before <| With a Nothing )
( With (a - 1) Nothing)
(RO.before <| With a Nothing)
(With (a - 1) Nothing)
)
, fuzz2 Fuzz.int Fuzz.int "One less - level 2"
, 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)
(RO.before <| With a <| Just <| With b Nothing)
(With (a - 1) Nothing)
)
, fuzz3 Fuzz.int Fuzz.int Fuzz.int "One less - level 3"
, 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)
(RO.before <| With a <| Just <| With b <| Just <| With c Nothing)
(With (a - 1) Nothing)
)
]
, describe "Compare vs. list compare"
@ -209,15 +241,16 @@ suite =
"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))
(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"
, 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) )
(RO.compare o1 o2)
(Basics.compare (RO.toList o1) (RO.toList o2))
)
]
]