faster ToCycles[]
- To: mathgroup at smc.vnet.net
- Subject: [mg9308] faster ToCycles[]
- From: "W. Meeussen" <w.meeussen.vdmcc at vandemoortele.be>
- Date: Mon, 27 Oct 1997 02:47:21 -0500
- Sender: owner-wri-mathgroup at wolfram.com
something for mixed permutations : both short & long cycles:
In[5]:=
mytocycles3[perm_List]:=Module[{c={},cyc,len,predi,theRest,i},
len=Length[perm];
theRest=Range[len];
While[theRest=!={} &&FreeQ[c,i=theRest[[1]]] ,
predi=Position[perm,i][[1,1]];
c=Join[c,
cyc={Drop[
FixedPointList[If[perm[[#1]] <= i,predi, perm[[#1]]]&,
i],-1]}];
theRest=Complement[theRest,Flatten[cyc]]
];
c]
it is reasonably faster for the few-long-cycles case :
In[6]:=
Table[n=6 Floor[n/6];
perm=RandomPermutation[n];
manyshort=FromCycles at Partition[perm,3];
fewlong=FromCycles at Partition[perm,Floor[n/3]];
mixed=FromCycles[Partition[Range[n/2],3]~Join~(
n/2+ Partition[Range[n/2],Floor[n/6]] ) ];
{n,
{ Timing[a=ToCycles [manyshort];],
Timing[b=RotateLeft/@mytocycles [manyshort];],
Timing[c=RotateLeft/@mytocycles2[manyshort];],
Timing[d=RotateLeft/@mytocycles3[manyshort];]}, a==b==c==d,{
Timing[e=ToCycles [fewlong];],
Timing[f=RotateLeft/@mytocycles [fewlong];],
Timing[g=RotateLeft/@mytocycles2[fewlong];],
Timing[h=RotateLeft/@mytocycles3[fewlong];]}, e==f==g==h,{
Timing[i=ToCycles [mixed];],
Timing[j=RotateLeft/@mytocycles [mixed];],
Timing[k=RotateLeft/@mytocycles2[mixed];],
Timing[l=RotateLeft/@mytocycles3[mixed];]}, i==j==k==l}
,{n,30,150,30}]/.{u_ Second,Null}:>u
Out[6]=
{{30, {0.11, 0.11, 0., 0.05}, True, {0.06, 0.11, 0., 0.05}, True,
{0.06, 0.11, 0., 0.06}, True},
{60, {0.5, 0.22, 0.05, 0.11}, True, {0.11, 0.22, 0.06, 0.05}, True,
{0.39, 0.16, 0.11, 0.05}, True},
{90, {1.48, 0.39, 0.16, 0.11}, True, {0.22, 0.44, 0.06, 0.05}, True,
{0.93, 0.39, 0.11, 0.11}, True},
{120, {3.24, 0.44, 0.27, 0.22}, True, {0.28, 0.55, 0.11, 0.11}, True,
{2.08, 0.5, 0.16, 0.17}, True},
{150, {5.98, 0.61, 0.33, 0.33}, True, {0.44, 0.71, 0.17, 0.11}, True,
{3.9, 0.6, 0.22, 0.22}, True}}
and for the big ones: if "forever" is read as "quite long" :
Out[7]=
{{300, {forever, 1.54, 0.93, 1.1}, True, {1.43, 1.81, 0.49, 0.11}, True,
{forever,1.49, 0.71, 0.6}, True}, {600, {forever,4.12, 3.3, 3.79},
True,
{6.04, 4.78, 1.59, 0.28}, True, {forever,3.95, 2.53, 2.03}, True},
{900, {forever,7.75, 6.86, 8.02}, True, {13.12, 8.79, 3.35, 0.44},
True,
{forever,7.58, 5.44, 4.34}, True}, {1200, {forever,12.3, 11.81,
14.17}, True,
{23.34, 13.79, 5.6, 0.61}, True, {forever,11.8, 9.23, 7.42}, True},
{1500, {forever,18.08, 18.23, 21.86}, True, {37.13, 20.38, 9.94,
0.77}, True,
{forever,18.18, 14.33, 11.37}, True}} Dr. Wouter L. J. MEEUSSEN
w.meeussen.vdmcc at vandemoortele.be
eu000949 at pophost.eunet.be