Code: Select all
(let ((result nil))
(maptree #'(lambda (item)
(when (atom item)
(pushnew item result)))
your-tree)
result)
Code: Select all
(let ((result nil))
(maptree #'(lambda (item)
(when (atom item)
(pushnew item result)))
your-tree)
result)
Code: Select all
(defun atoms (tree)
(when tree
(if (atom tree)
(list tree)
(nconc (atoms (car tree))
(atoms (cdr tree))))))
(defun extract-atoms (tree)
(remove-duplicates
(atoms tree)))
(defun delete-duplicates-with-order (list order-test &key (test #'eql) key)
(let ((last-elt (if key
(funcall key (first list))
(first list))))
(cons (car list)
(delete-if (lambda (x)
(prog1 (funcall test last-elt x)
(setf last-elt x)))
(cdr list)
:key key))))
;; this extracts atoms and return the sorted list acording to order-test
(defun extract-sort-ordered-atoms (tree order-test &key (test #'eql))
(let ((atoms (atoms tree)))
(delete-duplicates-with-order (sort atoms order-test) order-test :test test)))
;; if the actual order should be preserved, we need this complicated, extra-consing version
(defun extract-ordered-atoms (tree order-test &key (test #'eql))
(let* ((atoms (atoms tree))
;; saving the actual position of each atom so it can be restored later
(atoms-with-position (loop for elt in atoms
for pos from 0
collect (cons elt pos)))
;; sorting atoms acording to order-test
(sorted-atoms (sort atoms-with-position order-test :key #'car))
;; deleting duplicates as required by algorithm
(sorted-atoms-no-dups (delete-duplicates-with-order sorted-atoms order-test :key #'car))
;; restore the actual order as returned by atoms
(atoms-no-dups (sort sorted-atoms-no-dups #'< :key #'cdr)))
;; finally, throw away the position of each slot
(mapcar #'car atoms-no-dups)))
Code: Select all
CL-USER> (extract-sort-ordered-atoms '(((1 5 2) 3 4) 2 9 7 8 7 4 6 5 (9 0)) #'< :test #'=)
(0 1 2 3 4 5 6 7 8 9)
CL-USER> (extract-ordered-atoms '(((1 5 2) 3 4) 2 9 7 8 7 4 6 5 (9 0)) #'< :test #'=)
(1 5 2 3 4 9 7 8 6 0)