Data commit

Task/Binary-search/Haskell/binary-search-1.hs

@@ -0,0 +1,52 @@
+import Data.Array (Array, Ix, (!), listArray, bounds)
+
+-- BINARY SEARCH --------------------------------------------------------------
+bSearch
+  :: Integral a
+  => (a -> Ordering) -> (a, a) -> Maybe a
+bSearch p (low, high)
+  | high < low = Nothing
+  | otherwise =
+    let mid = (low + high) `div` 2
+    in case p mid of
+         LT -> bSearch p (low, mid - 1)
+         GT -> bSearch p (mid + 1, high)
+         EQ -> Just mid
+
+-- Application to an array:
+bSearchArray
+  :: (Ix i, Integral i, Ord e)
+  => Array i e -> e -> Maybe i
+bSearchArray a x = bSearch (compare x . (a !)) (bounds a)
+
+-- TEST -----------------------------------------------------------------------
+axs
+  :: (Num i, Ix i)
+  => Array i String
+axs =
+  listArray
+    (0, 11)
+    [ "alpha"
+    , "beta"
+    , "delta"
+    , "epsilon"
+    , "eta"
+    , "gamma"
+    , "iota"
+    , "kappa"
+    , "lambda"
+    , "mu"
+    , "theta"
+    , "zeta"
+    ]
+
+main :: IO ()
+main =
+  let e = "mu"
+      found = bSearchArray axs e
+  in putStrLn $
+     '\'' :
+     e ++
+     case found of
+       Nothing -> "' Not found"
+       Just x -> "' found at index " ++ show x

Task/Binary-search/Haskell/binary-search-2.hs

@@ -0,0 +1,46 @@
+import Data.Array (Array, Ix, (!), listArray, bounds)
+
+-- BINARY SEARCH USING A HELPER FUNCTION WITH A SIMPLER TYPE SIGNATURE
+findIndexBinary
+  :: Ord a
+  => (a -> Ordering) -> Array Int a -> Either String Int
+findIndexBinary p axs =
+  let go (lo, hi)
+        | hi < lo = Left "not found"
+        | otherwise =
+          let mid = (lo + hi) `div` 2
+          in case p (axs ! mid) of
+               LT -> go (lo, pred mid)
+               GT -> go (succ mid, hi)
+               EQ -> Right mid
+  in go (bounds axs)
+
+-- TEST ---------------------------------------------------
+haystack :: Array Int String
+haystack =
+  listArray
+    (0, 11)
+    [ "alpha"
+    , "beta"
+    , "delta"
+    , "epsilon"
+    , "eta"
+    , "gamma"
+    , "iota"
+    , "kappa"
+    , "lambda"
+    , "mu"
+    , "theta"
+    , "zeta"
+    ]
+
+main :: IO ()
+main =
+  let needle = "lambda"
+  in putStrLn $
+     '\'' :
+     needle ++
+     either
+       ("' " ++)
+       (("' found at index " ++) . show)
+       (findIndexBinary (compare needle) haystack)

Task/Binary-search/Haskell/binary-search-3.hs

@@ -0,0 +1,50 @@
+import Data.Array (Array, Ix, (!), listArray, bounds)
+
+-- BINARY SEARCH USING THE ITERATIVE ALGORITHM
+findIndexBinary_
+  :: Ord a
+  => (a -> Ordering) -> Array Int a -> Either String Int
+findIndexBinary_ p axs =
+  let (lo, hi) =
+        until
+          (\(lo, hi) -> lo > hi || 0 == hi)
+          (\(lo, hi) ->
+              let m = quot (lo + hi) 2
+              in case p (axs ! m) of
+                   LT -> (lo, pred m)
+                   GT -> (succ m, hi)
+                   EQ -> (m, 0))
+          (bounds axs) :: (Int, Int)
+  in if 0 /= hi
+       then Left "not found"
+       else Right lo
+
+-- TEST ---------------------------------------------------
+haystack :: Array Int String
+haystack =
+  listArray
+    (0, 11)
+    [ "alpha"
+    , "beta"
+    , "delta"
+    , "epsilon"
+    , "eta"
+    , "gamma"
+    , "iota"
+    , "kappa"
+    , "lambda"
+    , "mu"
+    , "theta"
+    , "zeta"
+    ]
+
+main :: IO ()
+main =
+  let needle = "kappa"
+  in putStrLn $
+     '\'' :
+     needle ++
+     either
+       ("' " ++)
+       (("' found at index " ++) . show)
+       (findIndexBinary_ (compare needle) haystack)