diff --git a/pkgs/contract-profile/boundary-view.rkt b/pkgs/contract-profile/boundary-view.rkt index 52769a235b..998002f6dc 100644 --- a/pkgs/contract-profile/boundary-view.rkt +++ b/pkgs/contract-profile/boundary-view.rkt @@ -187,7 +187,7 @@ (printf "splines=\"true\"\n") ; polyline kinda works too, maybe ;; cluster nodes per module, to show boundaries - (for ([module-nodes (in-list (group-by equal? nodes #:key node->module))] + (for ([module-nodes (in-list (group-by node->module nodes))] [cluster-idx (in-naturals 1)]) (define known-module? (node->module (first module-nodes))) ;; don't cluster nodes for which we have no module info diff --git a/pkgs/contract-profile/main.rkt b/pkgs/contract-profile/main.rkt index 9eb4036ee5..daf7f861d7 100644 --- a/pkgs/contract-profile/main.rkt +++ b/pkgs/contract-profile/main.rkt @@ -65,8 +65,8 @@ (displayln "\nBY CONTRACT\n") (define samples-by-contract - (sort (group-by equal? live-contract-samples - #:key (lambda (x) (blame-contract (car x)))) + (sort (group-by (lambda (x) (blame-contract (car x))) + live-contract-samples) > #:key length #:cache-keys? #t)) (for ([c (in-list samples-by-contract)]) (define representative (caar c)) @@ -78,8 +78,9 @@ (define representative (caar g)) (print-contract/loc representative) (for ([x (sort - (group-by equal? g - #:key (lambda (x) (blame-value (car x)))) ; callee source, maybe + (group-by (lambda (x) + (blame-value (car x))) ; callee source, maybe + g) > #:key length)]) (printf " ~a\n ~a ms\n" (blame-value (caar x)) @@ -88,8 +89,8 @@ (define samples-by-contract-by-caller (for/list ([g (in-list samples-by-contract)]) - (sort (group-by equal? (map sample-prune-stack-trace g) - #:key cddr) ; pruned stack trace + (sort (group-by cddr ; pruned stack trace + (map sample-prune-stack-trace g)) > #:key length))) (displayln "\nBY CALLER\n") diff --git a/pkgs/unstable-list-lib/unstable/list.rkt b/pkgs/unstable-list-lib/unstable/list.rkt index e897654799..8606ce1089 100644 --- a/pkgs/unstable-list-lib/unstable/list.rkt +++ b/pkgs/unstable-list-lib/unstable/list.rkt @@ -158,10 +158,10 @@ ;; stamourv added: -;; (y y -> bool) (listof x) #:key (x -> y) -> (listof (listof x)) +;; (x -> y) (listof x) [(y y -> bool)] -> (listof (listof x)) ;; groups together elements that are considered equal ;; =? should be reflexive, transitive and commutative -(define (group-by =? l #:key [key values]) +(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 @@ -180,7 +180,7 @@ (cons (car classes) rev-classes))])))) (provide/contract - [group-by (->* (procedure? list?) (#:key procedure?) + [group-by (->* (procedure? list?) (procedure?) list?)]) ;; endobson added: diff --git a/pkgs/unstable-pkgs/unstable-doc/scribblings/list.scrbl b/pkgs/unstable-pkgs/unstable-doc/scribblings/list.scrbl index eaca5f04dd..db2540293d 100644 --- a/pkgs/unstable-pkgs/unstable-doc/scribblings/list.scrbl +++ b/pkgs/unstable-pkgs/unstable-doc/scribblings/list.scrbl @@ -161,16 +161,16 @@ for which @racket[pred] produces a true value. @addition{Vincent St-Amour} -@defproc[(group-by [=? (-> B B any/c)] +@defproc[(group-by [extract-key (-> A B)] [lst (listof A)] - [#:key extract-key (-> A B) values]) + [=? (-> B B any/c) equal?]) (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)) +(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 98af4b2e69..8fb199649d 100644 --- a/pkgs/unstable-pkgs/unstable-test/tests/unstable/list.rkt +++ b/pkgs/unstable-pkgs/unstable-test/tests/unstable/list.rkt @@ -39,14 +39,14 @@ (check-equal? bs '(4 5 6)) (check-equal? cs '(7 8 9))))) (test-suite "group-by" - (check-equal? (group-by = '(1 4 2 56 2 3)) + (check-equal? (group-by values '(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)) + (check-equal? (group-by values '(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)) + (check-equal? (group-by values + '(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))) - (check-equal? (group-by = '((1 a) (4 b) (2 c) (56 d) (2 e) (3 f)) - #:key car) + (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)))))))