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

Last change on this file was 34400, checked in by Kon Lovett, 3 years ago

re-flow

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