codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; free time (define (flatten xs) (cond ((null? xs) xs) ((pair? xs) (append (flatten (car xs)) (flatten (cdr xs)))) (else (list xs)))) (define (free-time . xss) (let* ((lo (apply min (flatten xss))) (hi (apply max (flatten xss))) (len (- hi lo -1)) (free (make-vector len #t))) (do ((xss xss (cdr xss))) ((null? xss)) (do ((xs (car xss) (cdr xs))) ((null? xs)) (do ((i (caar xs) (+ i 1))) ((< (cadar xs) i)) (vector-set! free (- i lo) #f)))) (let loop ((in-free? #f) (start #f) (i 0) (xs (list))) (cond ((and in-free? (= i len)) (reverse (cons (list start (+ i lo)) xs))) ((= i len) (reverse xs)) ((and in-free? (vector-ref free i)) (loop #t start (+ i 1) xs)) ((and in-free? (not (vector-ref free i))) (loop #f #f (+ i 1) (cons (list start (+ i lo -1)) xs))) ((vector-ref free i) (loop #t (+ i lo) (+ i 1) xs)) ((not (vector-ref free i)) (loop #f #f (+ i 1) xs)))))) (define mike '((1 5) (10 14) (19 20) (21 24) (27 30))) (define sally '((3 5) (12 15) (18 21) (23 24))) (display (free-time mike sally)) (newline)
Private
[
?
]
Run code
Submit