bisect-search.ss
```(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).
[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).
[else
;; Case 3: right bisection point is between [m+1, 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

(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)
[else

(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 ...

(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: