MathGroup Archive 1999

[Date Index] [Thread Index] [Author Index]

Search the Archive

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


  • Prev by Date: Re: once more integrate
  • Next by Date: Casimirs...Re: FW: How to do Lie Algebras in Mathematica...
  • Previous by thread: Re: Help with geometry problem required.
  • Next by thread: Casimirs...Re: FW: How to do Lie Algebras in Mathematica...