From 3174b0c4bb5c1997b42cbed8a0de2b4063df785c Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Wed, 1 Jul 2020 21:25:24 +0100 Subject: [PATCH 1/4] Add UniformRange.isInRange function --- src/System/Random/Internal.hs | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index be879949..170cca72 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -597,9 +597,44 @@ class UniformRange a where -- -- > uniformRM (a, b) = uniformRM (b, a) -- + -- The range is understood as defined by means of 'isInRange', so + -- + -- > isInRange (a, b) <$> uniformRM (a, b) gen == pure True + -- + -- but beware of + -- [floating point number caveats](System-Random-Stateful.html#fpcaveats). + -- -- @since 1.2.0 uniformRM :: StatefulGen g m => (a, a) -> g -> m a + -- | A notion of (inclusive) ranges prescribed to @a@. + -- + -- Ranges are symmetric: + -- + -- > isInRange (lo, hi) x == isInRange (hi, lo) x + -- + -- Ranges include their endpoints: + -- + -- > isInRange (lo, hi) lo == True + -- + -- Ranges are transitive relations: + -- + -- > isInRange (lo, hi) mid && isInRange (lo, mid) x ==> isInRange (lo, hi) x + -- + -- Ranges are injective (up to symmetry), which means that + -- ranges between different endpoints cannot be the same: + -- + -- > (a, b) == (c, d) || (a, b) == (d, c) || + -- > there exists x such that + -- > isInRange (a, b) x && not (isInRange (c, d) x) + -- > || isInRange (c, d) x && not (isInRange (a, b) x) + -- + -- @since 1.3.0 + isInRange :: (a, a) -> a -> Bool + + default isInRange :: Ord a => (a, a) -> a -> Bool + isInRange (a, b) x = min a b <= x && x <= max a b + instance UniformRange Integer where uniformRM = uniformIntegralM From 3278904ebd2202126edffe62fa395aba2be88fbc Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Mon, 7 Dec 2020 07:23:02 +0000 Subject: [PATCH 2/4] Update laws for isInRange --- src/System/Random/Internal.hs | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index 170cca72..e53dc025 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -617,17 +617,14 @@ class UniformRange a where -- -- > isInRange (lo, hi) lo == True -- - -- Ranges are transitive relations: + -- When endpoints coincide, there is nothing else: -- - -- > isInRange (lo, hi) mid && isInRange (lo, mid) x ==> isInRange (lo, hi) x + -- > isInRange (x, x) y == x == y -- - -- Ranges are injective (up to symmetry), which means that - -- ranges between different endpoints cannot be the same: + -- Ranges are transitive relations: -- - -- > (a, b) == (c, d) || (a, b) == (d, c) || - -- > there exists x such that - -- > isInRange (a, b) x && not (isInRange (c, d) x) - -- > || isInRange (c, d) x && not (isInRange (a, b) x) + -- > isInRange (lo, hi) lo' && isInRange (lo, hi) hi' && + -- > && isInRange (lo', hi') x ==> isInRange (lo, hi) x -- -- @since 1.3.0 isInRange :: (a, a) -> a -> Bool From a663ea0a2df6e9bc2033812f8320178a9a51bc6b Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Mon, 18 Jan 2021 18:34:33 +0000 Subject: [PATCH 3/4] Add a law about endpoints --- src/System/Random/Internal.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index e53dc025..2b663518 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -621,6 +621,11 @@ class UniformRange a where -- -- > isInRange (x, x) y == x == y -- + -- Endpoints are endpoints: + -- + -- > isInRange (lo, hi) x ==> + -- > isInRange (lo, x) hi == x == hi + -- -- Ranges are transitive relations: -- -- > isInRange (lo, hi) lo' && isInRange (lo, hi) hi' && From 781e516dbfc629ca7ffa533a47fb4b1a679c3646 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Thu, 21 Jan 2021 19:22:54 +0000 Subject: [PATCH 4/4] Update src/System/Random/Internal.hs Co-authored-by: Leonhard Markert --- src/System/Random/Internal.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index 2b663518..408617e1 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -628,8 +628,8 @@ class UniformRange a where -- -- Ranges are transitive relations: -- - -- > isInRange (lo, hi) lo' && isInRange (lo, hi) hi' && - -- > && isInRange (lo', hi') x ==> isInRange (lo, hi) x + -- > isInRange (lo, hi) lo' && isInRange (lo, hi) hi' && isInRange (lo', hi') x + -- > ==> isInRange (lo, hi) x -- -- @since 1.3.0 isInRange :: (a, a) -> a -> Bool