diff --git a/elm.json b/elm.json index 4085353..c899358 100644 --- a/elm.json +++ b/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": { diff --git a/src/Internal/Tools/RationalOrder.elm b/src/Internal/Tools/RationalOrder.elm new file mode 100644 index 0000000..c61b147 --- /dev/null +++ b/src/Internal/Tools/RationalOrder.elm @@ -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) + ) \ No newline at end of file diff --git a/tests/Test/Tools/RationalOrder.elm b/tests/Test/Tools/RationalOrder.elm new file mode 100644 index 0000000..a7cdec2 --- /dev/null +++ b/tests/Test/Tools/RationalOrder.elm @@ -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) ) + ) + ] + ] +