fork(1) download
copy 
  1. ; binary search
  2.  
  3. (define (range . args)
  4.   (case (length args)
  5.     ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
  6.     ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
  7.     ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
  8.            (let loop ((x(car args)) (xs '()))
  9.              (if (le? (cadr args) x)
  10.                  (reverse xs)
  11.                  (loop (+ x (caddr args)) (cons x xs))))))
  12.     (else (error 'range "unrecognized arguments"))))
  13.  
  14. (define-syntax assert
  15.   (syntax-rules ()
  16.     ((assert expr result)
  17.       (if (not (equal? expr result))
  18.           (for-each display `(
  19.             #\newline "failed assertion:" #\newline
  20.             expr #\newline "expected: " ,result
  21.             #\newline "returned: " ,expr #\newline))))))
  22.  
  23. (define (bsearch lt? x xs)
  24.   (let loop ((lo 0) (hi (- (vector-length xs) 1)))
  25.     (let ((mid (quotient (+ lo hi) 2)))
  26.       ;(display lo) (display " ") (display mid)
  27.       ;(display " ") (display hi) (newline)
  28.       (cond ((< hi lo) #f)
  29.             ((lt? x (vector-ref xs mid))
  30.               (loop lo (- mid 1)))
  31.             ((lt? (vector-ref xs mid) x)
  32.               (loop (+ mid 1) hi))
  33.             (else mid)))))
  34.  
  35. (define (test-bsearch n)
  36.   (do ((i 0 (+ i 1))) ((= n i))
  37.     (let ((xs (list->vector (range 0 n 2))))
  38.       (do ((j -1 (+ j 1))) ((< n j))
  39.         (if (and (even? j) (< j n))
  40.             (assert (bsearch < j xs) (/ j 2))
  41.             (assert (bsearch < j xs) #f))))))
  42.  
  43. (test-bsearch 25)
Success #stdin #stdout 0.2s 8896KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/qzE6ZT
language:
Scheme (guile 2.2.4)
created:
7 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!