What is the best way to find the period of a (repeating) list in Mathematica?

前端 未结 9 1377
没有蜡笔的小新
没有蜡笔的小新 2021-01-01 15:12

What is the best way to find the period in a repeating list?

For example:

a = {4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2}

has repeat

9条回答
  •  死守一世寂寞
    2021-01-01 15:52

    Please see the comments interspersed with the code on how it works.

    (* True if a has period p *)
    testPeriod[p_, a_] := Drop[a, p] === Drop[a, -p]
    
    (* are all the list elements the same? *)
    homogeneousQ[list_List] := Length@Tally[list] === 1
    homogeneousQ[{}] := Throw[$Failed] (* yes, it's ugly to put this here ... *)
    
    (* auxiliary for findPeriodOfFirstElement[] *)
    reduce[a_] := Differences@Flatten@Position[a, First[a], {1}]
    
    (* the first element occurs every ?th position ? *)
    findPeriodOfFirstElement[a_] := Module[{nl},
      nl = NestWhileList[reduce, reduce[a], ! homogeneousQ[#] &];
      Fold[Total@Take[#2, #1] &, 1, Reverse[nl]]
      ]
    
    (* the period must be a multiple of the period of the first element *)
    period[a_] := Catch@With[{fp = findPeriodOfFirstElement[a]},
       Do[
        If[testPeriod[p, a], Return[p]],
        {p, fp, Quotient[Length[a], 2], fp}
        ]
       ]
    

    Please ask if findPeriodOfFirstElement[] is not clear. I did this independently (for fun!), but now I see that the principle is the same as in Verbeia's solution, except the problem pointed out by Brett is fixed.

    I was testing with

    b = RandomInteger[100, {1000}];
    a = Flatten[{ConstantArray[b, 1000], Take[b, 27]}];
    

    (Note the low integer values: there will be lots of repeating elements within the same period *)


    EDIT: According to Leonid's comment below, another 2-3x speedup (~2.4x on my machine) is possible by using a custom position function, compiled specifically for lists of integers:

    (* Leonid's reduce[] *)
    
    myPosition = Compile[
      {{lst, _Integer, 1}, {val, _Integer}}, 
      Module[{pos = Table[0, {Length[lst]}], i = 1, ctr = 0}, 
        For[i = 1, i <= Length[lst], i++, 
          If[lst[[i]] == val, pos[[++ctr]] = i]
        ]; 
        Take[pos, ctr]
      ], 
      CompilationTarget -> "C", RuntimeOptions -> "Speed"
    ]
    
    reduce[a_] := Differences@myPosition[a, First[a]]
    

    Compiling testPeriod gives a further ~20% speedup in a quick test, but I believe this will depend on the input data:

    Clear[testPeriod]
    testPeriod = 
     Compile[{{p, _Integer}, {a, _Integer, 1}}, 
      Drop[a, p] === Drop[a, -p]]
    

提交回复
热议问题