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

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

@ -162,6 +162,7 @@
;; groups together elements that are considered equal
;; =? should be reflexive, transitive and commutative
(define (group-by key l [=? equal?])
(define classes
(for/fold ([res '()]) ; list of lists
([elt (in-list l)])
(let loop ([classes res] ; "zipper" of the equivalence classes
@ -178,6 +179,8 @@
[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)

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

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

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