From 7abf555a8a2211f79dc0d99f1225de89c735f7f3 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 21 May 2014 16:10:21 -0700 Subject: [PATCH] Make group-by preserve the ordering of the original list. --- pkgs/unstable-list-lib/unstable/list.rkt | 35 ++++++++++--------- .../unstable-doc/scribblings/list.scrbl | 4 ++- .../unstable-test/tests/unstable/list.rkt | 6 ++-- 3 files changed, 26 insertions(+), 19 deletions(-) diff --git a/pkgs/unstable-list-lib/unstable/list.rkt b/pkgs/unstable-list-lib/unstable/list.rkt index 0ab229336d..2d79d6f339 100644 --- a/pkgs/unstable-list-lib/unstable/list.rkt +++ b/pkgs/unstable-list-lib/unstable/list.rkt @@ -162,22 +162,25 @@ ;; groups together elements that are considered equal ;; =? should be reflexive, transitive and commutative (define (group-by key l [=? equal?]) - (for/fold ([res '()]) ; list of lists - ([elt (in-list l)]) - (let loop ([classes res] ; "zipper" of the equivalence classes - [rev-classes '()]) - (cond [(null? classes) - ;; did not find an equivalence class, create a new one - (cons (list elt) res)] - [(=? (key elt) (key (car (car classes)))) - ;; found the equivalence class - (append rev-classes ; we keep what we skipped - ;; we extend the current class - (list (cons elt (car classes))) - (cdr classes))] ; and add the rest - [else ; keep going - (loop (cdr classes) - (cons (car classes) rev-classes))])))) + (define classes + (for/fold ([res '()]) ; list of lists + ([elt (in-list l)]) + (let loop ([classes res] ; "zipper" of the equivalence classes + [rev-classes '()]) + (cond [(null? classes) + ;; did not find an equivalence class, create a new one + (cons (list elt) res)] + [(=? (key elt) (key (car (car classes)))) + ;; found the equivalence class + (append rev-classes ; we keep what we skipped + ;; we extend the current class + (list (cons elt (car classes))) + (cdr classes))] ; and add the rest + [else ; keep going + (loop (cdr classes) + (cons (car classes) rev-classes))])))) + ;; reverse each class, so that group-by is stable + (map reverse classes)) ;; (listof x) ... -> (listof (listof x)) (define (cartesian-product . ls) diff --git a/pkgs/unstable-pkgs/unstable-doc/scribblings/list.scrbl b/pkgs/unstable-pkgs/unstable-doc/scribblings/list.scrbl index bb28130cc0..116dc2cdb7 100644 --- a/pkgs/unstable-pkgs/unstable-doc/scribblings/list.scrbl +++ b/pkgs/unstable-pkgs/unstable-doc/scribblings/list.scrbl @@ -167,7 +167,9 @@ for which @racket[pred] produces a true value. (listof (listof A))]{ Groups the given list into equivalence classes, with equivalence being -determined by @racket[=?]. +determined by @racket[=?]. Within each equivalence class, @racket[group-by] +preserves the ordering of the original list. The ordering of the equivalence +classes themselves is unspecified. @examples[#:eval the-eval (group-by (lambda (x) (modulo x 3)) '(1 2 1 2 54 2 5 43 7 2 643 1 2 0)) diff --git a/pkgs/unstable-pkgs/unstable-test/tests/unstable/list.rkt b/pkgs/unstable-pkgs/unstable-test/tests/unstable/list.rkt index df0c519b4e..bd421ed06d 100644 --- a/pkgs/unstable-pkgs/unstable-test/tests/unstable/list.rkt +++ b/pkgs/unstable-pkgs/unstable-test/tests/unstable/list.rkt @@ -47,9 +47,11 @@ '(1 4 2 56 2 3) (lambda (x y) (or (and (even? x) (even? y)) (and (odd? x) (odd? y))))) - '((2 56 2 4) (3 1))) + '((4 2 56 2) (1 3))) (check-equal? (group-by car '((1 a) (4 b) (2 c) (56 d) (2 e) (3 f))) - '(((3 f)) ((56 d)) ((2 e) (2 c)) ((4 b)) ((1 a))))) + '(((3 f)) ((56 d)) ((2 c) (2 e)) ((4 b)) ((1 a)))) + (check-equal? (group-by even? '(1 2 3 4 5 6)) + '((2 4 6) (1 3 5)))) (test-suite "cartesian-product" (check-equal? (cartesian-product '(1 2 3) '(a b c)) '((1 a) (1 b) (1 c)