lib/mlton/basic/binary-search.sml

   1 (* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  *
   4  * MLton is released under a BSD-style license.
   5  * See the file MLton-LICENSE for details.
   6  *)
   7
   8 structure BinarySearch: BINARY_SEARCH =
   9 struct
  10
  11 (* Based on page 38 of Programming Pearls, by Jon Bentley. *)
  12 fun 'a search (a: 'a array, f: 'a -> order): int option =
  13    let
  14       fun loop (min: int, max: int): int option =
  15          if min > max
  16             then NONE
  17          else
  18             let val mid = Int.quot (min + max, 2)
  19             in case f (Array.sub (a, mid)) of
  20                LESS => loop (min, mid - 1)
  21              | EQUAL => SOME mid
  22              | GREATER => loop (mid + 1, max)
  23             end
  24    in loop (0, Array.length a - 1)
  25    end
  26
  27 fun 'a largest (a: 'a array, f: 'a -> bool): int option =
  28    let
  29       fun loop(min, max, res: int option): int option =
  30          if min > max
  31             then res
  32          else
  33             let val mid = Int.quot(min + max, 2)
  34             in if f(Array.sub(a, mid))
  35                   then loop(mid + 1, max, SOME mid)
  36                else loop(min, mid - 1, res)
  37             end
  38    in loop(0, Array.length a - 1, NONE)
  39    end
  40
  41 fun 'a smallest(a: 'a array, f: 'a -> bool): int option =
  42    let
  43       fun loop(min, max, res: int option): int option =
  44          if min > max
  45             then res
  46          else
  47             let val mid = Int.quot(min + max, 2)
  48             in if f(Array.sub(a, mid))
  49                   then loop(min, mid - 1, SOME mid)
  50                else loop(mid + 1, max, res)
  51             end
  52    in loop(0, Array.length a - 1, NONE)
  53    end
  54
  55 end