25 lines
744 B
Scheme
25 lines
744 B
Scheme
(define (lis less? lst)
|
|
(define pile-tops (make-vector (length lst)))
|
|
(define (bsearch-piles x len)
|
|
(let aux ((lo 0)
|
|
(hi (- len 1)))
|
|
(if (> lo hi)
|
|
lo
|
|
(let ((mid (quotient (+ lo hi) 2)))
|
|
(if (less? (car (vector-ref pile-tops mid)) x)
|
|
(aux (+ mid 1) hi)
|
|
(aux lo (- mid 1)))))))
|
|
(let aux ((len 0)
|
|
(lst lst))
|
|
(if (null? lst)
|
|
(reverse (vector-ref pile-tops (- len 1)))
|
|
(let* ((x (car lst))
|
|
(i (bsearch-piles x len)))
|
|
(vector-set! pile-tops i (cons x (if (= i 0)
|
|
'()
|
|
(vector-ref pile-tops (- i 1)))))
|
|
(aux (if (= i len) (+ len 1) len) (cdr lst))))))
|
|
|
|
(display (lis < '(3 2 6 4 5 1))) (newline)
|
|
(display (lis < '(0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15))) (newline)
|