Geek Answers Handbook

A lisp refinement function

I did Graham Common Lisp Chapter 5 Exercise 5, which requires a function that takes an object X and a vector V, and returns a list of all the objects that immediately precede X in V.

It works like:

> (preceders #\a "abracadabra")
(#\c #\d #r)

I made a recursive version:

(defun preceders  (obj vec &optional (result nil) &key (startt 0))
  (let ((l (length vec)))
    (cond ((null (position obj vec :start startt :end l)) result) 
          ((= (position obj vec :start startt :end l) 0)
           (preceders obj vec result 
                      :startt (1+ (position obj vec :start startt :end l))))  
          ((> (position obj vec :start startt :end l) 0)
           (cons (elt vec (1- (position obj vec :start startt :end l))) 
                 (preceders obj vec result 
                            :startt (1+ (position obj vec
                                                 :start startt
                                                 :end l))))))))

This works correctly, but my teachers give me the following criticism:

"This causes lengths many times. Not so bad with vectors, but still unnecessary. More efficient and more flexible (for the user) code should define this as other sequence processing functions. Use: start and: end keyword parameters, as others do "sequence functions, with the same initial default values. The length must be called no more than once."

Common Lisp google, , , : , ": start : end keyword parameters", , " ". , , , , , . !

UPDATE:

, , :

(defun preceders (obj vec
                  &optional (result nil)
                  &key (start 0) (end (length vec)) (test #'eql))  
  (let ((pos (position obj vec :start start :end end :test test)))  
    (cond ((null pos) result)
          ((zerop pos) (preceders obj vec result
                                 :start (1+ pos) :end end :test test)) 
          (t (preceders obj vec (cons (elt vec (1- pos)) result)
                       :start (1+ pos) :end end :test test)))))

:

" , , , , IF COND."

, :

(defun preceders (obj vec) 
  (do ((i 0 (1+ i))
       (r nil (if (and (eql (aref vec i) obj) 
                       (> i 0)) 
                  (cons (aref vec (1- i)) r) 
                  r))) 
      ((eql i (length vec)) (reverse r))))

" DO > 0"

, , ! !

+5
5

:

(defun preceders (item vector 
                  &key (start 0) (end (length vector))
                       (test #'eql))
    ...
)

, START END.

TEST - . (funcall test item (isf vector i)). KEY...

LENGTH PRECEDERS.

: . , EQL , , ( ).

, PRECEDERS, , 0 1, . . LABELS PRECEDERS, .

(defun preceders (item vector 
                  &key (start 0) (end (length vector))
                       (test #'eql))
   (preceders-aux item vector start end test start (1+ start) nil))


(defun preceders-aux (item vector start end test pos0 pos1 result)
  (if (>= pos1 end)
      result
      ...
  ))

?

LOOP:

(defun preceders (item vector 
                  &key (start 0) (end (length vector))
                       (test #'eql))
  (let ((result nil))
    (loop for i from (1+ start) below end
          when (funcall test item (aref vector i))
          do (pushnew (aref vector (1- i)) result))
    (nreverse result)))
+8

, , Rainer Joswig, .

(defun preceders (obj seq &key (start 0) (end (length seq)) (test #'eql))          
  (%preceders obj seq nil start end test))

( %PRECEDERS, "private") . , , - .

, ( DEFUN) ( LABELS). , . YMMV.

:

(defun %preceders (obj seq result start end test)
  (let ((pos (position obj seq :start start :end end :test test)))
       ;; Use a local binding for POS, to make it clear that you want the 
       ;; same thing every time, and to cache the result of a potentially 
       ;; expensive operation. 
    (cond ((null  pos) (delete-duplicates (nreverse result) :test test))             
          ((zerop pos) (%preceders obj seq result (1+ pos) end test))
          ;; I like ZEROP better than (= 0 ...). YMMV.
          (t (%preceders obj seq 
                         (cons (elt seq (1- pos)) result)
                         ;; The other little bit of work to make things 
                         ;; tail-recursive.      
         (1+ pos) end test)))))

, , , , , , .

EDIT: "%" . , , , , , "*" .

, , DELETE-DUPLICATES. (.. ) , ADJOIN PUSHNEW, , , , EQ, EQL EQUAL.

+5

Rainer:

(defun preceders (item vector 
                  &key (start 0) (end (length vector))
                  (test #'eql))
  (delete-duplicates
   (loop
      for index from (1+ start) below end 
      for element = (aref vector index) 
      and previous-element = (aref vector (1- index)) then element
      when (funcall test item element)
      collect previous-element)))

, , , ( ).

+2

.

:

.

(if (foo)
  (bar (+ 1 baz))
  (bar baz))

, :

(bar (if (foo)
        (+ 1 baz)
        baz))


(let ((newbaz (if (foo)
                 (+ 1 baz)
                 baz)))
  (bar newbaz))

-:

= 1?

. ...

+1

, , , , ; , position , , . ( : , , . )

, start , end, .

(defun precede (obj vec &key (start 0) (end (length vec)) (test #'eql))
  (if (or (null vec) (< end 2)) nil
    (%precede-recur obj vec start end test '())))

(defun %precede-recur (obj vec start end test result)
  (let ((next (1+ start)))
    (if (= next end) (nreverse result)
      (let ((newresult (if (funcall test obj (aref vec next))
                         (adjoin (aref vec start) result)
                         result)))
        (%precede-recur obj vec next end test newresult)))))

Of course, this is another way of expressing the version loop.

Test:

[49]> (precede #\a "abracadabra") 
(#\r #\c #\d)
[50]> (precede #\a "this is a long sentence that contains more characters") 
(#\Space #\h #\t #\r)
[51]> (precede #\s "this is a long sentence that contains more characters")
(#\i #\Space #\n #\r)

Also, I'm interested in Robert, did your teacher say why he doesn’t like using adjoinor pushnewin a recursive algorithm?

+1
source

More articles:


All Articles