Ignore:
Timestamp:
07/22/10 00:03:13 (10 years ago)
Author:
Kon Lovett
Message:

More sections

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/combinators/trunk/sort-combinators.scm

    r18914 r18918  
    22;;;; Kon Lovett, Mar '09
    33
    4 (declare
    5   (usual-integrations)
    6   (generic)
    7   (inline)
    8   (local)
    9   (no-procedure-checks)
    10   (bound-to-procedure
    11     ##sys#check-closure) )
     4;; Issues
     5;;
     6;; - group/key is not a combinator
    127
    138(module sort-combinators (;export
     
    1510  make-equal/key make-less-than/key)
    1611
    17 (import scheme chicken srfi-1)
     12  (import scheme chicken srfi-1)
    1813
    19 (require-library srfi-1)
     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)) ) ) ) ) ) )
    2032
    2133;; Group a list of elements by some key attribute.
     
    2840
    2941(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)) ) ) ) ) )
     42  ((group-by keyproc equality) ls) )
    3543
    3644;; Define a less-than function for a sort of a structured sequence.
     
    4755;; E.g. to sort a list of lists by their first items, using
    4856;; string-case-insensitive comparison:
    49 ;; (make-hash-table (uni first string-ci-hash) (make-equal/key first string-ci=?))
     57;; (make-hash-table (o string-ci-hash first) (make-equal/key first string-ci=?))
    5058
    5159(define (make-equal/key keyproc #!optional (equal =))
Note: See TracChangeset for help on using the changeset viewer.