13
$\begingroup$

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?

$\endgroup$
12
$\begingroup$

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

ClearAll[fibjoin]

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

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

fibjoin[5]
(* {1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0} *)
$\endgroup$
  • $\begingroup$ 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 :). $\endgroup$ – user106492 Nov 24 '13 at 13:05
  • $\begingroup$ @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. $\endgroup$ – Simon Woods Nov 24 '13 at 13:20
  • 4
    $\begingroup$ Unfortunately fibjoin produces unpacked array. I propose to add Developer`ToPackedArray to {1} and {1,0}. It is ~2 times faster and uses ~4 times less memory. $\endgroup$ – ybeltukov Nov 24 '13 at 14:14
  • $\begingroup$ 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 $\endgroup$ – yshk Nov 25 '13 at 5:16
14
$\begingroup$

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[5]
(* {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]]
(* {1, 0, 1, 1, 0, 1, 0, 1, 1, 0, ... } *)
$\endgroup$
  • 2
    $\begingroup$ You need a ternary computer to represent male and female rabbits :D $\endgroup$ – Dr. belisarius Nov 24 '13 at 17:05
5
$\begingroup$

Here is an iterative approach:

f1 = Flatten @ Nest[{#, #[[1]]} &, {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 @@ #, #[[1]]} &, Developer`ToPackedArray /@ {{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} $

$\endgroup$
2
$\begingroup$

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.)

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

Call as Pluto[4]

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

$\endgroup$
1
$\begingroup$

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]={1};
fibjoin[2] = {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}]

godenratio

$\endgroup$
  • 3
    $\begingroup$ It would be better if you post code instead of the picture. Other users will be able to copy the code use it. $\endgroup$ – ybeltukov Nov 25 '13 at 12:49
  • 1
    $\begingroup$ Just updated. Thanks for reminding me. $\endgroup$ – yshk Nov 25 '13 at 18:46
0
$\begingroup$

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

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

It handles f[0] and f[1] automatically...

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.