codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; 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 (max (+ 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))
Private
[
?
]
Run code
Submit