fork download
copy 
  1. ; floor and ceiling in an array
  2.  
  3. (define xs '#(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47))
  4.  
  5. (define (floor-ceiling lt? x xs)
  6.   (let* ((len (vector-length xs)) (len-1 (- len 1)))
  7.     (if (lt? x (vector-ref xs 0)) (list -1 0)
  8.       (if (lt? (vector-ref xs (- len 1)) x) (list len-1 len)
  9.         (let loop ((lo 0) (hi len-1))
  10.           (let ((mid (+ lo (quotient (- hi lo) 2))))
  11.             (cond ((< hi lo) (list hi lo))
  12.                   ((lt? x (vector-ref xs mid)) (loop lo (- mid 1)))
  13.                   ((lt? (vector-ref xs mid) x) (loop (+ mid 1) hi))
  14.                   (else (list mid mid)))))))))
  15.  
  16. (define (test)
  17.   (do ((x 0 (+ x 1))) ((= x 50))
  18.     (let ((fc (floor-ceiling < x xs)) (len (vector-length xs)))
  19.       (when (< (cadr fc) (car fc))
  20.         (display "what? ") (display x) (display " ") (display fc) (newline))
  21.       (if (= (cadr fc) len)
  22.           (when (not (< (vector-ref xs (- len 1)) x))
  23.             (display "bad ceiling ") (display x) (display " ") (display fc) (newline))
  24.         (when (< (vector-ref xs (cadr fc)) x)
  25.           (display "bad ceiling ") (display x) (display " ") (display fc) (newline)))
  26.       (if (= (car fc) -1)
  27.           (when (not (< x (vector-ref xs 0)))
  28.             (display "bad floor ") (display x) (display " ") (display fc) (newline))
  29.           (when (< x (vector-ref xs (car fc)))
  30.             (display "bad floor ") (display x) (display fc) (newline))))))
Success #stdin #stdout 0.02s 42832KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/zfN2jq
language:
Scheme (guile 2.2.4)
created:
6 years ago
visibility:
secret

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!