{-
 -      ``Data/Random/Internal/Find''
 -  Utilities for searching fractional domains.  Needs cleanup, testing,
 -  and such.  Used for constructing generic ziggurats.
 -}

module Data.Random.Internal.Find where

findMax :: (Fractional a, Ord a) => (a -> Bool) -> a
findMax :: forall a. (Fractional a, Ord a) => (a -> Bool) -> a
findMax a -> Bool
p = forall a. Num a => a -> a
negate (forall a. (Fractional a, Ord a) => (a -> Bool) -> a
findMin (a -> Bool
pforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Num a => a -> a
negate))

-- |Given an upward-closed predicate on an ordered Fractional type,
-- find the smallest value satisfying the predicate.
findMin :: (Fractional a, Ord a) => (a -> Bool) -> a
findMin :: forall a. (Fractional a, Ord a) => (a -> Bool) -> a
findMin = forall a. (Fractional a, Ord a) => a -> a -> (a -> Bool) -> a
findMinFrom a
0 a
1

-- |Given an upward-closed predicate on an ordered Fractional type,
-- find the smallest value satisfying the predicate.  Starts at the
-- specified point with the specified stepsize, performs an exponential
-- search out from there until it finds an interval bracketing the
-- change-point of the predicate, and then performs a bisection search
-- to isolate the change point.  Note that infinitely-divisible domains
-- such as 'Rational' cannot be searched by this function because it does
-- not terminate until it reaches a point where further subdivision of the
-- interval has no effect.
findMinFrom :: (Fractional a, Ord a) => a -> a -> (a -> Bool) -> a
findMinFrom :: forall a. (Fractional a, Ord a) => a -> a -> (a -> Bool) -> a
findMinFrom a
z0 a
0 a -> Bool
p = forall a. (Fractional a, Ord a) => a -> a -> (a -> Bool) -> a
findMinFrom a
z0 a
1 a -> Bool
p
findMinFrom a
z0 a
step1 a -> Bool
p
    | a -> Bool
p a
z0      = a -> a -> a
descend (a
z0forall a. Num a => a -> a -> a
-a
step1) a
z0
    | Bool
otherwise = forall {a}. (Eq a, Num a) => a -> a
fixZero (a -> a -> a
ascend a
z0 (a
z0forall a. Num a => a -> a -> a
+a
step1))
    where
        -- eliminate negative zero, which, in many domains, is technically
        -- a feasible answer
        fixZero :: a -> a
fixZero a
0 = a
0
        fixZero a
z = a
z

        -- preconditions:
        -- not (p l)
        -- 0 <= l < x
        ascend :: a -> a -> a
ascend a
l a
x
            | a -> Bool
p a
x       = a -> a -> a
bisect a
l a
x
            | Bool
otherwise = a -> a -> a
ascend a
x forall a b. (a -> b) -> a -> b
$! a
2forall a. Num a => a -> a -> a
*a
xforall a. Num a => a -> a -> a
-a
z0

        -- preconditions:
        -- p h
        -- x < h <= 0
        descend :: a -> a -> a
descend a
x a
h
            | a -> Bool
p a
x       = (a -> a -> a
descend forall a b. (a -> b) -> a -> b
$! a
2forall a. Num a => a -> a -> a
*a
xforall a. Num a => a -> a -> a
-a
z0) a
x
            | Bool
otherwise = a -> a -> a
bisect a
x a
h

        -- preconditions:
        -- not (p l)
        -- p h
        -- l <= h
        bisect :: a -> a -> a
bisect a
l a
h
            | a
l forall {a}. Ord a => a -> a -> Bool
/< a
h    = a
h
            | a
l forall {a}. Ord a => a -> a -> Bool
/< a
mid Bool -> Bool -> Bool
|| a
mid forall {a}. Ord a => a -> a -> Bool
/< a
h
            = if a -> Bool
p a
mid then a
mid else a
h
            | a -> Bool
p a
mid     = a -> a -> a
bisect a
l a
mid
            | Bool
otherwise = a -> a -> a
bisect a
mid a
h
            where
                a
a /< :: a -> a -> Bool
/< a
b = Bool -> Bool
not (a
a forall {a}. Ord a => a -> a -> Bool
< a
b)
                mid :: a
mid = (a
lforall a. Num a => a -> a -> a
+a
h)forall a. Num a => a -> a -> a
*a
0.5