[ create a new paste ] login | about

Link: http://codepad.org/AVyPF6oO    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Dec 4:
; 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)


Output:
1
((6 9) (16 17) (25 26))


Create a new paste based on this one


Comments: