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