Re: Re: programing: reduce list to cycle
- To: mathgroup at smc.vnet.net
- Subject: [mg8622] Re: [mg8615] Re: programing: reduce list to cycle
- From: Wouter Meeussen <w.meeussen.vdmcc at vandemoortele.be>
- Date: Fri, 12 Sep 1997 04:10:37 -0400
- Sender: owner-wri-mathgroup at wolfram.com
hi Xah,
how does "rep" compare in speed?
rep[li_]:=Module[{i=1},While[RotateRight[li,i]=!=li,i++];i]
li=Flatten[Table[{3,1,0,3,3,1,0,3,1},{4}]]
{3, 1, 0, 3, 3, 1, 0, 3, 1, 3, 1, 0, 3, 3, 1, 0, 3, 1, 3,
1, 0, 3, 3, 1, 0, 3, 1, 3, 1, 0, 3, 3, 1, 0, 3, 1}
Partition[li,rep[li]]
{{3, 1, 0, 3, 3, 1, 0, 3, 1}, {3, 1, 0, 3, 3, 1, 0, 3, 1},
{3, 1, 0, 3, 3, 1, 0, 3, 1}, {3, 1, 0, 3, 3, 1, 0, 3, 1}}
lets "sabotage" the list "li"
rep[li~Join~{7}]
37
now, doesn't it make sense to return the "single" cycle
as "{li}" instead of "li" ?
Partition[li~Join~{7},37]
{{3, 1, 0, 3, 3, 1, 0, 3, 1, 3, 1, 0, 3, 3, 1, 0, 3, 1, 3,
1, 0, 3, 3, 1, 0, 3, 1, 3, 1, 0, 3, 3, 1, 0, 3, 1, 7}}
wouter.
At 03:07 09.09.97 -0400, you wrote:
>This is a summary of the shortest cycle problem.
>Problem:
>
>I want to reduce a list to its shortest cycle. For example, if
>myList={3,1,0,3,3,1,0,3,3,1,0,3}, then the desired result should be
>{3,1,0,3}. How to do it? myList are not always complete cycles, in such
>case, the whole list should be returned.
>
>Solutions:
>(*from a friend*)
>
>shortestCycle[lis_List] :=
> With[{l = Length[lis]},
> Take[lis, Do[If[Mod[l,i]===0 && MatchQ[Partition[lis,i],{(x_)..}],
> Return[i]],{i,1,l}]]];
>
>(*from Will Self wself at viking.emcmt.edu*)
>
>repe[x_List,n_Integer?Positive]:=Flatten[Table[x,{n}],1]
>
>factors[n_Integer?Positive]:= If[n==1,1,
>Sort[Flatten[Outer[Times,
>Sequence@@(Table[#[[1]]^x,{x,0,#[[2]]}]& /@ FactorInteger[n]) ]]]]
>
>minrep[x_List]:= Module[{m,f,temp},
>m=Length[x];f=factors[m];
>Do[If[repe[temp=Take[x,f[[k]] ],m/f[[k]]] == x,
> Return[temp]],{k,1,Length[f]}]]
>
>(*Speed comparison*)
>
>cycList=Table[Random[Integer,{1,9}],{i,1,20}]
>niceCycle=Flatten at Table[cycList,{i,1,1000}];
>notCycle=Flatten[{niceCycle,a}];
>Length at Flatten@niceCycle
>
>{2,9,4,4,1,4,8,6,1,3,7,9,2,9,6,4,5,9,7,5}
>
>20000
>
>a1=Timing at shortestCycle[niceCycle];
>a2=Timing at minrep[niceCycle];
>
>b1=Timing at shortestCycle[notCycle];
>b2=Timing at minrep[notCycle];
>
>(First/@{a1,a2})
>(First/@{b1,b2})
>
>{1.11667 Second,0.933333 Second}
>
>{3.56667 Second,0.966667 Second}
>
>Equal@(Last/@{a1,a2})&&Equal@(Last/@{b1,b2})
>
>True
>----------------
>
>They are both based on the same principle: by testing the divisibility of
>the length of the list, then compare original to a created list. The former
>is easy to understand, the latter is faster. There should be a pure pattern
>matching solution.
>
> Xah
> xah at best.com
> http://www.best.com/~xah/SpecialPlaneCurves_dir/specialPlaneCurves.html
> Mountain View, CA, USA
>
>
>
>
NV Vandemoortele Coordination Center
Oils & Fats Applied Research
Prins Albertlaan 79
Postbus 40
B-8870 Izegem (Belgium)
Tel: +/32/51/33 21 11
Fax: +/32/51/33 21 75
vdmcc at vandemoortele.be