TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: robertocuba on June 08, 2009, 01:41:15 PM
-
Hello:
I´m developing a following routine to remove elements from a list between identifiers "x" .... "x" of sub-list (recursive).
Problem:
List: ("a" 3 4 5 5 "b" 8 7 6 3 2 2 1 1 "c" 5 67 87 76 "d" 9 0 5 49 5 9)
The routine must be return:
List: ("a" 3 4 5 "b" 8 7 6 3 2 1 "c" 5 67 87 76 "d" 9 0 5 49)
Thanks !
-
Post the code you've developed so far.
-
from your example I'm having trouble understanding what you want to remove.
in three instances duplicated items have one removed
then there's the items at the end that are removed
-
Yes, I want remove the similar elements, between "a" and "b", and between "b" and " and ...
-
It appears to me that alpha characters are delimiters, anything before, between or after are subgroups, and the OP's want is to have each subgroup sport unique members. I'm getting a strong impression these exercises are actually homework assignments, and as much as I enjoy challenges, I have no interest if they are indeed homework. Of course I'm open to hearing an alternative explanation and viewing the OP's attempts thus far.
-
it was fun solving though.
-
Agreed.
Mine's a bit verbose at 14 lines.
-
3 recursives, not very streamlined... way too many lines that look similar and are begging to be condensed. it was fun to think through.
-
14 lines too (vlisp formated), only one recursive sub
-
Ummm...*Se7en: scratches head* ...why recursive?
And if this is homework then; `recursive' describes the procedure not necessarily the type of process. So what kind of process? -i.e. you want a ``Recursive procedure using a ______ process which will remove the elements....''?
-
11 lines, but need to call (foo lst nil)
-
you know I've never understood counting lines in lisp.
I mean in theory mine could be 3 lines.
(sorry, just trying to make me feel better about myself)
-
<snip>
I mean in theory mine could be 3 lines.
<snip>
In theory, it could be one. *lol*
-
11 lines, but need to call (foo lst nil)
Bizarro world: same here but 12 lines, 15 with the wrapper. :D
1 line if I skip the superfluous carriage returns. :-D
-
The code?
Thanks !
-
You post your attempts first robertocuba . :evil:
-
single recursive function containing two if statements, one of those empty list check, the other one an "(and".
requires reversal of list prior to use
heck yeah.
robertocuba, hurry up and post some stuff, I wanna show this off.
-
This is my first code:
(defun remove_doubles (lst)
(if lst
(cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
)
)
(defun process_list (list_p / contador centinel element lista_tmp list_final)
(setq contador 0)
(while (< contador (length list_p))
(progn
(setq centinel 0)
(setq element (nth contador list_p))
(if (= nil (numberp element))
(progn
(setq lista_tmp (cons (nth contador list_p) lista_tmp))
(while (= centinel 0)
(if (= T (numberp (nth (+ contador 1) list_p)))
(setq lista_tmp (cons (nth (+ contador 1) list_p) lista_tmp))
;else
(progn
(setq list_final (cons (remove_doubles lista_tmp) list_final))
(setq centinel 1)
)
)
(setq contador (+ contador 1))
)
)
)
)
)
)
(defun c:x ()
(setq l (process_list '("m1-1" 1 2 "m1-2" 3 3 4 "m1-3" 1 1 1 2 2 3)))
)
-
Not pretty but it works and is faster than my other attempts ...
(defun foo ( lst / bar )
(defun bar ( a b / c e )
(if a
(bar
(cdr a)
(if (eq 'str (type (setq e (car a))))
(cons (list e) b)
(if (member e (setq c (car b))) b (cons (cons e c) (cdr b)))
)
)
(apply 'append (reverse (mapcar 'reverse b)))
)
)
(bar lst nil)
)
-
Excellent !
Thanks
-
Don't get too excited, mine's likely the least elegant of them all. Stay tuned ... :)
-
Here's one of my other stabs:
(defun foo ( lst / bar )
(defun bar ( a b c / e f )
(if a
(bar
(cdr a)
(if (setq f (eq 'str (type (setq e (car a)))))
(list e)
(if (member e b) b (cons e b))
)
(if f (cons b c) c)
)
(apply 'append (reverse (mapcar 'reverse (cons b c))))
)
)
(bar lst nil nil)
)
-
(defun doit (thelist)
(reverse (remove (reverse thelist)))
)
(defun remove (alist)
(if alist
(if
(and
(/= (type (car alist)) 'STR)
(> (length (member (car alist) (cdr alist)))
(length
(vl-member-if '(lambda (item) (= (type item) 'STR)) alist)
)
)
)
(remove (cdr alist))
(cons (car alist) (remove (cdr alist)))
)
)
)
edit: forgot to add, there was some mild editing done without autocad around to check... so might need some minor tweaking to run. I'll check tomorrow.
-
(defun foo ( lst / bar )
(defun bar ( a b / c e )
(if a
(bar
(cdr a)
(if (eq 'str (type (setq e (car a))))
(cons (list e) b)
(if (member e (setq c (car b))) b (cons (cons e c) (cdr b)))
)
)
(apply 'append (reverse (mapcar 'reverse b)))
)
)
(bar lst nil)
)
I think my head just exploded with that
in the cool sorta way.
-
I think my head just exploded with that
in the cool sorta way.
Ditto :ugly:
Or as you say here "this".
-
I think my head just exploded with that
in the cool sorta way.
Glad I could help. :D
Wait 'til you see Gile's.
-
Slight variation for fun ...
(defun foo ( lst / bar )
(defun bar ( a b / c e )
(if (setq c (car b) e (car a))
(bar
(cdr a)
(if (eq 'str (type e))
(cons (list e) b)
(if (member e c) b (cons (cons e c) (cdr b)))
)
)
(apply 'append (reverse (mapcar 'reverse b)))
)
)
(bar lst nil)
)
-
plain. it is easier for me to follow than anything with recursion.
(defun GroupSet (lst / r subset)
(foreach e lst
(if (eq (type e) 'str)
(setq r (cons e r)
subset nil
)
(if (not (member e subset))
(setq r (cons e r)
subset (cons e subset)
)
)
)
)
(reverse r)
)
-
You never said if this was for a class or not, if it is may I suggest doing them on your own then posting the problems? As you can tell we all love a good challenge, but if it is for a class that's probably something you should work out most on your own.
-
:xTime difference ! I was sleeping while you were posting
mine look like MP's
(defun foo (lst / sub)
(defun sub (lst tmp / a)
(if lst
(if (numberp (setq a (car lst)))
(if (vl-position a tmp)
(sub (cdr lst) tmp)
(sub (cdr lst) (cons a tmp))
)
(append (reverse tmp) (sub (cdr lst) (list a)))
)
)
)
(sub (cdr lst) (list (car lst)))
)
-
:xTime difference ! I was sleeping while you were posting
mine look like MP's
(defun foo (lst / sub)
(defun sub (lst tmp / a)
(if lst
(if (numberp (setq a (car lst)))
(if (vl-position a tmp)
(sub (cdr lst) tmp)
(sub (cdr lst) (cons a tmp))
)
(append (reverse tmp) (sub (cdr lst) (list a)))
)
)
)
(sub (cdr lst) (list (car lst)))
)
Interesting, similar but different. Like I said a couple posts back, it scares me sometimes that our thought patterns are like those shared by brothers ... Lispin' Bruthas. :D
-
Similar but ... Gile's performance is far better:
Elapsed milliseconds / relative speed for 16384 iteration(s):
(FOO_GILE LST).....1171 / 1.72 <fastest>
(FOO_MP1 LST)......1891 / 1.07
(FOO_MP2 LST)......2015 / 1.00 <slowest>
If I replace the calls to type and member with numberp and vl-position respectively:
Elapsed milliseconds / relative speed for 16384 iteration(s):
(FOO_GILE LST).....1171 / 1.29 <fastest>
(FOO_MP1 LST)......1344 / 1.13
(FOO_MP2 LST)......1516 / 1.00 <slowest>
Gile's is still the better algorithm; kudos. :)
-
However!
(setq lst '("a" 3 4 5 5 "b" 8 7 6 3 2 2 1 1 "c" 5 67 87 76 "d" 9 0 5 49 5 9))
(foo_gile lst)
=> ("a" 3 4 5 "b" 8 7 6 3 2 1 "c" 5 67 87 76)
(foo_mp1 lst)
=> ("a" 3 4 5 "b" 8 7 6 3 2 1 "c" 5 67 87 76 "d" 9 0 5 49)
(foo_mp2 lst)
=> ("a" 3 4 5 "b" 8 7 6 3 2 1 "c" 5 67 87 76 "d" 9 0 5 49)
Hello:
I´m developing a following routine to remove elements from a list between identifiers "x" .... "x" of sub-list (recursive).
Problem:
List: ("a" 3 4 5 5 "b" 8 7 6 3 2 2 1 1 "c" 5 67 87 76 "d" 9 0 5 49 5 9)
The routine must be return:
List: ("a" 3 4 5 "b" 8 7 6 3 2 1 "c" 5 67 87 76 "d" 9 0 5 49)
Thanks !
-
wow, mine is really slow in comparison
-
wow, mine is really slow in comparison
Whao, I thought you were being sarcastic:
Elapsed milliseconds / relative speed for 16384 iteration(s):
(FOO_MP1 LST)......1375 / 17.74 <fastest>
(FOO_MP2 LST)......1563 / 15.61
(FOO_UCP LST).....24391 / 1.00 <slowest>
The good news is ... (foo_ucp lst)
=> ("a" 3 4 5 "b" 8 7 6 3 2 1 "c" 5 67 87 76 "d" 9 0 5 49)
-
Ooopss !!!
I didn't saw that yesterday, it was too late here
Here's a corrected one, I expect... one more line (if we count the lines :wink:)
(defun gile (lst / sub)
(defun sub (lst tmp / a)
(if lst
(if (numberp (setq a (car lst)))
(if (vl-position a tmp)
(sub (cdr lst) tmp)
(sub (cdr lst) (cons a tmp))
)
(append (reverse tmp) (sub (cdr lst) (list a)))
)
(reverse tmp)
)
)
(sub (cdr lst) (list (car lst)))
)
-
Ooopss !!!
I didn't saw that yesterday, it was too late here
Here's a corrected one ...
Well done my friend:
Elapsed milliseconds / relative speed for 16384 iteration(s):
(FOO_GILE LST)......1203 / 20.22 <fastest>
(FOO_MP1 LST).......1391 / 17.49
(FOO_MP2 LST).......1515 / 16.06
(FOO_UCP LST)......24328 / 1.00 <slowest>
:)
-
wow, mine is really slow in comparison
Whao, I thought you were being sarcastic:
Elapsed milliseconds / relative speed for 16384 iteration(s):
(FOO_MP1 LST)......1375 / 17.74 <fastest>
(FOO_MP2 LST)......1563 / 15.61
(FOO_UCP LST).....24391 / 1.00 <slowest>
The good news is ... (foo_ucp lst)
=> ("a" 3 4 5 "b" 8 7 6 3 2 1 "c" 5 67 87 76 "d" 9 0 5 49)
probably the length and member-if
-
This thread got busy.
I built a tail recursive (recursive procedure using an iterative process) procedure this morning. Its not very fast nor has it been ``cleaned'' --in fact, its fairly messy and almost incoherent-. If you want, you can time it but it will most likely be slow compared to the others in this thread (I didnt look at the code in this thread, but kinda felt i knew the direction the posters of this thread would go in so I did it to be different not fast).
(defun remove_dups-iter (tmp sofar lis)
(if (null lis)
;; cleanup
(reverse (apply 'append (cons tmp sofar)))
(remove_dups-iter
;; re iterate
(cons
;; tmp list
(if (not (member (car lis) tmp)) (car lis) )
(if (eq (type (car lis)) 'STR) 'nil tmp) )
(cond
;; sofar list
((eq (type (car lis)) 'STR)
(setq sofar (cons tmp sofar))
(setq tmp nil)
sofar)
( sofar ) )
;; remainder of list
(cdr lis))) )
(defun remove_dups_in-between-chars ( lst / tmp )
;; a cleaner interface
(remove_dups-iter '() '() lst) )
(remove_dups_in-between-chars '("a" 3 4 5 5 "b" 8 7 6 3 2 2 1 1 "c" 5 67 87 76 "d" 9 0 5 49 5 9))
=> ("a" 3 4 5 nil "b" 8 7 6 3 2 nil 1 nil "c" 5 67 87 76 "d" 9 0 5 49 nil nil)
-
Late entry, non recursive. 8-)
(defun NoDoups (lst / e nlst tmp)
(while (setq e (car lst))
(setq lst (cdr lst))
(if (numberp e)
(if (or (null tmp) (not (vl-position e tmp)))
(setq tmp (cons e tmp))
)
(progn
(if tmp (setq tmp (cons e tmp)))
(if nlst
(setq nlst (append tmp nlst))
(setq nlst (cons e tmp))
)
(setq tmp nil)
)
)
)
(if tmp (setq nlst (append tmp nlst)))
(reverse nlst)
)
-
(defun doit2 (thelist)
(reverse (remove2 (reverse thelist)))
)
(defun remove2 (alist)
(if alist
(if
(if (numberp (setq thelist alist
search (car alist)))
(progn
(While (and (/= (setq thelist (cdr thelist)
testitem (car thelist)
)
search
)
(numberp testitem)
)
)
(numberp testitem)
)
)
(remove2 (cdr alist))
(cons search (remove2 (cdr alist)))
)
)
)
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):
(NODOUPS BLAH)...........................1031 / 22.51 <fastest>
(GILEFOO BLAH)...........................1125 / 20.62
(DOIT2 BLAH).............................1484 / 15.64
(GROUPSET BLAH)..........................1750 / 13.26
(MP2FOO BLAH)............................1829 / 12.69
(MP1FOO BLAH)............................1844 / 12.58
(MP3FOO BLAH)............................1875 / 12.37
(REMOVE_DUPS_IN-BETWEEN-CHARS BLAH)......2484 / 9.34
(PROCESS_LIST BLAH)......................2890 / 8.03
(DOIT BLAH).............................23203 / 1.00 <slowest>
catchin up
-
Oh, I like that test run. :-)
-
well were you expecting anything else? ...try using foreach instead and you will really smoke us.
MP, quick question; I never quite understood what "relative speed for ... iteration(s):" meant? Is that the time per call?
-
Alan's non-recursive plain-jane version scoops the money, yes ?
-
yeah and he did it with a while loop too!?
-
well were you expecting anything else? ...try using foreach instead and you will really smoke us.
MP, quick question; I never quite understood what "relative speed for ... iteration(s):" meant? Is that the time per call?
Means that (NODOUPS BLAH) is 22.5 times faster than (DOIT BLAH)
ie 1031:23203
-
I'm pretty sure WHILE is faster than FOREACH.
In my test gile's was faster. :-o
-
If non recursive functions are allowed, here's mine
(defun gile2 (lst / item tmp result)
(while lst
(if (numberp (setq item (car lst)))
(if (not (vl-position item tmp))
(setq tmp (cons item tmp))
)
(setq result (append tmp result)
tmp (list item)
)
)
(setq lst (cdr lst))
)
(reverse (append tmp result))
)
-
Nice Gile.
My results.
(GILE2 LST)............................1592 / 2.15 <fastest>
(GILE LST).............................1632 / 2.09
(NODOUPS LST)..........................1683 / 2.03
(MP_FOO LST)...........................2504 / 1.36
(REMOVE_DUPS_IN-BETWEEN-CHARS LST).....3415 / 1.00 <slowest>
Not sure why my test are different.
-
<Naive Question>:
Do you all have the same LISP to test the speed of these things?
-
Everyone except KB. :-D
-
Everyone except KB. :-D
http://www.theswamp.org/index.php?topic=3952.0
is the one I'm using
-
Means that (NODOUPS BLAH) is 22.5 times faster than (DOIT BLAH)
ie 1031:23203
Ah, i see it. That makes total sense now that you put it that way...thanx!
-
Everyone except KB. :-D
http://www.theswamp.org/index.php?topic=3952.0
is the one I'm using
Thanks, I'll take a look :)
-
Everyone except KB. :-D
Yep :)
I have mine calculating the fastest as base 1 unit, and all athers with a higher relative index representing how much longer it takes to run..
ie if the fastest is 1 and the slowest is 12.6 you know it takes 12.6 times as long to run
but that's just me :)
-
That sounds more logical, is that posted anywhere KB?
-
That sounds more logical, is that posted anywhere KB?
;;=================================================================
;;
;; Output:
;;
;; Elapsed milliseconds / relative speed for 32768 iteration(s):
;;
;; (+ 1 1.0).......1452 / 1.1152 <slowest>
;; (+ 1.0 1.0).....1412 / 1.0845
;; (+ 1 1).........1332 / 1.023
;; (1+ 1)..........1302 / 1 <fastest>
;;
;; Mods by KWB 2005 to display the smallest time with the smallest ratio
;;
;;=================================================================
I've also modified this .. which [you] may want to revert to the original
(defun _main
(statements / boundary iterations timings slowest fastest lsetlen rsetlen index count)
(setq boundary 500 ; originally 1000 [kwb]
iterations 1
)
;; < ... big snip ... >
-
That sounds more logical
Doesn't to me. I think in terms of "Function A is x times faster than function B". Guess that makes me weird. :ugly:
-
Guess that makes me weird. :ugly:
yeah... only that
-
That sounds more logical
Doesn't to me. I think in terms of "Function A is x times faster than function B". Guess that makes me weird. :ugly:
Sorry, I didnt mean that statement as an insult.
*lol*
-
KB: Got it, thanx.