{- bisect.hs
 -
 - Code accompaniment to the blog post "Bisection commits when failures
 - are costly."
 -
 - Eric Zheng <ericzheng@cmu.edu>
 - Last revised 2021-10-9
 -}

data Commit = Good | Bad deriving (Eq, Show)
data CommitSequence = Seq (Int, Int)
data Counter = Counter (Int, Int)

instance Show CommitSequence where
  show (Seq (n, k)) = show list
    where
      good = take k $ repeat Good
      bad = take (n - k) $ repeat Bad
      list = good ++ bad

instance Show Counter where
  show (Counter (good, bad)) =
    "[" ++ show good ++ " good, " ++ show bad ++ " bad queries]"

empty_counter :: Counter
empty_counter = Counter (0, 0)

-- Build a sequence of n commits where commit #k is the last "good" one.
make_commits :: Int -> Int -> CommitSequence
make_commits n k = Seq (n, k)

-- Get the number of commits in a sequence.
number_commits :: CommitSequence -> Int
number_commits (Seq (n, _)) = n

-- Query a sequence at a given index, and update a counter depending on
-- whether the commit was good or bad.
query :: CommitSequence -> Int -> Counter -> (Counter, Commit)
query (Seq (_, k)) index (Counter (good_count, bad_count)) =
  if index <= k
     then (Counter (good_count + 1, bad_count), Good)
     else (Counter (good_count, bad_count + 1), Bad)

bisect_binary :: CommitSequence -> (Counter, Int)
bisect_binary commits =
  search empty_counter (n - 1) 0
  where
    n = number_commits commits
    search counts upper lower =
      if upper - lower <= 1
         then (counts, lower)
         else case commit of
                Good -> search counts' upper mid
                Bad  -> search counts' mid lower
      where
        mid = (upper + lower) `div` 2
        (counts', commit) = query commits mid counts

bisect_egg :: Float -> CommitSequence -> (Counter, Int)
bisect_egg c commits =
  egg_drop empty_counter k (n - 1) 0
  where
    n = number_commits commits
    k = floor $ c * (logBase 2 $ fromIntegral n)

    -- Linear search over for first bad commit in range [lower, upper),
    -- with spacing between guesses
    search counts spacing upper lower
      | lower == upper - 1 = (counts, lower + 1)
      | lower > upper - 1 = (counts, upper)  -- Not found with this spacing
      | otherwise =
          case query commits (lower + 1) counts of
            (counts', Good) -> search counts' spacing upper $ lower + spacing
            (counts', Bad)  -> (counts', lower + 1)

    egg_drop :: Counter -> Int -> Int -> Int -> (Counter, Int)
    egg_drop counts 0 upper lower = (counts, lower)
    egg_drop counts k upper lower =
      egg_drop counts' (k - 1) upper' lower'
      where
        n' = fromIntegral $ upper - lower + 1
        spacing = floor $ n' ** (1 - (1 / fromIntegral k))
        (counts', upper') = search counts spacing upper lower
        lower' = upper' - spacing