fork(1) download
copy 
  1. ; binary search with duplicates
  2.  
  3. (define (bsearch1 lt? x xs)
  4.   (let loop ((lo 0) (hi (- (vector-length xs) 1)))
  5.     (let ((mid (+ lo (quotient (- hi lo) 2))))
  6.       (cond ((< hi lo) #f)
  7.             ((lt? x (vector-ref xs mid)) (loop lo (- mid 1)))
  8.             ((lt? (vector-ref xs mid) x) (loop (+ mid 1) hi))
  9.             (else mid)))))
  10.  
  11. (display (bsearch1 < 0 '#(1 2 3 5 6 7))) (display #\space)
  12. (display (bsearch1 < 1 '#(1 2 3 5 6 7))) (display #\space)
  13. (display (bsearch1 < 2 '#(1 2 3 5 6 7))) (display #\space)
  14. (display (bsearch1 < 3 '#(1 2 3 5 6 7))) (display #\space)
  15. (display (bsearch1 < 4 '#(1 2 3 5 6 7))) (display #\space)
  16. (display (bsearch1 < 5 '#(1 2 3 5 6 7))) (display #\space)
  17. (display (bsearch1 < 6 '#(1 2 3 5 6 7))) (display #\space)
  18. (display (bsearch1 < 7 '#(1 2 3 5 6 7))) (display #\space)
  19. (display (bsearch1 < 8 '#(1 2 3 5 6 7))) (newline)
  20.  
  21. (define (bsearch2 lt? x xs)
  22.   (let loop ((lo 0) (hi (- (vector-length xs) 1)) (result #f))
  23.     (let ((mid (+ lo (quotient (- hi lo) 2))))
  24.       (cond ((< hi lo) result)
  25.             ((lt? x (vector-ref xs mid)) (loop lo (- mid 1) result))
  26.             ((lt? (vector-ref xs mid) x) (loop (+ mid 1) hi result))
  27.             (else (loop lo (- mid 1) mid))))))
  28.  
  29. (display (bsearch2 < 0 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
  30. (display (bsearch2 < 1 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
  31. (display (bsearch2 < 2 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
  32. (display (bsearch2 < 3 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
  33. (display (bsearch2 < 4 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
  34. (display (bsearch2 < 5 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
  35. (display (bsearch2 < 6 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
  36. (display (bsearch2 < 7 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (display #\space)
  37. (display (bsearch2 < 8 '#(1 2 2 3 4 4 4 4 6 6 6 6 6 6 7))) (newline)
Success #stdin #stdout 0.02s 42848KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
#f 0 1 2 #f 3 4 5 #f
#f 0 1 3 4 #f 8 14 #f
https://ideone.com/hyxZQi
language:
Scheme (guile 2.2.4)
created:
6 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!