Wheres-waldo function in LISP

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 (that is, a data structure built from conses) as an argument and returns a LISP expression that extracts the waldo character from this object, if present"

For instance,

For example: (wheres-waldo '(emerson ralph waldo)) =

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

For example: (wheres-waldo '(mentor (ralph waldo emerson) (henry david thoreau))) =

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

I wrote some recursion like

(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 greatly appreciated. Thank.

+3
4

, - , , , . , s-, , .

. , car cdr first rest - .

(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))))))

? (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

, :

? (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)))))))

:

(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))
+3

, waldo, , ? , waldo, , , , .

(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)

, aux, , . waldo, .

waldo , car, , , .

and/or . if , . , (and (eq cur 'waldo) acc) acc, cur - waldo, and . NIL, . or ( NIL) NIL, NIL. 2 .

+3

, . , .

(, " w130 > ", cons. "lisp object" , Lisp , conses). , , , .

+1

, , . - , , . , , , , , , , ( ), , , , .

(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 '())))

, , , . :

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

(car (cdr '(ralph waldo emerson))) waldo.

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

because (first (rest (first (rest '(ralph (waldo emerson))))))- emerson. Therefore, we solved the problem of obtaining a list of access functions. Now we need to create 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 the way we need it, while we also provide 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 them together:

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

This works the way 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))))))
+1
source

All Articles