source: project/release/4/combinators/trunk/sort-combinators.scm @ 19028

Last change on this file since 19028 was 19028, checked in by Kon Lovett, 10 years ago

Export Scheme-ish uni, etc. & arguments-X routines

File size: 2.2 KB
Line 
1;;;; sort-combinators.scm
2;;;; Kon Lovett, Mar '09
3
4;; Issues
5;;
6;; - group/key is not a combinator
7
8(module sort-combinators (;export
9  group-by group/key
10  make-equal/key make-less-than/key)
11
12  (import
13    scheme
14    chicken
15    (only srfi-1 span)
16    (only bi-combinators bi-each))
17
18  (require-library srfi-1 bi-combinators)
19
20  (declare
21    (type
22      (group-by (procedure ((procedure (*) *) #!optional (procedure (* *) boolean)) (procedure (list) list)))
23      (group/key (procedure ((procedure (*) *) list #!optional (procedure (* *) boolean)) list))
24      (make-less-than/key (procedure ((procedure (*) *) #!optional (procedure (* *) boolean)) (procedure (* *) boolean)))
25      (make-equal/key (procedure ((procedure (*) *) #!optional (procedure (* *) boolean)) (procedure (* *) boolean))) ) )
26
27;;
28
29;kinda violates the argument list orientation of comibinators
30(define (group-by proc #!optional (equals equal?))
31  (lambda (ls)
32    (let loop ((ls ls) (acc '()))
33      (if (null? ls) acc #;(reverse! acc)
34          (let ((key (proc (car ls))))
35            (receive (grouped rest) (span (lambda (item) (equals key (proc item))) ls)
36              (loop rest (cons grouped acc)) ) ) ) ) ) )
37
38;; Group a list of elements by some key attribute.
39;;
40;; The list must be in sorted order with respect to the key.
41;;
42;; examples:
43;; (group/key identity '(1 2 3 3 4 4 4)) --> ((1) (2) (3 3) (4 4 4))
44;; (group/key car '((a 1) (a 2) (b 1))) --> '(((a 1) (a 2)) ((b 1)))
45
46(define (group/key keyproc ls #!optional (equals equal?))
47  ((group-by keyproc equals) ls) )
48
49;; Define a less-than function for a sort of a structured sequence.
50;;
51;; E.g. to sort a list of lists by their first items, using
52;; string-case-insensitive comparison:
53;; (sort ls (make-less-than/key first string-ci<?))
54
55(define (make-less-than/key keyproc #!optional (less-than <))
56  (bi-each less-than keyproc) )
57
58;; Define a equal function for a sort of a structured sequence.
59;;
60;; E.g. to sort a list of lists by their first items, using
61;; string-case-insensitive comparison:
62;; (make-hash-table (o string-ci-hash first) (make-equal/key first string-ci=?))
63
64(define (make-equal/key keyproc #!optional (equals =))
65  (bi-each equals keyproc) )
66
67) ;module sort-combinators
Note: See TracBrowser for help on using the repository browser.