3
$\begingroup$

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

enter image description here

and how to get the following graph from initial image?

enter image description here

$\endgroup$
  • 5
    $\begingroup$ This is related. $\endgroup$ – J. M. will be back soon Feb 28 '16 at 7:53
  • 2
    $\begingroup$ 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. $\endgroup$ – kirma Feb 28 '16 at 17:32
  • $\begingroup$ @kirma Yup, as I found out here. $\endgroup$ – C. E. Feb 29 '16 at 1:27
8
$\begingroup$

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]];

enter image description here

$\endgroup$
4
$\begingroup$
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"]

Mathematica graphics

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]

Mathematica graphics

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

Mathematica graphics

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