Fix example a bit

This commit is contained in:
Ed Langley
2018-08-18 13:06:28 -07:00
parent 289289e708
commit 48ff3c1166
2 changed files with 20 additions and 16 deletions

View File

@ -6,16 +6,17 @@ the composition of more primitive operations.
#+BEGIN_SRC lisp #+BEGIN_SRC lisp
DATA-LENS> (funcall (on (compress-runs :collector 'combine-matching-lists) DATA-LENS> (funcall (on (compress-runs :collector 'combine-matching-lists)
(alexandria:compose (alexandria:compose
(over (juxt (element 0) (over (data-lens:juxt
'identity)) (data-lens:element 0)
(sorted 'string<))) 'identity))
'("January" "February" "March" "April" (sorted 'char< :key (element 0))))
"May" "June" "July" "August" '("January" "February" "March" "April"
"September" "October" "November" "December")) "May" "June" "July" "August"
"September" "October" "November" "December"))
#| ==> ((#\A "April" "August") #| ==> ((#\A "April" "August")
(#\D "December") (#\D "December")
(#\F "February") (#\F "February")
(#\J "January" "July" "June") (#\J "January" "June" "July")
(#\M "March" "May") (#\M "March" "May")
(#\N "November") (#\N "November")
(#\O "October") (#\O "October")

View File

@ -52,15 +52,18 @@
acc acc
(cons next 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) (defun combine-matching-lists (&key (test 'eql) &allow-other-keys)
(lambda (acc next) (lambda (acc next)
(if (and acc (matching-list-reducer test acc next)))
(funcall test (caar acc) (car next)))
(cons (cons (caar acc)
(append (cdar acc)
(cdr next)))
(cdr acc))
(cons next acc))))
(defun-ct compress-runs (&key (collector 'cons-new) (test 'eql) (key 'identity)) (defun-ct compress-runs (&key (collector 'cons-new) (test 'eql) (key 'identity))
(lambda (it) (lambda (it)
@ -72,7 +75,7 @@
(defun-ct sorted (comparator &rest r &key key) (defun-ct sorted (comparator &rest r &key key)
(declare (ignore key)) (declare (ignore key))
(lambda (it) (lambda (it)
(apply #'sort (copy-seq it) comparator r))) (apply #'stable-sort (copy-seq it) comparator r)))
(defun-ct element (num) (defun-ct element (num)
(lambda (it) (lambda (it)