; collect sets of ranges
(define (ranges . xs)
(let loop ((xs xs) (in-run #f) (prev #f))
(cond ((null? xs)
(when (and in-run prev)
(display "-")
(display prev))
(newline))
(in-run
(if (= (car xs) (+ 1 prev))
(loop (cdr xs) #t (car xs))
(begin (display "-")
(display prev)
(display ", ")
(display (car xs))
(loop (cdr xs) #f (car xs)))))
((and prev (= (car xs) (+ 1 prev)))
(loop (cdr xs) #t (car xs)))
(else (when prev (display ", "))
(display (car xs))
(loop (cdr xs) #f (car xs))))))
(display (ranges 0 1 2 7 21 22 108 109)) (newline)
(define (collect . xs)
(if (null? xs) (list)
(let loop ((xs (cdr xs))
(start (car xs))
(prev (car xs))
(zs (list)))
(cond ((null? xs) ; end of input
(if (= start prev)
(reverse (cons prev zs))
(reverse (cons (cons start prev) zs))))
((= (car xs) (+ prev 1)) ; continue run
(loop (cdr xs) start (car xs) zs))
(else ; end run, start new run
(if (= start prev)
(loop (cdr xs) (car xs) (car xs)
(cons prev zs))
(loop (cdr xs) (car xs) (car xs)
(cons (cons start prev) zs))))))))
(display (collect 0 1 2 7 21 22 108 109)) (newline)
(define (display-ranges xs)
(cond ((pair? (car xs))
(display (caar xs))
(display "-")
(display (cdar xs)))
(else (display (car xs))))
(when (pair? (cdr xs))
(display ", ")
(display-ranges (cdr xs))))
(display (display-ranges (collect 0 1 2 7 21 22 108 109))) (newline)
(define (collect-by break? . xs)
(if (null? xs) (list)
(let loop ((xs (cdr xs))
(start (car xs))
(prev (car xs))
(zs (list)))
(cond ((null? xs) ; end of input
(if (equal? start prev)
(reverse (cons prev zs))
(reverse (cons (cons start prev) zs))))
((break? prev (car xs)) ; continue run
(loop (cdr xs) start (car xs) zs))
(else ; end run, start new run
(if (equal? start prev)
(loop (cdr xs) (car xs) (car xs)
(cons prev zs))
(loop (cdr xs) (car xs) (car xs)
(cons (cons start prev) zs))))))))
(define (consecutive? a b) (= (+ a 1) b))
(display (display-ranges (collect-by consecutive? 0 1 2 7 21 22 108 109))) (newline)
(define (split-between pred? xs)
(let loop ((xs xs) (ys (list)) (xss (list)))
(cond ((null? xs) ; no input
(reverse (cons (reverse ys) xss)))
((null? (cdr xs)) ; singleton input
(reverse (cons (reverse (cons (car xs) ys)) xss)))
((pred? (car xs) (cadr xs)) ; start a new group
(loop (cons (cadr xs) (cddr xs)) (list)
(cons (reverse (cons (car xs) ys)) xss)))
(else ; extend an existing group
(loop (cons (cadr xs) (cddr xs))
(cons (car xs) ys) xss)))))
(define (display-ranges . xs)
(let loop ((xss (split-between (complement consecutive?) xs)))
(cond ((and (pair? (car xss)) (pair? (cdar xss)))
(display (caar xss))
(display "-")
(display (car (reverse (car xss)))))
(else (display (caar xss))))
(when (pair? (cdr xss))
(display ", ")
(loop (cdr xss))))
(newline))
(display (display-ranges (split-between consecutive? '(0 1 2 7 21 22 108 109)))) (newline)