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 (..) module Internal.Tools.RationalOrder exposing (..)
{-| # Rational order
{-|
# Rational order
The rational order module simulates the properties of the order of rational 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 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 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 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. creating two values a and b, create two new numbers in-between, and repeat.
-} -}
import Recursion exposing (base, recurse, recurseThen) import Recursion exposing (base, recurse, recurseThen)
{-| The RationalOrder consists of two items: a number for ordering and a {-| The RationalOrder consists of two items: a number for ordering and a
tie-breaking next RationalOrder type for when two RationalOrders have the same tie-breaking next RationalOrder type for when two RationalOrders have the same
number. number.
When the next RationalOrder is Nothing, it should be considered -infinite. When the next RationalOrder is Nothing, it should be considered -infinite.
-} -}
type RationalOrder type RationalOrder
= With Int (Maybe RationalOrder) = With Int (Maybe RationalOrder)
{-| Find a new value that comes after a given value. For optimization reasons, {-| Find a new value that comes after a given value. For optimization reasons,
this will find the nearest number at the highest level. this will find the nearest number at the highest level.
-} -}
@ -32,6 +40,7 @@ after : RationalOrder -> RationalOrder
after (With i _) = after (With i _) =
With (i + 1) Nothing With (i + 1) Nothing
{-| Find a new value that comes before a given value. For optimization reasons, {-| Find a new value that comes before a given value. For optimization reasons,
this will find the nearest number at the highest level. this will find the nearest number at the highest level.
-} -}
@ -39,6 +48,7 @@ before : RationalOrder -> RationalOrder
before (With i _) = before (With i _) =
With (i - 1) Nothing With (i - 1) Nothing
{-| Find a new value in-between two existing values. The inputs don't need to be {-| Find a new value in-between two existing values. The inputs don't need to be
ordered. ordered.
-} -}
@ -49,36 +59,36 @@ between x y =
case orders of case orders of
( Nothing, Nothing ) -> ( Nothing, Nothing ) ->
base (With 0 Nothing) base (With 0 Nothing)
( Just o1, Nothing ) -> ( Just o1, Nothing ) ->
base (before o1) base (before o1)
( Nothing, Just o2 ) -> ( Nothing, Just o2 ) ->
base (before o2) base (before o2)
( Just ((With i1 n1) as o1), Just ((With i2 n2) as o2) ) -> ( Just ((With i1 n1) as o1), Just ((With i2 n2) as o2) ) ->
case Basics.compare i1 i2 of case Basics.compare i1 i2 of
EQ -> EQ ->
recurseThen ( n1, n2 ) recurseThen ( n1, n2 )
( base << With i1 << Maybe.Just ) (base << With i1 << Maybe.Just)
LT -> LT ->
case compare (after o1) o2 of case compare (after o1) o2 of
LT -> LT ->
base (after o1) base (after o1)
_ -> _ ->
Maybe.map after n1 Maybe.map after n1
|> Maybe.withDefault (With 0 Nothing) |> Maybe.withDefault (With 0 Nothing)
|> Maybe.Just |> Maybe.Just
|> With i1 |> With i1
|> base |> base
GT -> GT ->
case compare (after o2) o1 of case compare (after o2) o1 of
LT -> LT ->
base (after o2) base (after o2)
_ -> _ ->
Maybe.map after n2 Maybe.map after n2
|> Maybe.withDefault (With 0 Nothing) |> Maybe.withDefault (With 0 Nothing)
@ -88,31 +98,33 @@ between x y =
) )
( Just x, Just y ) ( Just x, Just y )
compare : RationalOrder -> RationalOrder -> Basics.Order compare : RationalOrder -> RationalOrder -> Basics.Order
compare x y = compare x y =
Recursion.runRecursion Recursion.runRecursion
(\( With i1 n1, With i2 n2 ) -> (\( 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 ) -> ( EQ, Just o1, Just o2 ) ->
recurse ( o1, o2 ) recurse ( o1, o2 )
( EQ, Just _, Nothing ) -> ( EQ, Just _, Nothing ) ->
base GT base GT
( EQ, Nothing, Just _ ) -> ( EQ, Nothing, Just _ ) ->
base LT base LT
( EQ, Nothing, Nothing ) -> ( EQ, Nothing, Nothing ) ->
base EQ base EQ
( LT, _, _ ) -> ( LT, _, _ ) ->
base LT base LT
( GT, _, _ ) -> ( GT, _, _ ) ->
base GT base GT
) )
( x, y ) ( x, y )
fromList : List Int -> Maybe RationalOrder fromList : List Int -> Maybe RationalOrder
fromList = fromList =
Recursion.runRecursion Recursion.runRecursion
@ -120,11 +132,12 @@ fromList =
case items of case items of
[] -> [] ->
base Nothing base Nothing
head :: tail -> head :: tail ->
recurseThen tail (With head >> Maybe.Just >> base) recurseThen tail (With head >> Maybe.Just >> base)
) )
toList : RationalOrder -> List Int toList : RationalOrder -> List Int
toList = toList =
Recursion.runRecursion Recursion.runRecursion
@ -132,7 +145,7 @@ toList =
case next of case next of
Nothing -> Nothing ->
base [ i ] base [ i ]
Just n -> Just n ->
recurseThen n ((::) i >> base) recurseThen n ((::) i >> base)
) )

View File

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