{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Algorithms.BinarySearch
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
--------------------------------------------------------------------------------
module HGeometry.Algorithms.BinarySearch
  ( -- * Generic Binary Search algorithms
    binarySearchFirst
  , binarySearchLast
  , binarySearchUntil

  , BinarySearchResult(..)
  , firstTrue, lastFalse

  ,  BinarySearch(..)
  , binarySearchFirstIn, binarySearchFirstIdxIn
  , binarySearchLastIn, binarySearchLastIdxIn
  ) where

import           Data.Kind
import           Data.Sequence (Seq, ViewL(..),ViewR(..))
import qualified Data.Sequence as Seq
import           Data.Set (Set)
import qualified Data.Set.Internal as Set
import qualified Data.Vector.Generic as V
--------------------------------------------------------------------------------

-- | Given a monotonic predicate p, a lower bound l, and an upper bound u, with:
--  p l = False
--  p u = True
--  l < u.
--
-- Get the index h such that:
--
-- - all indices i <  h have p i = False, and
-- - all indices i >= h have p i = True
--
--
-- That is, find the first index h for which the predicate is True.
--
-- running time: \(O(\log(u - l))\)
{-# SPECIALIZE binarySearchFirst :: (Int -> Bool) -> Int -> Int -> Int #-}
{-# SPECIALIZE binarySearchFirst :: (Word -> Bool) -> Word -> Word -> Word #-}
binarySearchFirst   :: Integral a => (a -> Bool) -> a -> a -> a
binarySearchFirst :: forall a. Integral a => (a -> Bool) -> a -> a -> a
binarySearchFirst a -> Bool
p = a -> a -> a
go
  where
    go :: a -> a -> a
go a
l a
u = let d :: a
d = a
u a -> a -> a
forall a. Num a => a -> a -> a
- a
l
                 m :: a
m = a
l a -> a -> a
forall a. Num a => a -> a -> a
+ (a
d a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2)
             in if a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 then a
u else if a -> Bool
p a
m then a -> a -> a
go a
l a
m
                                             else a -> a -> a
go a
m a
u

-- | Given a monotonic predicate p, a lower bound l, and an upper bound u, with:
--  p l = False
--  p u = True
--  l < u.
--
-- Get the index h such that:
--
-- - all indices i <= h have p i = False, and
-- - all indices i >  h have p i = True
--
-- That is, find the last index h for which the predicate is False.
--
-- running time: \(O(\log(u - l))\)
{-# SPECIALIZE binarySearchLast :: (Int -> Bool) -> Int -> Int -> Int #-}
{-# SPECIALIZE binarySearchLast :: (Word -> Bool) -> Word -> Word -> Word #-}
binarySearchLast       :: (Integral a) => (a -> Bool) -> a -> a -> a
binarySearchLast :: forall a. Integral a => (a -> Bool) -> a -> a -> a
binarySearchLast a -> Bool
p a
l a
u = ((a -> Bool) -> a -> a -> a
forall a. Integral a => (a -> Bool) -> a -> a -> a
binarySearchFirst a -> Bool
p a
l a
u) a -> a -> a
forall a. Num a => a -> a -> a
- a
1

--------------------------------------------------------------------------------

-- | Given a value \(\varepsilon\), a monotone predicate \(p\), and two values \(l\) and
-- \(u\) with:
--
-- - \(p l\) = False
-- - \(p u\) = True
-- - \(l < u\)
--
-- we find a value \(h\) such that:
--
-- - \(p h\) = True
-- - \(p (h - \varepsilon)\) = False
--
-- >>> binarySearchUntil (0.1) (>= 0.5) 0 (1 :: Double)
-- 0.5
-- >>> binarySearchUntil (0.1) (>= 0.51) 0 (1 :: Double)
-- 0.5625
-- >>> binarySearchUntil (0.01) (>= 0.51) 0 (1 :: Double)
-- 0.515625
binarySearchUntil       :: (Fractional r, Ord r)
                        => r
                        -> (r -> Bool) -> r -> r -> r
binarySearchUntil :: forall r. (Fractional r, Ord r) => r -> (r -> Bool) -> r -> r -> r
binarySearchUntil r
eps r -> Bool
p = r -> r -> r
go
  where
    go :: r -> r -> r
go r
l r
u | r
u r -> r -> r
forall a. Num a => a -> a -> a
- r
l r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< r
eps = r
u
           | Bool
otherwise   = let m :: r
m = (r
l r -> r -> r
forall a. Num a => a -> a -> a
+ r
u) r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
2
                           in if r -> Bool
p r
m then r -> r -> r
go r
l r
m else r -> r -> r
go r
m r
u
{-# INLINABLE binarySearchUntil #-}


--------------------------------------------------------------------------------
-- * Binary Searching in some data structure

-- | Data type representing the result of a binary search
data BinarySearchResult a = AllTrue a
                          | FlipsAt a a -- ^ the last false elem and the first true elem
                          | AllFalse (Maybe a) -- ^ A maybe, since the collection may be empty
                          deriving (Int -> BinarySearchResult a -> ShowS
[BinarySearchResult a] -> ShowS
BinarySearchResult a -> String
(Int -> BinarySearchResult a -> ShowS)
-> (BinarySearchResult a -> String)
-> ([BinarySearchResult a] -> ShowS)
-> Show (BinarySearchResult a)
forall a. Show a => Int -> BinarySearchResult a -> ShowS
forall a. Show a => [BinarySearchResult a] -> ShowS
forall a. Show a => BinarySearchResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> BinarySearchResult a -> ShowS
showsPrec :: Int -> BinarySearchResult a -> ShowS
$cshow :: forall a. Show a => BinarySearchResult a -> String
show :: BinarySearchResult a -> String
$cshowList :: forall a. Show a => [BinarySearchResult a] -> ShowS
showList :: [BinarySearchResult a] -> ShowS
Show,BinarySearchResult a -> BinarySearchResult a -> Bool
(BinarySearchResult a -> BinarySearchResult a -> Bool)
-> (BinarySearchResult a -> BinarySearchResult a -> Bool)
-> Eq (BinarySearchResult a)
forall a.
Eq a =>
BinarySearchResult a -> BinarySearchResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
BinarySearchResult a -> BinarySearchResult a -> Bool
== :: BinarySearchResult a -> BinarySearchResult a -> Bool
$c/= :: forall a.
Eq a =>
BinarySearchResult a -> BinarySearchResult a -> Bool
/= :: BinarySearchResult a -> BinarySearchResult a -> Bool
Eq,(forall a b.
 (a -> b) -> BinarySearchResult a -> BinarySearchResult b)
-> (forall a b. a -> BinarySearchResult b -> BinarySearchResult a)
-> Functor BinarySearchResult
forall a b. a -> BinarySearchResult b -> BinarySearchResult a
forall a b.
(a -> b) -> BinarySearchResult a -> BinarySearchResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> BinarySearchResult a -> BinarySearchResult b
fmap :: forall a b.
(a -> b) -> BinarySearchResult a -> BinarySearchResult b
$c<$ :: forall a b. a -> BinarySearchResult b -> BinarySearchResult a
<$ :: forall a b. a -> BinarySearchResult b -> BinarySearchResult a
Functor,(forall m. Monoid m => BinarySearchResult m -> m)
-> (forall m a. Monoid m => (a -> m) -> BinarySearchResult a -> m)
-> (forall m a. Monoid m => (a -> m) -> BinarySearchResult a -> m)
-> (forall a b. (a -> b -> b) -> b -> BinarySearchResult a -> b)
-> (forall a b. (a -> b -> b) -> b -> BinarySearchResult a -> b)
-> (forall b a. (b -> a -> b) -> b -> BinarySearchResult a -> b)
-> (forall b a. (b -> a -> b) -> b -> BinarySearchResult a -> b)
-> (forall a. (a -> a -> a) -> BinarySearchResult a -> a)
-> (forall a. (a -> a -> a) -> BinarySearchResult a -> a)
-> (forall a. BinarySearchResult a -> [a])
-> (forall a. BinarySearchResult a -> Bool)
-> (forall a. BinarySearchResult a -> Int)
-> (forall a. Eq a => a -> BinarySearchResult a -> Bool)
-> (forall a. Ord a => BinarySearchResult a -> a)
-> (forall a. Ord a => BinarySearchResult a -> a)
-> (forall a. Num a => BinarySearchResult a -> a)
-> (forall a. Num a => BinarySearchResult a -> a)
-> Foldable BinarySearchResult
forall a. Eq a => a -> BinarySearchResult a -> Bool
forall a. Num a => BinarySearchResult a -> a
forall a. Ord a => BinarySearchResult a -> a
forall m. Monoid m => BinarySearchResult m -> m
forall a. BinarySearchResult a -> Bool
forall a. BinarySearchResult a -> Int
forall a. BinarySearchResult a -> [a]
forall a. (a -> a -> a) -> BinarySearchResult a -> a
forall m a. Monoid m => (a -> m) -> BinarySearchResult a -> m
forall b a. (b -> a -> b) -> b -> BinarySearchResult a -> b
forall a b. (a -> b -> b) -> b -> BinarySearchResult a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => BinarySearchResult m -> m
fold :: forall m. Monoid m => BinarySearchResult m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> BinarySearchResult a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> BinarySearchResult a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> BinarySearchResult a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> BinarySearchResult a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> BinarySearchResult a -> b
foldr :: forall a b. (a -> b -> b) -> b -> BinarySearchResult a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> BinarySearchResult a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> BinarySearchResult a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> BinarySearchResult a -> b
foldl :: forall b a. (b -> a -> b) -> b -> BinarySearchResult a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> BinarySearchResult a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> BinarySearchResult a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> BinarySearchResult a -> a
foldr1 :: forall a. (a -> a -> a) -> BinarySearchResult a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> BinarySearchResult a -> a
foldl1 :: forall a. (a -> a -> a) -> BinarySearchResult a -> a
$ctoList :: forall a. BinarySearchResult a -> [a]
toList :: forall a. BinarySearchResult a -> [a]
$cnull :: forall a. BinarySearchResult a -> Bool
null :: forall a. BinarySearchResult a -> Bool
$clength :: forall a. BinarySearchResult a -> Int
length :: forall a. BinarySearchResult a -> Int
$celem :: forall a. Eq a => a -> BinarySearchResult a -> Bool
elem :: forall a. Eq a => a -> BinarySearchResult a -> Bool
$cmaximum :: forall a. Ord a => BinarySearchResult a -> a
maximum :: forall a. Ord a => BinarySearchResult a -> a
$cminimum :: forall a. Ord a => BinarySearchResult a -> a
minimum :: forall a. Ord a => BinarySearchResult a -> a
$csum :: forall a. Num a => BinarySearchResult a -> a
sum :: forall a. Num a => BinarySearchResult a -> a
$cproduct :: forall a. Num a => BinarySearchResult a -> a
product :: forall a. Num a => BinarySearchResult a -> a
Foldable,Functor BinarySearchResult
Foldable BinarySearchResult
(Functor BinarySearchResult, Foldable BinarySearchResult) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> BinarySearchResult a -> f (BinarySearchResult b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    BinarySearchResult (f a) -> f (BinarySearchResult a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> BinarySearchResult a -> m (BinarySearchResult b))
-> (forall (m :: * -> *) a.
    Monad m =>
    BinarySearchResult (m a) -> m (BinarySearchResult a))
-> Traversable BinarySearchResult
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
BinarySearchResult (m a) -> m (BinarySearchResult a)
forall (f :: * -> *) a.
Applicative f =>
BinarySearchResult (f a) -> f (BinarySearchResult a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BinarySearchResult a -> m (BinarySearchResult b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinarySearchResult a -> f (BinarySearchResult b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinarySearchResult a -> f (BinarySearchResult b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinarySearchResult a -> f (BinarySearchResult b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
BinarySearchResult (f a) -> f (BinarySearchResult a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
BinarySearchResult (f a) -> f (BinarySearchResult a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BinarySearchResult a -> m (BinarySearchResult b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BinarySearchResult a -> m (BinarySearchResult b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
BinarySearchResult (m a) -> m (BinarySearchResult a)
sequence :: forall (m :: * -> *) a.
Monad m =>
BinarySearchResult (m a) -> m (BinarySearchResult a)
Traversable)


-- instance Alternative (BinarySearchResult a) where
--   l@(AllTrue _)   <|> _ = l
--   l@(FlipsAt _ _) <|> _ = l
--   l@(AllFalse m)  <|> r = case r of
--                             AllFalse Nothing -> l
--                             _                -> r

firstTrue :: BinarySearchResult a -> Maybe a
firstTrue :: forall a. BinarySearchResult a -> Maybe a
firstTrue = \case
  AllTrue a
x   -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  FlipsAt a
_ a
x -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  AllFalse Maybe a
_  -> Maybe a
forall a. Maybe a
Nothing

lastFalse  :: BinarySearchResult a -> Maybe a
lastFalse :: forall a. BinarySearchResult a -> Maybe a
lastFalse = \case
  AllTrue a
_    -> Maybe a
forall a. Maybe a
Nothing
  FlipsAt a
x a
_  -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  AllFalse Maybe a
mx  -> Maybe a
mx

----------------------------------------

-- | Containers storing elements on which we can binary search.
class BinarySearch v where
  -- | The type of the elements of the container
  type Elem  v :: Type
  -- | The type of indices used in the container.
  type Index v :: Type

  -- | Given a monotonic predicate p and a data structure v, find the pair of
  -- elements (v[h], v[h+1]) such that that
  --
  -- for every index i <= h we have p v[i] = False, and
  -- for every inedx i >  h we have p v[i] = True
  --
  --
  -- running time: \(O(T*\log n)\), where \(T\) is the time to execute the
  -- predicate.
  binarySearchIn     :: (Elem v -> Bool) -> v -> BinarySearchResult (Elem v)

  -- | Given a monotonic predicate p and a data structure v, find the
  -- index h such that that
  --
  -- for every index i <= h we have p v[i] = False, and
  -- for every inedx i >  h we have p v[i] = True
  --
  -- running time: \(O(T*\log n)\), where \(T\) is the time to execute the
  -- predicate.
  binarySearchIdxIn :: (Elem v -> Bool) -> v -> BinarySearchResult (Index v)

----------------------------------------

-- | Given a monotonic predicate p and a data structure v, find the
-- element v[h] such that that
--
-- for every index i <  h we have p v[i] = False, and
-- for every inedx i >= h we have p v[i] = True
--
-- returns Nothing if no element satisfies p
--
-- running time: \(O(T*\log n)\), where \(T\) is the time to execute the
-- predicate.
binarySearchFirstIn   :: BinarySearch v => (Elem v -> Bool) -> v -> Maybe (Elem v)
binarySearchFirstIn :: forall v. BinarySearch v => (Elem v -> Bool) -> v -> Maybe (Elem v)
binarySearchFirstIn Elem v -> Bool
p = BinarySearchResult (Elem v) -> Maybe (Elem v)
forall a. BinarySearchResult a -> Maybe a
firstTrue (BinarySearchResult (Elem v) -> Maybe (Elem v))
-> (v -> BinarySearchResult (Elem v)) -> v -> Maybe (Elem v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Elem v -> Bool) -> v -> BinarySearchResult (Elem v)
forall v.
BinarySearch v =>
(Elem v -> Bool) -> v -> BinarySearchResult (Elem v)
binarySearchIn Elem v -> Bool
p
{-# INLINE binarySearchFirstIn #-}

-- | Given a monotonic predicate p and a data structure v, find the
-- index h such that that
--
-- for every index i <  h we have p v[i] = False, and
-- for every inedx i >= h we have p v[i] = True
--
-- returns Nothing if no element satisfies p
--
-- running time: \(O(T*\log n)\), where \(T\) is the time to execute the
-- predicate.
binarySearchFirstIdxIn   :: BinarySearch v => (Elem v -> Bool) -> v -> Maybe (Index v)
binarySearchFirstIdxIn :: forall v.
BinarySearch v =>
(Elem v -> Bool) -> v -> Maybe (Index v)
binarySearchFirstIdxIn Elem v -> Bool
p = BinarySearchResult (Index v) -> Maybe (Index v)
forall a. BinarySearchResult a -> Maybe a
firstTrue (BinarySearchResult (Index v) -> Maybe (Index v))
-> (v -> BinarySearchResult (Index v)) -> v -> Maybe (Index v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Elem v -> Bool) -> v -> BinarySearchResult (Index v)
forall v.
BinarySearch v =>
(Elem v -> Bool) -> v -> BinarySearchResult (Index v)
binarySearchIdxIn Elem v -> Bool
p
{-# INLINE binarySearchFirstIdxIn #-}

-- | Given a monotonic predicate p and a data structure v, find the
-- element v[h] such that that
--
-- for every index i <= h we have p v[i] = False, and
-- for every inedx i >  h we have p v[i] = True
--
-- returns Nothing if no element satisfies p
--
-- running time: \(O(T*\log n)\), where \(T\) is the time to execute the
-- predicate.
binarySearchLastIn   :: BinarySearch v => (Elem v -> Bool) -> v -> Maybe (Elem v)
binarySearchLastIn :: forall v. BinarySearch v => (Elem v -> Bool) -> v -> Maybe (Elem v)
binarySearchLastIn Elem v -> Bool
p = BinarySearchResult (Elem v) -> Maybe (Elem v)
forall a. BinarySearchResult a -> Maybe a
lastFalse (BinarySearchResult (Elem v) -> Maybe (Elem v))
-> (v -> BinarySearchResult (Elem v)) -> v -> Maybe (Elem v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Elem v -> Bool) -> v -> BinarySearchResult (Elem v)
forall v.
BinarySearch v =>
(Elem v -> Bool) -> v -> BinarySearchResult (Elem v)
binarySearchIn Elem v -> Bool
p
{-# INLINE binarySearchLastIn #-}

-- | Given a monotonic predicate p and a data structure v, find the
-- index h such that that
--
-- for every index i <= h we have p v[i] = False, and
-- for every inedx i >  h we have p v[i] = True
--
-- returns Nothing if no element satisfies p
--
-- running time: \(O(T*\log n)\), where \(T\) is the time to execute the
-- predicate.
binarySearchLastIdxIn   :: BinarySearch v => (Elem v -> Bool) -> v -> Maybe (Index v)
binarySearchLastIdxIn :: forall v.
BinarySearch v =>
(Elem v -> Bool) -> v -> Maybe (Index v)
binarySearchLastIdxIn Elem v -> Bool
p = BinarySearchResult (Index v) -> Maybe (Index v)
forall a. BinarySearchResult a -> Maybe a
lastFalse (BinarySearchResult (Index v) -> Maybe (Index v))
-> (v -> BinarySearchResult (Index v)) -> v -> Maybe (Index v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Elem v -> Bool) -> v -> BinarySearchResult (Index v)
forall v.
BinarySearch v =>
(Elem v -> Bool) -> v -> BinarySearchResult (Index v)
binarySearchIdxIn Elem v -> Bool
p
{-# INLINE binarySearchLastIdxIn #-}

--------------------------------------------------------------------------------
-- * Searching on a Sequence

instance BinarySearch (Seq a) where
  type Index (Seq a) = Int
  type Elem  (Seq a) = a

  -- ^ runs in \(O(T*\log^2 n)\) time.
  binarySearchIn :: (Elem (Seq a) -> Bool)
-> Seq a -> BinarySearchResult (Elem (Seq a))
binarySearchIn Elem (Seq a) -> Bool
p Seq a
s = Seq a -> Int -> a
forall a. Seq a -> Int -> a
Seq.index Seq a
s (Int -> a) -> BinarySearchResult Int -> BinarySearchResult a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  (Elem (Seq a) -> Bool)
-> Seq a -> BinarySearchResult (Index (Seq a))
forall v.
BinarySearch v =>
(Elem v -> Bool) -> v -> BinarySearchResult (Index v)
binarySearchIdxIn Elem (Seq a) -> Bool
p Seq a
s
  {-# INLINABLE binarySearchIn #-}

  -- ^ runs in \(O(T*\log^2 n)\) time.
  binarySearchIdxIn :: (Elem (Seq a) -> Bool)
-> Seq a -> BinarySearchResult (Index (Seq a))
binarySearchIdxIn Elem (Seq a) -> Bool
p Seq a
s = case Seq a -> ViewR a
forall a. Seq a -> ViewR a
Seq.viewr Seq a
s of
                            ViewR a
EmptyR                 -> Maybe Int -> BinarySearchResult Int
forall a. Maybe a -> BinarySearchResult a
AllFalse Maybe Int
forall a. Maybe a
Nothing
                            (Seq a
_ :> a
x)   | Elem (Seq a) -> Bool
p a
Elem (Seq a)
x       -> case Seq a -> ViewL a
forall a. Seq a -> ViewL a
Seq.viewl Seq a
s of
                              (a
y :< Seq a
_) | Elem (Seq a) -> Bool
p a
Elem (Seq a)
y          -> Int -> BinarySearchResult Int
forall a. a -> BinarySearchResult a
AllTrue Int
0
                              ViewL a
_                       -> (Int -> Bool) -> Int -> Int -> BinarySearchResult Int
binarySearch Int -> Bool
p' Int
0 Int
u
                                       | Bool
otherwise -> Maybe (Index (Seq a)) -> BinarySearchResult (Index (Seq a))
forall a. Maybe a -> BinarySearchResult a
AllFalse (Maybe (Index (Seq a)) -> BinarySearchResult (Index (Seq a)))
-> Maybe (Index (Seq a)) -> BinarySearchResult (Index (Seq a))
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just (Seq a -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    where
      p' :: Int -> Bool
p' = a -> Bool
Elem (Seq a) -> Bool
p (a -> Bool) -> (Int -> a) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> Int -> a
forall a. Seq a -> Int -> a
Seq.index Seq a
s
      u :: Int
u  = Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  {-# INLINABLE binarySearchIdxIn #-}


binarySearch       :: (Int -> Bool) -> Int -> Int -> BinarySearchResult Int
binarySearch :: (Int -> Bool) -> Int -> Int -> BinarySearchResult Int
binarySearch Int -> Bool
p Int
l Int
u = let h' :: Int
h' = (Int -> Bool) -> Int -> Int -> Int
forall a. Integral a => (a -> Bool) -> a -> a -> a
binarySearchFirst Int -> Bool
p Int
l Int
u
                     in Int -> Int -> BinarySearchResult Int
forall a. a -> a -> BinarySearchResult a
FlipsAt (Int
h'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
h'


instance {-# OVERLAPPABLE #-} V.Vector v a => BinarySearch (v a) where
  type Index (v a) = Int
  type Elem  (v a) = a

  binarySearchIdxIn :: (Elem (v a) -> Bool) -> v a -> BinarySearchResult (Index (v a))
binarySearchIdxIn Elem (v a) -> Bool
p' v a
v | v a -> Bool
forall (v :: * -> *) a. Vector v a => v a -> Bool
V.null v a
v   = Maybe Int -> BinarySearchResult Int
forall a. Maybe a -> BinarySearchResult a
AllFalse Maybe Int
forall a. Maybe a
Nothing
                         | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Bool
p Int
n' = Maybe Int -> BinarySearchResult Int
forall a. Maybe a -> BinarySearchResult a
AllFalse (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n')
                         | Bool
otherwise  = if Int -> Bool
p Int
0 then Int -> BinarySearchResult Int
forall a. a -> BinarySearchResult a
AllTrue Int
0 else (Int -> Bool) -> Int -> Int -> BinarySearchResult Int
binarySearch Int -> Bool
p Int
0 Int
n'
    where
      n' :: Int
n' = v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.length v a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
      p :: Int -> Bool
p = a -> Bool
Elem (v a) -> Bool
p' (a -> Bool) -> (Int -> a) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v a
v v a -> Int -> a
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
V.!)
  {-# INLINABLE binarySearchIn #-}

  binarySearchIn :: (Elem (v a) -> Bool) -> v a -> BinarySearchResult (Elem (v a))
binarySearchIn Elem (v a) -> Bool
p v a
v = (v a
v v a -> Int -> a
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
V.!) (Int -> a) -> BinarySearchResult Int -> BinarySearchResult a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  (Elem (v a) -> Bool) -> v a -> BinarySearchResult (Index (v a))
forall v.
BinarySearch v =>
(Elem v -> Bool) -> v -> BinarySearchResult (Index v)
binarySearchIdxIn Elem (v a) -> Bool
p v a
v
  {-# INLINABLE binarySearchIdxIn #-}

instance BinarySearch (Set a) where
  type Index (Set a) = Int
  type Elem  (Set a) = a

  binarySearchIn :: (Elem (Set a) -> Bool)
-> Set a -> BinarySearchResult (Elem (Set a))
binarySearchIn Elem (Set a) -> Bool
p = Set a -> BinarySearchResult a
Set a -> BinarySearchResult (Elem (Set a))
go
    where
      go :: Set a -> BinarySearchResult a
go = \case
        Set a
Set.Tip                     -> Maybe a -> BinarySearchResult a
forall a. Maybe a -> BinarySearchResult a
AllFalse Maybe a
forall a. Maybe a
Nothing
        Set.Bin Int
_ a
k Set a
l Set a
r | Elem (Set a) -> Bool
p a
Elem (Set a)
k       -> case Set a -> BinarySearchResult a
go Set a
l of
                                         AllFalse Maybe a
Nothing  -> a -> BinarySearchResult a
forall a. a -> BinarySearchResult a
AllTrue a
k
                                         AllFalse (Just a
x) -> a -> a -> BinarySearchResult a
forall a. a -> a -> BinarySearchResult a
FlipsAt a
x a
k
                                         BinarySearchResult a
res               -> BinarySearchResult a
res
                        | Bool
otherwise -> case Set a -> BinarySearchResult a
go Set a
r of
                                         AllFalse Maybe a
Nothing -> Maybe a -> BinarySearchResult a
forall a. Maybe a -> BinarySearchResult a
AllFalse (a -> Maybe a
forall a. a -> Maybe a
Just a
k)
                                         BinarySearchResult a
res              -> BinarySearchResult a
res
  {-# INLINABLE binarySearchIn #-}

  binarySearchIdxIn :: (Elem (Set a) -> Bool)
-> Set a -> BinarySearchResult (Index (Set a))
binarySearchIdxIn Elem (Set a) -> Bool
p = Set a -> BinarySearchResult Int
Set a -> BinarySearchResult (Index (Set a))
go
    where
      go :: Set a -> BinarySearchResult Int
go = \case
        Set a
Set.Tip                     -> Maybe Int -> BinarySearchResult Int
forall a. Maybe a -> BinarySearchResult a
AllFalse Maybe Int
forall a. Maybe a
Nothing
        Set.Bin Int
_ a
k Set a
l Set a
r | Elem (Set a) -> Bool
p a
Elem (Set a)
k       -> case Set a -> BinarySearchResult Int
go Set a
l of
                                         AllFalse Maybe Int
Nothing  -> Int -> BinarySearchResult Int
forall a. a -> BinarySearchResult a
AllTrue Int
0
                                         AllFalse (Just Int
h) -> Int -> Int -> BinarySearchResult Int
forall a. a -> a -> BinarySearchResult a
FlipsAt Int
h (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                                         BinarySearchResult Int
res               -> BinarySearchResult Int
res
                        | Bool
otherwise -> let h :: Int
h = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
Set.size Set a
l
                                       in case Set a -> BinarySearchResult Int
go Set a
r of
                                            AllFalse Maybe Int
Nothing  -> Maybe Int -> BinarySearchResult Int
forall a. Maybe a -> BinarySearchResult a
AllFalse (Maybe Int -> BinarySearchResult Int)
-> Maybe Int -> BinarySearchResult Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
h
                                            BinarySearchResult Int
res               -> (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h) (Int -> Int) -> BinarySearchResult Int -> BinarySearchResult Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinarySearchResult Int
res
  {-# INLINABLE binarySearchIdxIn #-}



--------------------------------------------------------------------------------