Paste code

(defstruct node key value left right)

(defun cluster-1 (proc test list)
  (labels
      ((insert (key value tree)
  (cond ((null tree)
  (make-node :key key :value (list value)))
        ((funcall test key (node-key tree))
  (let ((left (insert key value (node-left tree))))
    (make-node :key (node-key tree) :value (node-value tree)
        :left left :right (node-right tree))))
        ((funcall test (node-key tree) key)
  (let ((right (insert key value (node-right tree))))
    (make-node :key (node-key tree) :value (node-value tree)
        :left (node-left tree) :right right)))
        (t
  (let ((new (cons value (node-value tree))))
    (make-node :key key :value new
        :left (node-left tree) :right (node-right tree))))))
       (in-order (tree)
  (if (null tree) '()
      (append (in-order (node-left tree))
       (list (node-value tree))
       (in-order (node-right tree)))))
       (recurse (list tree)
  (if (null list)
      ;; flatten tree into a list
      (in-order tree)
      ;; build tree
      (recurse (cdr list) (insert (funcall proc (car list)) (car list) tree)))))
    (recurse list '())))

(lisp-unit:define-test cluster-1
  (let ((x '("this" "is" "a" "fun" "and" "useful" "program")))
    (lisp-unit:assert-equal
     '(("a") ("is") ("and" "fun") ("this") ("useful") ("program"))
     (cluster-1 #'length #'< x))
    (lisp-unit:assert-equal
     '(("and" "a") ("fun") ("is") ("program") ("this") ("useful"))
     (cluster (lambda (string)
  (elt string 0))
       #'char< x ))))