source: project/release/4/combinators/tags/1.1.0/sort-combinators.scm @ 18914

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

Added section.

File size: 1.6 KB
Line 
1;;;; sort-combinators.scm
2;;;; Kon Lovett, Mar '09
3
4(declare
5  (usual-integrations)
6  (generic)
7  (inline)
8  (local)
9  (no-procedure-checks)
10  (bound-to-procedure
11    ##sys#check-closure) )
12
13(module sort-combinators (;export
14  group/key
15  make-equal/key make-less-than/key)
16
17(import scheme chicken srfi-1)
18
19(require-library srfi-1)
20
21;; Group a list of elements by some key attribute.
22;;
23;; The list must be in sorted order with respect to the key.
24;;
25;; examples:
26;; (group/key identity '(1 2 3 3 4 4 4)) --> ((1) (2) (3 3) (4 4 4))
27;; (group/key car '((a 1) (a 2) (b 1))) --> '(((a 1) (a 2)) ((b 1)))
28
29(define (group/key keyproc ls #!optional (equality equal?))
30  (let loop ((ls ls) (acc '()))
31    (if (null? ls) acc #;(reverse! acc)
32        (let ((key (keyproc (car ls))))
33          (receive (grouped rest) (span (lambda (item) (equality key (keyproc item))) ls)
34            (loop rest (cons grouped acc)) ) ) ) ) )
35
36;; Define a less-than function for a sort of a structured sequence.
37;;
38;; E.g. to sort a list of lists by their first items, using
39;; string-case-insensitive comparison:
40;; (sort ls (make-less-than/key first string-ci<?))
41
42(define (make-less-than/key keyproc #!optional (less-than <))
43  (lambda (a b) (less-than (keyproc a) (keyproc b)) ) )
44
45;; Define a equal function for a sort of a structured sequence.
46;;
47;; E.g. to sort a list of lists by their first items, using
48;; string-case-insensitive comparison:
49;; (make-hash-table (uni first string-ci-hash) (make-equal/key first string-ci=?))
50
51(define (make-equal/key keyproc #!optional (equal =))
52  (lambda (a b) (equal (keyproc a) (keyproc b)) ) )
53
54) ;module sort-combinators
Note: See TracBrowser for help on using the repository browser.