This question already has an answer here:
finding largest increasing subset of an array (non-contiguous)
(1 answer)
Closed 4 years ago.
I need to create an algorithm that extracts one of the largest possible subsets from a list, in which all elements are ordered. This subset can be non-consecutive, but must preserve the order from the original list. For example:
Input: Possible Output:
[1,2,8,3,6,4,7,9,5] -> [1,2,3,6,7,9]
One might rephrase the question as "which elements do I at least have to remove so that the remaining list is sorted".
I'm not looking for an implementation, but just for ideas for a simple algorithm.
My best approach so far would be to build a tree with nodes for each number, and their children being all larger numbers following in the list. Then the longest path down the tree should equal the sorted subset. However, that seems overly complicated.
Context: this is to check student's answers on a test where they have to order items by size. I want to find out for how many they got right, relative to each other.
A recursive implementation in Scala with standard list functions (size, map, filter, dropWhile, reduce):
def longestClimb (nx: List[Int]) : List[Int] = nx match {
case Nil => Nil
case _ => {
val lix = nx.map (n => n :: longestClimb (nx.dropWhile (_ != n).filter (_ > n)))
lix.reduce ((a, b) => if (a.size > b.size) a else b)
}
}
Invocation:
scala> val nx = List (1, 2, 8, 3, 6, 4, 7, 9, 5)
scala> longestClimb (nx)
res7: List[Int] = List(1, 2, 3, 4, 7, 9)
Prosa: For an empty list, the result is the empty list and the end of the recursive process.
For the whole list, every point is tried as starting point. Let's look for example at the 6 value. For the 6 is evaluated longestClimb of nx.dropWhile (_ != 6) (which is 6, 4, 7, 9, 5) filtered for (_ > 6) which reduces the former sample to (7, 9) which results in the List (6, 7, 9).
That's hardly the longest List over all, but a candidate for a longest sublist, but since only one largest List is searched, the bias of lix.reduce ((a, b) => if (a.size > b.size) a else b) yields another list of equal length, while lix.reduce ((a, b) => if (a.size >= b.size) a else b) would have resulted in the equal length list (1, 2, 3, 6, 7, 9).
To measure, how far we get with this approach, I use a timing and an iterating function:
def timed (name: String) (f: => Any) = {
val a = System.currentTimeMillis
val res = f
val z = System.currentTimeMillis
val delta = z-a
println (name + ": " + (delta / 1000.0))
res
}
val r = util.Random
def testRandomIncreasing (max: Int) : Unit = {
(2 to max).map { i =>
val cnt = Math.pow (2, i).toInt
val l = (1 to cnt).toList
val lr = r.shuffle (l)
val s = f"2^${i}=${cnt}\t${lr}%s"
val res = timed (s) (longestClimb (lr))
println (res)
}
}
and the results are pretty interesting:
testRandomIncreasing (7)
2^2=4 List(2, 4, 3, 1): 0.0
List(2, 3)
2^3=8 List(2, 7, 5, 6, 8, 1, 4, 3): 0.0
List(2, 5, 6, 8)
2^4=16 List(15, 6, 10, 7, 1, 16, 9, 4, 13, 14, 5, 2, 8, 11, 3, 12): 0.0
List(1, 4, 5, 8, 11, 12)
2^5=32 List(1, 5, 30, 26, 27, 7, 20, 6, 29, 23, 31, 21, 22, ...10): 0.002
List(1, 5, 6, 13, 14, 15, 16, 18)
2^6=64 List(2, 57, 7, 45, 51, 49, 4, 16, 23, 21, 5, 3, 62, ... 55): 0.899
List(2, 4, 5, 9, 12, 14, 18, 19, 26, 31, 36, 41, 42, 54, 55)
2^7=128 List(16, 106, 65, 94, 84, 13, 57, 52, 117, 48, 38, ... 110): 42.195
List(13, 14, 33, 35, 37, 40, 53, 55, 58, 74, 75, 78, 97, 114, 116, 121, 123, 128)
Interesting, in that the last step from 64 to 128 values, the time increased by a factor of about 40. A former test with another random seed, lead to a factor of about 2000 and it took about 8 minutes for 2^7 values in the REPL. The test for 2^8 elements had to be interrupted, because I didn't want to wait 11 days for the result in the worst case.
Algorithm:
A sequence of numbers is called a wiggle sequence if the differences
between successive numbers strictly alternate between positive and
negative. The first difference (if one exists) may be either positive
or negative. A sequence with fewer than two elements is trivially a
wiggle sequence.
For example, [1,7,4,9,2,5] is a wiggle sequence because the
differences (6,-3,5,-7,3) are alternately positive and negative. In
contrast, [1,4,7,2,5] and [1,7,4,5,5] are not wiggle sequences, the
first because its first two differences are positive and the second
because its last difference is zero.
Given a sequence of integers, return the length of the longest
subsequence that is a wiggle sequence. A subsequence is obtained by
deleting some number of elements (eventually, also zero) from the
original sequence, leaving the remaining elements in their original
order.
Examples:
Input: [1,7,4,9,2,5]
Output: 6
The entire sequence is a wiggle sequence.
Input: [1,17,5,10,13,15,10,5,16,8]
Output: 7
There are several subsequences that achieve this length. One is [1,17,10,13,10,16,8].
Input: [1,2,3,4,5,6,7,8,9]
Output: 2
My soln:
def wiggle_max_length(nums)
[ build_seq(nums, 0, 0, true, -1.0/0.0),
build_seq(nums, 0, 0, false, 1.0/0.0)
].max
end
def build_seq(nums, index, len, wiggle_up, prev)
return len if index >= nums.length
if wiggle_up && nums[index] - prev > 0 || !wiggle_up && nums[index] - prev < 0
build_seq(nums, index + 1, len + 1, !wiggle_up, nums[index])
else
build_seq(nums, index + 1, len, wiggle_up, prev)
end
end
This is working for smaller inputs (e.g [1,1,1,3,2,4,1,6,3,10,8] and for all the sample inputs, but its failing for very large inputs (which is harder to debug) like:
[33,53,12,64,50,41,45,21,97,35,47,92,39,0,93,55,40,46,69,42,6,95,51,68,72,9,32,84,34,64,6,2,26,98,3,43,30,60,3,68,82,9,97,19,27,98,99,4,30,96,37,9,78,43,64,4,65,30,84,90,87,64,18,50,60,1,40,32,48,50,76,100,57,29,63,53,46,57,93,98,42,80,82,9,41,55,69,84,82,79,30,79,18,97,67,23,52,38,74,15]
which should have output: 67 but my soln outputs 57. Does anyone know what is wrong here?
The approach tried is a greedy solution (because it always uses the current element if it satisfies the wiggle condition), but this does not always work.
I will try illustrating this with this simpler counter-example: 1 100 99 6 7 4 5 2 3.
One best sub-sequence is: 1 100 6 7 4 5 2 3, but the two build_seq calls from the algorithm will produce these sequences:
1 100 99
1
Edit: A slightly modified greedy approach does work -- see this link, thanks Peter de Rivaz.
Dynamic Programming can be used to obtain an optimal solution.
Note: I wrote this before seeing the article mentioned by #PeterdeRivaz. While dynamic programming (O(n2)) works, the article presents a superior (O(n)) "greedy" algorithm ("Approach #5"), which is also far easier to code than a dynamic programming solution. I have added a second answer that implements that method.
Code
def longest_wiggle(arr)
best = [{ pos_diff: { length: 0, prev_ndx: nil },
neg_diff: { length: 0, prev_ndx: nil } }]
(1..arr.size-1).each do |i|
calc_best(arr, i, :pos_diff, best)
calc_best(arr, i, :neg_diff, best)
end
unpack_best(best)
end
def calc_best(arr, i, diff, best)
curr = arr[i]
prev_indices = (0..i-1).select { |j|
(diff==:pos_diff) ? (arr[j] < curr) : (arr[j] > curr) }
best[i] = {} if best.size == i
best[i][diff] =
if prev_indices.empty?
{ length: 0, prev_ndx: nil }
else
prev_diff = previous_diff(diff)
j = prev_indices.max_by { |j| best[j][prev_diff][:length] }
{ length: (1 + best[j][prev_diff][:length]), prev_ndx: j }
end
end
def previous_diff(diff)
diff==:pos_diff ? :neg_diff : :pos_diff·
end
def unpack_best(best)
last_idx, last_diff =
best.size.times.to_a.product([:pos_diff, :neg_diff]).
max_by { |i,diff| best[i][diff][:length] }
return [0, []] if best[last_idx][last_diff][:length].zero?
best_path = []
loop do
best_path.unshift(last_idx)
prev_index = best[last_idx][last_diff][:prev_ndx]
break if prev_index.nil?
last_idx = prev_index·
last_diff = previous_diff(last_diff)
end
best_path
end
Examples
longest_wiggle([1, 4, 2, 6, 8, 3, 2, 5])
#=> [0, 1, 2, 3, 5, 7]]
The length of the longest wiggle is 6 and consists of the elements at indices 0, 1, 2, 3, 5 and 7, that is, [1, 4, 2, 6, 3, 5].
A second example uses the larger array given in the question.
arr = [33, 53, 12, 64, 50, 41, 45, 21, 97, 35, 47, 92, 39, 0, 93, 55, 40, 46,
69, 42, 6, 95, 51, 68, 72, 9, 32, 84, 34, 64, 6, 2, 26, 98, 3, 43, 30,
60, 3, 68, 82, 9, 97, 19, 27, 98, 99, 4, 30, 96, 37, 9, 78, 43, 64, 4,
65, 30, 84, 90, 87, 64, 18, 50, 60, 1, 40, 32, 48, 50, 76, 100, 57, 29,
arr.size 63, 53, 46, 57, 93, 98, 42, 80, 82, 9, 41, 55, 69, 84, 82, 79, 30, 79,
18, 97, 67, 23, 52, 38, 74, 15]
#=> 100
longest_wiggle(arr).size
#=> 67
longest_wiggle(arr)
#=> [0, 1, 2, 3, 5, 6, 7, 8, 9, 10, 12, 14, 16, 17, 19, 21, 22, 23, 25,
# 27, 28, 29, 30, 32, 34, 35, 36, 37, 38, 39, 41, 42, 43, 44, 47, 49, 50,
# 52, 53, 54, 55, 56, 57, 58, 62, 63, 65, 66, 67, 70, 72, 74, 75, 77, 80,
# 81, 83, 84, 90, 91, 92, 93, 95, 96, 97, 98, 99]
As indicated, the largest wiggle is comprised of 67 elements of arr. Solution time was essentially instantaneous.
The values of arr at those indices are as follows.
[33, 53, 12, 64, 41, 45, 21, 97, 35, 47, 39, 93, 40, 46, 42, 95, 51, 68, 9,
84, 34, 64, 6, 26, 3, 43, 30, 60, 3, 68, 9, 97, 19, 27, 4, 96, 37, 78, 43,
64, 4, 65, 30, 84, 18, 50, 1, 40, 32, 76, 57, 63, 53, 57, 42, 80, 9, 41, 30,
79, 18, 97, 23, 52, 38, 74, 15]
[33, 53, 12, 64, 41, 45, 21, 97, 35, 92, 0, 93, 40, 69, 6, 95, 51, 72, 9, 84, 34, 64, 2, 98, 3, 43, 30, 60, 3, 82, 9, 97, 19, 99, 4, 96, 9, 78, 43, 64, 4, 65, 30, 90, 18, 60, 1, 40, 32, 100, 29, 63, 46, 98, 42, 82, 9, 84, 30, 79, 18, 97, 23, 52, 38, 74]
Explanation
I had intended to provide an explanation of the algorithm and its implementation, but having since learned there is a superior approach (see my note at the beginning of my answer), I have decided against doing that, but would of course be happy to answer any questions. The link in my note explains, among other things, how dynamic programming can be used here.
Let Wp[i] be the longest wiggle sequence starting at element i, and where the first difference is positive. Let Wn[i] be the same, but where the first difference is negative.
Then:
Wp[k] = max(1+Wn[k'] for k<k'<n, where A[k'] > A[k]) (or 1 if no such k' exists)
Wn[k] = max(1+Wp[k'] for k<k'<n, where A[k'] < A[k]) (or 1 if no such k' exists)
This gives an O(n^2) dynamic programming solution, here in pseudocode
Wp = [1, 1, ..., 1] -- length n
Wn = [1, 1, ..., 1] -- length n
for k = n-1, n-2, ..., 0
for k' = k+1, k+2, ..., n-1
if A[k'] > A[k]
Wp[k] = max(Wp[k], Wn[k']+1)
else if A[k'] < A[k]
Wn[k] = max(Wn[k], Wp[k']+1)
result = max(max(Wp[i], Wn[i]) for i = 0, 1, ..., n-1)
In a comment on #quertyman's answer, #PeterdeRivaz provided a link to an article that considers various approaches to solving the "longest wiggle subsequence" problem. I have implemented "Approach #5", which has a time-complexity of O(n).
The algorithm is simple as well as fast. The first step is to remove one element from each pair of consecutive elements that are equal, and continue to do so until there are no consecutive elements that are equal. For example, [1,2,2,2,3,4,4] would be converted to [1,2,3,4]. The longest wiggle subsequence includes the first and last elements of the resulting array, a, and every element a[i], 0 < i < a.size-1 for which a[i-1] < a[i] > a[i+1] ora[i-1] > a[i] > a[i+1]. In other words, it includes the first and last elements and all peaks and valley bottoms. Those elements are A, D, E, G, H, I in the graph below (taken from the above-referenced article, with permission).
Code
def longest_wiggle(arr)
arr.each_cons(2).
reject { |a,b| a==b }.
map(&:first).
push(arr.last).
each_cons(3).
select { |triple| [triple.min, triple.max].include? triple[1] }.
map { |_,n,_| n }.
unshift(arr.first).
push(arr.last)
end
Example
arr = [33, 53, 12, 64, 50, 41, 45, 21, 97, 35, 47, 92, 39, 0, 93, 55, 40,
46, 69, 42, 6, 95, 51, 68, 72, 9, 32, 84, 34, 64, 6, 2, 26, 98, 3,
43, 30, 60, 3, 68, 82, 9, 97, 19, 27, 98, 99, 4, 30, 96, 37, 9, 78,
43, 64, 4, 65, 30, 84, 90, 87, 64, 18, 50, 60, 1, 40, 32, 48, 50, 76,
100, 57, 29, 63, 53, 46, 57, 93, 98, 42, 80, 82, 9, 41, 55, 69, 84,
82, 79, 30, 79, 18, 97, 67, 23, 52, 38, 74, 15]
a = longest_wiggle(arr)
#=> [33, 53, 12, 64, 41, 45, 21, 97, 35, 92, 0, 93, 40, 69, 6, 95, 51, 72,
# 9, 84, 34, 64, 2, 98, 3, 43, 30, 60, 3, 82, 9, 97, 19, 99, 4, 96, 9,
# 78, 43, 64, 4, 65, 30, 90, 18, 60, 1, 40, 32, 100, 29, 63, 46, 98, 42,
# 82, 9, 84, 30, 79, 18, 97, 23, 52, 38, 74, 15]
a.size
#=> 67
Explanation
The steps are as follows.
arr = [3, 4, 4, 5, 2, 3, 7, 4]
enum1 = arr.each_cons(2)
#=> #<Enumerator: [3, 4, 4, 5, 2, 3, 7, 4]:each_cons(2)>
We can see the elements that will be generated by this enumerator by converting it to an array.
enum1.to_a
#=> [[3, 4], [4, 4], [4, 5], [5, 2], [2, 3], [3, 7], [7, 4]]
Continuing, remove all but one of each group of successive equal elements.
d = enum1.reject { |a,b| a==b }
#=> [[3, 4], [4, 5], [5, 2], [2, 3], [3, 7], [7, 4]]
e = d.map(&:first)
#=> [3, 4, 5, 2, 3, 7]
Add the last element.
f = e.push(arr.last)
#=> [3, 4, 5, 2, 3, 7, 4]
Next, find the peaks and valley bottoms.
enum2 = f.each_cons(3)
#=> #<Enumerator: [3, 4, 5, 2, 3, 7, 4]:each_cons(3)>
enum2.to_a
#=> [[3, 4, 5], [4, 5, 2], [5, 2, 3], [2, 3, 7], [3, 7, 4]]
g = enum2.select { |triple| [triple.min, triple.max].include? triple[1] }
#=> [[4, 5, 2], [5, 2, 3], [3, 7, 4]]
h = g.map { |_,n,_| n }
#=> [5, 2, 7]
Lastly, add the first and last values of arr.
i = h.unshift(arr.first)
#=> [3, 5, 2, 7]
i.push(arr.last)
#=> [3, 5, 2, 7, 4]
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 {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.
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]]
Above methods are better if you have no noise. If your signal is only approximate then Fourier transform methods might be useful. I'll illustrate with a "parametrized" setup wherein the length and number of repetitions of the base signal, the length of the trailing part, and a bound on the noise perturbation are all variables one can play with.
noise = 20;
extra = 40;
baselen = 103;
base = RandomInteger[10000, {baselen}];
repeat = 5;
signal = Flatten[Join[ConstantArray[base, repeat], Take[base, extra]]];
noisysignal = signal + RandomInteger[{-noise, noise}, Length[signal]];
We compute the absolute value of the FFT. We adjoin zeros to both ends. The object will be to threshold by comparing to neighbors.
sigfft = Join[{0.}, Abs[Fourier[noisysignal]], {0}];
Now we create two 0-1 vectors. In one we threshold by making a 1 for each element in the fft that is greater than twice the geometric mean of its two neighbors. In the other we use the average (arithmetic mean) but we lower the size bound to 3/4. This was based on some experimentation. We count the number of 1s in each case. Ideally we'd get 100 for each, as that would be the number of nonzeros in a "perfect" case of no noise and no tail part.
In[419]:=
thresh1 =
Table[If[sigfft[[j]]^2 > 2*sigfft[[j - 1]]*sigfft[[j + 1]], 1,
0], {j, 2, Length[sigfft] - 1}];
count1 = Count[thresh1, 1]
thresh2 =
Table[If[sigfft[[j]] > 3/4*(sigfft[[j - 1]] + sigfft[[j + 1]]), 1,
0], {j, 2, Length[sigfft] - 1}];
count2 = Count[thresh2, 1]
Out[420]= 114
Out[422]= 100
Now we get our best guess as to the value of "repeats", by taking the floor of the total length over the average of our counts.
approxrepeats = Floor[2*Length[signal]/(count1 + count2)]
Out[423]= 5
So we have found that the basic signal is repeated 5 times. That can give a start toward refining to estimate the correct length (baselen, above). To that end we might try removing elements at the end and seeing when we get ffts closer to actually having runs of four 0s between nonzero values.
Something else that might work for estimating number of repeats is finding the modal number of zeros in run length encoding of the thresholded ffts. While I have not actually tried that, it looks like it might be robust to bad choices in the details of how one does the thresholding (mine were just experiments that seem to work).
Daniel Lichtblau
The following assumes that the cycle starts on the first element and gives the period length and the cycle.
findCyclingList[a_?VectorQ] :=
Module[{repeats1, repeats2, cl, cLs, vec},
repeats1 = Flatten#Differences[Position[a, First[a]]];
repeats2 = Flatten[Position[repeats1, First[repeats1]]];
If[Equal ## Differences[repeats2] && Length[repeats2] > 2(*
is potentially cyclic - first element appears cyclically *),
cl = Plus ### Partition[repeats1, First[Differences[repeats2]]];
cLs = Partition[a, First[cl]];
If[SameQ ## cLs (* candidate cycles all actually the same *),
vec = First[cLs];
{Length[vec], vec}, $Failed], $Failed] ]
Testing
b = RandomInteger[50, {100}];
a = Join[b, b, b, b, Take[b, 27]];
findCyclingList[a]
{100, {47, 15, 42, 10, 14, 29, 12, 29, 11, 37, 6, 19, 14, 50, 4, 38,
23, 3, 41, 39, 41, 17, 32, 8, 18, 37, 5, 45, 38, 8, 39, 9, 26, 33,
40, 50, 0, 45, 1, 48, 32, 37, 15, 37, 49, 16, 27, 36, 11, 16, 4, 28,
31, 46, 30, 24, 30, 3, 32, 31, 31, 0, 32, 35, 47, 44, 7, 21, 1, 22,
43, 13, 44, 35, 29, 38, 31, 31, 17, 37, 49, 22, 15, 28, 21, 8, 31,
42, 26, 33, 1, 47, 26, 1, 37, 22, 40, 27, 27, 16}}
b1 = RandomInteger[10000, {100}];
a1 = Join[b1, b1, b1, b1, Take[b1, 23]];
findCyclingList[a1]
{100, {1281, 5325, 8435, 7505, 1355, 857, 2597, 8807, 1095, 4203,
3718, 3501, 7054, 4620, 6359, 1624, 6115, 8567, 4030, 5029, 6515,
5921, 4875, 2677, 6776, 2468, 7983, 4750, 7609, 9471, 1328, 7830,
2241, 4859, 9289, 6294, 7259, 4693, 7188, 2038, 3994, 1907, 2389,
6622, 4758, 3171, 1746, 2254, 556, 3010, 1814, 4782, 3849, 6695,
4316, 1548, 3824, 5094, 8161, 8423, 8765, 1134, 7442, 8218, 5429,
7255, 4131, 9474, 6016, 2438, 403, 6783, 4217, 7452, 2418, 9744,
6405, 8757, 9666, 4035, 7833, 2657, 7432, 3066, 9081, 9523, 3284,
3661, 1947, 3619, 2550, 4950, 1537, 2772, 5432, 6517, 6142, 9774,
1289, 6352}}
This case should fail because it isn't cyclical.
findCyclingList[Join[b, Take[b, 11], b]]
$Failed
I tried to something with Repeated, e.g. a /. Repeated[t__, {2, 100}] -> {t} but it just doesn't work for me.
Does this work for you?
period[a_] :=
Quiet[Check[
First[Cases[
Table[
{k, Equal ## Partition[a, k]},
{k, Floor[Length[a]/2]}],
{k_, True} :> k
]],
$Failed]]
Strictly speaking, this will fail for things like
a = {1, 2, 3, 1, 2, 3, 1, 2, 3, 4, 5}
although this can be fixed by using something like:
(Equal ## Partition[a, k]) && (Equal ## Partition[Reverse[a], k])
(probably computing Reverse[a] just once ahead of time.)
I propose this. It borrows from both Verbeia and Brett's answers.
Do[
If[MatchQ ## Equal ## Partition[#, i, i, 1, _], Return ## i],
{i, #[[ 2 ;; Floor[Length##/2] ]] ~Position~ First##}
] /. Null -> $Failed &
It is not quite as efficient as Vebeia's function on long periods, but it is faster on short ones, and it is simpler as well.
I don't know how to solve it in mathematica, but the following algorithm (written in python) should work. It's O(n) so speed should be no concern.
def period(array):
if len(array) == 0:
return False
else:
s = array[0]
match = False
end = 0
i = 0
for k in range(1,len(array)):
c = array[k]
if not match:
if c == s:
i = 1
match = True
end = k
else:
if not c == array[i]:
match = False
i += 1
if match:
return array[:end]
else:
return False
# False
print(period([4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2,1]))
# [4, 5, 1, 2, 3]
print(period([4, 5, 1, 2, 3, 4, 5, 1, 2, 3, 4, 5, 1, 2]))
# False
print(period([4]))
# [4, 2]
print(period([4,2,4]))
# False
print(period([4,2,1]))
# False
print(period([]))
Ok, just to show my own work here:
ModifiedTortoiseHare[a_List] := Module[{counter, tortoise, hare},
Quiet[
Check[
counter = 1;
tortoise = a[[counter]];
hare = a[[2 counter]];
While[(tortoise != hare) || (a[[counter ;; 2 counter - 1]] != a[[2 counter ;; 3 counter - 1]]),
counter++;
tortoise = a[[counter]];
hare = a[[2 counter]];
];
counter,
$Failed]]]
I'm not sure this is a 100% correct, especially with cases like {pattern,pattern,different,pattern, pattern} and it gets slower and slower when there are a lot of repeating elements, like so:
{ 1,2,1,1, 1,2,1,1, 1,2,1,1, ...}
because it is making too many expensive comparisons.
#include <iostream>
#include <vector>
using namespace std;
int period(vector<int> v)
{
int p=0; // period 0
for(int i=p+1; i<v.size(); i++)
{
if(v[i] == v[0])
{
p=i; // new potential period
bool periodical=true;
for(int i=0; i<v.size()-p; i++)
{
if(v[i]!=v[i+p])
{
periodical=false;
break;
}
}
if(periodical) return p;
i=p; // try to find new period
}
}
return 0; // no period
}
int main()
{
vector<int> v3{1,2,3,1,2,3,1,2,3};
cout<<"Period is :\t"<<period(v3)<<endl;
vector<int> v0{1,2,3,1,2,3,1,9,6};
cout<<"Period is :\t"<<period(v0)<<endl;
vector<int> v1{1,2,1,1,7,1,2,1,1,7,1,2,1,1};
cout<<"Period is :\t"<<period(v1)<<endl;
return 0;
}
This sounds like it might relate to sequence alignment. These algorithms are well studied, and might already be implemented in mathematica.