什么是发现数学中的一个(重复)名单的期限最好的方法是什么? [英] What is the best way to find the period of a (repeating) list in Mathematica?
问题描述
什么是找到时期重复列表的最佳方法是什么?
What is the best way to find the period in a repeating list?
例如:
a = {4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2}
有重复 {4,5,1,2,3}
其余 {4,5,1,2}
的匹配,但不完整。
has repeat {4, 5, 1, 2, 3}
with the remainder {4, 5, 1, 2}
matching, but being incomplete.
该算法应该足够快,以处理较长的情况下,像这样:
The algorithm should be fast enough to handle longer cases, like so:
b = RandomInteger[10000, {100}];
a = Join[b, b, b, b, Take[b, 27]]
该算法应该返回 $失败
如果没有重复的图案像上面。
The algorithm should return $Failed
if there is no repeating pattern like above.
推荐答案
请参阅与code。关于它是如何工作穿插的意见。
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}
]
]
请询问是否 findPeriodOfFirstElement []
目前尚不清楚。我这样做是独立的(为了好玩!),但现在我看到的原理是一样的维尔比亚的解决方案,但这个问题指出布雷特是固定的。
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.
我是测试用
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 *)
编辑:根据低于列昂尼德的评论,另外2-3倍加速(〜2.4倍我的机器上)可以通过使用自定义位功能,专为整数列表编译:
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]]
编译 testPeriod
给出了一个快速测试另外〜20%的增速,但我相信,这将依赖于输入数据:
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]]
这篇关于什么是发现数学中的一个(重复)名单的期限最好的方法是什么?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!