; binary search with duplicates

(define (bsearch1 lt? x xs)
  (let loop ((lo 0) (hi (- (vector-length xs) 1)))
    (let ((mid (+ lo (quotient (- hi lo) 2))))
      (cond ((< hi lo) #f)
            ((lt? x (vector-ref xs mid)) (loop lo (- mid 1)))
            ((lt? (vector-ref xs mid) x) (loop (+ mid 1) hi))
            (else mid)))))

(display (bsearch1 < 0 '#(1 2 3 5 6 7))) (display #\space)
(display (bsearch1 < 1 '#(1 2 3 5 6 7))) (display #\space)
(display (bsearch1 < 2 '#(1 2 3 5 6 7))) (display #\space)
(display (bsearch1 < 3 '#(1 2 3 5 6 7))) (display #\space)
(display (bsearch1 < 4 '#(1 2 3 5 6 7))) (display #\space)
(display (bsearch1 < 5 '#(1 2 3 5 6 7))) (display #\space)
(display (bsearch1 < 6 '#(1 2 3 5 6 7))) (display #\space)
(display (bsearch1 < 7 '#(1 2 3 5 6 7))) (display #\space)
(display (bsearch1 < 8 '#(1 2 3 5 6 7))) (newline)

(define (bsearch2 lt? x xs)
  (let loop ((lo 0) (hi (- (vector-length xs) 1)) (result #f))
    (let ((mid (+ lo (quotient (- hi lo) 2))))
      (cond ((< hi lo) result)
            ((lt? x (vector-ref xs mid)) (loop lo (- mid 1) result))
            ((lt? (vector-ref xs mid) x) (loop (+ mid 1) hi result))
            (else (loop lo (- mid 1) mid))))))

(display (bsearch2 < 0 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
(display (bsearch2 < 1 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
(display (bsearch2 < 2 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
(display (bsearch2 < 3 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
(display (bsearch2 < 4 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
(display (bsearch2 < 5 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
(display (bsearch2 < 6 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
(display (bsearch2 < 7 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
(display (bsearch2 < 8 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (newline)