Ciągi Fibonacciego i Złota Liczba

Autor : Mateusz Wojtaszek, IV rok Fizyki Fazy Skondensowanej, Wydział Fizyki, Astronomii i Informatyki Stosowanej Uniwersytetu Jagiellońskiego
Bibliografia :
[1] The Golden Ratio and Fibonacci numbers; Richard A. Dunlap 1997;
[2] The Golden Section; Hans Walser; 2001
Data: Styczeń 2009

I. Co to jest złoty stosunek

Złoty stosunek to taki, w którym stosunek pierwszej części do drugiej, jest taki sam, jak stosunek drugiej części do sumy ich obu.

N[GoldenRatio,10]

GoldenRatio == (1/2)*(1 + Sqrt[5])

Dlaczego złoty stosunek oznaczamy literą ϕ? Ponieważ już od starożytności interesowano się tym szczególnym podziałem, uznając go za doskonały, wręcz boski. Szczególnie zafascynowany był nim Fidiasz. Dlatego złotą liczbę nazwano ϕ.

Ale dlaczego złoty podział jest tak szczególny? Widząc przedmioty podzielone według tego stosunku, człowiek uważa, że są one wyjątkowo symetryczne i piękne. Dlatego też złoty podział jest stosowany w malarstwie, rzeźbie, architekturze i sztuce użytkowej. Przykładem tego mogą być formaty papieru, w którym stosunek dłuższego boku do krótszego jest złotą liczbą.

Spójrzmy poniżej, czy prostokąt ze złotym podziałem nie wydaje się idealny?

Show[Graphics[{LightBlue,Rectangle[{0,0},{1,1}],Blue,Rectangle[{0,1.1},{1.5,3.1}],Blend[{Red,Yellow}],Rectangle[{2,0},{4,2 GoldenRatio}]}],ImageSize -> 600*{1, 1/GoldenRatio}]

II. Co to są liczby Fibonacciego?

Fibonacci naprawdę nazywał się Leonardo De Pisa, a znany jest jako Syn Bonaccio, czyli Filius Bonaccio - w skrócie Fibonacci. Rozwiązał on problem dotyczący zagadki królików. Załóżmy, że każda para dorosłych królików po miesiącu wydaje na świat jednego potomka. Potomek, potrzebuje jednego miesiąca na osiągnięcie dojrzałości. Załóżmy również, że króliki nie umierają. Fibonacci odpowiedział na pytanie, ile będzie par królików po n miesiącach. Taki ciąg liczb (w tym przypadku liczby te określają ilość par królików) nazywamy ciągiem Fibonacciego. Jego zapis rekurencyjny przedstawia się następujaco:

Fibonacci[n + 1] == Fibonacci[n - 1] + 
   Fibonacci[n]

TableForm[Table[{n,Fibonacci[n],Fibonacci[n-1],Fibonacci[n+1]},{n,1,10}]]

Powyżej przedstawiono tabelę, w której zebrano w pierwszej kolumnie miesiąc, w drugiej ilość par dorosłych królików, w trzeciej ilość par dzieci królików, w czwartej ilość par wszystkich królików.

Ciągi liczb Fibonacciego mają jeszcze wiele odzwierciedleń w przyrodzie, ale nie jest to tematem tej prezentacji, dlatego przejdźmy do związków liczb Fibonacciego ze Złotą Liczbą.

III. Czy można z liczb Fibonacciego otrzymać Złotą Liczbę?

Skorzystajmy z równania: Fibonacci[n + 1] == Fibonacci[n - 1] + 
   Fibonacci[n]
Załóżmy, że liczbę Fibonacci[n + 1] potrafimy zapisać równaniem:

Fibonacci[n + 1] = α*Fibonacci[n]

W taki razie można także zapisać:

Fibonacci[n + 2] = α*Fibonacci[n + 1] = 
   α^2*Fibonacci[n]

Podstawiając wynik do wzoru:

Fibonacci[n + 2] == Fibonacci[n + 1] + 
   Fibonacci[n]

Otrzymamy:

α^2 - α - 1 = 0

Rozwiązując to równanie (zwane kwadratowym równaniem Fibonacciego) otrzymamy :

Solve[(α^2)-α-1==0,α]

Okazuje się, że jedna z tych liczb to złota liczba, a druga - to jej odwrotność!!!

rozw=Flatten[Solve[(α^2)-α-1==0,α]]

rozw[[1,2]] == -(1/GoldenRatio)

rozw[[2,2]] == GoldenRatio

Okazuje się także, korzystając z tego samego warunku, że:

((Fibonacci[n])/(Fibonacci[n-1]))(Overscript[→, n->∞])ϕ

Jest to relacja odkryta przez Keplera. Sprawdźmy, czy Kepler miał rację, korzystając z pomocy programu Mathematica!

Limit[((Fibonacci[n])/(Fibonacci[n-1])),n->∞]

Zobaczmy to także na wykresie:

Clear["Global`*"];
Framed[
Manipulate[
Show[
Plot[g=GoldenRatio*n/n,{n,0,k}],
ListPlot[Table[f=Fibonacci[n]/Fibonacci[n-1], {n, 2, k}],PlotStyle->Directive[Black,PointSize[0.01]]],
ImageSize -> 400*{1, 1/GoldenRatio},PlotRange->{0.8,2.0},AxesOrigin->{0,0.8}],
{{k,2,"Stopień"}, 2, 50},
"k",
Dynamic[Floor[k]],
Delimiter,
{{a,2,"Dokładność"},2,20},
Dynamic[Floor[a]],
Delimiter,
"Fibonacci[k]/Fibonacci[k-1]",
Dynamic[N[f,a]],
"",
"Złota Liczba",
Dynamic[N[GoldenRatio,a]],
Delimiter,
"Fibonacci[k]-Złota Liczba",
Dynamic[N[Abs[f-g],5]],
ControlPlacement->{Left,Left},LabelStyle->{Bold,Medium},Paneled->False]
,FrameMargins->10]

IV. Czy można korzystając ze Złotej Liczby otrzymać ciąg Fibonacciego?

Skoro można z Liczb Fibonacciego otrzymać Złotą Liczbę, to można także otrzymać Liczby Fibonacciego korzystając ze znajomości wartości Złotej Liczby.

Skorzystajmy z tożsamości:

Fibonacci[n] = GoldenRatio^n/Sqrt[5]

Sprawdźmy, czy wzór jest poprawny:

Clear["Global`*"];
Framed[
Manipulate[
Show[
ListPlot[Table[g=GoldenRatio^n/Sqrt[5], {n, 0, k}],PlotStyle->Directive[Red,PointSize[0.01]]],
ListPlot[Table[f=Fibonacci[n], {n, 0, k}],PlotStyle->Directive[Black,PointSize[0.01]]],
ImageSize -> 400*{1, 1/GoldenRatio}],
{{k,0,"Stopień"}, 0, 50},
"k",
Dynamic[Floor[k]],
Delimiter,
"Fibonacci[k]",
Dynamic[N[f,6]],
"",
"Złota Liczba^k/Sqrt[5]",
Dynamic[N[g,6]],
Delimiter,
"Fibonacci[k]-(Złota Liczba)k/Sqrt[5]",
Dynamic[N[Abs[f-g],5]],
ControlPlacement->{Left,Left},LabelStyle->{Bold,Medium},Paneled->False]
,FrameMargins->10]

Sprawdźmy to równanie także w inny sposób. Weźmy przybliżenie całkowite obu stron. Spójrzmy na tabelę poniżej. Jak widać, obie liczby bardzo szybko są sobie równe.

TableForm[Table[{N[GoldenRatio^(n)/Sqrt[5],10],Round[GoldenRatio^(n)/Sqrt[5]],Fibonacci[n]},{n,0,25}]]

Sprawdźmy - już tylko liczbowo - kilka pozostałych relacji pomiędzy liczbami Fibonacciego, a Złotą Liczbą.

Limit[Fibonacci[n]/Fibonacci[n - m], n -> Infinity] == 
  GoldenRatio^m

Reduce[Limit[Fibonacci[n]/Fibonacci[n - m], 
    n -> Infinity] == GoldenRatio^m]

Fibonacci[n] == -(-(1/GoldenRatio))^n + GoldenRatio^n

Limit[GoldenRatio^n - (-(1/GoldenRatio))^n, 
   n -> Infinity] == Limit[Fibonacci[n], n -> Infinity]

GoldenRatio == 
  Sum[(-1)^i/(Fibonacci[i]*Fibonacci[i - 1]), 
    {i, 2, n}] + 1

Manipulate[
  N[Sum[(-1)^i/(Fibonacci[i]*Fibonacci[i - 1]), 
     {i, 2, n}] + 1, 20], Dynamic[Floor[n]], 
  {n, 1, 50}, Dynamic[N[GoldenRatio, 20]], 
  ControlPlacement -> Top, Paneled -> False, 
  FrameMargins -> 10, Frame -> True]

V. Inne związki między Złotą Liczbą, a liczbami ciągu Fibonacciego.

Spójrzmy poniżej. Kolejne dobudowywane prostokąty mają boki w stosunku Złotym.

Clear["Global`*"];
gr[0]:={{0,0},{GoldenRatio,1}};
gr[n_]:=Module[{m=Mod[n,4],a,b,c,d},{{a,b},{c,d}}=gr[n-1];
Switch[Mod[n,4],0,{{a,d},{a+GoldenRatio^n,d+GoldenRatio^n}},1,{{c,d+GoldenRatio^n},{c-GoldenRatio^n,d}},2,{{c-GoldenRatio^n,b-GoldenRatio^n},{c,b}},3,{{a+GoldenRatio^n,b},{a,b-GoldenRatio^n}}]];
Framed[
Manipulate[
Graphics[{EdgeForm[Directive[Opacity[.5],White]],Table[{RGBColor[0.1+k/20,0.3+k/20,0.1*k/10](*ColorData[35,k+1]*),Rectangle@@gr[k]},{k,0,aa}]},ImageSize -> 400*{1, 1/GoldenRatio}],
{{aa,0,"Stopień"},0,10},
"Ilość kwadratów:",
Dynamic[Floor[aa]],
FrameMargins->10,Paneled->False,ControlPlacement->Top(*,Slider[0.5,Background->Blue]*)
]]

Łatwo zauważyć, że podobną konkstrukcję można stworzyć dla liczb Fibonacciego.

Clear["Global`*"];
gr[0]:={{0,0},{1,-1}};
gr[n_]:=Module[{m=Mod[n,4],a,b,c,d},{{a,b},{c,d}}=gr[n-1];
Switch[Mod[n,4],0,{{a,d},{a+Fibonacci[n],d-Fibonacci[n]}},1,{{c,d+Fibonacci[n]},{c+Fibonacci[n],d}},2,{{c-Fibonacci[n],b+Fibonacci[n]},{c,b}},3,{{a-Fibonacci[n],b},{a,b-Fibonacci[n]}}]];
Framed[
Manipulate[
Graphics[{EdgeForm[Directive[Opacity[.5],White]],Table[{RGBColor[0.1+k/20,0.3+k/20,0.1*k/10](*ColorData[35,k+1]*),Rectangle@@gr[k]},{k,1,a}]},ImageSize -> 400*{1, 1/GoldenRatio}],
{{a,1,"Stopień"},1,10},
"Ilość kwadratów:",
Dynamic[Floor[a]],
FrameMargins->10,Paneled->False,ControlPlacement->Top(*,Slider[0.5,Background->Blue]*)
]]

Dalej w tym przypadku stosunki poszczególnych boków bądę tworzyły Złotą Liczbę, ale im boki będą dłuższe, tym przybliżenie tej liczby będzie dokładniejsze. Dodatkowo do podanego  powyżej przykładu możemy dobudować spiralę:

Clear["Global`*"];
kwadrat[0]:={{0,0},{1,-1}};
kwadrat[n_]:=Module[{m=Mod[n,4],a,b,c,d},{{a,b},{c,d}}=kwadrat[n-1];
Switch[Mod[n,4],0,{{a,d},{a+Fibonacci[n],d-Fibonacci[n]}},1,{{c,d+Fibonacci[n]},{c+Fibonacci[n],d}},2,{{c-Fibonacci[n],b+Fibonacci[n]},{c,b}},3,{{a-Fibonacci[n],b},{a,b-Fibonacci[n]}}]];
kolo[0]:={1,0};
kolo[1]:={1,0};
kolo[2]:={1,-1};
kolo[3]:={2,-1};
kolo[w_]:=Module[{mo=Mod[w,4],a,b},{a,b}=kolo[w-1];
Switch[Mod[w,4],
0,kolo[w-4]+{Fibonacci[w-3],Fibonacci[w-2]},
1,kolo[w-4]+{-Fibonacci[w-2],Fibonacci[w-3]},
2,kolo[w-4]-{Fibonacci[w-3],Fibonacci[w-2]},
3,kolo[w-4]+{Fibonacci[w-2],-Fibonacci[w-3]}]];
kat[1]:={0,π/2};
kat[2]:={π/2,π};
kat[3]:={π,3 π/2};
kat[0]:={3 π/2,2 π};
kat[g_]:=Module[{deg=Mod[g,4],ka1,ka2},{ka1,ka2}=kat[g-1];
Switch[Mod[g,4],
0,kat[0],
1,kat[1],
2,kat[2],
3,kat[3]]];
Framed[
Manipulate[
Show[
Graphics[{EdgeForm[Directive[Opacity[.5],White]],Table[{RGBColor[0.1+k/20,0.3+k/20,0.1*k/10](*ColorData[35,k+1]*),Rectangle@@kwadrat[k]},{k,1,a}]}],
Graphics[{
Table[{Circle[Flatten[kolo[kk-1]],Fibonacci[kk],kat[kk-1]]},{kk,1,b}]}],ImageSize -> 500*{1, 1/GoldenRatio}],
{{a,1,"Stopień"},1,20},
"Ilość kwadratów:",
Dynamic[Floor[a]],
{{b,1,"Kąt"},1,20},
FrameMargins->10,Paneled->False,ControlPlacement->Top(*,Slider[0.5,Background->Blue]*)
]]

Sprawdźmy teraz inną relację dla liczb Fibonacciego w sposób graficzny.

Sum[Fibonacci[i]*Fibonacci[i - 1], {i, 2, j + 1}] == 
  Fibonacci[j + 1]^2

Poniżej jest ilustracja tej realcji w postaci tabeli.

TableForm[Table[{Sum[Fibonacci[i]*Fibonacci[i - 1], 
     {i, 2, j + 1}], Fibonacci[j + 1]^2}, 
   {j, 1, 31, 2}]]

A poniżej jest graficzna ilustracja tej relacji:

Clear["Global`*"];
gr[0]:={{0,0},{1,-1}};
gr[n_]:=Module[{m=Mod[n,4],a,b,c,d},{{a,b},{c,d}}=gr[n-1];
Switch[Mod[n,4],0,{{a,d},{a+Fibonacci[n],d-Fibonacci[n+1]}},1,{{c,d+Fibonacci[n+1]},{c+Fibonacci[n],d}},2,{{c-Fibonacci[n],b+Fibonacci[n+1]},{c,b}},3,{{a-Fibonacci[n],b},{a,b-Fibonacci[n+1]}}]];
Framed[
Manipulate[
Graphics[{EdgeForm[Directive[Opacity[.5],White]],Table[{RGBColor[0.1+k/20,0.3+k/20,0.1*k/10](*ColorData[35,k+1]*),Rectangle@@gr[k]},{k,1,a}]},ImageSize -> 600*{1, 1/GoldenRatio}],
{{a,1,"Stopień"},1,10},
"Ilość kwadratów:",
Dynamic[Floor[a]],
FrameMargins->10,Paneled->False,ControlPlacement->Top(*,Slider[0.5,Background->Blue]*)
]]

Weźmy teraz relację identyczną jak powyżej, ale dla parzystych j.

Sum[Fibonacci[i]*Fibonacci[i - 1], {i, 2, j + 1}] == 
  Fibonacci[j + 1]^2 - 1

TableForm[Table[
   {Sum[Fibonacci[i]*Fibonacci[i - 1], 
     {i, 2, j + 1}], Fibonacci[j + 1]^2 - 
     1}, {j, 2, 32, 2}]]

Graficzna ilustracja powyższej relacji:

Clear["Global`*"];
gr[0]:={{0,0},{1,-1}};
gr[n_]:=Module[{m=Mod[n,4],a,b,c,d},{{a,b},{c,d}}=gr[n-1];
Switch[Mod[n,4],0,{{a,d},{a+Fibonacci[n+1],d-Fibonacci[n]}},1,{{c,d+Fibonacci[n]},{c+Fibonacci[n+1],d}},2,{{c-Fibonacci[n+1],b+Fibonacci[n]},{c,b}},3,{{a-Fibonacci[n+1],b},{a,b-Fibonacci[n]}}]];
Framed[
Manipulate[
Graphics[{EdgeForm[Directive[Opacity[.5],White]],Table[{RGBColor[0.1+k/20,0.3+k/20,0.1*k/10](*ColorData[35,k+1]*),Rectangle@@gr[k]},{k,1,a}]},ImageSize -> 400*{1, 1/GoldenRatio}],
{{a,1,"Stopień"},1,10},
"Ilość kwadratów:",
Dynamic[Floor[a]],
FrameMargins->10,Paneled->False,ControlPlacement->Top(*,Slider[0.5,Background->Blue]*)
]]

Poniżej znajduje się kilka ilustracji, na których ukryto Złotą Liczbę oraz niektóre liczby ciągu Fibonacciego.

Clear["Global`*"];
Needs["Polytopes`"]
<<Polytopes`
Manipulate[
Show[
Graphics[{Blue,PointSize[0.03], Point /@ Vertices[Pentagon]}],
Graphics[Circle[{0,0},1]],
Graphics[Line[Table[Vertices[Pentagon][[If[Mod[k,6]==0,1,Mod[k,6]]]],{k,1,6}]]],
Graphics[Line[Table[Vertices[Pentagon][[If[k==11,1,If[k>6,Mod[k+1,6],Mod[k,6]]]]],{k,1,11,2}]]],
Graphics[Line[{q,p}]],
Graphics[Line[{{a,b}}],
PlotRange->All,ImageSize -> 400*{1, 1/GoldenRatio}]],
{{p,{0,0}},Locator},{{q,{1,1}},Locator},{{a,{0,1}},Locator},{{b,{1,0}},Locator},
"Gdzie skrył się złoty podział?",
"Współrzędne 1",
Dynamic[Round[Abs[p-q],0.02]],
Delimiter,
"Długość 1",
Dynamic[Round[EuclideanDistance[p,q],0.02]],
Delimiter,
"Współrzędne 2",
Dynamic[Round[Abs[a-b],0.02]],
Delimiter,
"Długość 2",
Dynamic[Round[EuclideanDistance[a,b],0.02]],
Delimiter,
"Stosunek 2 do 1",
Dynamic[Round[EuclideanDistance[a,b]/EuclideanDistance[p,q],0.02]],
Delimiter,
Dynamic[If[Round[EuclideanDistance[a,b]/EuclideanDistance[p,q],0.02]==Round[GoldenRatio,0.02],"ZŁOTA LICZBA",If[Round[EuclideanDistance[a,b]/EuclideanDistance[p,q],0.02]==Round[(GoldenRatio)^(-1),0.02],"Odwrotność ZŁOTEJ LICZBY"," "]]]]

Clear["Global`*"];
Manipulate[
Show[
Graphics[{LightBlue,EdgeForm[Thick],Rectangle[{0,0},{1,1}]}],
Graphics[{LightBlue,EdgeForm[Thick],Rectangle[{1,0},{GoldenRatio,1}]}],
Graphics[{Thick,Black,Line[{{1,0},{GoldenRatio,1}}]}],
Graphics[{Thick,Line[{{0,1},{GoldenRatio,0}}]}],
Graphics[Line[{q,p}]],
Graphics[Line[{a,b}]],
PlotRange->All,ImageSize -> 400*{1, 1/GoldenRatio}],
{{p,{0,0}},Locator},{{q,{1,1}},Locator},{{a,{0,1}},Locator},{{b,{1,0}},Locator},
"Gdzie skrył się złoty podział?",
"Współrzędne 1",
Dynamic[Round[Abs[p-q],0.02]],
Delimiter,
"Długość 1",
Dynamic[Round[EuclideanDistance[p,q],0.02]],
Delimiter,
"Współrzędne 2",
Dynamic[Round[Abs[a-b],0.02]],
Delimiter,
"Długość 2",
Dynamic[Round[EuclideanDistance[a,b],0.02]],
Delimiter,
"Stosunek 2 do 1",
Dynamic[Round[EuclideanDistance[a,b]/EuclideanDistance[p,q],0.02]],
Delimiter,
Dynamic[If[Round[EuclideanDistance[a,b]/EuclideanDistance[p,q],0.02]==Round[GoldenRatio,0.02],"ZŁOTA LICZBA",If[Round[EuclideanDistance[a,b]/EuclideanDistance[p,q],0.02]==Round[(GoldenRatio)^(-1),0.02],"Odwrotność ZŁOTEJ LICZBY"," "]]]]

Clear["Global`*"];
Manipulate[
Show[
Graphics[{Blue,Thick,Circle[{0,0},0.5]}],
Graphics[{Blue,Thick,Line[{{0,0},{0,-0.5},{-1,-0.5}}]}],
Graphics[{Blue,Thick,Line[{{-1,-0.5},{1,0.5}}]}],
Graphics[Line[{q,p}]],
Graphics[Line[{a,b}]],
PlotRange->All,ImageSize -> 400*{1, 1/GoldenRatio}],
{{p,{-0.5,0}},Locator},{{q,{0.5,0}},Locator},{{a,{0,0.5}},Locator},{{b,{0,-0.5}},Locator},
"Gdzie skrył się złoty podział?",
"Współrzędne 1",
Dynamic[Round[Abs[p-q],0.02]],
Delimiter,
"Długość 1",
Dynamic[Round[EuclideanDistance[p,q],0.02]],
Delimiter,
"Współrzędne 2",
Dynamic[Round[Abs[a-b],0.02]],
Delimiter,
"Długość 2",
Dynamic[Round[EuclideanDistance[a,b],0.02]],
Delimiter,
"Stosunek 2 do 1",
Dynamic[Round[EuclideanDistance[a,b]/EuclideanDistance[p,q],0.02]],
Delimiter,
Dynamic[If[Round[EuclideanDistance[a,b]/EuclideanDistance[p,q],0.02]==Round[GoldenRatio,0.02],"ZŁOTA LICZBA",If[Round[EuclideanDistance[a,b]/EuclideanDistance[p,q],0.02]==Round[(GoldenRatio)^(-1),0.02],"Odwrotność ZŁOTEJ LICZBY"," "]]]]

Kraków, styczeń 2009

Notebook zgodny z Mathematica 7.0 for Students