suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Make group-by preserve the ordering of the original list.

Browse Source
This commit is contained in:
Vincent St-Amour 2014-05-21 16:10:21 -07:00
parent fbcada2045
commit 7abf555a8a
3 changed files with 26 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
pkgs/unstable-list-lib/unstable/list.rkt
View File

@ -162,22 +162,25 @@
;; groups together elements that are considered equal ;; groups together elements that are considered equal
;; =? should be reflexive, transitive and commutative ;; =? should be reflexive, transitive and commutative
(define (group-by key l [=? equal?]) (define (group-by key l [=? equal?])
(for/fold ([res '()]) ; list of lists (define classes
([elt (in-list l)]) (for/fold ([res '()]) ; list of lists
(let loop ([classes res] ; "zipper" of the equivalence classes ([elt (in-list l)])
[rev-classes '()]) (let loop ([classes res] ; "zipper" of the equivalence classes
(cond [(null? classes) [rev-classes '()])
;; did not find an equivalence class, create a new one (cond [(null? classes)
(cons (list elt) res)] ;; did not find an equivalence class, create a new one
[(=? (key elt) (key (car (car classes)))) (cons (list elt) res)]
;; found the equivalence class [(=? (key elt) (key (car (car classes))))
(append rev-classes ; we keep what we skipped ;; found the equivalence class
;; we extend the current class (append rev-classes ; we keep what we skipped
(list (cons elt (car classes))) ;; we extend the current class
(cdr classes))] ; and add the rest (list (cons elt (car classes)))
[else ; keep going (cdr classes))] ; and add the rest
(loop (cdr classes) [else ; keep going
(cons (car classes) rev-classes))])))) (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)) ;; (listof x) ... -> (listof (listof x))
(define (cartesian-product . ls) (define (cartesian-product . ls)

4
pkgs/unstable-pkgs/unstable-doc/scribblings/list.scrbl
View File

@ -167,7 +167,9 @@ for which @racket[pred] produces a true value.
(listof (listof A))]{ (listof (listof A))]{
Groups the given list into equivalence classes, with equivalence being 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 @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)) (group-by (lambda (x) (modulo x 3)) '(1 2 1 2 54 2 5 43 7 2 643 1 2 0))

6
pkgs/unstable-pkgs/unstable-test/tests/unstable/list.rkt
View File

@ -47,9 +47,11 @@
'(1 4 2 56 2 3) '(1 4 2 56 2 3)
(lambda (x y) (or (and (even? x) (even? y)) (lambda (x y) (or (and (even? x) (even? y))
(and (odd? x) (odd? 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))) (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" (test-suite "cartesian-product"
(check-equal? (cartesian-product '(1 2 3) '(a b c)) (check-equal? (cartesian-product '(1 2 3) '(a b c))
'((1 a) (1 b) (1 c) '((1 a) (1 b) (1 c)