[ create a new paste ] login | about

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

programmingpraxis - Scheme, pasted on Mar 17:
; an array of two symbols

(define (make-list n x)
  (let loop ((n n) (xs '()))
    (if (zero? n) xs
      (loop (- n 1) (cons x xs)))))

(define-syntax fold-of
  (syntax-rules (range in is)
    ((_ "z" f b e) (set! b (f b e)))
    ((_ "z" f b e (v range fst pst stp) c ...)
      (let* ((x fst) (p pst) (s stp)
             (le? (if (positive? s) <= >=)))
        (do ((v x (+ v s))) ((le? p v) b)
          (fold-of "z" f b e c ...))))
    ((_ "z" f b e (v range fst pst) c ...)
      (let* ((x fst) (p pst) (s (if (< x p) 1 -1)))
        (fold-of "z" f b e (v range x p s) c ...)))
    ((_ "z" f b e (v range pst) c ...)
      (fold-of "z" f b e (v range 0 pst) c ...))
    ((_ "z" f b e (x in xs) c ...)
      (do ((t xs (cdr t))) ((null? t) b)
        (let ((x (car t)))
          (fold-of "z" f b e c ...))))
    ((_ "z" f b e (x is y) c ...)
      (let ((x y)) (fold-of "z" f b e c ...)))
    ((_ "z" f b e p? c ...)
      (if p? (fold-of "z" f b e c ...)))
    ((_ f i e c ...)
      (let ((b i)) (fold-of "z" f b e c ...)))))

(define-syntax list-of (syntax-rules ()
  ((_ arg ...) (reverse (fold-of
    (lambda (d a) (cons a d)) '() arg ...)))))

(define (f vec)
  (let ((len (vector-length vec)))
    (let loop ((lo 0) (hi 1))
      (when verbose? (display "first loop: ")
        (display lo) (display " ") (display hi) (newline))
      (if (zero? (vector-ref vec hi))
          (loop hi (min (+ hi hi) (- len 1)))
          (let loop ((lo lo) (hi hi))
            (let ((mid (quotient (+ lo hi) 2)))
              (when verbose? (display "second loop: ")
                (display lo) (display " ") (display mid)
                (display " ") (display hi) (newline))
              (cond ((= lo hi) hi)
                    ((zero? (vector-ref vec mid))
                      (loop (+ mid 1) hi))
                    (else (loop lo mid)))))))))

(define verbose? #t)
(display (f '#(0 0 1 1 1 1))) (newline)

(define (test n)
  (list-of (list vec result)
    (x range 1 n)
    (y range 1 n)
    (vec is (list->vector (append (make-list x 0) (make-list y 1))))
    (result is (f vec))
    (or (not (= (vector-ref vec result) 1))
        (not (= (vector-ref vec (- result 1)) 0)))))

(set! verbose? #f)
(display (test 100))


Output:
1
2
3
4
5
6
first loop: 0 1
first loop: 1 2
second loop: 1 1 2
second loop: 2 2 2
2
()


Create a new paste based on this one


Comments: