(emacs) lisp: search anything in a ((nested) list)

6
votes

I need to locate a particular value that can be buried into a deeply nested list, and never at the same place. Or even the same depth ; Here is one form of the list:

(setq my-list '(((partnum . 1) (type (TEXT . plain)) (body (charset UTF-8))
                 (disposition nil) (transfer-encoding QUOTED-PRINTABLE))
                ((partnum . 2) (type (TEXT . html)) (body (charset UTF-8))
                 (disposition nil) (transfer-encoding QUOTED-PRINTABLE))))

Now I need to retrieve the value of "charset" ; The first one if any. In this very configuration, it's easy:

(car (cdr (cadr (third (car my-list)))))
   => UTF-8

But this is when I know exactly where the "body" cell is.

I tried to use mapcar recursively like this :

(defun search-rec (list)
  (mapcar
     (lambda (x)
       (if (listp x)
           (search-rec x)
         (message "OY %s" x)))
     list))

but every time, I get the error (wrong-type-argument listp 1) when the recursion hits the first atom of the first cons cell. I guess my question really is what it is :

How can I search in a list?

EDIT Now the list looks like this, "charset" is still in (body) (told you that was about the only constant thing) and it's no longer found :(

(setq my-list '(((partnum . 1)
                (1.1 (type (TEXT . plain)) (body (charset UTF-8))
                     (disposition nil) (transfer-encoding 7BIT))
                (1.2 (type (TEXT . html)) (body (charset UTF-8))
                     (disposition nil) (transfer-encoding 7BIT))
                (type . alternative) (body (boundary e89a8fb2067eba300404c63c5f7f))
                (disposition nil) (transfer-encoding nil))
               ((partnum . 1.1) (type (TEXT . plain)) (body (charset UTF-8))
                (disposition nil) (transfer-encoding 7BIT))
               ((partnum . 1.2) (type (TEXT . html)) (body (charset UTF-8))
                (disposition nil) (transfer-encoding 7BIT))
               ((partnum . 2) (type (IMAGE . x-xpixmap)) (body (name ladybug.xpm))
                (disposition nil) (transfer-encoding BASE64))))

EDIT here is some more IRL example:

    (setq my-list haystack-list)
    (setq my-needle (tree-assoc 'charset my-list))
    (message "
-------------\n
- my-list: %s\n
- my-needle: %s\n
-------------\n" my-list my-needle)

Produces:

  • my-list: ((TEXT plain (charset UTF-8) nil nil 7BIT 260 18 nil nil nil) (TEXT html (charset UTF-8) nil nil QUOTED-PRINTABLE 738 17 nil nil nil) alternative (boundary e89a8fb1f8061a6be404c70a24a0) nil nil)

  • my-needle: nil

When on the other hand:

(tree-assoc 'charset '((TEXT plain (charset UTF-8) nil nil 7BIT 260 18 nil nil nil)
(TEXT html (charset UTF-8) nil nil QUOTED-PRINTABLE 738 17 nil nil nil) 
alternative (boundary e89a8fb1f8061a6be404c70a24a0) nil nil))
  =>(charset UTF-8)

So really, I don't know what's going on here : One could argue "what is this haystack-list and where does it come from?" But is it relevant ? I'm working on a copy (my-list) of this haystack-list so what gives those different results ? The quoting of the list ? Guys, I'm really lost

NB (This behaviour (Works in a direct eval, but not in a defun/let production situation) occurred with all the solution given)

EDIT: I ended up extracting the first list found, and then extracting (not searching) elements from that list. I proved faster ; Of course this is when you can say "my element is always in the fist list found) ; thanks to everybody, I learned a lot through all this.

4
algorithmemacslispelisp
Whatever is generating those lists should probably be generating string values rather than symbol values. I suspect part of your problem stems from there and it will make further processing difficult. - Vatine
I guess you're right, Vatine. Nearly every solution given here worked on the quoted list examples, but broke in the let context (on a "listp" test. Like the whole idea was not to distiguish between lists and atoms... I'm lost). Problem is, this list is generated by a big (imap.el) and I don't want to edit it... - yPhil
So far, it seems that what I'm trying to do (search for "something" into "my-list" no matter what my-list exactly is as long as it is a syntactically correct list) is impossible. I did not know that some lists could be "improper"... Hum. - yPhil

4 Answers

7
votes

It looks like you want the tree analog of Association Lists. By following the conventions of the assoc function, which retrieves the list element that contains the given key as its head, here is a version of assoc that works on tree:

(defun tree-assoc (key tree)
  (when (consp tree)
    (destructuring-bind (x . y)  tree
      (if (eql x key) tree
        (or (tree-assoc key x) (tree-assoc key y))))))

Example: 

(let ((my-list '(((partnum . 1)
                  (1.1 (type (TEXT . plain)) (body (charset UTF-8))
                   (disposition nil) (transfer-encoding 7BIT))
                  (1.2 (type (TEXT . html)) (body (charset UTF-8))
                   (disposition nil) (transfer-encoding 7BIT))
                  (type . alternative) (body (boundary e89a8fb2067eba300404c63c5f7f))
                  (disposition nil) (transfer-encoding nil))
                 ((partnum . 1.1) (type (TEXT . plain)) (body (charset UTF-8))
                  (disposition nil) (transfer-encoding 7BIT))
                 ((partnum . 1.2) (type (TEXT . html)) (body (charset UTF-8))
                  (disposition nil) (transfer-encoding 7BIT))
                 ((partnum . 2) (type (IMAGE . x-xpixmap)) (body (name ladybug.xpm))
                  (disposition nil) (transfer-encoding BASE64)))))
  (tree-assoc 'charset my-list))

=> (charset UTF-8)
2
votes

It depends a bit of what you're wanting to do and how similar the list structures are (that is, do you always have a list of HTML parts? is the charset always inside a body element?)

A first step may be:

(defun list-query (list-of-keys data)
  (let ((data data))
    (while (and data list-of-keys)
      (setq data (assoc (car list-of-keys) data))
      (setq list-of-keys (cdr list-of-keys)))
    data))

Calling (list-query '(body charset) (car my-list)) gives (charset UTF-8) as a result. Looping over my-list to find the first (or all) charsets inside body lists should be relatively easy.

2
votes

As Rainer's answer implicitly indicates, the problem you're running into is that the cdr of a cons cell might point to a list or it might point to some other kind of object; your search-rec function doesn't guard against the latter possibility.

Here's an Elisp version of what you're looking for (not thoroughly tested; works with your example data):

(defun find-charset (l)
  (catch 'my-result
    (find-charset-do l)))

(defun find-charset-do (l)
  (when (and (consp l) 
             (listp (cdr l)))
    (if (and (eq (car l) 'charset)
             (symbolp (cadr l)))
        (throw 'my-result (cadr l))
      (dolist (e l)
        (find-charset-do e)))))
2
votes

Here's my take at the problem, perhaps you'll find it useful:

(defun depth-first-search (tree searched &optional comparator)
  "TREE is the nested list of elements to search, SEARCHED
is the element to search for, COMPARATOR is the function used
to compare elements of the tree to the searched element, if
you don't provide any, then `equal' is used.
Returns a list of subscripts to be used with `nth' to find the
searched element. If the result is `nil', the list itself
is the searched element. If the result is not a list,
the `not-found' symbol, then the element was not found."
  (unless comparator (setq comparator #'equal))
  (let ((operations 'not-found))
    (labels ((%df-search
              (item ops)
              (if (funcall comparator item searched)
                  (setq operations (reverse ops))
                (let ((offset 0))
                  (when (consp item)
                    (dolist (i item)
                      (%df-search i (cons offset ops))
                      (unless (eq operations 'not-found)
                        (return))
                      (incf offset)))))))
      (%df-search tree nil)
      operations)))

(defun nth-repeat (subscripts tree)
  "Given the list of SUBSCRIPTS, will subsequently evaluate
`nth' with every subscript on the result of the previous evaluation
 such as to find the element in the TREE."
  (let ((result tree))
    (dolist (i subscripts result)
      (setq result (nth i result)))))

(nth-repeat 
 (depth-first-search '(1 (1 1 2) (1 1 1 3)) 3)
 '(1 (1 1 2) (1 1 1 3)))

It will require that you use cl but this is so common, that you probably won't even notice that, most chances are you already have it.

EDIT: OK, this way you can avoid entirely looking into the last element of improper lists, however, this means you cannot search there either:

(defun depth-first-search (tree searched &optional comparator)
  "TREE is the nested list of elements to search, SEARCHED
is the element to search for, COMPARATOR is the function used
to compare elements of the tree to the searched element, if
you don't provide any, then `equal' is used.
Returns a list of subscripts to be used with `nth' to find the
searched element. If the result is `nil', the list itself
is the searched element. If the result is not a list,
the `not-found' symbol, then the element was not found."
  (unless comparator (setq comparator #'equal))
  (let ((operations 'not-found))
    (labels ((%df-search
              (item ops)
              (if (funcall comparator item searched)
                  (setq operations (reverse ops))
                (let ((offset 0))
                  (when (consp item)
                    (block outer
                      (maplist
                       (lambda (x)
                         (%df-search (car x) (cons offset ops))
                         (when (or (not (eq operations 'not-found))
                                   (not (listp (cdr x))))
                           (return-from outer))
                         (incf offset))
                       item)))))))
      (%df-search tree nil)
      operations)))

(defun nth-repeat (subscripts tree)
  "Given the list of SUBSCRIPTS, will subsequently evaluate
`nth' with every subscript on the result of the previous evaluation
 such as to fint the element in the TREE."
  (let ((result tree))
    (dolist (i subscripts result)
      (setq result (nth i result)))))

(defvar my-list '(((partnum . 1)
                   (1.1 (type (TEXT . plain)) (body (charset UTF-8))
                        (disposition nil) (transfer-encoding 7BIT))
                   (1.2 (type (TEXT . html)) (body (charset UTF-8))
                        (disposition nil) (transfer-encoding 7BIT))
                   (type . alternative) (body (boundary e89a8fb2067eba300404c63c5f7f))
                   (disposition nil) (transfer-encoding nil))
                  ((partnum . 1.1) (type (TEXT . plain)) (body (charset UTF-8))
                   (disposition nil) (transfer-encoding 7BIT))
                  ((partnum . 1.2) (type (TEXT . html)) (body (charset UTF-8))
                   (disposition nil) (transfer-encoding 7BIT))
                  ((partnum . 2) (type (IMAGE . x-xpixmap)) (body (name ladybug.xpm))
                   (disposition nil) (transfer-encoding BASE64))))

(depth-first-search
 my-list '(charset UTF-8))              ; (0 1 2 1)

(nth-repeat
 (depth-first-search
  my-list '(charset UTF-8)) my-list)    ; (charset UTF-8)

Probably, not the best way to approach the problem, but a better solution would require changing the algorithm to record a sequence of cars and cdrs that would take you to the element in question. In which case you could also search in the "improper" part of the list. But it's too late here now :) Perhaps tomorrow.

EDIT 2:

(defun tree-to-proper-tree (tree)
  (cond
   ((null tree) nil)
   ((consp tree)
    (let ((head
           (if (consp (car tree))
               (tree-to-proper-tree (car tree))
             (car tree))))
    (cons head
          (tree-to-proper-tree (cdr tree)))))
   (t (list tree))))

(defun find-path-to (tree node &optional comparator)
  (unless comparator (setq comparator #'equal))
  (let ((operations 'not-found))
    (labels ((%df-search
              (item ops)
              (if (funcall comparator item node)
                  (setq operations (reverse ops))
                (when (consp item)
                      (%df-search (car item) (cons 'car ops))
                      (%df-search (cdr item) (cons 'cdr ops))))))
      (%df-search tree nil)
      operations)))

(defun c*r-path (path tree)
  (dolist (i path tree)
    (setq tree (funcall i tree))))

(defvar my-list '(((partnum . 1)
                   (1.1 (type (TEXT . plain)) (body (charset UTF-8))
                        (disposition nil) (transfer-encoding 7BIT))
                   (1.2 (type (TEXT . html)) (body (charset UTF-8))
                        (disposition nil) (transfer-encoding 7BIT))
                   (type . alternative) (body (boundary e89a8fb2067eba300404c63c5f7f))
                   (disposition nil) (transfer-encoding nil))
                  ((partnum . 1.1) (type (TEXT . plain)) (body (charset UTF-8))
                   (disposition nil) (transfer-encoding 7BIT))
                  ((partnum . 1.2) (type (TEXT . html)) (body (charset UTF-8))
                   (disposition nil) (transfer-encoding 7BIT))
                  ((partnum . 2) (type (IMAGE . x-xpixmap)) (body (name ladybug.xpm))
                   (disposition nil) (transfer-encoding BASE64))))

(tree-to-proper-tree my-list) ; the same lists as above but made into a proper lists

(c*r-path (find-path-to my-list 'UTF-8) my-list) ; UTF-8
(c*r-path (find-path-to my-list 'plain) my-list) ; plain

OK, so, here it goes, the tree-to-proper-tree, if you choose that, will transform the tree in the way that all improper sub-trees will become proper trees. Alternatively, you can use find-path-to to find what sequence of car and cdr will bring you to the element you have searched, and c*r-path will evaluate that sequence to return the element recorded in that way.

Note that it will be quite challenging to search for repeating occurrences of the same node in this way. You would have to provide some comparator function that counts how many times the item was found.