Q&A's, tips, howto's
cormullion
Posts: 2038 Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W
Contact:
Post
by cormullion » Mon Dec 28, 2009 5:14 pm
How do you get all the duplicates in a list? Ie the opposite of
unique ...
Code: Select all
(set 'l '(5 7 1 3 5 2 9 12 6 4 8 5 10 5 5))
(??? l)
;-> (5 5 5 5 5)
I though I could persuade
difference /
intersect to do it, but no luck yet..
itistoday
Posts: 429 Joined: Sun Dec 02, 2007 5:10 pm
Contact:
Post
by itistoday » Mon Dec 28, 2009 8:08 pm
Finding duplicates requires keeping a memory of what you've seen, while making a note as to whether you've already seen it before.
Code: Select all
(new Tree 'dups.mem)
(define (dups l (convert int))
(delete 'dups.mem nil)
(new Tree 'dups.mem)
(dolist (el l)
(dups.mem (string el) (if $it 2 1))
)
(intersect l (find-all '(? 2) (dups.mem) (convert (first $it))) true)
)
(set 'l '(5 7 1 3 5 2 9 12 6 4 8 5 10 5 5))
(println (dups l))
;=> (5 5 5 5 5)
Last edited by
itistoday on Mon Dec 28, 2009 10:50 pm, edited 1 time in total.
cormullion
Posts: 2038 Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W
Contact:
Post
by cormullion » Mon Dec 28, 2009 10:24 pm
Cool - thanks! I'll use that as a working solution for now. However, I have the vague feeling that there should be a cleaner (or shorter) solution than this... ! :)
itistoday
Posts: 429 Joined: Sun Dec 02, 2007 5:10 pm
Contact:
Post
by itistoday » Mon Dec 28, 2009 10:51 pm
cormullion wrote: Cool - thanks! I'll use that as a working solution for now. However, I have the vague feeling that there should be a cleaner (or shorter) solution than this... ! :)
If you find out let me know. ;-p
BTW, I updated the code, I made a small mistake. I changed this:
To this:
Code: Select all
(delete 'dups.mem nil) ; fast delete on 10.1.9 and later
Kazimir Majorinc
Posts: 388 Joined: Thu May 08, 2008 1:24 am
Location: Croatia
Contact:
Post
by Kazimir Majorinc » Mon Dec 28, 2009 11:02 pm
I think
count has exactly the information one needs, just in different form.
Code: Select all
> (set 'l '(5 7 1 3 5 2 9 12 6 4 8 5 10 5 5 6 6)) ; I appended few sixes
(5 7 1 3 5 2 9 12 6 4 8 5 10 5 5 6 6)
> (flat (map dup l (replace 1 (count l l) 0)))
(5 5 5 5 5 6 6 6)
> (flat (map (lambda(x y)(if (!= y 1)(list x)(list))) l (count l l)))
(5 5 6 5 5 5 6 6)
itistoday
Posts: 429 Joined: Sun Dec 02, 2007 5:10 pm
Contact:
Post
by itistoday » Mon Dec 28, 2009 11:13 pm
Nicely done Kazimir! I'm not very familiar with the 'count' function, but it looks like I should be!
That looks like the solution cormullion is looking for, and it's faster than mine too! :-)
In my tests, this method is the fastest so far (and it's the shortest too):
Code: Select all
(flat (map dup l (replace 1 (count l l) 0)))
cormullion
Posts: 2038 Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W
Contact:
Post
by cormullion » Tue Dec 29, 2009 9:41 am
Clever, Kazimir - I wouldn't have thought of using count on the same list, but it's the right solution. The second one keep the order of the original too.
Kazimir Majorinc
Posts: 388 Joined: Thu May 08, 2008 1:24 am
Location: Croatia
Contact:
Post
by Kazimir Majorinc » Wed Dec 30, 2009 11:36 am
Perhaps it could be nice additional function, say redundant as a pair to unique .
Although I am not sure whether it would be better that
(set 'l '(5 7 1 3 5 2 9 12 6 4 8 5 10 5 5 6 6))
(redundant l) => (5 5 6 5 5 5 6 6)
or
(redundant l) => (5 5 5 5 6 6) , without first 5 and first 6
(flat (map (lambda(x y)(if (zero? y) (list x) '())) l (count l l)))
kks
Posts: 13 Joined: Sat Dec 26, 2009 12:05 am
Post
by kks » Fri Jan 01, 2010 12:40 am
A "imperative" solution:
Code: Select all
(let (R '() L l E nil)
(while L
(setq E (pop L))
(when (or (find E R) (find E L))
(push E R -1) ))
R )
or in one line ;-)
Code: Select all
(let (R '() L l E nil) (while L (setq E (pop L)) (when (or (find E R) (find E L)) (push E R -1))) R)
But I love Kazimir's solution. Thanks.
Happy New Year 2010 to all of you newLISPer!