List of multiple elements
Dr. Wolfgang Hintze
a={1,1,2,1,2};
we can reduce multiple instances of elements using
b=Union[a]
{1,2}
The question is now how to compute the list of multiple elements.
In our example this would be m={1,1,2}.
A possible solution is
m[x_]:= Flatten[Take[#, {1, Length[#] - 1}] & /@ Select[Split[x],
Length[#] > 1 &]]
m[a]
{1,1,2}
I'm sure there is a much more elegant solution. Can you suggest one?
Remark
m[a] can be viewed as a kind of difference: m[a] = a "MINUS" Union[a]
Inverting gives the "SUM": a = m[a] "PLUS" Union[a] =
Join[m[a],Union[a]]
Regards,
Wolfgang
Bill Rowe
>Given the list
>a={1,1,2,1,2};
>we can reduce multiple instances of elements using
>b=Union[a] {1,2}
>The question is now how to compute the list of multiple elements. In
>our example this would be m={1,1,2}.
>A possible solution is
>m[x_]:= Flatten[Take[#, {1, Length[#] - 1}] & /@ Select[Split[x],
>Length[#] > 1 &]]
>m[a] {1,1,2}
>I'm sure there is a much more elegant solution. Can you suggest one?
The function you have included cannot possibly give the result
you indicate. With the particular example you start with Split
will only create one sub-list of length greater than 1 which is
{1,1}. Since you only select sub-lists with length greater than
1, you effectively drop all elements not equal to 1 from the
original list. Consequently, you cannot end up with what you
have indicated.
The following will obtain the result you have indicated you want.
In[13]:= b = Union[a];
=46latten@DeleteDuplicates[a //. {x__, Sequence @@ b, y___} :> {x,
b, y}]
Out[14]= {1,1,2}
But, it is far from clear to me this will scale in an
intelligent way to deal with a more complex case.
The simplest way I can think of to get the desired end result
would be something like
a[[;;3]]
or
Drop[a,-2]
but these clearly aren't general solutions
Adriano Pascoletti
In[1]:= a = {1, 1, 2, 1, 2};
In[2]:= Tally[a]
Out[2]= {{1, 3}, {2, 2}}
In[3]:= Tally[a] /. {i_, n_ /; n > 1} :> Sequence @@ ConstantArray[i, n - 1]
Out[3]= {1, 1, 2}
Adriano Pascoletti
2010/8/26 Dr. Wolfgang Hintze <w...@snafu.de>
> Given the list
>
> a={1,1,2,1,2};
>
> we can reduce multiple instances of elements using
>
> b=Union[a]
> {1,2}
>
> The question is now how to compute the list of multiple elements.
> In our example this would be m={1,1,2}.
>
> A possible solution is
>
> m[x_]:= Flatten[Take[#, {1, Length[#] - 1}] & /@ Select[Split[x],
> Length[#] > 1 &]]
>
> m[a]
> {1,1,2}
>
> I'm sure there is a much more elegant solution. Can you suggest one?
>
Raffy
v = {1, 1, 2, 1, 2};
Join @@ (Gather[v][[All, 2 ;;]])
Join @@ (ConstantArray[#1, #2 - 1] & @@@ Tally[v])
Ray Koopman
See Bill White's "DuplicateElements" from Oct 2005:
http://groups.google.ca/group/comp.soft-sys.math.mathematica/msg/02c640176775e2e1
It deletes the initial instance of every value. All instances after
the first are kept, in the order in which they come.
Dr. Wolfgang Hintze
"Bill Rowe" <read...@sbcglobal.net> schrieb im Newsbeitrag
news:i57rm6$1fa$1...@smc.vnet.net...
m1[x_]:= Flatten[Take[#, {1, Length[#] - 1}] & /@
Select[Split[Sort[x]], Length[#] > 1 &]]
Derivation by example
x={1, 1, 2, 3, 1, 3}
Sort[x]
{1, 1, 1, 2, 3, 3}
Split[%]
{{1, 1, 1}, {2}, {3, 3}}
Select[%, Length[#] > 1 &]
{{1, 1, 1}, {3, 3}}
Take[#, {1, Length[#] - 1}] & /@ %
Out[77]=
{{1, 1}, {3}}
In[78]:=
Flatten[%]
Out[78]=
{1, 1, 3}
Regards,
Wolfgang
Dana DeLouis
> a={1,1,2,1,2};
> {1,1,2}
Hi. One additional way might be to just delete each unique item from the original list.
DupsOnly[v_List] := Module[{u, t},
u = Union[v];
t = Fold[DeleteCases[#1, #2, {1}, 1] &, v, u];
Sort[t]
]
DupsOnly[{1, 1, 2, 1, 2}]
{1, 1, 2}
v = RandomChoice[Range[5], 10]
{4, 2, 2, 3, 5, 5, 3, 3, 1, 1}
Sort[v]
{1, 1, 2, 2, 3, 3, 3, 4, 5, 5}
DupsOnly[v]
{1, 2, 3, 3, 5}
I may be wrong, but the suggestion on =93DuplicateElements=94 seems a little slower in the following case:
v = RandomChoice[Range[5], 10000];
Timing[DupsOnly[v]] // First
0.003875
Timing[DuplicateElements[v]] // First
0.5468
= = = = = = = = = =
HTH : >)
Dana DeLouis
Ray Koopman
>> {1,1,2}
>
> Hi. One additional way might be to just delete each unique item from the original list.
>
> DupsOnly[v_List] := Module[{u, t},
> u = Union[v];
> t = Fold[DeleteCases[#1, #2, {1}, 1] &, v, u];
> Sort[t]
> ]
>
> DupsOnly[{1, 1, 2, 1, 2}]
> {1, 1, 2}
>
> v = RandomChoice[Range[5], 10]
> {4, 2, 2, 3, 5, 5, 3, 3, 1, 1}
>
> Sort[v]
> {1, 1, 2, 2, 3, 3, 3, 4, 5, 5}
>
> DupsOnly[v]
> {1, 2, 3, 3, 5}
>
>
> v = RandomChoice[Range[5], 10000];
>
> Timing[DupsOnly[v]] // First
> 0.003875
>
> Timing[DuplicateElements[v]] // First
> 0.5468
>
> = = = = = = = = = =
> HTH : >)
> Dana DeLouis
dupels2 is a faster version of DuplicateElements:
dupels2[v_List] := Module[{f,dups={}},
f[n_] := (f[n] := (dups = {dups,n})); f/@v; Flatten@dups]
DupsOnlee is an unsorted version of DupsOnly:
DupsOnlee[v_List] := Fold[DeleteCases[#1, #2, {1}, 1] &, v, Union@v]
DupsOnlee slows as Length@Union@v/Length@v increases;
dupels2 does not. The crossover seems to be at about 5/1000.
(The dummy call to Timing is necessary to avoid the problem noted in
http://groups.google.ca/group/comp.soft-sys.math.mathematica/msg/1125a9dbeae0d5db
)
{m,n} = {40,1*^4}
Timing[w = Table[Random[Integer,{1,m}],{n}]; Do[Null,{1*^7}]];
First@AbsoluteTiming[t1 = dupels2[w];]
First@AbsoluteTiming[t2 = DupsOnlee[w];]
t1 === t2
{40,10000}
0.068693 Second
0.059314 Second
True
{m,n} = {50,1*^4}
Timing[w = Table[Random[Integer,{1,m}],{n}]; Do[Null,{1*^7}]];
First@AbsoluteTiming[t1 = dupels2[w];]
First@AbsoluteTiming[t2 = DupsOnlee[w];]
t1 === t2
{50,10000}
0.069162 Second
0.072681 Second
True
{m,n} = {60,1*^4}
Timing[w = Table[Random[Integer,{1,m}],{n}]; Do[Null,{1*^7}]];
First@AbsoluteTiming[t1 = dupels2[w];]
First@AbsoluteTiming[t2 = DupsOnlee[w];]
t1 === t2
{60,10000}
0.066558 Second
0.100195 Second
True
Bill Rowe
>Bill, you are right, I made a mistake forgetting the Sort
>m1[x_]:= Flatten[Take[#, {1, Length[#] - 1}] & /@
>Select[Split[Sort[x]], Length[#] > 1 &]]
>Derivation by example
>x={1, 1, 2, 3, 1, 3}
>Sort[x]
>{1, 1, 1, 2, 3, 3}
>Split[%]
>{{1, 1, 1}, {2}, {3, 3}}
>Select[%, Length[#] > 1 &]
>{{1, 1, 1}, {3, 3}}
>Take[#, {1, Length[#] - 1}] & /@ %
>Out[77]=
>{{1, 1}, {3}}
>In[78]:=
>Flatten[%]
>Out[78]=
>{1, 1, 3}
The derivation makes it clear what you want to do. Here is some
code that does the same and seems to me to be simpler
In[6]:= Flatten[Most /@ DeleteCases[Split@Sort[x], {_}]]
Out[6]= {1,1,3}
Ray Koopman
>
> dupels2 is a faster version of DuplicateElements:
>
> dupels2[v_List] := Module[{f,dups={}},
> f[n_] := (f[n] := (dups = {dups,n})); f/@v; Flatten@dups]
>
> DupsOnlee is an unsorted version of DupsOnly:
>
> DupsOnlee[v_List] := Fold[DeleteCases[#1, #2, {1}, 1] &, v, Union@v]
If you can tolerate sorted results then sordups
is 10x faster than dupels2 and DupsOnlee.
sordups[v_List] := Flatten[Rest/@Split@Sort@v]
{m,n} = {50,1*^4}
Timing[w = Table[Random[Integer,{1,m}],{n}]; Do[Null,{1*^7}]];
First@AbsoluteTiming[t1 = dupels2[w];]
First@AbsoluteTiming[t2 = DupsOnlee[w];]
First@AbsoluteTiming[t3 = sordups[w];]
Sort@t1 === Sort@t2 === t3
{50,10000}
0.060016 Second
0.071353 Second
0.006265 Second
True
Ray Koopman
>
> dupels2[v_List] := Module[{f,dups={}},
> f[n_] := (f[n] := (dups = {dups,n})); f/@v; Flatten@dups]
dupels1 is twice as fast as dupels2.
dupels1[v_List] := Module[{f}, f[x_] := ((f[x] = x); {});
Flatten[f/@v]]
{m,n} = {50,1*^4}
Timing[w = Table[Random[Integer,{1,m}],{n}]; Do[Null,{1*^7}]];
First@AbsoluteTiming[t1 = dupels1[w];]
First@AbsoluteTiming[t2 = dupels2[w];]
t1 === t2
{50,10000}
0.030357 Second
0.060681 Second
True
Raffy
> On Aug 30, 3:18 am, Ray Koopman <koop...@sfu.ca> wrote:
>
>
>
> > dupels2 is a faster version of DuplicateElements:
>
> > dupels2[v_List] := Module[{f,dups={}},
> > f[n_] := (f[n] := (dups = {dups,n})); f/@v; Flatten@dups]
>
> dupels1 is twice as fast as dupels2.
>
> dupels1[v_List] := Module[{f}, f[x_] := ((f[x] = x); {});
/@v]]
>
> {m,n} = {50,1*^4}
> Timing[w = Table[Random[Integer,{1,m}],{n}]; Do[Null,{1*^7}]];
> First@AbsoluteTiming[t1 = dupels1[w];]
> First@AbsoluteTiming[t2 = dupels2[w];]
> t1 === t2
>
> {50,10000}
> 0.030357 Second
> 0.060681 Second
> True
I'm pretty sure the solution I posted above is the fastest unless more
assumptions are made.
Most of the solutions listed require multiple searches over the
elements or require sorting neither of which are necessary.
dup3[v_] := Join @@ (ConstantArray[#1, #2 - 1] & @@@ Tally[v]);
v = RandomInteger[{1, 100}, 10000000];
dup3[v]; // Timing ==> 0.031
sordups[v]; // Timing ==> 2.87
Ray Koopman
> I'm pretty sure the solution I posted above is the fastest unless
> more assumptions are made.
> Most of the solutions listed require multiple searches over the
> elements or require sorting neither of which are necessary.
>
> dup3[v_] := Join @@ (ConstantArray[#1, #2 - 1] & @@@ Tally[v]);
>
> v = RandomInteger[{1, 100}, 10000000];
> dup3[v]; // Timing ==> 0.031
> sordups[v]; // Timing ==> 2.87
I agree that if speed matters then any code using Split@Sort[...]
should be reconsidered. In the present case the determiners seem to
be the length of the list, the number of different values in it, and
the user's requirements regarding the ordering of the results. If
ordering does not matter then dup3 will be faster for longer lists
with fewer different values, and sordups will be faster for shorter
lists with more different values. For lists with less than 10^4
elements, the critical ratio of number of different values to total
list length seems to be in the neighborhood of 10%. For lists with
more than 10^4 elements, sordups slows suddenly, suggesting to me that
there may be a change in the kernel implementation for longer lists.