在Mathematica中查找(重复)列表周期的最佳方法是什么?
问题内容:
在重复列表中找到期间的最佳方法是什么?
例如:
a = {4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2}
已重复{4, 5, 1, 2, 3}
,其余部分{4, 5, 1, 2}
匹配,但不完整。
该算法应足够快以处理更长的情况,如下所示:
b = RandomInteger[10000, {100}];
a = Join[b, b, b, b, Take[b, 27]]
$Failed
如果没有上述重复模式,则算法应返回。
问题答案:
请查看注释,以及在代码中穿插的注释,以了解其工作原理。
(* 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}
]
]
请询问是否findPeriodOfFirstElement[]
不清楚。我独立进行此操作(出于娱乐目的!),但是现在我看到该原理与Verbeia的解决方案相同,只是Brett指出的问题已解决。
我正在测试
b = RandomInteger[100, {1000}];
a = Flatten[{ConstantArray[b, 1000], Take[b, 27]}];
(请注意低整数值:同一时期内会有很多重复元素*)
编辑: 根据下面的[列昂尼德(eonid)的评论,通过使用专门为整数列表编译的自定义位置函数,可以再提高2-3倍的速度(在我的机器上约为2.4倍):
(* 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]]
编译可以testPeriod
在快速测试中进一步提高〜20%的速度,但是我相信这将取决于输入数据:
Clear[testPeriod]
testPeriod =
Compile[{{p, _Integer}, {a, _Integer, 1}},
Drop[a, p] === Drop[a, -p]]