Page 2 of 2

Re: A procedure to extract atoms from a list

Posted: Sun Mar 08, 2009 9:01 pm
by Kohath
How about this? Define a function to map over a tree in a way analogous to mapc, say we call it maptree, and then use it with pushnew:

Code: Select all

(let ((result nil))
  (maptree #'(lambda (item)
               (when (atom item)
                 (pushnew item result)))
           your-tree)
  result)

Re: A procedure to extract atoms from a list

Posted: Mon Mar 09, 2009 5:55 am
by gugamilare
Actually this version seems pretty good. But it seems to be difficult to change if you problem changes a bit (at least to me).
For instance, I've concluded these (both yours and eric-and-jane-smith's) algorithm is O(n^2) in the worst case. If the elements have a total order (e.g. numbers) it is possible to make a O(n log(n)) version when the implementation sort algorithm is O(n logn) (e.g. on SBCL, even for lists):

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)))
It seems to work:

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)
Off course, due to code complexity, the extract-ordered-atoms should be slower for small lists. This must not be the case of extract-sort-ordered-atoms, although I didn't test if this is true.

I don't know how to adapt your version for this case, unless if we change the pushnew with push, which would make it a disguised flatten.