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

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

More sections

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