Wheres-waldo function in LISP

Question

I am trying to solve problems on LISP and I am stuck with this problem for many days.

"Write a function, called wheres-waldo, that takes a lisp object (i.e., a data structure built from conses) as argument and returns a Lisp expression that extracts the symbol waldo from this object, if it is present"

For example,

E.g: (wheres-waldo '(emerson ralph waldo)) =

OUTPUT: (FIRST (REST (REST '(EMERSON RALPH WALDO))))

E.g: (wheres-waldo '(mentor (ralph waldo emerson) (henry david thoreau))) =

OUTPUT: (FIRST (REST (FIRST (REST 
                 '(MENTOR (RALPH WALDO EMERSON)
                          (HENRY DAVID THOREAU))))))

I have written some recursion for example,

(defun wheres-waldo(lispOBJ)
    (cond ((null lispOBJ) nil)
    (equalp (first lispOBJ) waldo)
    ( t (***stuck here how to write recursion for this***))
)

I found this question from http://ai.eecs.umich.edu/people/wellman/courses/eecs492/f94/MP1.html wheres-waldo. Any help would be appreciated. Thank you.

uselpa · Accepted Answer · 2014-02-23T00:25:14.643

You need to loop over a list, and if an element is a list, recurse into the sublist, exactly as you would implement a deep search. The only difference is that, in order to produce the required output, you need to carry on the s-expression retracing the functions you used to get there.

Here is one possible implementation. Note that I have used the more traditional car and cdr instead of first and rest - they are equivalent.

(defun whereis (who obj &optional (sexp (list 'quote obj)))
  (cond
   ; we found the object - return the s-expr
   ((eq obj who) sexp)
   ; try car and the cdr
   ((and obj (listp obj)) 
    (or (whereis who (car obj) (list 'car sexp))
        (whereis who (cdr obj) (list 'cdr sexp))))))

then:

? (whereis 'waldo '(emerson ralph waldo))
(CAR (CDR (CDR '(EMERSON RALPH WALDO))))

? (whereis 'waldo '(mentor (ralph waldo emerson) (henry david thoreau)))
(CAR (CDR (CAR (CDR '(MENTOR (RALPH WALDO EMERSON) (HENRY DAVID THOREAU))))))

? (whereis 'thoreau '(mentor (ralph waldo emerson) (henry david thoreau)))
(CAR (CDR (CDR (CAR (CDR (CDR '(MENTOR (RALPH WALDO EMERSON) (HENRY DAVID THOREAU))))))))

? (whereis 'scotty '(beam me up . scotty))
(CDR (CDR (CDR '(BEAM ME UP . SCOTTY))))

? (whereis 'waldo '(emerson ralph))
NIL

If your element can appear more than once, you could also build a list of results:

? (whereis 'c '(a b c d c b a))
((CAR (CDR (CDR '(A B C D C B A)))) (CAR (CDR (CDR (CDR (CDR '(A B C D C B A)))))))

with this code:

(defun whereis (who obj)
  (let ((res nil)) ; the final result
    (labels
        ; sub-function: walks the whole list recursively
        ((sub (obj sexp)
           ; found it - add to result list
           (when (eq obj who) (setf res (cons sexp res)))
           ; try car and cdr
           (when (and obj (listp obj))
             (sub (cdr obj) (list 'cdr sexp))
             (sub (car obj) (list 'car sexp)))))
      ; call sub-function
      (sub obj (list 'quote obj)))
    res))

Sylwester · Answer 2 · 2014-02-23T18:56:39.197

The main problem with your approach is that if first elements equals waldo, how are you suppose to generate the answer? There may be many possible paths waldo might be in so we need a way to indicate in the iteration what path we are on and we need to backtrack if we are at a dead end.

(defun wheres-waldo (o)
  (labels                                          ; labels is to make local functions 
   ((aux (cur acc)                                 ; define loacl function aux with args cur and acc
      (or                                          ; or stops at the first non NIL value
       (and (eq cur 'waldo) acc)                   ; if (eq cur 'waldo) we return acc 
       (and (consp cur)                            ; (else) if object is a cons 
            (or                                    ; then one of the followin
             (aux (car cur) (list 'first acc))     ; answer might be in the car
             (aux (cdr cur) (list 'rest acc))))))) ; or the cdr of the cons 
    (aux o (list 'quote o))))                      ; call aux with original object and the same object quoted. (list 'quote x) ==> 'x (as data)

As you see, main work is done by aux that has an object and an accumuolator idicating the path and the quotes data. If you find waldo then the result is the accumulator.

If waldo exists in several locations it always do car first so not necessarily the shortest answer but the first it finds.

I use and/or here. These are similar to if except it's the value of the expression that gets returned. Eg (and (eq cur 'waldo) acc) will make sure we return acc if cur is waldo since and evaluates to the last true value. If there is one NIL value it becomes the result of the form. For or it will evaluate to the first true value (everything not NIL) or NIL if all expressions mounts to NIL. In Exercise 2 of your link you were to rewrite a function in a similar way.

@prk added comments. Hope it helps:) – Sylwester Feb 23 '14 at 18:59 — Sylwester, Feb 23 '14 at 18:59

score 1 · Answer 3 · answered Feb 22 '14 at 19:37

That is not where you are stuck. You are stuck at devising a strategy, not at writing code.

You will have to do a tree search (the thing you call a "lisp object" is actually just a cons tree—"lisp object" is a misleading term because in Lisp, a lot of things are objects, not just conses). Decide whether to do a breadth-first or depth-first search, how to accumulate the accessor path, and how to communicate the match or mismatch up the call tree.

score 1 · Answer 4 · answered Feb 23 '14 at 00:09

Sometimes it's a bit easier to approach a slightly more general problem, and then figure out how to specialize it to the particular problem at hand. In this case, you're handed a structure of some sort, along with a number of accessors that can access substructures of that structure. Given an element to find, and a thing to search, you can search by checking whether the thing is the element, and if is, then returning the path so far (in an appropriate format), and if it's not, then if it's a structure that you can decompose with the accessors, try each decomposed part.

(defun find-element (element structure structure-p accessors &key (test 'eql))
  (labels ((fe (thing path)
             "If THING and ELEMENT are the same (under TEST), then 
              return PATH.  Otherwise, if THING is a structure (as 
              checked with STRUCTURE-P),  then iterate through 
              ACCESSORS and recurse on the result of each one
              applied to THING."
             (if (funcall test thing element)
                 ;; return from the top level FIND-ELEMENT
                 ;; call, not just from FE.
                 (return-from find-element path)
                 ;; When THING is a structure, see what 
                 ;; each of the ACCESSORS returns, and 
                 ;; make a recursive call with it.
                 (when (funcall structure-p thing)
                   (dolist (accessor accessors)
                     (fe (funcall accessor thing)
                         (list* accessor path)))))))
    ;; Call the helper function 
    ;; with an initial empty path
    (fe structure '())))

This will return the sequence of accessors that we need, in reverse order that they need to be applied to structure. For instance:

(find-element 'waldo '(ralph waldo emerson) 'consp '(car cdr))
;=> (CAR CDR)

because (car (cdr '(ralph waldo emerson))) is waldo. Similarly

(find-element 'emerson '(ralph (waldo emerson)) 'consp '(first rest))
;=> (FIRST REST FIRST REST)

because (first (rest (first (rest '(ralph (waldo emerson)))))) is emerson. So we've solved the problem of getting a list of accessor functions. Now we need to build up the actual expression. This is actually a fairly simple task using reduce:

(defun build-expression (accessor-path structure)
   (reduce 'list accessor-path
           :initial-value (list 'quote structure)
           :from-end t))

This works in the way we need it to, as long as we also provide a the structure. For instance:

(build-expression '(frog-on bump-on log-on hole-in bottom-of) '(the sea))
;=> (FROG-ON (BUMP-ON (LOG-ON (HOLE-IN (BOTTOM-OF '(THE SEA))))))

(build-expression '(branch-on limb-on tree-in bog-down-in) '(the valley o))
;=> (BRANCH-ON (LIMB-ON (TREE-IN (BOG-DOWN-IN '(THE VALLEY O)))))

Now we just need to put these together:

(defun where-is-waldo? (object)
  (build-expression
   (find-element 'waldo object 'consp '(first rest))
   object))

This works like we want:

(where-is-waldo? '(ralph waldo emerson))
;=> (FIRST (REST '(RALPH WALDO EMERSON)))

(where-is-waldo? '(mentor (ralph waldo emerson) (henry david thoreau)))
;=> (FIRST (REST (FIRST (REST '(MENTOR (RALPH WALDO EMERSON) (HENRY DAVID THOREAU))))))

Wheres-waldo function in LISP

4 Answers4