find two numbers in a sorted list wich sum equals to k

2sum_eq_k.hs

-- GHCi, version 8.8.4
-- video https://www.youtube.com/watch?v=JPikTujq6mw&t=2839s
import Data.Maybe
import Data.List
-- given an ordered list of numbers and number k
-- find 2 numbers x and y such as x+y=k

-- input: [-2,-1,1,4,7,8,12,13] k = 9
-- output: 1,8

-- c1 = -2
-- c2 = 11

-- c1 = 8
-- c2 = 1

-- input: [-2,-1,1,4,4,4,4,6,8,12,13] k = 8

--find element index in a sorted list with binary search (left most or right most)

data LR = Lm | Rm deriving Eq

b :: Ord a => [a] -> a -> LR -> Maybe Int
b [] _ _ = Nothing
b xs e lr = go Nothing 0 xs where
                    go c _ [] = c
                    go c cb [a] = if a == e then Just cb else c
                    go c cb x | (me == e) && (lr == Rm) = go (Just $ cb+mi) (cb+(length xl)+1) xr
                              | (me == e) && (lr == Lm) = go (Just $ cb+mi) cb xl
                              | e > me = go c (cb+(length xl)+1) xr
                              | e < me = go c cb xl
                       where
                          (xl,(me:xr)) = splitAt mi x
                          mi = ((length x) `div` 2)


---- find the element predecessor
bfp_ :: Ord a => [a] -> a -> Maybe a
bfp_ xs e = go Nothing xs where
                              go bc [] = bc
                              go bc xs | e > me = go bc' r
                                         | e < me = go bc l
                                         | e == me = go bc l
                                            where bc' = if isNothing bc then Just me else (max me) <$> bc
                                                  (l,(me:r)) = splitAt mi xs
                                                  mi = (length xs) `div` 2

---- find the element succ
bfs_ :: Ord a => [a] -> a -> Maybe a
bfs_ xs e = go Nothing xs where
                              go bc [] = bc
                              go bc xs | e > me = go bc r
                                         | e < me = go bc' l
                                         | e == me = go bc r
                                            where bc' = if isNothing bc then Just me else (min me) <$> bc
                                                  (l,(me:r)) = splitAt mi xs
                                                  mi = (length xs) `div` 2

-- find one pair a and b such that a+b = k
f :: (Ord a, Num a) => [a] -> a -> Maybe (a,a)
f xs k = gor xs
    where
      gor [] = Nothing
      gor (c1:xs)
          | is_find_elem = Just (c1,c2)
          | is_no_pred = Nothing
          | otherwise = gol csl
          where
             c2 = k - c1 -- c1+c2 = k
             is_find_elem = isJust $ b xs c2 Rm
             is_no_pred = isNothing $ bfp_ xs c2
             csl = fst $ splitAt (pi+1) xs
             pi = fromJust $ b xs (fromJust $ bfp_ xs c2) Rm
      gol [] = Nothing
      gol xs
          | is_find_elem = Just (c1,c2)
          | is_no_succ = Nothing
          | otherwise = gor csr
          where
             c1 = last xs
             c2 = k - c1
             is_find_elem = isJust $ b xs c2 Lm
             is_no_succ = isNothing $ bfs_ xs c2
             si = fromJust $ b xs (fromJust $ bfs_ xs c2) Lm
             csr = snd $ splitAt si xs



-- find all pairs a and b such that a+b = k
f_ :: (Ord a, Num a) => [a] -> a -> [(a,a)]
f_ xs k = gor xs []
    where
      gor [] fp = fp
      gor (c1:xs) fp
          | is_find_elem && is_no_pred = (c1,c2):fp-- Just (c1,c2)
          | is_find_elem = gol csl ((c1,c2):fp)
          | is_no_pred = fp
          | otherwise = gol csl fp
          where
             c2 = k - c1 -- c1+c2 = k
             is_find_elem = isJust $ b xs c2 Rm
             is_no_pred = isNothing $ bfp_ xs c2
             csl = fst $ splitAt (pi+1) xs
             pi = fromJust $ b xs (fromJust $ bfp_ xs c2) Rm
      gol [] fp = fp
      gol xs fp
          | is_find_elem && is_no_succ = (c1,c2):fp -- Just (c1,c2)
          | is_find_elem = gor csr ((c1,c2):fp)
          | is_no_succ = fp
          | otherwise = gor csr fp
          where
             c1 = last xs
             c2 = k - c1
             is_find_elem = isJust $ b xs c2 Lm
             is_no_succ = isNothing $ bfs_ xs c2
             si = fromJust $ b xs (fromJust $ bfs_ xs c2) Lm
             csr = snd $ splitAt si xs

-- *Main> f_ [1,2,3,3,4,5] 6
-- [(3,3),(4,2),(1,5)]
-- *Main> f_ [0,1,2,3,3,4,5,6] 6
-- [(3,3),(2,4),(5,1),(0,6)]
-- *Main> f_ [-1,0,1,2,3,3,4,5,6,7] 6
-- [(3,3),(4,2),(1,5),(6,0),(-1,7)]

video - https://www.youtube.com/watch?v=JPikTujq6mw&t=2839s