12
$\begingroup$

I have a list of lists of numbers:

{{5,2,1},{8,1,3},{6,1,1,1},{8,1,3},{6,1,1,1},{8,1,3}} 

As you can see, they eventually cycle, but not immediately. I need a function that will take a list of lists of numbers like this and return the cycle length (in this case $2$), and I need it to be as fast as possible.

The naive way is to take the first element that appears more than once, find it's first two positions in the list and subtract them:

findCycle[list_] := (tbl = Flatten[Position[list, Select[list, (Count[list, #] > 1 &)][[1]]]]; tbl[[2]] - tbl[[1]]) 

But this is slower than I'd like, and it errors when there is not a cycle. I'll be running this on ~25000 lists of 500 items.

$\endgroup$
2
  • $\begingroup$ If you reverse the list first, the part that is not cycling yet will be at the end, so that you don't have to bother about that. $\endgroup$ Commented Jun 15, 2018 at 8:51
  • $\begingroup$ @GijsvanOort This seems an interesting idea, but does not constitute as a full-fledged answer. Can you back it up with code? Also, how would you treat the case when there is no cycle? $\endgroup$ Commented Jun 15, 2018 at 9:05

3 Answers 3

10
$\begingroup$

FindTransientRepeat

periodF1 = Length @ Last @ FindTransientRepeat[#, 2]&; lst = {{5, 2, 1}, {8, 1, 3}, {6, 1, 1, 1}, {8, 1, 3}, {6, 1, 1, 1}, {8, 1, 3}}; periodF1 @ lst 

2

$\endgroup$
3
$\begingroup$

Just for tip:

 data = ContinuedFraction[(Sqrt[12] + 2)/7, 10004]; Timing[Length@Last@FindTransientRepeat[data, 2]] {0.0624004, 6} Timing[First@Differences@Flatten@Position[data, Last@data]] {0.0156001, 6} 
$\endgroup$
2
$\begingroup$
ll = {}; Reap[ Do[ If[MemberQ[ll, i], Sow[Length[ll] - Flatten[Position[ll, i]] + 1]; Break[], AppendTo[ll, i] ], {i, list} ] ][[2]] 

We can use Break to stop loop when duplicate value is found

$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.