Counting Fibonacci Orbits

Question

If we define a Fibonacci-like sequence as f_k(n) = (f_k(n-1) + f_k(n-2)) % k, for some integer k (where % is the modulo operator), the sequence will necessarily be cyclic, because there are only k² different values for (f_k(n-1), f_k(n-2)). However, this cycle doesn't usually include all possible pairs of values, so depending on the two starting values f_k(0) and f_k(1), we might get different cycles. For example, for k = 2, we have the following four possibilities, depending on the first two values:

0, 0, 0, 0, 0, 0, 0, 0, 0, ...
0, 1, 1, 0, 1, 1, 0, 1, 1, ...
1, 0, 1, 1, 0, 1, 1, 0, 1, ...
1, 1, 0, 1, 1, 0, 1, 1, 0, ...

Due to the cyclic nature of the sequences, there are really only two fundamentally different sequences here, with orbits (0) and (0, 1, 1). Let's look at k = 3:

0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ...
0, 1, 1, 2, 0, 2, 2, 1, 0, 1, 1, 2, 0, 2, 2, 1, ...
0, 2, 2, 1, 0, 1, 1, 2, 0, 2, 2, 1, 0, 1, 1, 2, ...
1, 0, 1, 1, 2, 0, 2, 2, 1, 0, 1, 1, 2, 0, 2, 2, ...
1, 1, 2, 0, 2, 2, 1, 0, 1, 1, 2, 0, 2, 2, 1, 0, ...
1, 2, 0, 2, 2, 1, 0, 1, 1, 2, 0, 2, 2, 1, 0, 1, ...
2, 0, 2, 2, 1, 0, 1, 1, 2, 0, 2, 2, 1, 0, 1, 1, ...
2, 1, 0, 1, 1, 2, 0, 2, 2, 1, 0, 1, 1, 2, 0, 2, ...
2, 2, 1, 0, 1, 1, 2, 0, 2, 2, 1, 0, 1, 1, 2, 0, ...

Again, there are only two different orbits: (0) and (0, 1, 1, 2, 0, 2, 2, 1).

For higher k we might get more orbits, but they will still fall into a comparably small number of classes. For example k = 4 yields the four orbits (0), (0,1,1,2,3,1), (0, 2, 2), (0, 3, 3, 2, 1, 3) and k = 5 the three orbits (0), (0, 1, 1, 2, 3, 0, 3, 3, 1, 4, 0, 4, 4, 3, 2, 0, 2, 2, 4, 1) and (1, 3, 4, 2).

Your task in this challenge is to compute how many orbits the sequence generates for a given k. This is OEIS A015134. Here are the first 100 values (starting from k = 1):

1, 2, 2, 4, 3, 4, 4, 8, 5, 6, 14, 10, 7, 8, 12, 16, 9, 16, 22, 16,
29, 28, 12, 30, 13, 14, 14, 22, 63, 24, 34, 32, 39, 34, 30, 58, 19,
86, 32, 52, 43, 58, 22, 78, 39, 46, 70, 102, 25, 26, 42, 40, 27, 52,
160, 74, 63, 126, 62, 70, 63, 134, 104, 64, 57, 78, 34, 132, 101, 60,
74, 222, 37, 38, 62, 328, 89, 64, 82, 124, 41, 86, 42, 172, 75, 44,
184, 178, 181, 132, 82, 180, 99, 140, 104, 246, 49, 50, 114, 76

Make sure to check k = 11, which is the first input which yields more than k orbits.

Rules

You're given a positive integer k and should output A015134(k).

You may write a program or a function and use any of the standard methods of receiving input and providing output.

You may use any programming language, but note that these loopholes are forbidden by default.

This is code-golf, so the shortest valid answer – measured in bytes – wins.

• Peter Taylor: This is close enough to codegolf.stackexchange.com/q/26578/194 that I won't close it unilaterally but I would cast the 5th vote to close as dupe.

Answer 1

Husk, (削除) 17 (削除ここまで) 16 bytes

Lüȯ€U¡ȯ↔m%0∫π2l·0

Try it online!

Explanation

Lüȯ€U¡ȯ↔m%0∫π2l·0 Implicit input, say n=4.
 l·0 Lowered range: [0,1,2,3]
 π2 Cartesian second power: [[0,0],[0,1],[1,0],[0,2]..
 üȯ Deduplicate with respect to this function:
 €U¡ȯ↔m%0∫ Arguments are two pairs, say a=[0,2], b=[1,1]
 ¡ȯ Iterate on a:
 ∫ Cumulative sum,
 m%0 take modulo n of each,
 ↔ then reverse: [[0,2],[2,0],[2,2],[0,2],[2,0]..
 U Cut at first repeated element: [[0,2],[2,0],[2,2]]
 € Is b in this list? No, so they are distinct in ü.
L Number of remaining pairs.

Answer 2

Bash, (削除) 172 (削除ここまで), (削除) 119 (削除ここまで), (削除) 113 (削除ここまで), 91 bytes

n=1ドル;for((k=0;k<n*n;++k)){((H[k]||++c));for((;!H[k];k=(k/n+k)%n*n+k/n)){ H[k]=1;};};echo $c

Try it online

Answer 3

Wolfram Language (Mathematica), (削除) 76 (削除ここまで) 70 bytes

Tr[EdgeCycleMatrix[#->{#[[2]],Tr@#~Mod~n}&/@Tuples[Range[n=#]-1,2]]!]&

Try it online!

How it works

We construct the graph given by the rules {{0,0}->{0,0}, {1,0}->{1,1}, ...} that, given two elements of a generalized Fibonacci sequence, find the next one modulo n. The EdgeCycleMatrix gives the incidence matrix from cycles to edges in this graph; we want to count its rows.

(There are a number of built-ins that do a similar task, but ConnectedComponents is longer, and FindCycle needs lots of extra inputs to make it work. Besides, EdgeCycleMatrix is a rectangular array, not funny-shaped like the other two, which helps later.)

To count the rows of the matrix, we take the factorial of the entries to turn it into a matrix of all ones, then take the trace. (Each cycle contains at least one edge and therefore there are at least as many columns as rows - so this counts the rows and not the columns.)

Answer 4

MATL, (削除) 38 (削除ここまで) 36 bytes

:qt!J*+le"@GU:"t&Zjwy+G\J*+hu]S]Xhun

Try it online! It times out in the online compiler for input exceeding 7.

Explanation

The code defines orbits in terms of complex numbers, where the imaginary part is the new term and the real part is the preceding term in the Fibonacci sequence. Each complex value encodes the state of the sequence. Namely, given a+jb the next value is computed as b+j(a+b).

The possible starting values are a+jb with a, b in [0, 1, ..., k-1]. For each starting value, the code iterates k^2 times. Actually, to make the code shorter, each iteration is applied to all accumulated so values so far, and the results are deduplicated (which would be necessary at the end anyway). After the last iteration, the vector of deduplicated complex values is sorted (by absolute value, then by angle). This gives a "signature" for each orbit.

At the end of the program, signatures are collected into a cell array. The number of unique signatures is the desired output.

:q % Implicit input: k. Push row vector [0, 1, ..., k-1]
t! % Duplicate, transpose: gives column vector [0; 1; ...; k-1]
J*+ % Multiply by 1j, add with broadcast. Gives a k ×ばつ k matrix of
 % values a+jb with a, b in [0, 1, ..., k-1]
le % Linearize into a row vector
" % For each c in that vector
 @ % Push c
 GU:" % Do the following k^2 times
 t&Zj % Duplicate and split into real and imaginary parts: a, b
 wy+ % Swap, duplicate, from below, add: transforms a, b into
 % b, a+b. This is the basic step in the Fibonacci sequence
 % In subsequent iterations a and b may be vectors instead
 % of numbers, as they include all values obtained so far
 G\ % Modulo k, element-wise
 J*+ % Times 1j, add. Gives the next complex number for each of
 % the complex numbers so far
 hu % Append to values so far and deduplicate. This may extend
 % the vector of complex numbers
 ] % End
 S % Sort
] % End
Xh % Collect entire stack into a cell array
u % Deduplicate
n % Number of entries. Implicit display

Answer 5

Jelly, 17 bytes

Ṛ+\%3
Ḷṗ2ÇÐL·€Ṣ€QL

Try it online!

Answer 6

Haskell, (削除) 196 (削除ここまで) 191 bytes

import Data.List
o(a:b)=1+o[x|x<-b,not$(0<$a)==(0<$x)&&isInfixOf a(x++x)]
o _=0
k#(a,b)=(b,mod(a+b)k)
p!(a:b)|elem a p=fst<$>p|r<-p++[a]=r!b
f k=o[[]!iterate(k#)(a,b)|a<-[0..k-1],b<-[0..k-1]]

Try it online!

This could probably be improved. Particularly if someone can find a way to avoid isInfixOf and remove the import.

Basic idea is to generate a list of "states" (tuples containing the two previous values) to see when it starts to cycle. Then we check whether each orbit is different to its predecessors (really works the other way around but it's hard to put into words). To check if orbits are the same we check if the length is the same and whether one fits into the other concatenated with itself. For example [0,2,2],[2,2,0]: length of both is 3 and [0,2,2,0,2,2] contains [2,2,0] as a continuous subsequence. I'm not sure if it's foolproof but it seems to work.

EDIT: thanks to Laikoni for taking off 5 bytes! I should've read more of those tips.

• Laikoni: It looks like you can use this tip to avoid length. Another byte can be saved in ! with |r<-p++[a]=r!b.

Answer 7

JavaScript (ES6), (削除) 337 (削除ここまで) 335 bytes

Sorry for the Ω(k^3) brute-force algorithm.

(k,x=o=0,u=[],s=(q,w,v,j=d=0)=>{while(j++<v)d|=q.reduce((a,b,i)=>a&=b==w[(i+j)%v],1);return d})=>{for(;x<k;x++)for(y=0;y<k;y++){l=2;r=[x,y];do{r.push((c=(d=r[(l+=2)-3])+r[l-4])%k,(c+d)%k)}while(!(t=r.slice(0,h=l/2)).reduce((a,b,i)=>a&=b==r[i+h],1));if(!u.reduce((q,z)=>q|=(t.length-(a=z.length)?0:s(t,z,a)),0)){o++;u.push(t)}}return o}

The performance... (削除) When I was calculating A015134(something beyond k=50) it exceeded 60s limit on TIO. (削除ここまで)

var g=(k,x=o=0,u=[],s=(q,w,v,j=d=0)=>{while(j++<v)d|=q.reduce((a,b,i)=>a&=b==w[(i+j)%v],1);return d})=>{for(;x<k;x++)for(y=0;y<k;y++){l=2;r=[x,y];do{r.push((c=(d=r[(l+=2)-3])+r[l-4])%k,(c+d)%k)}while(!(t=r.slice(0,h=l/2)).reduce((a,b,i)=>a&=b==r[i+h],1));if(!u.reduce((q,z)=>q|=(t.length-(a=z.length)?0:s(t,z,a)),0)){o++;u.push(t)}}return o}
for (var ix = 1; ix <= 15; ix++)
 console.log(`A015134(${ix}) = ${g(ix)}`);

Explanation(Ungolfed)

function CheckIfSameOrbit(Array_1, Array_2, Length) { // Checks if the orbits are equal
 var d = false, j = 0; // Assume both have same length
 while (j < v) { // Checks for different startings
 j++; 
 d |= Array_1.reduce(function(Acc, Item, Index) { // Element-by-element comparison
 Acc &= Item == w[(Index + j) % v], 1); 
 }); // Return true if any starting
 } // point makes two orbits identical
}
function A015134(k) { // Main Program
 var o = 0, u = []; 
 for (var x = 0; x < k; x++) { // Checks different pairs of (x, y)
 for (var y = 0; y < k; y++) {
 var l = 2, r = [x, y], h = 1, t;
 do { // Find until a complete orbit is
 l += 2; // found (except for (0, 0) case)
 h = l / 2;
 var d = r[l - 3], c = r[l - 3] + r[l - 4];
 r.push(c % k, (c + d) % k);
 t = r.slice(0, h);
 } 
 while (!t.reduce(function(Acc, Item, Index) { // Which is, if 2 identical copies
 Acc &= Item == r[Index + h]; // of the orbit are calculated
 }, 1));
 if (!u.reduce(function(Acc, Item) { // If the orbit is a new one
 var a = Item.length;
 Acc |= (t.length - a ? 0 : s(t, Item, a));
 }, 0)) {
 o++; // Increment the counter, and
 u.push(t); // record it to the list
 }
 }
 }
 return o; // Ultimately return the counter;
}

Answer 8

Perl 5, 80+1 (-p) bytes

$n=$_;map{$a[$_]||++$\;$a[$_]++until$a[$_=0|($_/$n+$_)%$n*$n+$_/$n]}0..$n**2-1}{

Try it online

Answer 9

JavaScript (ES6), 102 bytes

k=>F=(a=0,b=0,C=0,q)=>q?F[q=[a,b%=k]]?0:1|F(b,a+b,C,F[q]=1):b<k?F(a,b+1,C+F(a,b,C,1)):++a<k?F(a,0,C):C

Returns a function which returns the result. For 3 more bytes we can have it return the result directly:

k=>(F=(a,b,C,q)=>q?F[q=[a,b%=k]]?0:1|F(b,a+b,C,F[q]=1):b<k?F(a,b+1,C+F(a,b,C,1)):++a<k?F(a,0,C):C)(0,0,0)

Both have time complexity O(n²).

Answer 10

Python 2, 214 bytes

def h(k):
 R=[]
 for p in[[i/k,i%k,(i/k+i%k)%k]for i in range(k*k)]:
	while p[:2]!=p[-2:]:
		p.append(sum(p[-2:])%k)
	p=p[:-2]
	if not any([p==x[i:]+x[:i]for i in range(len(p))for x in R]):R.append(p)
 print len(R)

Try it online!

It's not very efficient but it's the golfiest I could do.