TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: MP on April 23, 2005, 01:08:08 AM
-
Having residual caffiene in my system and thinking about Chuck's discussion earlier today on car | cdr I got to thinking about a real old vanilla lisp version of removenth that I had penned using cdr, member etc. and then dreamed up this little number I thought might make Se7en's forehead twitch a bit.
(defun RemoveNth ( n lst / len foo i )
(defun foo (x)
(if (eq n (setq i (1+ i)))
(defun foo (x) nil)
)
)
(cond
( (zerop n) (cdr lst))
( (eq n (1- (setq len (length lst))))
(reverse (cdr (reverse lst)))
)
( (< (setq i -1) n len)
(vl-remove-if 'foo lst)
)
( lst )
)
)
;; examples of use
(setq lst '(0 1 2 3 4 5 6 7))
(removenth -1 lst) ;; => (0 1 2 3 4 5 6 7)
(removenth 0 lst) ;; => (1 2 3 4 5 6 7)
(removenth 4 lst) ;; => (0 1 2 3 5 6 7)
(removenth 7 lst) ;; => (0 1 2 3 4 5 6)
(removenth 8 lst) ;; => (0 1 2 3 4 5 6 7)
What do ya think?
:lol:
(Pssst -- there's room for optimization, can ya see it?)
Edit: Updated to reflect this post, much better (http://www.theswamp.org/phpBB2/viewtopic.php?p=59079#59079).
-
heh, I'm pleased It doesn't have comments in it :)
That double defun is tricky
-
(http://www.theswamp.org/screens/mp/prophead.png)
-
hehehehe ........ LOL
that's great stuff MP.
-
Too much coffee today; seriously. :shock:
Thank you Kerry, thank you Mark.
:lol:
-
hehehe .. is that the code monkey ??
is he caffinated too ?
-
He's known as <PeterSellersVoice>'the code minkey'</PeterSellersVoice>.
:)
-
That is a sick bit of code Michael. What brand of coffee do you have in the drip bag.?
-
Instant. Works fast -- no waiting.
:lol:
-
<-- sockless
-
Do you guys like this variant?
(defun RemoveNth ( n lst / len foo i )
(defun foo (pair)
(if (eq n (setq i (1+ i)))
(defun foo (pair) nil)
)
)
(cond
( (zerop n) (cdr lst))
( (eq n (1- (setq len (length lst))))
(reverse (cdr (reverse lst)))
)
( (< (setq i -1) n len)
(vl-remove-if 'foo lst)
)
( lst )
)
)
:lol:
-
Now you're just being a show-off :P
:dood:
-
Actually, it should read like this --
(defun RemoveNth ( n lst / len foo i )
(defun foo (x)
(if (eq n (setq i (1+ i)))
(defun foo (x) nil)
)
)
(cond
( (zerop n) (cdr lst))
( (eq n (1- (setq len (length lst))))
(reverse (cdr (reverse lst)))
)
( (< (setq i -1) n len)
(vl-remove-if 'foo lst)
)
( lst )
)
)
There is still at least one level of optimization that can be done in my mind. Any takers?
:)
-
Any takers?
yea right ..... I wish.
I'm still hung-up on ...
(defun foo (x)
(if (eq n (setq i (1+ i)))
(defun foo (x) nil)
)
-
Want for me to 'splain?
BRB (grabbin' a mug o' brew ...)
-
Want for me to 'splain?
BRB (grabbin' a mug o' brew ...)
I do! I do!
-
Want for me to 'splain?
Oh heck yea!!
-
Let's say we have a list of 3 items '(a b c) and we want to remove the 2nd, or 1th item (b).
(RemoveNth 1 '(a b c)) ...
(foo a):
;; i = 0 after assignment, so this
;; returns nil to vl-remove-if, iow,
;; the current item is not removed
(if (eq 1 (setq i (1+ i)))
(defun foo (x) nil)
)
(foo b):
;; i = 1 after assignment, so this
;; returns a new definition of foo
;; which is also a non nil value,
;; thus vl-remove-if removes this item
;; from the list
(if (eq 1 (setq i (1+ i)))
(defun foo (x) nil)
)
(foo c):
;; for this and any remaining calls
;; foo returns nil no matter what we
;; throw at it, so vl-remove-if will
;; not remove any more items
Make sense?
Can anyone see where there's room for optimization?
:)
-
Make sense?
Ok.. now it does. Very cool stuff MP.
-
Can anyone see where there's room for optimization?
No I can't, at least not at this time.
-
Can anyone see where there's room for optimization?
I can!
First, you have to take into account the time of day --> early
Then you calculate how much coffee has been ingested --> approximately 20oz.
Do a little math, look at the code, and it's fairly easy to see that
(setq drink_more_coffee T)
is desperately needed.
-
Wait.... maybe if you stop the search after you get the first match?
-
Make sense?
Ok.. now it does.
(http://theswamp.org/screens/mp/thumbsup.gif)
Very cool stuff MP.
Thanks man. :oops:
-
Wait.... maybe if you stop the search after you get the first match?
close or "no cigar" ?
-
Close: You can't have vl-remove-if stop iterating the list once it starts, all one can do is try to optimize the predicate function, which is what I've done via (defun foo (x) nil) once the target has been realized.
There's still at least one other thing.
:)
-
If there were no overhead associated with reverse, consider this --
(defun RemoveNth ( n lst / len foo i )
(defun foo (x)
(if (eq n (setq i (1+ i)))
(defun foo (x) nil)
)
)
(cond
( (zerop n) (cdr lst))
( (eq n (1- (setq len (length lst))))
(reverse (cdr (reverse lst)))
)
( (< (setq i -1) n len)
(if (< n (1+ (/ len 2)))
(vl-remove-if 'foo lst)
(reverse
(RemoveNth (- len n 1)
(reverse lst)
)
)
)
)
( lst )
)
)
:P
-
That'll take a picture for me figure out. :D
-
Hint -- it never has to count higher than half the length of the list.
:)
-
Hey nice trick!
Optomise huh?! well lets see... I think the first thing i would do is to test a while loop against the vl-remove-if and see which one whips thru faster. (You can stop a while loop while you cant a vl-remove so i would be intrested in seeing those results.) However if the while loop is faster then that would negate your fany defining trick.
If the vl-remove function is faster then i would test to see if a set-lambda is faster then a defun. (Which i kinda doubt, but i think its worth a shot if we can remove a bit of time associated with recaling the function definition.)
But if that fails then i would mabey tackle a tree type of recusrsion. (Operate ont the front and the back of the list at the same time. --BUT that would increase the stack a T O N! so that might not work out either.)
-
Go crazy John. :)
Here's my non optimized vanilla lisp version (word wrap will kill it) --
(defun RemoveNth ( n lst / len key pair )
(cond
( (zerop n) (cdr lst))
( (eq n (1- (setq len (length lst))))
(reverse (cdr (reverse lst)))
)
( (< (setq key -1.0) n len)
(mapcar 'cdr
(append
(reverse
(cdr
(member
(setq pair
(nth n
(setq lst
(mapcar
'(lambda (item)
(cons
(setq key
(1+ key)
)
item
)
)
lst
)
)
)
)
(reverse lst)
)
)
)
(cdr (member pair lst))
)
)
)
( lst )
)
)
Haven't had time to bench any of this stuff, so I don't know what's faster. May prove intellestink!
-
If anyone is mildy interested I did some tests today and found both versions of the removenth function that use vl-remove-if were approx. 2x faster than the vanilla version, using lists with 1,000 to 1,000,000 items (using a representative spread of 'n' positions).
Having said that, that isn't terrible performance for vanilla lisp.
Challenge extended -- writer a faster variant in either vanilla or visual lisp. Hint - recursive will look prettier but ...
:)
-
That is interesting, thanks.
Sorry I've been too busy to participate but here are some more variations for your speed test.
Not sure if you had run across them before.
http://www.theswamp.org/index.php?topic=635.0
http://www.theswamp.org/index.php?topic=754.0
<edit: repair broken links>
-
Let's not forget about this (http://www.theswamp.org/phpBB2/viewtopic.php?p=9412#9412) one
-
Holy chyt, wish I'd been here for all those threads; good stuff!
:)
-
You should've followed Cadaver over here sooner. You would've been here for them.
-
Came over the first time I saw him reference the place. Of course, I've never been called 'Captain Observant'.
-
PS: If I'm not mistaken this (http://www.theswamp.org/phpBB2/viewtopic.php?p=9412#9412) one will remove every instance of an item from a list; not the same as removing the nth item.
:)
-
True. That was the point of that challenge. I just like how simply effective it was.
-
(defun removenth (n lst / j)
(setq j -1)
(vl-remove-if '(lambda (x)
(= n (setq j (1+ j)))
) lst
)
)
-
(defun remove-i (ind lst)
(if (or (zerop ind) (null lst))
(cdr lst)
(cons (car lst) (remove-i (1- ind) (cdr lst)))
)
)
-
not recursive
(defun remove-nth (l n / a)
;;(remove-nth l 20)
(while (and l (> n 0))
(setq a (cons (car l) a)
l (cdr l)
n (1- n)
) ;_ setq
) ;_ while
(append (reverse a) (cdr l))
)
-
;; CAB 11.16.07 rev. 12.23.08
;; Remove based on pointer list
(defun RemoveNlst (nlst lst)
(setq i -1)
(vl-remove-if '(lambda (x) (vl-position (setq i (1+ i)) nlst)) lst)
)
(setq result (RemoveNlst '(1 4) '(0 "A" 2 3 "B" 5 6 7 8 9)))
;; removes A & B
-
I see the links in my previous post were broken.
Here are the new links:
http://www.theswamp.org/index.php?topic=635.0
http://www.theswamp.org/index.php?topic=754.0
-
Here is something similar I wrote a long time ago to be able to set or remove an atom from in a list. It's a lot more "brute force" and the speed of it will depend on the position of the element that we are trying to remove. also, there is a lot of overhead from the double reverse of the Add function.
(Defun Add ( ATM LST )
(Reverse (Cons ATM (Reverse LST)) )
)
(Defun SetNth ( IDX LST ITM / cnt return )
(SetQ cnt 0 )
(While (< cnt IDX)
(SetQ return (Add (Car LST) return)
LST (Cdr LST)
cnt (1+ cnt)
)
)
(SetQ return (Append (Add ITM return) (Cdr LST)) )
return
)
(Defun RemoveNth ( IDX LST / cnt return )
(SetQ cnt 0 )
(While (< cnt IDX)
(SetQ return (Add (Car LST) return)
LST (Cdr LST)
cnt (1+ cnt)
)
)
(SetQ return (Append return (Cdr LST)) )
return
)
It's very similar to ElpanovEvgeniy's solution, but he managed to get around the double reverse!
-
Here is my code.
(defun remove-n (n lst / a b)
(setq a lst)
(repeat n
(setq b (cons (car a) b)
a (cdr a)
)
)
(setq a (cdr a))
(foreach i b
(setq a (cons i a))
)
a
)By the way, I posted a function that insert an element in nth position of a list.
(defun insert-n (n element lst / a b)
(setq a lst)
(repeat n
(setq b (cons (car a) b)
a (cdr a)
)
)
(setq a (cons element a))
(foreach i b
(setq a (cons i a))
)
a
)It's very similar as the function "remove-nth".
-
I never saw this post, soory to ge t here so late.
Would this work?
(defun REMNTH (Ctrl Lst / NewList)
(if (and (numberp Ctrl)(>= Ctrl 0)(< Ctrl (length Lst))(listp Lst))
(setq NewList (vl-remove (nth Ctrl Lst) Lst))
)
)
-
I think vl-remove takes out all occurrences found in the list.
Yup...(vl-remove 1 '(1 1 1 2 2 3 3 4 5 6 7)) >>> (2 2 3 3 4 5 6 7)
-
Crap, you're right....... :lol:
Back to the dwg brd....
-
dang how did i miss out on this bit of fun?
-
uhmmm ...
'cause you weren't a member when it happened ..perhaps ?
-
I should've atleast caught some of page 3
-
(defun FOO (X)
(if (eq N (setq I (1+ I)))
(defun FOO (X) NIL)
)
)
It's funny!!!
First meet it
-
not recursive
(defun remove-nth (l n / a)
;;(remove-nth l 20)
(while (and l (> n 0))
(setq a (cons (car l) a)
l (cdr l)
n (1- n)
) ;_ setq
) ;_ while
(append (reverse a) (cdr l))
)
The above function questions exist, such as:
_$ (remove_nth -3 '("a" "b" "c" d e d f g h d d d))
("b" "c" D E D F G H D D D)
_$ (remove_nth 18 '("a" "b" "c" d e d f g h d d d))
("a" "b" "c" D E D F G H D D D)
When n is less than 0, the function of problem exist.
Here are my revised code:
;; modified by 小李子
(defun remove_nth (n l / a)
(if (and l (>= n 0) (< n (length l)))
(progn
(while (> n 0)
(setq a (cons (car l) a)
l (cdr l)
n (1- n)
)
)
(setq l (append (reverse a) (cdr l)))
)
)
l
)
-
Here is something similar I wrote a long time ago to be able to set or remove an atom from in a list. It's a lot more "brute force" and the speed of it will depend on the position of the element that we are trying to remove. also, there is a lot of overhead from the double reverse of the Add function.
(Defun Add ( ATM LST )
(Reverse (Cons ATM (Reverse LST)) )
)
(Defun SetNth ( IDX LST ITM / cnt return )
(SetQ cnt 0 )
(While (< cnt IDX)
(SetQ return (Add (Car LST) return)
LST (Cdr LST)
cnt (1+ cnt)
)
)
(SetQ return (Append (Add ITM return) (Cdr LST)) )
return
)
(Defun RemoveNth ( IDX LST / cnt return )
(SetQ cnt 0 )
(While (< cnt IDX)
(SetQ return (Add (Car LST) return)
LST (Cdr LST)
cnt (1+ cnt)
)
)
(SetQ return (Append return (Cdr LST)) )
return
)
It's very similar to ElpanovEvgeniy's solution, but he managed to get around the double reverse!
When n is less than 0 or greater than (length LST), the function of problem exist.such as:
_$ (remove-nth -3 '("a" "b" "c" d e d f g h d d d))
("b" "c" D E D F G H D D D)
_$ (remove-nth 18 '("a" "b" "c" d e d f g h d d d))
("a" "b" "c" D E D F G H D D D nil nil nil nil nil nil)
Here are my revised code:
;; 上面的函数有错误，所以修改后为：by 小李子
(Defun Remove-Nth-0 (IDX LST / cnt ret)
(if (and LST (>= IDX 0) (< IDX (length LST)))
(progn
(SetQ cnt 0)
(While (< cnt IDX)
(SetQ ret (Add (Car LST) ret)
LST (Cdr LST)
cnt (1+ cnt)
)
)
(SetQ ret (Append ret (Cdr LST)))
)
(setq ret LST)
)
ret
)
-
[quote author=highflybird link=topic=4903.msg331499#msg331499 date=1235496262]
Here is my code.
[code](defun remove-n (n lst / a b)
(setq a lst)
(repeat n
(setq b (cons (car a) b)
a (cdr a)
)
)
(setq a (cdr a))
(foreach i b
(setq a (cons i a))
)
a
)By the way, I posted a function that insert an element in nth position of a list.
(defun insert-n (n element lst / a b)
(setq a lst)
(repeat n
(setq b (cons (car a) b)
a (cdr a)
)
)
(setq a (cons element a))
(foreach i b
(setq a (cons i a))
)
a
)It's very similar as the function "remove-nth".
[/quote]
Here are my revised code:
;; 修改为如下：by 小李子
(defun remove-n (n lst / a b)
(setq a lst)
(if (and lst (>= n 0) (< n (length lst)))
(progn
(repeat n
(setq b (cons (car a) b)
a (cdr a)
)
)
(setq a (cdr a))
(foreach i b
(setq a (cons i a))
)
)
) ;end if
a
)
;; 修改为如下代码：by 小李子
(defun insert-n (n element lst / a b)
(setq a lst)
(if (and (>= n 0) (<= n (length a)))
(progn
(repeat n
(setq b (cons (car a) b)
a (cdr a)
)
)
(setq a (cons element a))
(foreach i b
(setq a (cons i a))
)
)
)
a
)
[/code]
-
(ACET-LIST-REMOVE-NTH 2 '("a" "b" "c" "d" "e" "a" "a" "b" "i" "b" "k"))
> ("a" "b" "d" "e" "a" "a" "b" "i" "b" "k")