Jak povzbudit zájem studentů 
o matematiku?

Antonín Slavík
Matematicko-fyzikální fakulta UK
slavik@karlin.mff.cuni.cz

Fibonacciova čísla

Úloha o králících

Leonardo Pisánský (Fibonacci, 1202):
Máme jeden pár mladých králíků. Každý králík dospívá za jeden měsíc, dospělému páru se každý měsíc narodí další pár králíků. Kolik párů budeme mít po n měsících?

grf=;
grm=;
gr=GraphicsRow[{grf,grm}];
Manipulate[With[{pos={{0.`,0.`},{0.`,1.`},{0.9258200997725514`,1.8516401995451028`},{1.7741310502909748`,2.6611965754364624`},{3.3528371517369977`,3.3528371517369977`},{5.3285658939847975`,3.806118495703427`},{8.182608119098033`,4.091304059549016`},{11.759742747173759`,4.115909961510815`}}[[generations]]},Column[{MapAt[Prepend[{Text[Style["generations",16],{-2,pos[[2]]+.5pos[[2]]/(generations-1)}],Text[Style["number of pairs",16],{pos[[1]]+2,pos[[2]]+.5pos[[2]]/(generations-1)}],MapIndexed[Text[First@#2,{-2,#}]&,Range[pos[[2]],0,-pos[[2]]/(generations-1)]],MapIndexed[Text[Fibonacci[First@#2],{pos[[1]]+2,#}]&,Range[pos[[2]],0,-pos[[2]]/(generations-1)]]},#]&,ToExpression@ToBoxes@TreeForm[DeleteCases[n[m@@Nest[m[#,n[#]]&,n[m],12]],(n|m)[__],{generations}]/.m_[]->m,ImageSize->{500,375},VertexRenderingFunction-> If[show=="labels",Automatic, (Inset[gr,#1,Automatic,{1.,.3}]&)],PlotStyle->Thickness[.01],EdgeRenderingFunction->Function[{p,vl,el},{Which[vl[[1]]===n,Orange,ReleaseHold@vl==={m,n},Blue,ReleaseHold@vl==={m,m},Brown],Arrowheads[Medium],Arrow[p,.15]}]],1],Text@Style[Row[Riffle[{"a pair of rabbits:","\!\(\*
StyleBox[\"born\",\nFontColor->RGBColor[0, 0, 1]]\)","\!\(\*
StyleBox[\"mature\",\nFontColor->RGBColor[1, 0.5, 0]]\)","\!\(\*
StyleBox[\"survive\",\nFontColor->RGBColor[0.6, 0.4, 0.2]]\)"},{"","|","|"}]," "],18]},Alignment->Center]],{{generations,2,"generations"},2,8,1, Appearance->"Labeled"},{{show,"labels"},{"labels","rabbits"}},SaveDefinitions->True]

Fibonacci Rabbits ze stránek The Wolfram Demonstrations Project
http://demonstrations.wolfram.com/FibonacciRabbits/
Autor: Enrique Zeleny

Je-li (Subscript[F, n]) počet králíků po n měsících, pak (Subscript[F, 0])=(Subscript[F, 1])=1 a (Subscript[F, n])=(Subscript[F, n-1])+(Subscript[F, n-2]) pro každé n≥2.

fib[0]:=1;
fib[1]:=1;
fib[n_]:=fib[n-1]+fib[n-2]

Table[fib[n],{n,0,10}]

Občas se jako (Subscript[F, n]) označují i posunuté posloupnosti.

Table[Fibonacci[n],{n,0,10}]

fib20=Table[fib[n],{n,0,20}]

ListPlot[fib20,PlotRange->All,Filling->Axis]

ListLogPlot[fib20,PlotRange->All,Filling->Axis]

Úloha o dlaždicích

Kolika způsoby lze vydláždit obdélník o rozměrech 2×n, máme-li k dispozici dlaždice o rozměrech 2×1?

start[l_]:={0}~Join~Delete[Accumulate[l],Length[l]];
tiling[l_]:=MapThread[(#1 /. {1->Rectangle[{#2,0},{#2+1,2}],2->{Rectangle[{#2,0},{#2+2,1}],Rectangle[{#2,1},{#2+2,2}]}})&,{l,start[l]}];
showTiling[l_]:=Graphics[{EdgeForm[Black],Yellow}~Join~tiling[l]];
allTilings[1]:={{1}};
allTilings[2]:={{1,1},{2}};
allTilings[n_]:=Map[{1}~Join~#&,allTilings[n-1]]~Join~Map[{2}~Join~#&,allTilings[n-2]];
showAllTilings[n_]:=Map[showTiling,allTilings[n]]

showAllTilings[2]

showAllTilings[3]

showAllTilings[4]

showAllTilings[5]

showAllTilings[6]

Je-li (Subscript[a, n]) počet dláždění obdélníka 2×n, pak (Subscript[a, 0])=(Subscript[a, 1])=1 a (Subscript[a, n])=(Subscript[a, n-1])+(Subscript[a, n-2]) pro každé n≥2.
Platí tedy (Subscript[a, n])=(Subscript[F, n]) pro každé n.

Periodicita zbytků

Zbytky (Subscript[F, n]) při dělení dvěma (perioda 3):

Table[Mod[fib[n],2],{n,0,20}]

Zbytky (Subscript[F, n]) při dělení třemi (perioda 8):

Table[Mod[fib[n],3],{n,0,20}]

Zbytky (Subscript[F, n]) při dělení čtyřmi (perioda 6):

Table[Mod[fib[n],4],{n,0,20}]

Věta: Zbytky (Subscript[F, n]) při dělení libovolným číslem tvoří periodickou posloupnost.
(D. D. Wall, Fibonacci Series Modulo m, American Mathematical Monthly 67, 525-532, 1960.)

Manipulate[m=Min[{m,w}];ArrayPlot[Partition[Mod[Fibonacci[#]&/@Range[0,-1+w ^2 ],m]/If[h===Hue,m,m-1],w],ImageSize->350,ColorFunction->h, ColorFunctionScaling->False,AspectRatio->1,Mesh->True,Frame->False],{{w,8,"size n"},2,64,1,Appearance->"Labeled"},{{m,3, "modulus m"},2,w,1,Appearance->"Labeled"},{{h,"LightTemperatureMap",""},{"LightTemperatureMap"->"color",GrayLevel->"gray-level"},ControlType->SetterBar}]

Fibonacci Residues are Periodic ze stránek The Wolfram Demonstrations Project
http://demonstrations.wolfram.com/FibonacciResiduesArePeriodic/
Autor: Michael Schreiber

Fibonacciova prvočísla

V této části pracujeme s posunutou Fibonacciovou posloupností (0,1,1,2,3,...).

Table[Fibonacci[n],{n,0,10}]

Kdy je (Subscript[F, k]) prvočíslo?

fibprimes[n_]:=Cases[Range[n],k_/;PrimeQ[Fibonacci[k]]]

fibprimes[5000]//Timing

IntegerLength[Fibonacci[5000]]

Pro k≥5 platí: Je-li (Subscript[F, k]) prvočíslo, pak k je prvočíslo.

fibprimes2[n_]:=Cases[Range[n],k_/;(k==4||PrimeQ[k])&&PrimeQ[Fibonacci[k]]]

fibprimes2[5000]//Timing

Otevřený problém: Obsahuje Fibonacciova posloupnost nekonečně mnoho prvočísel?
Pravděpodobně největší známé Fibonacciovo prvočíslo je (Subscript[F, 604711]) (126 377 cifer - Lifschitz, 2005).

Zobecněná úloha o králících

Viz např. článek A. M. Oller, The Dying Rabbit Problem Revisited.

MortalRabbitsEvolution[LifeSpan_,FertilityAge_,InitialNumber_, ObservationTime_]:=
Block[{𝒞,Χ},
𝒞[h_,n_Integer?NonNegative]/;n<h=InitialNumber;
𝒞[h_,n_Integer?NonNegative]/;n≥h:=(𝒞[h,n]=𝒞[h,n-1]+𝒞[h,n-h]);
Χ[{k_,h_},n_Integer?NonNegative]/;n<k-1:=𝒞[h,n];
Χ[{k_,h_},n_Integer?NonNegative]/;n>k-2:=Χ[{k,h},n]=Array[Χ[{k,h},n-#1]&,k-h,h,Plus];
Table[Χ[{LifeSpan,FertilityAge},n],{n,0,ObservationTime}]
];
Manipulate[Module[{seq},
If[ls<fa,ls=fa];
seq=MortalRabbitsEvolution[ls,fa,in,30];
If[FreeQ[seq,0],ListLogPlot,ListPlot][seq,PlotRange->All,Filling->Axis,ImageSize->{500,350},AxesLabel->{"time","population"}]],
{{ls,10,"life span"},1,20,1,ControlType->SetterBar,Appearance->"Row"},
{{fa,1,"fertility age"},1,10,1,ControlType->SetterBar,Appearance->"Row"},
{{in,1,"initial pairs"},1,5,1,Appearance->"Labeled"},
Bookmarks->{"Perrin sequence":>{ls=4,fa=2,in=1}},SaveDefinitions->True,AutorunSequencing->{1,2}]

Mortal Fibonacci Rabbits ze stránek The Wolfram Demonstrations Project
http://demonstrations.wolfram.com/MortalFibonacciRabbits/
Autor: Oleksandr Pavlyk

Cyklistické úlohy

Kterým směrem jel cyklista?

Cyklista jede po rovném terénu, přední a zadní kolo zanechávají stopy - rovinné křivky. 
Dokážete určit, která křivka odpovídá kterému kolu a jakým směrem cyklista jel?
(Úloha a obrázek jsou z knihy Stan Wagon, Mathematica in Action, Springer, 2000;
viz též Sherlock Holmes, Adventure at the Priory School)

Cyklistická matematika

Předpokládejme, že vzdálenost os předního a zadního kola je L>0. V každém okamžiku platí, že přední kolo se dotýká země v místě, které dostaneme posunutím z bodu dotyku zadního kola o vzdálenost L ve směru tečny.

cyklista[L_,krivka_,tmin_,tmax_,pRange_]:=Module[{predni,zadni},
predni[u_]:=(krivka+L*D[krivka,t]/Norm[D[krivka,t]])/.t->u;
zadni[u_]:=(krivka/.t->u);
Manipulate[ParametricPlot[{predni[u],zadni[u]},{u,tmin+0.01,t},PlotStyle->{{Thick,Red},{Thick,Blue}},PlotRange->pRange,Epilog->{PointSize[Large],Point[{zadni[t],predni[t]}],Line[{zadni[t],predni[t]}]}],{t,tmin,tmax}]]

Příklad 1: Zadní kolo jede po kružnici o poloměru 1.

cyklista[1,{Cos[t],Sin[t]},0,2Pi,{{-2,2},{-2,2}}]

Cvičení: Jaký je poloměr kružnice, po které jede přední kolo?

Příklad 2: Zadní kolo jede po elipse.

cyklista[1,{Cos[t],0.5Sin[t]},0,2Pi,{{-2,2},{-2,2}}]

Příklad 3: Zadní kolo jede po parabole.

cyklista[1,{t,t^2},-2,2,{{-2,2},{-1,4}}]

Příklad 4: Zadní kolo jede po sinusoidě.

cyklista[1,{t,Sin[4t]/4},-Pi,Pi,{{-Pi,Pi+1},{-2,2}}]

Obrácená úloha

Známe-li dráhu předního kola, jak určit dráhu zadního kola? Tato úloha vede na řešení nelineární diferenciální rovnice (viz článek S. R. Dunbar, R. J. C. Bosman, S. E. M. Nooij, The Track of a Bicycle Back Tire. Mathematics Magazine, Vol. 74, No. 4 (Oct., 2001), pp. 273–287).

frontWheelPath[t_,{{P0:{X0_,Y0_},t0_},{P1:{X1_,Y1_},t1_}}]:=(t-t0)/(t1-t0) P1+(1-(t-t0)/(t1-t0)) P0;
rearWheelPath[t_,{{P0:{X0_,Y0_},t0_},{P1:{X1_,Y1_},t1_}},{x0_,y0_},L_]:=Module[{xf,yf,xb,yb,τ},{xf[τ_],yf[τ_]}=frontWheelPath[τ,{{P0,t0},{P1,t1}}];
{xb[t],yb[t]}/.NDSolve[{xb'[t]==1/L^2 (xf'[t] (xf[t]-xb[t])^2+yf'[t] (xf[t]-xb[t]) (yf[t]-yb[t])),yb'[t]==1/L^2 (yf'[t] (yf[t]-yb[t])^2+xf'[t] (yf[t]-yb[t]) (xf[t]-xb[t])),xb[t0]==x0,yb[t0]==y0},{xb,yb},{t,t0,t1}][[1]]];
frontAndRearWheelPathSegment[{{P0_,t0_},{P1_,t1_}},p0_,L_,n_]:=frontAndRearWheelPathSegment[{{P0,t0},{P1,t1}},p0,L,n]=With[{λ=Norm[P1-P0]},If[λ<10^-10,{{P0,p0}},Table[Evaluate[{frontWheelPath[t,{{P0,t0},{P1,t1}}],rearWheelPath[t,{{P0,t0},{P1,t1}},p0,L]}],{t,t0,t1,(t1-t0)/n}]]]//N//Developer`ToPackedArray;
bikePositions[{{P0_,t0_}},p0_,L_,n_]:={{P0,p0}};
bikePositions[positionTimeList_,p0_,L_,n_,frontAndRearWheelPathSegment_]:=Flatten[FoldList[frontAndRearWheelPathSegment[#2,#1[[-1,-1]],L,n]&,{{positionTimeList[[1,1]],p0}},Partition[positionTimeList,2,1]],1]//Developer`ToPackedArray;
Manipulate[DynamicModule[{frontWheelPathBag,loc={0,0},bikeData,Λ=2.5,T0=AbsoluteTime[],Tnew,frontAndRearWheelPathSegmentLocal},DownValues[frontAndRearWheelPathSegmentLocal]=DownValues[frontAndRearWheelPathSegment]/.frontAndRearWheelPathSegment->frontAndRearWheelPathSegmentLocal;
frontWheelPathBag={{{0.,0.},0.0}};
Column[{Column[{Button["start a new bike ride",frontWheelPathBag={{{0.,0.},0.0}};
loc={0,0};
DownValues[frontAndRearWheelPathSegmentLocal]={Last[DownValues[frontAndRearWheelPathSegmentLocal]]}]}],Dynamic@Deploy@Graphics[{bikeData=bikePositions[frontWheelPathBag,{-L,0},L,n,frontAndRearWheelPathSegmentLocal];
{GrayLevel[0.8],Thickness[0.0012],If[sb,Line[bikeData],{}]},{Darker[Blue],Point[bikeData[[-1,-1]]],Line[Last/@bikeData]},{Darker[Red],Opacity[0.66],Line[First/@frontWheelPathBag]},{Locator[Dynamic[loc,(Tnew=AbsoluteTime[];
If[Norm[frontWheelPathBag[[-1,1]]-#]>10.^-3&&Abs[frontWheelPathBag[[-1,2]]-Tnew]>10.^-3,AppendTo[frontWheelPathBag,{#,Tnew-T0}]];
If[Not[is],loc=#,loc=If[Max[Abs[#]]<Λ,#,{Max[Min[#[[1]],Λ],-Λ],Max[Min[#[[2]],Λ],-Λ]}]])&,UpdateInterval->0],Style["•",Darker[Red]]]}},PlotRange->Λ,PlotRangeClipping->True,Frame->True,FrameTicks->False,ImageSize->320,PlotLabel->Row[{"straight bike segments: ",Length[frontWheelPathBag]-1}]]}]],{{L,1,"wheel base"},0.01,3,ImageSize->Small},{{sb,False,"show bike positions"},{True,False}},{{n,4,"bikes per step"},1,24,1,ImageSize->Small},{{is,False,"restrict bike path to square"},{True,False}},ControlPlacement->Left,SaveDefinitions->True,AutorunSequencing->{1}]

Bicycle Rides ze stránek The Wolfram Demonstrations Project
http://demonstrations.wolfram.com/BicycleRides/
Autor: Michael Trott

Cesta na Měsíc

Úloha a obrázky převzaty z článku Andrew J. Simoson, Pursuit Curves for the Man in the Moone, College Mathematics Journal, 38(5), 2007, pp. 330-338.

Francis Godwin, The Man in the Moone (1638):
Astronaut je přivázán k hejnu labutí, které jej dopraví na Měsíc. Labutě se vznesou ze Země a míří stále 
k Měsíci, cesta trvá 12 dní. Jakou rychlostí musely labutě letět?

Perioda oběhu Měsíce kolem Země: p=27,3 dne

Lunární jednotka: 1 LU = 384 000 km (vzdálenost Země od Měsíce)
Poloměr Země: R=0.0167 LU

Matematická formulace úlohy:

Poloha Měsíce v čase t je M(t)=(Cos(2π t/p),Sin(2π t/p))

Počáteční poloha astronauta je X(0)=(R,0)

Rychlost labutí je rovna konstantě v (v jednotkách LU / den)

Je-li X(t) poloha astronauta v čase t, pak X'(t) je vektor délky v ve směru M(t)-X(t)

Module[{t,v, tmax, dirQ,p=27.3},
Manipulate[Module[{ R,tmaxfound=∞},
M[t_?NumericQ]:={Cos[((2 π t)/p)],Sin[((2 π t)/p)]};
 p=27.3;R=0.0167;
Show[sol=X[t] /. First@NDSolve[{X'[t]==((v (M[t]-X[t]))/(Norm[M[t]-X[t]])),X[0]=={R,0}},X[t],{t,0,tmax},Method->{"EventLocator","Event":>Norm[M[t]-X[t]]-0.01,"EventAction":>Throw[tmaxfound=t,"StopIntegration"]}];
LastPoint=sol /. t ->If[NumericQ[ tmaxfound], tmaxfound, tmax];
newtmax=Min[tmaxfound, tmax];
ParametricPlot[sol, {t, 0, newtmax}, PlotStyle -> Thickness[0.004]],
Graphics[{Thickness[0.004],Circle[],(*If[v<2π/p,{Red,Thickness[00.003],Dashed,Circle[{0,0},((v p)/(2 π))]}, {}],*)
{Blue,Disk[{0,0},R]},
{PointSize[0.03],{Darker[Green], Point[M[newtmax]]}, PointSize[0.02],Point[LastPoint]},
If[dirQ && Norm[LastPoint-M[newtmax]]> 0.015,{{Thickness[0.001], Line[{LastPoint,M[newtmax]}]},
Blue,Arrow[{LastPoint,LastPoint + v Normalize[(M[newtmax]-LastPoint)]}]},{}],
Text["Moon orbit", {0.85,0.8}], Text["Earth",{0.07,-0.07}], Text["Moon",M[newtmax]1.12]}],
Frame->True,FrameTicks->{{{-1,0,1}, {}},{{-1,0,1}, {}}}, BaseStyle->12,Axes->False, ImageSize->400, PlotRange-> 1.25,ImagePadding->15]], 
{{v, 0.15, "flying speed of swans [LU/day]"},0.01,0.3, Appearance->"Labeled"}, 
{{tmax, 0.1, "flight time [days]"}, 0.1, 100, Appearance->"Labeled"},
{{dirQ, True, "swan velocity vector"}, {True, False}}, TrackedSymbols->Manipulate]]

Flying to the Moon ze stránek The Wolfram Demonstrations Project
http://demonstrations.wolfram.com/FlyingToTheMoon/
Autor: Stan Wagon, Macalester College

384000*0.25/24