Add group-by to unstable/list.

This commit is contained in:
Vincent St-Amour 2011-11-30 17:16:33 -05:00
parent 8509b81f47
commit 29bea4863e
3 changed files with 57 additions and 1 deletions

View File

@ -37,4 +37,16 @@
(map/values 3 values '(1 2 3) '(4 5 6) '(7 8 9))])
(check-equal? as '(1 2 3))
(check-equal? bs '(4 5 6))
(check-equal? cs '(7 8 9)))))))
(check-equal? cs '(7 8 9)))))
(test-suite "group-by"
(check-equal? (group-by = '(1 4 2 56 2 3))
'((3) (56) (2 2) (4) (1)))
(check-equal? (group-by = '(1 2 1 2 54 2 5 43 7 2 643 1 2 0))
'((0) (2 2 2 2 2) (7) (43) (5) (54) (643) (1 1 1)))
(check-equal? (group-by (lambda (x y) (or (and (even? x) (even? y))
(and (odd? x) (odd? y))))
'(1 4 2 56 2 3))
'((2 56 2 4) (3 1)))
(check-equal? (group-by = '((1 a) (4 b) (2 c) (56 d) (2 e) (3 f))
#:key car)
'(((3 f)) ((56 d)) ((2 e) (2 c)) ((4 b)) ((1 a)))))))

View File

@ -154,3 +154,31 @@
(remf f (cdr ls)))]))
(provide/contract [remf (-> procedure? list? list?)])
;; stamourv added:
;; (y y -> bool) (listof x) #:key (x -> y) -> (listof (listof x))
;; groups together elements that are considered equal
;; =? should be reflexive, transitive and commutative
(define (group-by =? l #:key [key values])
(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))]))))
(provide/contract
[group-by (->* (procedure? list?) (#:key procedure?)
list?)])

View File

@ -160,4 +160,20 @@ for which @racket[pred] produces a true value.
}
@addition{Vincent St-Amour}
@defproc[(group-by [=? (-> B B any/c)]
[lst (listof A)]
[#:key extract-key (-> A B) values])
(listof (listof A))]{
Groups the given list into equivalence classes, with equivalence being
determined by @racket[=?].
@examples[#:eval the-eval
(group-by = '(1 2 1 2 54 2 5 43 7 2 643 1 2 0))
]
}
@close-eval[the-eval]