Reputation: 1425
In an application I'm working on in Racket I need to take a list of numbers and partition the list into sub-lists of consecutive numbers: (In the actual application, I'll actually be partitioning pairs consisting of a number and some data, but the principle is the same.)
i.e. if my procedure is called chunkify
then:
(chunkify '(1 2 3 5 6 7 9 10 11)) -> '((1 2 3) (5 6 7) (9 10 11))
(chunkify '(1 2 3)) -> '((1 2 3))
(chunkify '(1 3 4 5 7 9 10 11 13)) -> '((1) (3 4 5) (7) (9 10 11) (13))
(chunkify '(1)) -> '((1))
(chunkify '()) -> '(())
etc.
I've come up with the following in Racket:
#lang racket
(define (chunkify lst)
(call-with-values
(lambda ()
(for/fold ([chunk '()] [tail '()]) ([cell (reverse lst)])
(cond
[(empty? chunk) (values (cons cell chunk) tail)]
[(equal? (add1 cell) (first chunk)) (values (cons cell chunk) tail)]
[else (values (list cell) (cons chunk tail))])))
cons))
This works just fine, but I'm wondering given the expressiveness of Racket if there isn't a more straightforward simpler way of doing this, some way to get rid of the "call-with-values" and the need to reverse the list in the procedure etc., perhaps some way comepletely different.
My first attempt was based very loosely on a pattern with a collector in "The Little Schemer" and that was even less straightforward than the above:
(define (chunkify-list lst)
(define (lambda-to-chunkify-list chunk) (list chunk))
(let chunkify1 ([list-of-chunks '()]
[lst lst]
[collector lambda-to-chunkify-list])
(cond
[(empty? (rest lst)) (append list-of-chunks (collector (list (first lst))))]
[(equal? (add1 (first lst)) (second lst))
(chunkify1 list-of-chunks (rest lst)
(lambda (chunk) (collector (cons (first lst) chunk))))]
[else
(chunkify1 (append list-of-chunks
(collector (list (first lst)))) (rest lst) list)])))
What I'm looking for is something simple, concise and straightforward.
Upvotes: 10
Views: 3455
Reputation: 18917
Here's my version:
(define (chunkify lst)
(let loop ([lst lst] [last #f] [resint '()] [resall '()])
(if (empty? lst)
(append resall (list (reverse resint)))
(begin
(let ([ca (car lst)] [cd (cdr lst)])
(if (or (not last) (= last (sub1 ca)))
(loop cd ca (cons ca resint) resall)
(loop cd ca (list ca) (append resall (list (reverse resint))))))))))
It also works for the last test case.
Upvotes: 1
Reputation: 59
I want to play.
At the core this isn't really anything that's much different from what's been offered but it does put it in terms of the for/fold loop. I've grown to like the for loops as I think they make for much more "viewable" (not necessarily readable) code. However, (IMO -- oops) during the early stages of getting comfortable with racket/scheme I think it's best to stick to recursive expressions.
(define (chunkify lst)
(define-syntax-rule (consecutive? n chunk)
(= (add1 (car chunk)) n))
(if (null? lst)
'special-case:no-chunks
(reverse
(map reverse
(for/fold ([store `((,(car lst)))])
([n (cdr lst)])
(let*([chunk (car store)])
(cond
[(consecutive? n chunk)
(cons (cons n chunk) (cdr store))]
[else
(cons (list n) (cons chunk (cdr store)))])))))))
(for-each
(ƛ (lst)
(printf "input : ~s~n" lst)
(printf "output : ~s~n~n" (chunkify lst)))
'((1 2 3 5 6 7 9 10 11)
(1 2 3)
(1 3 4 5 7 9 10 11 13)
(1)
()))
Upvotes: 1
Reputation: 31147
Yet another way to do it.
#lang racket
(define (split-between pred xs)
(let loop ([xs xs]
[ys '()]
[xss '()])
(match xs
[(list) (reverse (cons (reverse ys) xss))]
[(list x) (reverse (cons (reverse (cons x ys)) xss))]
[(list x1 x2 more ...) (if (pred x1 x2)
(loop more (list x2) (cons (reverse (cons x1 ys)) xss))
(loop (cons x2 more) (cons x1 ys) xss))])))
(define (consecutive? x y)
(= (+ x 1) y))
(define (group-consecutives xs)
(split-between (λ (x y) (not (consecutive? x y)))
xs))
(group-consecutives '(1 2 3 5 6 7 9 10 11))
(group-consecutives '(1 2 3))
(group-consecutives '(1 3 4 5 7 9 10 11 13))
(group-consecutives '(1))
(group-consecutives '())
Upvotes: 2
Reputation: 236034
I can think of a simple, straightforward solution using a single procedure with only primitive list operations and tail recursion (no values
, let-values
, call-with-values
) - and it's pretty efficient. It works with all of your test cases, at the cost of adding a couple of if
expressions during initialization for handling the empty list case. It's up to you to decide if this is concise:
(define (chunkify lst)
(let ((lst (reverse lst))) ; it's easier if we reverse the input list first
(let loop ((lst (if (null? lst) '() (cdr lst))) ; list to chunkify
(cur (if (null? lst) '() (list (car lst)))) ; current sub-list
(acc '())) ; accumulated answer
(cond ((null? lst) ; is the input list empty?
(cons cur acc))
((= (add1 (car lst)) (car cur)) ; is this a consecutive number?
(loop (cdr lst) (cons (car lst) cur) acc))
(else ; time to create a new sub-list
(loop (cdr lst) (list (car lst)) (cons cur acc)))))))
Upvotes: 3
Reputation: 10653
Here's how I'd do it:
;; chunkify : (listof number) -> (listof (non-empty-listof number))
;; Split list into maximal contiguous segments.
(define (chunkify lst)
(cond [(null? lst) null]
[else (chunkify/chunk (cdr lst) (list (car lst)))]))
;; chunkify/chunk : (listof number) (non-empty-listof number)
;; -> (listof (non-empty-listof number)
;; Continues chunkifying a list, given a partial chunk.
;; rchunk is the prefix of the current chunk seen so far, reversed
(define (chunkify/chunk lst rchunk)
(cond [(and (pair? lst)
(= (car lst) (add1 (car rchunk))))
(chunkify/chunk (cdr lst)
(cons (car lst) rchunk))]
[else (cons (reverse rchunk) (chunkify lst))]))
It disagrees with your final test case, though:
(chunkify '()) -> '() ;; not '(()), as you have
I consider my answer more natural; if you really want the answer to be '(())
, then I'd rename chunkify
and write a wrapper that handles the empty case specially.
If you prefer to avoid the mutual recursion, you could make the auxiliary function return the leftover list as a second value instead of calling chunkify
on it, like so:
;; chunkify : (listof number) -> (listof (non-empty-listof number))
;; Split list into maximal contiguous segments.
(define (chunkify lst)
(cond [(null? lst) null]
[else
(let-values ([(chunk tail) (get-chunk (cdr lst) (list (car lst)))])
(cons chunk (chunkify tail)))]))
;; get-chunk : (listof number) (non-empty-listof number)
;; -> (values (non-empty-listof number) (listof number))
;; Consumes a single chunk, returns chunk and unused tail.
;; rchunk is the prefix of the current chunk seen so far, reversed
(define (get-chunk lst rchunk)
(cond [(and (pair? lst)
(= (car lst) (add1 (car rchunk))))
(get-chunk (cdr lst)
(cons (car lst) rchunk))]
[else (values (reverse rchunk) lst)]))
Upvotes: 4