Is there an easy way to remove an element from a list, returning
a new list which shares the tail of the original list?
Can someone think of an easy way to do this using loop. From
my understing of REMOVE, if any element must be removed
then the entire list is copied.
i.e., i want to loop on a list collecting the elements up to
a point, then skip an element, then in one lump operation
nconc the rest of the list onto the list being collected (without
proceeding with the iteration).
Any ideas?
-jim
Jimka wrote:
> Is there an easy way to remove an element from a list, returning
> a new list which shares the tail of the original list?
>
> Can someone think of an easy way to do this using loop. From
> my understing of REMOVE, if any element must be removed
> then the entire list is copied.
No, the HyperSpec clearly states that "If any elements need to be
removed, the result will be a copy. _The result of remove may share with
sequence [that is, the second parameter];_ the result may be identical
to the input sequence if no elements need to be removed."
Pascal
--
My website: http://p-cos.net
Closer to MOP & ContextL:
http://common-lisp.net/project/closer/
my experiment with sbcl shows that it does not
try to preserve the tail.
(setq a '(1 2 3 4))
(setq b (remove 2 a))
(setf (car (cddr a)) 300)
a
--> (1 2 300 4)
b
--> (1 3 4)
"Jimka" <·····@rdrop.com> writes:
> my experiment with sbcl shows that it does not try to preserve the
> tail.
I couldn't resist to try this on my movitz CL implementation:
INIT> (setf a '(1 2 3 4))
(1 2 3 4)
INIT> (setf b (remove 2 a))
(1 3 4)
INIT> (setf (car (cddr a)) 300)
300
INIT> a
(1 2 300 4)
INIT> b
(1 300 4)
The relevant code I think is this (I might have "borrowed" it from
somewhere, I don't remember):
(defun list-remove-simple (item list)
"The same as list-remove, without count, end, or key, with test=eql."
(cond
((endp list)
nil)
((eql item (car list))
(list-remove-simple item (cdr list)))
(t (do ((i 1 (1+ i))
(p0 list (cdr p0))
(p1 (cdr list) (cdr p1)))
((endp p1) list)
(declare (index i))
(when (eql item (car p1))
(return
;; reiterate from <list> to <p1>, consing up a copy, with
;; the copy's tail being the recursive call to list-remove.
(do* ((new-list (cons (car list) nil))
(x (cdr list) (cdr x))
(new-x new-list))
((eq x p1)
(setf (cdr new-x) (list-remove-simple item (cdr p1)))
new-list)
(setf new-x
(setf (cdr new-x)
(cons (car x) nil))))))))))
--
Frode Vatvedt Fjeld
Pascal Costanza wrote:
>> Can someone think of an easy way to do this using loop. From
>> my understing of REMOVE, if any element must be removed
>> then the entire list is copied.
>
> No, the HyperSpec clearly states that "If any elements need to be
> removed, the result will be a copy. _The result of remove may share with
> sequence [that is, the second parameter];_ the result may be identical
> to the input sequence if no elements need to be removed."
So this means what the OP said, doesn't it? I think the sentence "The
result of remove may share with sequence" is true, if the sentence before,
"If any elements need to be removed, the result will be a copy", is not
true, and it is only true, if the sentence "the result may be identical to
the input sequence if no elements need to be removed" is true, but I didn't
found a formal definition of the semicolon in the hypersec :-)
Some tests:
CL-USER > (defparameter x '(1 2 3 4))
X
CL-USER > (defparameter y (remove 3 x))
Y
CL-USER > x
(1 2 3 4)
CL-USER > y
(1 2 4)
CL-USER > (setf (elt y 2) 5)
5
CL-USER > x
(1 2 3 4)
CL-USER > y
(1 2 5)
A remove-with-tail could cause interesting to find problems:
CL-USER > (defparameter x '(1 2 3 4))
X
CL-USER > (defparameter y (remove-with-tail 3 x))
Y
CL-USER > x
(1 2 3 4)
CL-USER > y
(1 2 4)
CL-USER > (setf (elt y 2) 5)
5
CL-USER > x
(1 2 3 5)
CL-USER > y
(1 2 5)
And if more than one element is removed, only the last tail could be
shared.
--
Frank Buss, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
So can someone think of a clever way with LOOP to
write remove-preserving-tail, only iterating until the
to-be-deleted element is encountered? I only want to remove the
first occurance in my case.
Jimka wrote:
> So can someone think of a clever way with LOOP to
> write remove-preserving-tail, only iterating until the
> to-be-deleted element is encountered?
Yes, this is easy, you don't need loop:
(defun remove-preserving-tail (item elements)
(let ((position (position item elements)))
(if position
(append (subseq elements 0 position)
(nthcdr (1+ position) elements))
elements)))
But you shouldn't do it. Why do you want to preserve the tail?
--
Frank Buss, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
Hi frank,
(defun remove-preserving-tail (item elements)
(let ((position (position item elements)))
;; ^^^^^^^^^
;; once
(if position
(append (subseq elements 0 position)
;; ^^^^^^^^
;; twice
;; ^^^^^^^^
;; 3 times
(nthcdr (1+ position) elements))
;; ^^^^^^^
;; 4 times
elements)))
Interesting try, but a problem with this attempted solution
is that you traverse the list four times up to the ITEM.
a more efficient solution should be able to traverse once down
to item, skip item, then lconc the rest of the list.
I'm not sure why you say i SHOULD not do this? What's your
reasoning that this SHOULD not be done?
Why do I want to? becase i'm trying to find the fastest way
possible to remove an element from a list, and allocate the
least amount of extra memory. I know that my algorithem will
not want to destructively modify the list anytime later, so preserving
the tail is safe.
From: Bill Atkins
Subject: Re: how to remove but preserve tail.
Date:
Message-ID: <87hd6abwxi.fsf@rpi.edu>
"Jimka" <·····@rdrop.com> writes:
> Hi frank,
>
> (defun remove-preserving-tail (item elements)
> (let ((position (position item elements)))
> ;; ^^^^^^^^^
> ;; once
> (if position
> (append (subseq elements 0 position)
> ;; ^^^^^^^^
> ;; twice
> ;; ^^^^^^^^
> ;; 3 times
> (nthcdr (1+ position) elements))
> ;; ^^^^^^^
> ;; 4 times
> elements)))
>
> Interesting try, but a problem with this attempted solution
> is that you traverse the list four times up to the ITEM.
> a more efficient solution should be able to traverse once down
> to item, skip item, then lconc the rest of the list.
>
> I'm not sure why you say i SHOULD not do this? What's your
> reasoning that this SHOULD not be done?
>
> Why do I want to? becase i'm trying to find the fastest way
> possible to remove an element from a list, and allocate the
> least amount of extra memory. I know that my algorithem will
> not want to destructively modify the list anytime later, so preserving
> the tail is safe.
Will the DELETE function meet your needs? It is a destructive version
of REMOVE that will modify structure to prevent consing. I'm not sure
exactly what you're looking for, and you may already be aware of
DELETE, but maybe not.
Bill
Thanks but but i explicitly want to avoid destructive functions in my
case. Thanks anyway.
From: Bill Atkins
Subject: Re: how to remove but preserve tail.
Date:
Message-ID: <8764mq21wl.fsf@rpi.edu>
"Jimka" <·····@rdrop.com> writes:
> Thanks but but i explicitly want to avoid destructive functions in my
> case. Thanks anyway.
The specification you've made is, in essence, destructive. Why do you
want to avoid DELETE?
Bill Atkins <············@rpi.edu> writes:
> "Jimka" <·····@rdrop.com> writes:
>
> > Thanks but but i explicitly want to avoid destructive functions in my
> > case. Thanks anyway.
>
> The specification you've made is, in essence, destructive. Why do you
> want to avoid DELETE?
Not really. The original list remains intact. That would not be the
case with DELETE. Perhaps the OP wants to be able to keep the original
list around intact for other processing.
--
Thomas A. Russ, USC/Information Sciences Institute
In article <··············@rpi.edu>, Bill Atkins <············@rpi.edu>
wrote:
> "Jimka" <·····@rdrop.com> writes:
>
> > Thanks but but i explicitly want to avoid destructive functions in my
> > case. Thanks anyway.
>
> The specification you've made is, in essence, destructive. Why do you
> want to avoid DELETE?
sharing != destructive
--
Barry Margolin, ······@alum.mit.edu
Arlington, MA
*** PLEASE post questions in newsgroups, not directly to me ***
*** PLEASE don't copy me on replies, I'll read them in the group ***
"Jimka" <·····@rdrop.com> writes:
> Why do I want to? becase i'm trying to find the fastest way
> possible to remove an element from a list, and allocate the
> least amount of extra memory. I know that my algorithem will
> not want to destructively modify the list anytime later, so preserving
> the tail is safe.
Why don't you already have a modifiable list? If you want to delete
an item quickly, it'd be quickier if you didn't have to copy conses!
The more so if you possibly have several elements to delete...
Then you can just use:
(defun quick-delete-once-from-list (item list)
(loop with guarded = (cons nil list)
for current on guarded
until (or (null (cdr current)) (eql item (cadr current)))
finally (unless (null (cdr current))
(setf (cdr current) (cddr current)))
(return (cdr guarded))))
Usage: (setf list (QUICK-DELETE-ONCE-FROM-LIST item list))
[64]> (mapcar (lambda (item) (QUICK-DELETE-ONCE-FROM-LIST item (list 1 2 3 4 5)))
'(1 2 3 4 5 6))
((2 3 4 5) (1 3 4 5) (1 2 4 5) (1 2 3 5) (1 2 3 4) (1 2 3 4 5))
--
__Pascal Bourguignon__ http://www.informatimago.com/
What is this talk of 'release'? Klingons do not make software 'releases'.
Our software 'escapes' leaving a bloody trail of designers and quality
assurance people in it's wake.
>Why don't you already have a modifiable list? If you want to delete
>an item quickly, it'd be quickier if you didn't have to copy conses!
>The more so if you possibly have several elements to delete...
sorry, i do not understand; you cannot copy the list in the first
place without copying the conses.
My original solution before posting to c.l.l. was simply to use the
REMOVE function, but i noticed that is is copying the list many times.
Since i know i never need to destructivley modify the list, i would
hopefully get better performance by sharing as much of the list as
possible each time. At least that was my suspicion so i wanted such
an implementation should i could do some performance analysis and
see if my suspicion was the case.
A big advantage of not destructively modifying the list is that it
allows
my to use a recursive function such as the following. It allows me to
remove all the elements from the list in all possible orders.
(defun exhaust-list (done list)
(when list
(format t "~A~%" (list done list))
(dolist (item list)
(exhaust-list (cons item done) (remove-preserving-tail item
list)))))
"Jimka" <·····@rdrop.com> writes:
>>Why don't you already have a modifiable list? If you want to delete
>>an item quickly, it'd be quickier if you didn't have to copy conses!
>>The more so if you possibly have several elements to delete...
>
> sorry, i do not understand; you cannot copy the list in the first
> place without copying the conses.
Yes, you lose some time up front, but when it's time to delete an item
you'll be quicker.
(defparameter fruits (copy-list
(append *some-hundreds-of-fruits*
'(apple orange tomato lemon pear))))
;; Run some other lengthy initializations...
(when (visiting-p (some-tax-inspector))
(time (unless (is-legally-a-fruit-p 'tomato)
(quick-delete-once-from-list 'tomato fruits))))
;; Whew! How fast we deleted it from the fruit list... Tax inspectors will be happy.
> My original solution before posting to c.l.l. was simply to use the
> REMOVE function, but i noticed that is is copying the list many times.
> Since i know i never need to destructivley modify the list, i would
> hopefully get better performance by sharing as much of the list as
> possible each time. At least that was my suspicion so i wanted such
> an implementation should i could do some performance analysis and
> see if my suspicion was the case.
Did you profile?
_When_ must you get a speed improvement?
> A big advantage of not destructively modifying the list is that it
> allows
> my to use a recursive function such as the following. It allows me to
> remove all the elements from the list in all possible orders.
>
> (defun exhaust-list (done list)
> (when list
> (format t "~A~%" (list done list))
> (dolist (item list)
> (exhaust-list (cons item done)
> (remove-preserving-tail item list)))))
Yes, in this usage, you don't want my destructive quick-delete-once-from-list.
--
__Pascal Bourguignon__ http://www.informatimago.com/
In deep sleep hear sound,
Cat vomit hairball somewhere.
Will find in morning.
Thanks for the help and insight. I've mentioned your name
in a faster sudoku solution on the thread "Sudoku Solver"
where i used remove-preserving-tail to squeeze a little extra
performance out.
Here is the code using my version of remove-preserving-tail.
(defvar *unsolved* '-)
(defun unsolved (x)
(eql x *unsolved*))
(defun solved (x)
(numberp x))
(defun print-sudoku (sudoku)
(loop for y from 0 below 9
finally (terpri)
do (loop for x from 0 below 9 finally (terpri) do
(format t "~A" (if (plusp (aref sudoku y x))
(aref sudoku y x)
*unsolved*)))))
(defun digits-in-region (sudoku x y)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type simple-array sudoku)
(type (integer 0 8) x y))
(loop
with x0 = (* 3 (truncate x 3))
with y0 = (* 3 (truncate y 3))
with x1 = (+ x0 2)
with y1 = (+ y0 2)
for x from x0 to x1
append (loop for y from y0 to y1
for digit = (aref sudoku y x)
when (solved digit) collect digit)))
(defun digits-in-row (sudoku y)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type (simple-array sudoku))
(type (integer 0 8) y))
(loop for x from 0 below 9
for digit = (aref sudoku y x)
when (solved digit) collect digit))
(defun digits-in-column (sudoku x)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type (simple-array sudoku))
(type (integer 0 8) x))
(loop for y from 0 below 9
for digit = (aref sudoku y x)
when (solved digit) collect digit))
(defun possible-digits (sudoku x y)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type (simple-array sudoku))
(type (integer 0 8) x y))
(set-difference
'(1 2 3 4 5 6 7 8 9)
(nconc (digits-in-region sudoku x y)
(digits-in-row sudoku y)
(digits-in-column sudoku x))))
(defun print-cells (sudoku pairs)
(when pairs
(format t "~A,~A: ~A~%" (car (car pairs))
(cdr (car pairs))
(possible-digits sudoku (car (car pairs))
(cdr (car pairs))))
(print-cells sudoku (cdr pairs))))
(defun solve (sudoku)
(declare (optimize (speed 3) (safety 0) (debug 0))
(type simple-array sudoku)
(type (simple-array unsigned-byte (9 9)) sudoku))
(labels ((sort-cells (pairs)
;; caculate a list similar to the given list of pairs
;; except that an element which minimizes
;; #'possible-digits is moved to the beginning of
;; the list.
(min-and-rest pairs
:key
(lambda (pair)
(length (the list (possible-digits
sudoku
(car pair)
(cdr pair)))))))
(solve-next (pairs)
(unless pairs
(print-sudoku sudoku)
(return-from solve))
(let ((pair (car pairs))
(pairs (cdr pairs)))
(let ((x (car pair))
(y (cdr pair)))
(let ((possible-digits
(possible-digits sudoku x y)))
;; if there are no possible digits,
;; then backtrack
(when possible-digits
;; try each possible solution for this
;; position until one works or we have to
;; backtrack.
(dolist (digit possible-digits)
(setf (aref sudoku y x) digit)
;; move the remaining unsolved cell which has
;; the minimum number of possible digits to
;; the beginning of the list of remaining
;; cells, and solve away.
(solve-next (sort-cells pairs)))
;; return the cell to unsolved,
;; and backtrack.
(setf (aref sudoku y x) *unsolved*)))))))
;; call solve-next with list of all unsolved cells
;; sorted into in order of increasing possible digits.
;; Note, this sorting only occures once at the top level,
;; thereafter it is hoped that the list is almost sorted.
;; By almost sorted, i mean that every element is not too far
;; from the ideal sorted position.
(solve-next (sort (loop for x from 0 below 9
nconc (loop for y from 0 below 9
when (unsolved (aref sudoku y x))
collect (cons x y)))
#'<
:key (lambda (pair)
(length (possible-digits sudoku
(car pair)
(cdr pair))))))))
;; if the first element of the given list minimizes the key function,
;; then return the list,
;; else build a new list with the minimizing element first
;; followed by the rest of the list. If the minimizing element
;; appears more the once, the first occuranc will simply be moved
;; to the beginning of the new list.
;; E.g.,
;; ( 3 4 5 6 0 6 7 0 2 3)
;; ---> ( 0 3 4 5 6 6 7 0 2 3)
(defun min-and-rest (list &key (key #'identity) (test #'<))
(loop with min = (car list)
for elem in list
;; when test < min
when (funcall test (funcall key elem) (funcall key min))
do (setq min elem)
finally (return (if (eql min (car list))
list
(cons min (remove-preserving-tail min list))))))
;; remove an element from a list the first time the element
;; occurs and only consing the minimum amount of cells
;; possible.
;; If the item is not found in the list, then return the list.
;; else return a copy of the first portion of the list and
;; share the remaining tail after the skipped item.
(defun remove-preserving-tail (item list)
(labels ((rpt (sub)
(cond ((null sub)
(return-from remove-preserving-tail list))
((eql item (car sub))
(cdr sub))
(t
(cons (car sub) (rpt (cdr sub)))))))
(rpt list)))
;; unused testing function
(defun exhaust-list (done list)
(when list
(format t "~A~%" (list done list))
(dolist (item list)
(exhaust-list (cons item done) (remove-preserving-tail item
list)))))
(defun make-sudoku (list)
(make-array '(9 9)
:adjustable nil
:initial-contents
list))
(defparameter *sudoku-1* (make-sudoku
'((- - 2 3 - - 7 - -)
(- - 4 - - 9 - - -)
(6 - - - - - - 5 -)
(- 7 - - - 2 - 6 -)
(- - 3 7 - - 4 - -)
(- 1 - - - - - 2 -)
(- 3 - - - - - - 9)
(- - - 4 - - 6 - -)
(- - 5 - - 8 2 - -))))
(defparameter *sudoku-2* (make-sudoku
'(( - - 9 1 8 3 - - 4)
( - - - - - 5 8 2 9)
( 4 8 6 - - - - - -)
( 8 - - - 5 - 3 9 -)
( - 6 - 8 4 9 - 1 -)
( - 9 7 - 2 - - - 8)
( - - - - - - 4 6 7)
( 5 2 1 6 - - - - -)
( 6 - - 9 3 8 2 - -))))
(time (solve *sudoku-1*) )
(time (solve *sudoku-2*) )
hi Pascal, another point that i failed to mention earlier is that
my remove-preserving-tail function most often needs to remove something
close to the beginning of the list. I've ordered my data to
try to make that occur very often. This is what made me consider
trying
to share the tails in the first place as an experiment.
"Jimka" <·····@rdrop.com> writes:
> So can someone think of a clever way with LOOP to
> write remove-preserving-tail, only iterating until the
> to-be-deleted element is encountered? I only want to remove the
> first occurance in my case.
Why do you want LOOP?
Can you write a recursive function to do it?
(defun remove-first-occurence-keeping-tail (item list)
(labels ((remove (current result)
(cond ((null current) (nreverse result))
((eql item (car current)) (nreconc result (cdr current)))
(t (remove (cdr current) (cons (car current) result))))))
(remove list '())))
[34]> (let ((list '(1 2 3 4 5)))
(list list (REMOVE-FIRST-OCCURENCE-KEEPING-TAIL '3 list)))
((1 2 3 . #1=(4 5)) (1 2 . #1#))
If you insist on loop:
(defun remove-first-occurence-keeping-tail (item list)
(loop with current = list
with result = '()
until (or (null current) (eql item (car current)))
do (push (pop current) result)
finally (return (nreconc result (cdr current)))))
Note, if the item is not found I returned a copy of the list.
We could return the original list instead:
(defun remove-first-occurence-keeping-tail (item list)
(labels ((remove (current result)
(cond ((null current) list)
((eql item (car current)) (nreconc result (cdr current)))
(t (remove (cdr current) (cons (car current) result))))))
(remove list '())))
(defun remove-first-occurence-keeping-tail (item list)
(loop with current = list
with result = '()
until (or (null current) (eql item (car current)))
do (push (pop current) result)
finally (return (if (null current)
list
(nreconc result (cdr current))))))
--
__Pascal Bourguignon__ http://www.informatimago.com/
PLEASE NOTE: Some quantum physics theories suggest that when the
consumer is not directly observing this product, it may cease to
exist or will exist only in a vague and undetermined state.
Hi Pascal, good idea to use a recursive function. I still don't
like the implemention of this function that has to traverse
the list multiple times, once to find ITEM and second to append
to it or to reverse the tmp accumulated list.
Here is my variant of your solution that does not have to
reverse the list.
(defun remove-preserving-tail (item list)
(labels ((rpt (sub)
(cond ((null sub)
(return-from remove-preserving-tail list))
((eql item (car sub))
(cdr sub))
(t
(cons (car sub) (rpt (cdr sub)))))))
(rpt list)))
"Jimka" <·····@rdrop.com> writes:
> Hi Pascal, good idea to use a recursive function. I still don't
> like the implemention of this function that has to traverse
> the list multiple times, once to find ITEM and second to append
> to it or to reverse the tmp accumulated list.
> Here is my variant of your solution that does not have to
> reverse the list.
>
> (defun remove-preserving-tail (item list)
> (labels ((rpt (sub)
> (cond ((null sub)
> (return-from remove-preserving-tail list))
> ((eql item (car sub))
> (cdr sub))
> (t
> (cons (car sub) (rpt (cdr sub)))))))
> (rpt list)))
Keep in mind that:
1- Common Lisp doesn't specify tail call optimization.
(my recursive solution may overflow the stack ON POOR,
but conforming implementations, given a big enough (position item list).)
2- Your recursive call is not a tail call, so you don't get any TCO,
therefore your solution will overflow the stack ON ANY
implementation, given a big enough (position item list).
3- There's not much difference in stacking items on a result list to
be nreversed at the end and stacking them in stack frames, to be
"reversed" at the end:
Fetch the TRACING-LABELS macro from:
http://groups.google.com/group/comp.lang.lisp/msg/e22c29123d94c152?dmode=source&hl=en
[93]> (defun remove-preserving-tail (item list)
(tracing-labels ((rpt (sub)
(cond ((null sub)
(return-from remove-preserving-tail list))
((eql item (car sub))
(cdr sub))
(t
(cons (car sub) (rpt (cdr sub)))))))
(rpt list)))
[94]> (REMOVE-PRESERVING-TAIL 5 (list 1 2 3 4 5 6 7 8 9))
Entering RPT ((1 2 3 4 5 6 7 8 9))
Entering RPT ((2 3 4 5 6 7 8 9))
Entering RPT ((3 4 5 6 7 8 9))
Entering RPT ((4 5 6 7 8 9))
Entering RPT ((5 6 7 8 9))
Exiting RPT --> (6 7 8 9)
Unwinding RPT
Exiting RPT --> (4 6 7 8 9)
Unwinding RPT
Exiting RPT --> (3 4 6 7 8 9)
Unwinding RPT
Exiting RPT --> (2 3 4 6 7 8 9)
Unwinding RPT
Exiting RPT --> (1 2 3 4 6 7 8 9)
Unwinding RPT
(1 2 3 4 6 7 8 9)
Here, you see that your function reverses the prefix, while unstacking
the stackframes where the items have been stored.
REMOVE-FIRST-OCCURENCE-KEEPING-TAIL
[96]>
(defun remove-first-occurence-keeping-tail (item list)
(tracing-labels ((remove (current result)
(cond ((null current) (nreverse result))
((eql item (car current)) (nreconc result (cdr current)))
(t (remove (cdr current) (cons (car current) result))))))
(remove list '())))
[97]> (REMOVE-FIRST-OCCURENCE-KEEPING-TAIL 5 (list 1 2 3 4 5 6 7 8 9))
Entering REMOVE ((1 2 3 4 5 6 7 8 9) NIL)
Entering REMOVE ((2 3 4 5 6 7 8 9) (1))
Entering REMOVE ((3 4 5 6 7 8 9) (2 1))
Entering REMOVE ((4 5 6 7 8 9) (3 2 1))
Entering REMOVE ((5 6 7 8 9) (4 3 2 1))
Exiting REMOVE --> (1 2 3 4 6 7 8 9)
Unwinding REMOVE
Exiting REMOVE --> (1 2 3 4 6 7 8 9)
Unwinding REMOVE
Exiting REMOVE --> (1 2 3 4 6 7 8 9)
Unwinding REMOVE
Exiting REMOVE --> (1 2 3 4 6 7 8 9)
Unwinding REMOVE
Exiting REMOVE --> (1 2 3 4 6 7 8 9)
Unwinding REMOVE
(1 2 3 4 6 7 8 9)
Here you see that the result (with nreverse) have been done at once in
the deeper function call, and since it's a tail call (the result is
returned immediately from all the stack frames), a compiler could
optimize it out, not allocating the unneeded stackframes. (Which
doesn't occur with TRACING-LABELS which makes the last call non-tail).
--
__Pascal Bourguignon__ http://www.informatimago.com/
Until real software engineering is developed, the next best practice
is to develop with a dynamic system that has extreme late binding in
all aspects. The first system to really do this in an important way
is Lisp. -- Alan Kay
"Jimka" <·····@rdrop.com> writes:
>>3- There's not much difference in stacking items on a result list to
>> be nreversed at the end and stacking them in stack frames, to be
>> "reversed" at the end:
>
> actually that is a very good piece of information to know... thanks.
>
> What do you get with remove-first-occurence-keeping-tail
The same as with remove-preserving-tail.
> why you try to exhaustively remove in all possible orders?
If you're asking about this function:
(defun remove-first-occurence-keeping-tail (item list)
(labels ((remove (current result)
(cond ((null current) (nreverse result))
((eql item (car current)) (nreconc result (cdr current)))
(t (remove (cdr current) (cons (car current) result))))))
(remove list '())))
Note that REMOVE is the one defined locally with LABELS, not the one
exported from COMMON-LISP.
> (defun exhaust-list (done list)
> (when list
> (format t "~A~%" (list done list))
> (dolist (item list)
> (exhaust-list (cons item done)
> (remove-first-occurence-keeping-tail item
> list)))))
>
> (exhaust-list nil '(1 2 3 4))
>
> With remove-preserving-tail i get 4! iterations, but with
> remove-first-occurence-keeping-tail i get only one iteration.
> I would expect to see the following output.
With the above remove-first-occurence-keeping-tail I get the same output.
If you use a destructive function, dolist cannot work satisfactorily,
because it can be implemented in such a way that the modifications on
the list interfer badly with it. Since you use dolist, you must use
non destructive functions on the list (at least, non-destructive from
the cons containing the item to the end of the list).
--
__Pascal Bourguignon__ http://www.informatimago.com/
CONSUMER NOTICE: Because of the "uncertainty principle," it is
impossible for the consumer to simultaneously know both the precise
location and velocity of this product.
From: Marcin 'Qrczak' Kowalczyk
Subject: Re: how to remove but preserve tail.
Date:
Message-ID: <87wtf4vq59.fsf@qrnik.zagroda>
Pascal Bourguignon <······@informatimago.com> writes:
> 2- Your recursive call is not a tail call, so you don't get any TCO,
> therefore your solution will overflow the stack ON ANY implementation,
> given a big enough (position item list).
Well, on any implementation which limits the stack to be significantly
smaller than total available memory.
(Which is probably most of them though.)
--
__("< Marcin Kowalczyk
\__/ ······@knm.org.pl
^^ http://qrnik.knm.org.pl/~qrczak/
I've written a non-recursive version based on
the ideas of tconc and lconc. (lazy in this case
to make them a bit faster).
;; Remove the given element the first time it occurs
;; in the list consing as few cells as possible,
;; and only traversing as far as necessary into the list.
;; This function is completely non-destructive.
;; This is done by using tconc to collect the elements
;; of the list until we reach the unwanted item,
;; then using lconc to setf cdr to the remaining elements
;; without traversing any further.
;; An annoying side effect is that if the unwanted element
;; is not found then the entire list is re-allocated and then simply
;; thrown away for the garbage collector.
;; This does not matter for our application because we always
;; call remove-preserving-tail with an item that is for sure in
;; the list, but an in-general a safer implementation would save list
;; and return that value rather than returning nil in case the
;; item is unfound.
(defun remove-preserving-tail (item list)
(if (eql item (car list))
(cdr list)
(let ((conc (list nil)))
(loop for sub on list
do (if (eql item (car sub))
(progn (lazy-lconc conc (cdr sub))
(return-from remove-preserving-tail (car conc)))
(lazy-tconc conc (car sub))))
list)))
;; like lconc except that it does not
;; advance the cdr of the conc to the end of the list
;; until necessary. for lconc and tconc the conc structure
;; usually is in a state where (cdr conc) is the last cons
;; cell of the list. in the case of lazy-lconc and lazy-tconc
;; (cdr conc) is just some cons cell but will be advanced to the
;; end on demand whenevery anything needs to be added.
(defun lazy-lconc (conc list)
(let ((ptr (cdr conc)))
(if ptr
(progn
(loop while (cdr ptr)
do (pop ptr))
(setf (cdr ptr) list)
(setf (cdr conc) ptr))
(progn
(setf (car conc) list)
(setf (cdr conc) list)))))
(defun lazy-tconc (conc item)
(lazy-lconc conc (list item)))
"Jimka" <·····@rdrop.com> writes:
> So can someone think of a clever way with LOOP to
> write remove-preserving-tail, only iterating until the
> to-be-deleted element is encountered? I only want to remove the
> first occurance in my case.
Hmm. It would seem a recursive solution might be simpler, but if it has
to be loop, how about:
(defun remove-1-sharing-tail (item list)
(loop for remainder on list by #'cdr
when (eql item (first remainder))
return (nconc head (rest remainder))
else collect (first remainder) into head
finally (return list)))
USER> (setq foo (list 1 2 3 4 5 6 7 3))
(1 2 3 4 5 6 7 3)
USER> (setq bar (remove-1-sharing-tail 3 foo))
(1 2 4 5 6 7 3)
USER> (eq foo bar)
NIL
USER> (eq (cdddr foo) (cddr bar))
T
--
Thomas A. Russ, USC/Information Sciences Institute
"Jimka" <·····@rdrop.com> writes:
> Is there an easy way to remove an element from a list, returning
> a new list which shares the tail of the original list?
The usual idea is to write "copy-list" and then tweak it so
that it doesn't bother with the unwanted element.
Later in the thread you say that you only want to make one
ommision. This makes the problem easy. Once you have
encountered the unwanted element you can stop
copying and just use the tail.
If you want to remove all occurences of the unwanted
item you have to go right to the end of the list to make
sure that you have got them all. You can preserve tails by
building the copy on the ebb of the recursion instead of on
the flood of the recursion:
CL-USER> (defun my-remove (unwanted-item list)
(if (endp list) '()
(let ((result (my-remove unwanted-item
(cdr list))))
(if (eql (car list)
unwanted-item)
result
(if (eql result
(cdr list))
list
(cons (car list)
result))))))
MY-REMOVE
CL-USER> (write (list list
(my-remove 'a list))
:circle t)
((A . #1=(B C D E)) #1#)
((A B C D E) (B C D E))
I like the tidal metaphor of the ebb and flood of the
recursion, but earlier work
http://www.brics.dk/RS/02/12/BRICS-RS-02-12.pdf
draws on Middle Earth for its terminology.
Alan Crowe
Edinburgh
Scotland