Concatenation of lists in a Fibonacci-like pattern

I am trying to create a List of elements that follow the general pattern:

$$X_{n+1} = X_n X_{n-1}$$

where the operation on the right hand side is concatenation, i.e., joining.

I want to achieve the following pattern:

• $X_0 = \{1\}$
• $X_1 = \{1,0\}$
• $X_2 = X_1X_0 = \{1,0,1\}$
• $X_3 = X_2X_1 = \{1,0,1,1,0\}$
• $X_4 = X_3X_2 = \{1,0,1,1,0,1,0,1\}$
• $X_5 = X_4X_3 = \{1,0,1,1,0,1,0,1,1,0,1,1,0\}$

This is much like a Fibonacci sum but is more like a Fibonacci joining. If you notice, the dimension of the $n^\text{th}$ set is the $n^\text{th}$ Fibonacci number.

I have gone along the lines of a Do loop but I don't know how to loop the current output with a previous output. My feeble attempts have bee thus far:

X0 = {1};X1 = {1, 0};t = Join[X0, X1];Do[Print[t];t = Join[t, t], {3}]

whose out put is

{1,1,0}
{1,1,0,1,1,0}
{1,1,0,1,1,0,1,1,0,1,1,0}

Now this is just joining the two sets three times. How do I join the set with a previous output one? Is there a tool to use that is easier/more efficient than the Do loop?

Why not just use a recursive definition like you would for a regular Fibonnaci function?

ClearAll[fibjoin]

fibjoin = {1};
fibjoin = {1, 0};

mem : fibjoin[n_] := mem = Join[fibjoin[n - 1], fibjoin[n - 2]]

fibjoin
(* {1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0} *)
• Thank you! What part does the function/expression "mem" play here? I am new to Mathematica and I have never seen this being used. I need to understand my code as well, not just be able to use it :). – user106492 Nov 24 '13 at 13:05
• @user106492, it's for memoization - so that fibjoin remembers results it has previously found. Without it recursive functions like this are terribly inefficient. Have a look at this question for some discussion. – Simon Woods Nov 24 '13 at 13:20
• Unfortunately fibjoin produces unpacked array. I propose to add DeveloperToPackedArray to {1} and {1,0}. It is ~2 times faster and uses ~4 times less memory. – ybeltukov Nov 24 '13 at 14:14
• Cacheing + recursive pattern is always delicious in solving this problem. Just a quick note here: for large amount of recursion you may increase the limit by this link – yshk Nov 25 '13 at 5:16

It is so-called Rabbit sequence. One can notice that at each step

$$0 \to 1, \quad 1 \to 10.$$

The substitution $0\to1$ corresponds to young rabbits growing old, and $1\to10$ corresponds to old rabbits producing young rabbits.

fib[n_] := Nest[Flatten[# /. {0 -> {1}, 1 -> {1, 0}}] &, {1}, n]
fib
(* {1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0} *)

It is not as efficient as Simon Woods's solution, but this alternative method in my opinion is also interesting.

Furthermore, the limiting sequence $1, 0, 1, 1, 0, 1, 0, \ldots$ is the binary representation of the rabbit constant

r = Sum[N[1/2^Floor[k*GoldenRatio], 120], {k, 0, 300}] - 1
(* 0.70980344286129... *)

RealDigits[r, 2][]
(* {1, 0, 1, 1, 0, 1, 0, 1, 1, 0, ... } *)
• You need a ternary computer to represent male and female rabbits :D – Dr. belisarius Nov 24 '13 at 17:05

Here is an iterative approach:

f1 = Flatten @ Nest[{#, #[]} &, {1, 0}, # - 1] &;

f1 @ 5
{1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0}

I find this nice and clean, but it doesn't handle a zero argument, and it's not particularly efficient. Here is a variation to address both points:

f2 = First @ Nest[{Join @@ #, #[]} &, DeveloperToPackedArray /@ {{1}, {0}}, #] &;

Array[fx, 6, 0] // Grid

$\begin{array}{ccccccccccccc} 1 & & & & & & & & & & & & \\ 1 & 0 & & & & & & & & & & & \\ 1 & 0 & 1 & & & & & & & & & & \\ 1 & 0 & 1 & 1 & 0 & & & & & & & & \\ 1 & 0 & 1 & 1 & 0 & 1 & 0 & 1 & & & & & \\ 1 & 0 & 1 & 1 & 0 & 1 & 0 & 1 & 1 & 0 & 1 & 1 & 0 \end{array}$

If you want a Do-based solution:

Block[{a = {1, 0}, b = {1}, n = 5},
Do[
{a, b} = {a~Join~b, a},
{n - 1}];
a]

will return the nth term, for n >= 1. (I'm feeling too lazy to package this into a function, but you can do that.)

Pluto[n_Integer] :=
Block[{s1 = {1}, s2 = {1, 0},s3 = {}}, {Table[{s3 = {s2, s1} // Flatten, s1 = s2,
s2 = s3}, {n}]}; s3]

Call as Pluto

{1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0}

This number is amazing. When it comes to Fibonacci, we cannot get rid of golden ratio. Just compare the count of zeros and ones:

Remove[fibjoin]
fibjoin={1};
fibjoin = {1,0};
fibjoin[n_] :=  fibjoin[n] =  Join[fibjoin[n-1], fibjoin[n-2]]

N@Table[Count[fibjoin[k],0]/Count[fibjoin[k],1] , {k,1,20}] • It would be better if you post code instead of the picture. Other users will be able to copy the code use it. – ybeltukov Nov 25 '13 at 12:49
• Just updated. Thanks for reminding me. – yshk Nov 25 '13 at 18:46

I am very late to this but another (not very pretty) interative approach:

f[n_] := First@Nest[{#[], Join[#[], #[]]} &, {{1}, {1, 0}}, n]

It handles f and f automatically...