summary of intersection and element counts
- To: mathgroup at smc.vnet.net
- Subject: [mg20799] summary of intersection and element counts
- From: "Arturas Acus" <acus at itpa.lt>
- Date: Sun, 14 Nov 1999 18:13:50 -0500 (EST)
- Sender: owner-wri-mathgroup at wolfram.com
First of all let me thank all who helped me with this problem: Bob
Hanlon, Tomas Garza, Fred Simons, Andrzej Kozlowski, Tobias Oed, Arnold
Knopfmacher and especially Daniel Lichtblau and Hartmut Wolf for their
suggestions and comments concerning evaluation speed.
Next, below I display some comparisions of all suggested functions
from all members, except that seven (!) solutions provided by
Hartmut Wolf: these are discused in his letter. From all Wolf
solutions I selected the best one: yourIntersection[2] to see it
performance in general context. All my tests are done on simple
symbolic input below
l2=Table[FromCharacterCode[Random[Integer,{97,122}]],{10000}];
l1=Table[FromCharacterCode[Random[Integer,{97,122}]],{10000}];
Daniel Lichtblau solution
vivesect[ll_]:=Map[{#[[1]],Length[#]}&,Split[Sort[ll]]]
myIntersection[1][l1_List,l2_List]:=
Module[{nl=Sort[Join[Flatten[Map[vivesect,{l1,l2}],1]]]},
nl=Split[nl,#[[1]]===#2[[1]]&];
Flatten[Cases[nl,{{x_,m_},{x_,n_}}\[RuleDelayed]Table[x,{m}]],1]]
Fred Simons
myIntersection[2][list1_,list2_]:=
Flatten[ReplaceAll[List@@PolynomialGCD[Times@@list1,Times@@list2],
Power[x_,n_]\[RuleDelayed]Table[x,{n}]]]
Hartmut Wolf (the fastest of all 7):
myIntersection[3][l1_,l2_]:=
Module[{un1,un2},{un1,un2}=
Flatten[Transpose[{#,Range[Length[#]]}]&/@#,1]&/@Split/@Sort/@{l1,l2};
Transpose[Intersection[un1,un2]][[1]]]
Bob Hanlon
shuffle[inList_List]:=
Module[{oldList=inList,newList={},ptr},
Do[ptr=Random[Integer,{1,Length[oldList]}];
newList=Append[newList,oldList[[ptr]]];
oldList=Drop[oldList,{ptr}],{Length[inList]}]; newList];
runs[aList_List?VectorQ]:={First[#],Length[#]}&/@Split[Sort[aList]];
myIntersection[4][list1_List?VectorQ,list2_List?VectorQ]:=
Module[{intr=Intersection[list1,list2]},
Flatten[Transpose[{Select[runs[list1],MemberQ[intr,#[[1]]]&],
Select[runs[list2],MemberQ[intr,#[[1]]]&]}]/.{{x_,
m_Integer},{x_,n_Integer}}\[RuleDelayed]
Table[x,{Min[m,n]}]]];
myIntersection[5][list1_List?VectorQ,list2_List?VectorQ]:=
Flatten[Table[#,{Min[Count[list1,#],Count[list2,#]]}]&/@
Intersection[list1,list2]];
Andrzej Kozlowski
myIntersection[6][l_,m_]:=
Flatten[Map[Table[#,{i,1,Min[Count[l,#],Count[m,#]]}]&,Intersection[l,m]]]
Tobias Oed
myIntersection[7][l1_,
l2_]:=(Flatten[
Map[Table[#,{Min[Count[l1,#],Count[l2,#]]}]&,Union[l1,l2]]])
Arnold Knopfmacher
myIntersection[8][l1_,l2_]:=
Table[#[[1]],{#[[2]]}]&/@Take[#,{1,Length[#],2}]&[
Select[Sort[
Join[{#[[1]],Length[#]}&/@Split[l1],{#[[1]],Length[#]}&/@Split[l2]]],
MemberQ[Intersection[l1,l2],#[[1]]]&]]
Tomas Garza:
myIntersection[9][A_List,B_List]:=
Module[{Ap=Split[Sort[A]],Bp=Split[Sort[B]]},
ulti[x_List]:=If[Length[x]\[Equal]0,{},Last[x]];
desc[x_List]:=Table[Take[x,j],{j,1,Length[x]}];
Flatten[
Table[Table[
ulti[Intersection[desc[Ap[[j]]],desc[Bp[[i]]]]],{j,1,
Length[Ap]}],{i,1,Length[Bp]}]]]
Timings for first 7 functions:
Evaluate[Function[x,Hold[Timing[x[##];]]]/@Array[myIntersection,7]]&[l1,
l2]//ReleaseHold
Out=
{{0.32 Second,Null},{0.43 Second,Null},{0.8 Second,Null},{0.55
Second,
Null},{1.38 Second,Null},{1.44 Second,Null},{1.42 Second,Null}}
The last two functions are too slow and I aborted calculations.
SameQ[Sequence@@Map[Function[x,x[##]],Array[myIntersection,7]]&[l1,l2]]
Out=
True
Thus all these seven functions are quite fast and indeed timing of
all of them is quite apropriate for my aims. The most original idea, of
course is of Fred Simons. I should say that something similar came to
my minds few days ago, but after observing that
{Timing[Sort[l1];],Timing[Times@@l1;]}
Out=
{{0.11 Second,Null},{0.18 Second,Null}}
I refused this idea. Also the rezult of Times becomes much slower if
inputs are complex objects. The Sort function now is indeed very fast.
The myIntersection[1] and [3] also can handle intersections of Lists
of Lists. Thus Daniel Lichtblau solution remains fastest in all
tests I was able to perform.
Dr. Arturas Acus
Institute of Theoretical
Physics and Astronomy
Gostauto 12, 2600,Vilnius
Lithuania
E-mail: acus at itpa.lt
Fax: 370-2-225361
Tel: 370-2-612906