# Fibonacci spiral in sunflower

How to find and detect the Fibonacci spiral in sunflower image?

and how to get the following graph from initial image?

• This is related. – J. M. will be back soon Feb 28 '16 at 7:53
• Claiming that patterns on sunflower seeds (or many other things in nature) would be specifically Fibonacci spirals is a bit of hype. Similar they may be, but those processes don't necessarily converge to this single pattern. – kirma Feb 28 '16 at 17:32
• @kirma Yup, as I found out here. – C. E. Feb 29 '16 at 1:27

## 2 Answers

Just for fun:

fun[r_, p_, t_] := r {Cos[2 Pi t/p], Sin[2 Pi t/p]}
fb[n_, t_, col_] :=
Module[{tab, a = Fibonacci[n], b = Fibonacci[n - 1]},
tab = Table[
Line[{fun[1, a, j], fun[1, b, j]}], {j, 0, LCM[a, b],
LCM[a, b]/t}];
Graphics[{col, Disk[{0, 0}, 1], White, tab}, Background -> Black,
ImageSize -> 400]]


Visualizing:

res = Column[{Row[{"{", Fibonacci[#], ",", Fibonacci[# - 1], "}"}],
fb[#, 1000, Red]}] & /@ Range[4, 10];
grid = Grid[Partition[res, 3]];


i0 = Import@"http://i.stack.imgur.com/3cOud.jpg";
i1 = ImageCrop[i0, 380, {Left, Bottom}];
i2 = ColorConvert[ImageResize[i1, 200], "GrayScale"] // ImageAdjust;
i3 = ImageMultiply[
ImageMultiply[i2,
ImagePad[
ImageResize[Graphics[{White, Disk[]}, Background -> Black],
ImageDimensions@i2/1.2], First@ImageDimensions@i2]],
ImagePad[ImageResize[Graphics[{Disk[]}], ImageDimensions@i2/2],
First@ImageDimensions@i2, Padding -> White]];
i4 = ColorConvert[i3, "Grayscale"]


cents = # - ImageDimensions@i4/2 & /@
ComponentMeasurements[Erosion[MorphologicalBinarize[i4, .6], 1],
"Centroid"][[All, 2]];

rot[ang_, pts_] := RotationTransform[ang] /@ pts

f = Nearest[cents];

ListPlot[{cents, rot[0, cents]}, AspectRatio -> 1]


cross[{a_, b_}] := Sign@Last@Cross[Join[a, {0}], Join[#, {0}]] & /@ b
dist[{a_, b_}] := If[Norm@# > Norm@a, 1000, Norm[a - #]] & /@ b

lines[i_] :=
Transpose[{Last /@
First /@ (SortBy[#, #[[2]] &] & /@ (Select[#, #[[1]] ==
i &] & /@ (Transpose[{cross@#,
dist@#, #[[2]]}] & /@ ({#, Rest@f[#, 7]} & /@
cents)))), cents}];

GraphicsRow[ ColorCombine[{i4,
ColorNegate@ ImageResize[ Graphics[{Thick, Line /@ lines[#]},
PlotRange -> {{-100, 100}, {-100, 100}},
AspectRatio -> 1], {200, 201}]}] & /@ {1, -1}]