2012-04-29 68 views
11

En una aplicación en la que estoy trabajando Racket necesito tomar una lista de números y dividir la lista en sublistas de números consecutivos: (En la aplicación real, en realidad estaré la partición de pares formados por un número y algunos datos, pero el principio es el mismo)Particionando una lista en Racket

es decir, si mi procedimiento se llama chunkify a continuación:.

(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.

yo he llegado con el siguiente en Raqueta:

#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)) 

Esto funciona muy bien, pero me pregunto dada la expresividad de la raqueta si no hay una manera más sencilla más sencilla de hacer esto, de alguna manera para deshacerse de los "valores call-con-" y la necesidad de invertir la lista en el procedimiento, etc., quizás de alguna manera completamente diferente.

Mi primer intento fue muy vagamente basada en un patrón con un colector en "The Little Schemer" y que era incluso menos sencilla que la anterior:

(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)]))) 

Lo que estoy buscando es algo sencillo, conciso y directo.

+0

Esto es más de un "por favor revisa mi código", no "lo que está mal con mi código", por lo que creo que pertenecería a www.codereview.stackexchange.com –

Respuesta

4

Así es como yo lo haría:

;; 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))])) 

que no está de acuerdo con su caso prueba final, sin embargo:

(chunkify '()) -> '() ;; not '(()), as you have 

Considero mi respuesta más natural; si realmente quieres que la respuesta sea '(()), renombraré chunkify y escribiré un contenedor que maneje el estuche vacío especialmente.

Si prefiere evitar la recursión mutua, se puede hacer la función auxiliar devuelve la lista de sobra como un segundo valor en lugar de llamar chunkify en él, así:

;; 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)])) 
+0

Gracias Ryan. El caso de prueba final es irrelevante, por lo que '() o' (()) está bien. Simplemente puse eso porque lo probé solo para ver que no conseguí algo extraño por eso. –

+0

Gracias de nuevo. La recursión mutua es el patrón que estaba buscando pero que no pude descifrar. Una recursión para crear los fragmentos y otra que los constriñe a la lista de fragmentos. –

3

puedo pensar en una solución sencilla y directa utilizando un único procedimiento con operaciones de lista única primitivas y la recursión de cola (sin values, let-values, call-with-values) - y es bastante eficiente. Funciona con todos sus casos de prueba, a costa de agregar un par de expresiones if durante la inicialización para manejar el caso de la lista vacía. Depende de usted decidir si esto es concisa:

(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))))))) 
+1

Gracias Oscar, eso fue muy rápido (algo así como 40 minutos de mi publicación). Es un poco humillante cuando pienso cuánto tiempo tardé en llegar a mi solución :-) Saludos. –

3

Sin embargo, otra manera de hacerlo .

#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 '()) 
+0

Gracias soegaard, particularmente por mostrar el uso de la coincidencia de patrones. –

1

Quiero jugar.

En el núcleo esto no es realmente nada que sea muy diferente de lo que se ha ofrecido pero lo pone en términos del bucle for/fold. He crecido para que me gusten los bucles for, ya que creo que hacen mucho más más código "visible" (no necesariamente legible).Sin embargo, (IMO - oops) durante las primeras etapas de sentirse cómodo con raqueta/esquema, creo que es mejor apegarse a las expresiones recursivas.

(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) 
    ())) 
+0

Muchas gracias dlm. Usando Racket hay tantas formas diferentes de hacer las cosas. Me he ido con la solución de Ryan pero paso "¿consecutiva?" como una función de primera clase. Ya que utilizo "Chunkify" con varios tipos diferentes de listas de listas en la aplicación. –

1

aquí está mi versión:

(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)))))))))) 

También funciona para el último caso de prueba.

Cuestiones relacionadas