module Algorithm.Search.SternBrocot where

import GHC.Real

{- |
>>> binarySearchRational 100 (\x -> compare (x * x) 2)
(140 % 99,99 % 70)
>>> map (fromRational @Double) [140 % 99,  99 % 70]
[1.4141414141414141,1.4142857142857144]
>>> binarySearchRational (10^10) (`compare`(1 % (10^10)))
(1 % 10000000000,1 % 9999999999)
>>> binarySearchRational (10^10) (`compare`((10^10-1) % (10^10)))
(9999999999 % 10000000000,1 % 1)
-}
binarySearchRational ::
  Integer ->
  (Rational -> Ordering) ->
  (Rational, Rational)
binarySearchRational :: Integer -> (Rational -> Ordering) -> (Rational, Rational)
binarySearchRational Integer
n Rational -> Ordering
approx = Rational -> Rational -> (Rational, Rational)
go (Integer
0 Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
1) (Integer
1 Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
0)
  where
    go :: Rational -> Rational -> (Rational, Rational)
go l :: Rational
l@(Integer
lp :% Integer
lq) r :: Rational
r@(Integer
rp :% Integer
rq)
      | Rational -> Integer
forall a. Ratio a -> a
denominator Rational
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
n = (Rational
l, Rational
r)
      | Bool
otherwise = case Rational -> Ordering
approx Rational
m of
          Ordering
LT ->
            (Rational -> Rational -> (Rational, Rational))
-> Rational -> Rational -> (Rational, Rational)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rational -> Rational -> (Rational, Rational)
go Rational
r
              (Rational -> (Rational, Rational))
-> ([Integer] -> Rational) -> [Integer] -> (Rational, Rational)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Rational] -> Rational
forall a. HasCallStack => [a] -> a
last
              ([Rational] -> Rational)
-> ([Integer] -> [Rational]) -> [Integer] -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational
m :)
              ([Rational] -> [Rational])
-> ([Integer] -> [Rational]) -> [Integer] -> [Rational]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Bool) -> [Rational] -> [Rational]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile
                ( \Rational
m' ->
                    Rational -> Integer
forall a. Ratio a -> a
denominator Rational
m' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n Bool -> Bool -> Bool
&& Rational -> Ordering
approx Rational
m' Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT
                )
              ([Rational] -> [Rational])
-> ([Integer] -> [Rational]) -> [Integer] -> [Rational]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Rational) -> [Integer] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
i -> (Integer
lp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
rp) Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% (Integer
lq Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
rq))
              ([Integer] -> (Rational, Rational))
-> [Integer] -> (Rational, Rational)
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
2) Integer
2
          Ordering
EQ -> Rational -> Rational -> (Rational, Rational)
go Rational
m Rational
r
          Ordering
GT ->
            Rational -> Rational -> (Rational, Rational)
go Rational
l
              (Rational -> (Rational, Rational))
-> ([Integer] -> Rational) -> [Integer] -> (Rational, Rational)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Rational] -> Rational
forall a. HasCallStack => [a] -> a
last
              ([Rational] -> Rational)
-> ([Integer] -> [Rational]) -> [Integer] -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational
m :)
              ([Rational] -> [Rational])
-> ([Integer] -> [Rational]) -> [Integer] -> [Rational]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Bool) -> [Rational] -> [Rational]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile
                ( \Rational
m' ->
                    Rational -> Integer
forall a. Ratio a -> a
denominator Rational
m' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n Bool -> Bool -> Bool
&& Rational -> Ordering
approx Rational
m' Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
                )
              ([Rational] -> [Rational])
-> ([Integer] -> [Rational]) -> [Integer] -> [Rational]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Rational) -> [Integer] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
i -> (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
lp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
rp) Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
lq Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
rq))
              ([Integer] -> (Rational, Rational))
-> [Integer] -> (Rational, Rational)
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
2) Integer
2
      where
        !m :: Rational
m = (Integer
lp Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
rp) Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% (Integer
lq Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
rq)

{- |
>>> binarySearchMinRational 100 (1 <)
101 % 100
>>> binarySearchMinRational 100 (1 <=)
1 % 1
-}
binarySearchMinRational :: Integer -> (Rational -> Bool) -> Rational
binarySearchMinRational :: Integer -> (Rational -> Bool) -> Rational
binarySearchMinRational Integer
n Rational -> Bool
f =
  (Rational, Rational) -> Rational
forall a b. (a, b) -> b
snd ((Rational, Rational) -> Rational)
-> ((Rational -> Ordering) -> (Rational, Rational))
-> (Rational -> Ordering)
-> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> (Rational -> Ordering) -> (Rational, Rational)
binarySearchRational Integer
n ((Rational -> Ordering) -> Rational)
-> (Rational -> Ordering) -> Rational
forall a b. (a -> b) -> a -> b
$ \Rational
x ->
    if Rational -> Bool
f Rational
x then Ordering
GT else Ordering
LT

{- |
>>> binarySearchMaxRational 100 (< 1)
99 % 100
>>> binarySearchMaxRational 100 (<= 1)
1 % 1
-}
binarySearchMaxRational :: Integer -> (Rational -> Bool) -> Rational
binarySearchMaxRational :: Integer -> (Rational -> Bool) -> Rational
binarySearchMaxRational Integer
n Rational -> Bool
f =
  (Rational, Rational) -> Rational
forall a b. (a, b) -> a
fst ((Rational, Rational) -> Rational)
-> ((Rational -> Ordering) -> (Rational, Rational))
-> (Rational -> Ordering)
-> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> (Rational -> Ordering) -> (Rational, Rational)
binarySearchRational Integer
n ((Rational -> Ordering) -> Rational)
-> (Rational -> Ordering) -> Rational
forall a b. (a -> b) -> a -> b
$ \Rational
x ->
    if Rational -> Bool
f Rational
x then Ordering
LT else Ordering
GT