Add group-by to unstable/list.
This commit is contained in:
parent
8509b81f47
commit
29bea4863e
|
@ -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)))))))
|
||||
|
|
|
@ -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?)])
|
||||
|
|
|
@ -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]
|
||||
|
|
Loading…
Reference in New Issue
Block a user