(module bisect-search mzscheme
  
  (require (lib "list.ss")
           (lib "etc.ss")
           (lib "contract.ss"))
  
  
  (provide/contract (vector-bisect-left ((vectorof any/c) (any/c any/c . -> . (integer-in -1 1)) any/c . -> . number?)))
  ;; vector-bisect-left: (vectorof X) (Y X -> (union -1 0 1)) Y -> number
  ;;
  ;; Like vector-binary-search from SRFI 43, searches through vec,
  ;; assuming vec is sorted in nondecreasing order.
  ;; Unlike binary-search, we find the position left of the key
  ;; rather than the key itself.
  ;;
  ;; Note: we search on the half-open interval [left, right).
  (define vector-bisect-left 
    (case-lambda 

      [(vec cmp-function key)
       (vector-bisect-left vec cmp-function key 0 (vector-length vec))]

      [(vec cmp-function key left right)
       ;; Loop invariant: the bisection point b lies in the
       ;; half-open interval [left, right).
       (let loop ([left left]
                  [right right])
         (cond
           ;; Termination argument:
           ;; We eventually terminate because the quantity (- right left)
           ;; decreases on each iteration, and we hit the base case:
           [(>= left right) left]
           [else
            (let* ([m (midpoint left right)]
                   [cmp (cmp-function key (vector-ref vec m))])
              (cond
                ;; Each of the loop calls preserves the loop
                ;; invariant:
                [(< cmp 0)
                 ;; Case 1: left bisection point is between [left, m).
                 (loop left m)]
                [(> cmp 0) 
                 ;; Case 2: left bisection point is between [m+1, right).
                 (loop (add1 m) right)]
                [else 
                 ;; Case 3: left bisection point is between [left, m).
                 (loop left m)]))]))]))
  
  
  
    (provide/contract (vector-bisect-right ((vectorof any/c) (any/c any/c . -> . (integer-in -1 1)) any/c . -> . number?)))
  ;; vector-bisect-right: (vectorof X) (Y X -> (union -1 0 1)) Y -> number
  ;;
  ;; Like vector-binary-search from SRFI 43, searches through vec,
  ;; assuming vec is sorted in nondecreasing order.
  ;; Unlike binary-search, we find the position right of the key
  ;; rather than the key itself.
  ;;
  ;; Note: we search on the half-open interval [left, right).
  (define vector-bisect-right 
    (case-lambda 

      [(vec cmp-function key)
       (vector-bisect-right vec cmp-function key 0 (vector-length vec))]

      [(vec cmp-function key left right)
       ;; Loop invariant: the bisection point b lies in the
       ;; half-open interval [left, right).
       (let loop ([left left]
                  [right right])
         (cond
           ;; Termination argument:
           ;; We eventually terminate because the quantity (- right left)
           ;; decreases on each iteration, and we hit the base case:
           [(>= left right) left]
           [else
            (let* ([m (midpoint left right)]
                   [cmp (cmp-function key (vector-ref vec m))])
              (cond
                ;; Each of the loop calls preserves the loop
                ;; invariant:
                [(< cmp 0)
                 ;; Case 1: right bisection point is between [left, m).
                 (loop left m)]
                [(> cmp 0) 
                 ;; Case 2: right bisection point is between [m+1, right).
                 (loop (add1 m) right)]
                [else 
                 ;; Case 3: right bisection point is between [m+1, right).
                 (loop (add1 m) right)]))]))]))
  
  ;; midpoint: number number -> number
  ;; Returns the integer midpoint between a and b.
  (define (midpoint a b)
    (quotient (+ a b) 2))
  
  
  ;                                    
  ;                                    
  ;  @@@@@                             
  ;    @                   @           
  ;    @                   @           
  ;    @     @@@@   @@@@  @@@@    @@@@ 
  ;    @    @    @ @    @  @     @    @
  ;    @    @@@@@@  @@     @      @@   
  ;    @    @         @@   @        @@ 
  ;    @    @    @ @    @  @   @ @    @
  ;    @     @@@@   @@@@    @@@   @@@@ 
  ;                                    
  ;                             @@@@@@@@
  
  ;; The code below is just for internal testing,
  ;; and won't be exposed to the outside world.
  
  (define (make-cmp lt eq)
    (lambda (x y)
      (cond [(lt x y) -1]
            [(eq x y) 0]
            [else 1])))
  
  (define numeric-cmp (make-cmp < =))
  
  (define (vector-search-left vec cmp-function key)
    (let loop ([i 0])
      (cond 
        [(= i (vector-length vec))
         i]
        [else
         (let ([v (cmp-function key (vector-ref vec i))])
           (cond
             [( < v 0) i]
             [( = v 0) i]
             [else
              (loop (add1 i))]))])))
  
  (define (vector-search-right vec cmp-function key)
    (let loop ([i 0])
      (cond 
        [(= i (vector-length vec))
         i]
        [else
         (let ([v (cmp-function key (vector-ref vec i))])
           (cond
             [( < v 0) 
              i]
             [( = v 0) 
              (loop (add1 i))]
             [else
              (loop (add1 i))]))])))
  
  
  (define (test-left v cmp key)
    (test vector-bisect-left vector-search-left v cmp key))

  (define (test-right v cmp key)
    (test vector-bisect-right vector-search-right v cmp key))

           
  (define (test bisect-f linear-f v cmp key)
    (let ([binary (bisect-f v cmp key)]
          [linear (linear-f v cmp key)])
    (unless (= binary linear)
      (error 'test 
             "vec:~a key:~a bisect:~a linear:~a" 
             v
             key 
             binary
             linear))))
  
  (define-syntax (repeat stx)
    (syntax-case stx ()
      [(_ (var n) e ...)
       (syntax/loc stx
         (let loop ([var 0])
           (when (< var n)
             e ...
             (loop (add1 var)))))]))
  

  (define (make-test-vector number-of-elts range)
    (list->vector
     (quicksort (build-list number-of-elts 
                            (lambda (i) (random range)))
                <)))

  (define (random-monkey-test-suite N)
    (let ([vec (make-test-vector N N)])
      (repeat (j N)
              (test-right vec numeric-cmp j)
              (test-left vec numeric-cmp j))))
  
  
  ;; this test is taken from Python's test suite of bisect.py:
  (define (grade score)
    (define grades "FEDCBA")
    (define breakpoints (vector 30 44 66 75 85))
    (string-ref
     grades
     (vector-bisect-right breakpoints numeric-cmp score))))