Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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?

share|improve this question

7 Answers 7

up vote 12 down vote accepted

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} *)
share|improve this answer
    
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
4  
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. –  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 –  Shenghui 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[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, ... } *)
share|improve this answer
1  
You need a ternary computer to represent male and female rabbits :D –  belisarius Nov 24 '13 at 17:05

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} $

share|improve this answer

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

share|improve this answer
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}

share|improve this answer

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

share|improve this answer
3  
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
1  
Just updated. Thanks for reminding me. –  Shenghui Nov 25 '13 at 18:46

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

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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