diff --git a/README.org b/README.org index f5cb2dc..c9309de 100644 --- a/README.org +++ b/README.org @@ -6,16 +6,17 @@ the composition of more primitive operations. #+BEGIN_SRC lisp DATA-LENS> (funcall (on (compress-runs :collector 'combine-matching-lists) (alexandria:compose - (over (juxt (element 0) - 'identity)) - (sorted 'string<))) - '("January" "February" "March" "April" - "May" "June" "July" "August" - "September" "October" "November" "December")) - #| ==> ((#\A "April" "August") + (over (data-lens:juxt + (data-lens:element 0) + 'identity)) + (sorted 'char< :key (element 0)))) + '("January" "February" "March" "April" + "May" "June" "July" "August" + "September" "October" "November" "December")) + #| ==> ((#\A "April" "August") (#\D "December") (#\F "February") - (#\J "January" "July" "June") + (#\J "January" "June" "July") (#\M "March" "May") (#\N "November") (#\O "October") diff --git a/lens.lisp b/lens.lisp index 46c4989..5408abd 100644 --- a/lens.lisp +++ b/lens.lisp @@ -52,15 +52,18 @@ acc (cons next acc)))) +(defun matching-list-reducer (test acc next) + (if (and acc + (funcall test (caar acc) (car next))) + (cons (cons (caar acc) + (append (cdar acc) + (cdr next))) + (cdr acc)) + (cons next acc))) + (defun combine-matching-lists (&key (test 'eql) &allow-other-keys) (lambda (acc next) - (if (and acc - (funcall test (caar acc) (car next))) - (cons (cons (caar acc) - (append (cdar acc) - (cdr next))) - (cdr acc)) - (cons next acc)))) + (matching-list-reducer test acc next))) (defun-ct compress-runs (&key (collector 'cons-new) (test 'eql) (key 'identity)) (lambda (it) @@ -72,7 +75,7 @@ (defun-ct sorted (comparator &rest r &key key) (declare (ignore key)) (lambda (it) - (apply #'sort (copy-seq it) comparator r))) + (apply #'stable-sort (copy-seq it) comparator r))) (defun-ct element (num) (lambda (it)