I am trying to write a program that identifies upper triangular matrices. I am quite new to Prolog and i would like your assistance on this.
Considering a matrix as a list of lists, where each list is a matrix row,
how can I do it with basic predicates only, such as append, reverse, prefix, sublists, length etc ? (will not probably use all these predicates but just to give you an idea)
My attempts failed, mainly because I cannot access the elements of each list/row properly.
In SWI-Prolog, you can use the predicate nth0/3 to access elements of a list (indexing from 0).
For example, to access the element in the third column (J = 2) of the second row (I = 1) of matrix M, you can ask:
?- M = [[10, 20, 30], [0, 40, 50], [0, 0, 60]], nth0(1, M, R), nth0(2, R, C).
M = [[10, 20, 30], [0, 40, 50], [0, 0, 60]],
R = [0, 40, 50],
C = 50.
So, you can define the following predicate to access elements of a matrix:
element(I, J, M, C) :-
nth0(I, M, R),
nth0(J, R, C).
matrix([[10, 20, 30],
[ 0, 40, 50],
[ 0, 0, 60]]).
Example:
?- matrix(M), element(I, J, M, X).
M = [[10, 20, 30], [0, 40, 50], [0, 0, 60]],
I = J, J = 0,
X = 10 ;
M = [[10, 20, 30], [0, 40, 50], [0, 0, 60]],
I = 0,
J = 1,
X = 20 ;
M = [[10, 20, 30], [0, 40, 50], [0, 0, 60]],
I = 0,
J = 2,
X = 30 ;
M = [[10, 20, 30], [0, 40, 50], [0, 0, 60]],
I = 1,
J = X, X = 0 ;
M = [[10, 20, 30], [0, 40, 50], [0, 0, 60]],
I = J, J = 1,
X = 40 ;
M = [[10, 20, 30], [0, 40, 50], [0, 0, 60]],
I = 1,
J = 2,
X = 50
...
Now that you know how to access the elements, I think you can find a way to solve your problem.
Hint: Use the predicate forall/2 to define this rule in Prolog:
A matrix M is upper triangular if
For every element Xij of M such that j<i,
we have Xij = 0.
EDIT Another possible solution, using append/3 and length/2, is:
elem(I, J, M, X) :-
append(Prefix1, [Row|_], M),
append(Prefix2, [X|_], Row),
length(Prefix1, I),
length(Prefix2, J).
Examples:
?- matrix(M), elem(1, 2, M, X).
M = [[10, 20, 30], [0, 40, 50], [0, 0, 60]],
X = 50 ;
false.
?- matrix(M), elem(I, J, M, X).
M = [[10, 20, 30], [0, 40, 50], [0, 0, 60]],
I = J, J = 0,
X = 10 ;
M = [[10, 20, 30], [0, 40, 50], [0, 0, 60]],
I = 0,
J = 1,
X = 20
...
false;
Related
hi i have an array that dimension after mining push to that how can i increase Qty after each pushing for similar dimension?
suppose to we have this array:
[x,y,Qty]
b=[]
b.push[100,50,1]
b.push[20,30,1]
b.push[100,50,1]
b.push[10,60,1]
how can i have this result: b = [ [100,50,2],[20,30,1],[10,60,1] ]
Suppose we are given the following (which differs slightly from the example).
b = [[100, 50, 1], [20, 30, 2], [100, 50, 1], [10, 60, 1]]
Let's begin with a relatively inefficient solution and then see how it can be improved.
Staightforward but relatively inefficient solution
We first compute the following array.
arr = b.map { |x,y,z| [x, y] }
#=> [[100, 50], [20, 30], [100, 50], [10, 60]]
Before continuing suppose b were to change in future such that each element contain four, rather than three, values, such as [100, 50, 20, 2]. We could change the calculation of arr to arr = b.map { |w,x,y,z| [w, x, y] }, but a better solution is to use the splat operator, *, to perform Array#decomposition. By using the splat operator we need not change this code if the size of the elements of b changes.
arr = b.map { |*a,z| a }
#=> [[100, 50], [20, 30], [100, 50], [10, 60]]
For each element (array) e of b, the array a will contain all but the last element of e and z will contain the last element of e, regardless of the size of e.
Next we use the method Array#uniq to obtain the unique elements of arr.
arr_uniq = arr.uniq
#=> [[100, 50], [20, 30], [10, 60]]
We may then compute the desired array as follows.
arr_uniq.map do |a|
tot = 0
b.each { |*c,z| tot += z if a == c }
[*a, tot]
end
#=> [[100, 50, 2], [20, 30, 2], [10, 60, 1]]
Recall that tot += z is effectively the same as tot = tot + z.
This approach is relatively inefficient because the array b is traversed completely for each element of arr_uniq. We should be able to make only a single pass through b.
Improving efficiency
We step through each element of b to construct a hash.
h = {}
b.each do |*a,z|
if h.key?(a)
h[a] += z
else
h[a] = z
end
end
h #=> {[100, 50]=>2, [20, 30]=>2, [10, 60]=>1}
We now need only convert h to the desired array (though it may be more useful to stop here and use the hash for subsequent calculations).
h.map { |k,v| [*k, v] }
#=> [[100, 50, 2], [20, 30, 2], [10, 60, 1]]
We now consider how to make this calculation more Ruby-like.
Wrapping up
To improve upon the construction of h above we make use of two methods: the form of class method Hash::new that takes an argument called the default value; and Enumerable#each_with_object.
b.each_with_object(Hash.new(0)) { |(*a,z),h| h[a] += z }
.map { |k,v| [*k, v] }
#=> [[100, 50, 2], [20, 30, 2], [10, 60, 1]]
This first step is to compute a hash:
b.each_with_object(Hash.new(0)) { |(*a,z),h| h[a] += z }
#=> {[100, 50]=>2, [20, 30]=>2, [10, 60]=>1}
You may wish to review the link to array decomposition that I gave earler to see how the block variables a, z and h in |(*a,z),h| are assigned values.
If a hash is defined
h = Hash.new(0)
h[k] returns the default value, here zero, if h does not contain a key k.
Initially,
h[[100, 50]] += 1
expands to
h[[100, 50]] = h[[100, 50]] + 1
Since h has no keys at this time--specifically no key [100, 50]--h[[100, 50]] on the right returns the default value, so the expression becomes
h[[100, 50]] = 0 + 1
h #=> { [100, 50] => 1 }
Later, when the same key [100, 50] is encountered (when h #=> { [100, 50] => 1, [20, 30] => 2 }), the expresson becomes
h[[100, 50]] = 1 + 1
h #=> { [100, 50] => 2, [20, 30] => 2 }
This time, h has a key [100, 50], so h[[100, 50]] on the right returns its value, which equals 1 (and the default value is not used).
Alternative method: use Enumerable#group_by
We could alternatively compute the desired array as follows.
b.group_by { |*a,z| a }
.map { |k,v| [*k, v.sum(&:last)] }
#=> [[100, 50, 2], [20, 30, 2], [10, 60, 1]]
The first step is to compute a hash:
b.group_by { |*a,z| a }
#=> {[100, 50]=>[[100, 50, 1], [100, 50, 1]],
[20, 30]=>[[20, 30, 2]], [10, 60]=>[[10, 60, 1]]}
When compared to the method above that employs Hash::new, this calculation has the minor disadvantage that the memory requirements for the values in the intermediate are somewhat greater.
% SEND+MORE=MONEY
solve(VarList):-
VarList=[D,E,M,N,O,R,S,Y], % Οι μεταβλητές του προβλήματος
Digits=[0,1,2,3,4,5,6,7,8,9], % Οι τιμές των μεταβλητών (τα ψηφία)
member(D,Digits),
member(E,Digits),
member(M,Digits),
member(N,Digits), % Ανάθεση τιμών στις μεταβλητές
member(O,Digits),
member(R,Digits),
member(S,Digits),
member(Y,Digits),
M=0, S=0, % Περιορισμοί
E=D,
M=D, M=E,
N=D, N=E, N=M,
O=D, O=E, O=M, O=N,
R=D, R=E, R=M, R=N, R=O,
S=D, S=E, S=M, S=N, S=O, S=R,
Y=D, Y=E, Y=M, Y=N, Y=O, Y=R, Y=S,
S*1000+E*100+N*10+D + M*1000+O*100+R*10+E =:= M*10000+O*1000+N*100+E*10+Y.
if i decrease the number of varriables VarList. does it improves its speed?
if i S*1000+E*100+N*10+D + M*1000+O*100+R*10+E =:= M*10000+O*1000+N*100+E*10+Y
before the checks does it improve its speed?
A clpfd approach, I am putting my solution in case someone is looking into this problem.
:- use_module( library( clpfd)).
puzzle(X):-
X=([S,E,N,D]+[M,O,R,E]=[M,O,N,E,Y]),
Vars=[S,E,N,D,M,O,R,Y],Vars ins 0..9,
S*1000 + E*100 + N*10 + D +
M*1000 + O*100 + R*10 + E #=
M*1000 + O*1000 + N*100 + E*10 + Y,
S#\=0, M#\=0,
all_different(Vars),
labeling([],Vars).
?- puzzle(X).
X = ([1, 8, 0, 5]+[4, 2, 7, 8]=[4, 2, 0, 8, 3])
X = ([1, 8, 0, 5]+[6, 2, 7, 8]=[6, 2, 0, 8, 3])
X = ([1, 8, 0, 5]+[9, 2, 7, 8]=[9, 2, 0, 8, 3])
X = ([1, 8, 0, 6]+[3, 2, 7, 8]=[3, 2, 0, 8, 4])
X = ([1, 8, 0, 6]+[5, 2, 7, 8]=[5, 2, 0, 8, 4])
X = ([1, 8, 0, 6]+[9, 2, 7, 8]=[9, 2, 0, 8, 4])
X = ([2, 7, 0, 4]+[5, 3, 6, 7]=[5, 3, 0, 7, 1])....
No, if you move the line
S*1000+E*100+N*10+D + M*1000+O*100+R*10+E =:= M*10000+O*1000+N*100+E*10+Y
above what you call "Περιορισμοί" ("restrictions", according to Google Translate), it will only become slower because it will needlessly perform the arithmetic calculations which would have been avoided with the restrictions weeding out the illegal digits assignments first.
You also have erroneous equations S = 0, M = 0, E = D, ... when it should have been S =\= 0, M =\= 0, E =\= D, ..., since all the digits in these numbers are required to be unique and the first digits in the numbers can't be zeroes.
Overall your code's speed can be improved, by reducing the domain of available values with each choice of a digit value, using select/3, instead of making all the choices from the same unaffected domain Digits with member/2. This will much reduce the combinatorial choices space, and all the digits picked will be different by construction obviating the inequality checks. The tag cryptarithmetic-puzzle's info page and Q&A entries should have more discussion and / or examples of this technique (also, the tag zebra-puzzle).
I have the following chunk of Prolog taken from a YouTube tutorial on Prolog:
change(H, Q, D, N, P) :-
member(H, [0, 1, 2]),
member(Q, [0, 1, 2, 3, 4]),
member(D, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10]),
member(N, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20]),
S is 50*H + 25*Q + 10*D + 5*N,
S =< 100,
P is 100-S.
It's a program to make change on a dollar. H is half dollars, Q is quarters, D for dimes, N for nickels, P for pennies.
If I type change(H, 0, 0, 0, 0). as a query, it resolves to H=2. In the video, he mentions this is a program that makes change for $1, so I understand that two half dollars are $1, but I don't understand how it gets that.
My understanding of Prolog is that when I pass change(H, 0, 0, 0, 0)., it looks to find a value for H that will satisfy the conditions, so it goes to the first line and sees that 0 would work, then for the other "member" lines sees that the 0s that were passed also are correct.
It then sets S to a value, which given the above values would be S = 0. The next line makes sure it's less than or equal to 100, which 0 is, then sets P to 100-S (which is 100).
How is it not done there with H = 0? What am I missing?
member(H,[0,1,2]) binds H to either 0, 1 or 2. Since Q, D, N and P are all 0, the only value for H that will satisfy the equations at the bottom is 2.
When H=0, S will be 0, 100-S will be 100, and since P is 0, P is 100-S will fail.
When H=1, S will be 50, 100-S will be 50, and since P is 0, P is 100-S will fail.
When H=2, S will be 100, 100-S will be 0, and since P is 0, P is 100-S will succeed.
In addition to the operational explanation, I would like to suggest CLP(FD) constraints for such problems, which are easier to understand and more declarative than lower-level arithmetic predicates. For example, in SICStus Prolog, YAP and SWI:
:- use_module(library(clpfd)).
change(H, Q, D, N, P) :-
H in 0..2,
Q in 0..4,
D in 0..10,
N in 0..20,
S #= 50*H + 25*Q + 10*D + 5*N,
S #=< 100,
P #= 100-S.
Let us now reason declaratively:
If H = 0, as you ask, and the other parameters are 0, as you specified, then what are admissible values of P?
?- change(0, 0, 0, 0, P).
P = 100.
From this, we see that if all other arguments are 0, then the only valid solution for your query is P = 100. Thus, the goal change(0, 0, 0, 0, 0) will certainly fail.
I have a matrix, and its elements on the main diagonal aren't sorted, so I need a function that will return new matrix with sorted elements on the main diagonal. I can't understand why this won't work.
Function[A_] := Module[{res, diagonal = {}, m, n},
{m, n} = Dimensions[A];
Table[AppendTo[diagonal, A[[i, i]]], {i, 1, m}];
dijagonal = SelectionSort[diagonal];
Table[A[[i, i]] = dijagonal[[i]], {i, 1, m}];
Return[A // MatrixForm];
];
Selection sort works.
This can be an example of matrix:
A={{60, 10, 68, 72, 64},{26, 70, 32, 19, 29},{94, 78, 86, 59, 17},
{77, 13, 34, 39, 0}, {31, 71, 11, 48, 83}}
When I run it, this shows up:
Set::setps: {{60,10,68,72,64},{26,70,32,19,29},{94,78,86,59,17},{77,13,34,39,0},{31,71,11,48,83}} in the part assignment is not a symbol. >>
The main issues
you can not define your own function named Function. (Generally avoid using any symbol beginning with a capital to avoid conflicts )
you can not modify the the input argument, so make a copy
just use Sort not SelectionSort
I made a couple of other changes that are more stylistic as well:
function[A0_] :=
Module[{res, diagonal = {}, m, n, A = A0},
{m, n} = Dimensions[A];
diagonal = Table[A[[i, i]], {i, 1, m}];
dijagonal = Sort[diagonal];
Do[A[[i, i]] = dijagonal[[i]], {i, 1, m}]; A]
function[A] // MatrixForm
note you can do all this inline:
ReplacePart[ A,
Table[ {i, i} -> (Sort#Diagonal[A])[[i]], {i, Length#A} ]]
or
(A + DiagonalMatrix[Sort## - # &#Diagonal[A]])
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.