[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/UxAnLcJF    [ raw code | fork ]

programmingpraxis - Scheme, pasted on Mar 13:
(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
    ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
    ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
           (let loop ((x(car args)) (xs '()))
             (if (le? (cadr args) x)
                 (reverse xs)
                 (loop (+ x (caddr args)) (cons x xs))))))
    (else (error 'range "unrecognized arguments"))))

(define-syntax assert
  (syntax-rules ()
    ((assert expr result)
      (if (not (equal? expr result))
          (for-each display `(
            #\newline "failed assertion:" #\newline
            expr #\newline "expected: " ,result
            #\newline "returned: " ,expr #\newline))))))

(define (bsearch t vs)
  (let loop ((lo 0) (hi (- (vector-length vs) 1)))
    (if (< hi lo) -1
      (let ((mid (quotient (+ lo hi) 2)))
        (cond ((< t (vector-ref vs mid))
                (loop lo (- mid 1)))
              ((< (vector-ref vs mid) t)
                (loop (+ mid 1) hi))
              (else mid))))))

(define (test-search limit)
  (do ((n 0 (+ n 1))) ((= n limit))
    (let ((in-order (list->vector (range n)))
          (all-equal (make-vector n 1)))
      (do ((i 0 (+ i 1))) ((= i n))
        (assert (bsearch i in-order) i)
        (assert (bsearch (+ i 1/2) in-order) -1)
        (assert (bsearch (- i 1/2) in-order) -1))
      (assert (bsearch 1/2 all-equal) -1)
      (assert (bsearch 3/2 all-equal) -1)
      (if (positive? n) (assert (< -1 (bsearch 1 all-equal) n) #t)))))

(test-search 12)


Output:
No errors or program output.


Create a new paste based on this one


Comments: