Group Abstract Group Abstract

Message Boards Message Boards

Help with Halloween costumes

Every year our family makes costumes, and this time we are making "the world" and an "oak tree". Does anyone have any ideas for doing these in Wolfram Language?

Maybe for the world, I am thinking of projecting the map of the world onto two halves of an icosahedron. One half attached to the front of a shirt and the other half attached to the back. I am close on this part, but maybe it has become too complicated. Something Is wrong here, and this approach also involves more cutting and taping than I would prefer.

ToMapCoordinates[v_] := N[ToPolarCoordinates[v][[{3, 2}]]/Degree]
verts = Map[ToMapCoordinates,  PolyhedronData["Icosahedron", "VertexCoordinates"]];
GeoTriangle[{a_, b_, c_}] := GeoGraphics[Polygon[{a, b, c}]]
GeoTriangle[verts[[#]]] & /@  PolyhedronData["Icosahedron", "FaceIndices"]

For the oak tree, I was trying to make oak leaves and acorns using PolarPlot. Does anyone have an Oak leaf? Here is my attempt at an acorn.

PolarPlot[1.4 - CubeRoot[1 + Sin[x]], {x, 0, 2 Pi}]

acorn
POSTED BY: Todd Rowland
10 Replies
Sort By:

Does anyone have an Oak leaf?

Note: WolframAlpha has popular curves, but no leaf curves, seemingly ... but right now leafs are popular.

First shot: Get an oak leaf from the web

enter image description here

now get it's outline

In[23]:= pic = Import[FileNameJoin[{NotebookDirectory[], "test", "oak-leaf1.jpg"}]]

In[36]:= Export[FileNameJoin[{NotebookDirectory[], "test", "oak-edge.png"}], EdgeDetect[ColorNegate[pic]]]
Out[36]= "N:\\Udo\\Abt_N\\test\\oak-edge.png"

In[39]:= Clear[pic2]
pic2 = Import[FileNameJoin[{NotebookDirectory[], "test", "oak-edge.png"}], "Data"]

In[62]:= toddLeaf[p_?MatrixQ] := 
 Block[{o1 = Length[p], o2 = Length[First[p]], l, ll = {}, cr, lr = {}},
   For[i1 = 1, i1 <= o1, i1++,
    l = p[[i1]];
    cr = 0;
    For[i2 = 1, i2 <= o2 && cr == 0, i2++,
     cr = l[[i2]]
    ];
    If[i2 < o2,
     ll = Join[ll, {{i1, i2}}]
    ];
    cr = 0;
    For[i2 = o2, i2 >= 1 && cr == 0, i2--,
     cr = l[[i2]]
    ];
    If[i2 > 1,
     lr = Join[lr, {{i1, i2}}]
    ]
   ];
   Flatten[{Reverse[lr], ll}, 1]
  ] /; Union[Flatten[p]] == {0, 1}

In[63]:= Graphics[Line[toddLeaf[pic2]]]

to see

enter image description here

it does not follow the fingers inwards because only the first and the last 1 on a row has been stored ... room for improvement ... but this way each leaf half is a function over x which can be used for further work on it.
POSTED BY: Udo Krause

This is going to go much easier

pic = Import[FileNameJoin[{NotebookDirectory[], "test", "oak-leaf1.jpg"}]]
Export[FileNameJoin[{NotebookDirectory[], "test", "oak-edge.png"}], EdgeDetect[ColorNegate[pic]]]

Clear[pic3, pts, sTour]
pic3 = Import[FileNameJoin[{NotebookDirectory[], "test", "oak-edge.png"}]];
pts = PixelValuePositions[pic3, 1];
sTour = FindShortestTour[pts];
Graphics[Line[pts[[Last[sTour]]]]]

giving a real graphical Oak leaf

enter image description here

if one searches for two points with the greatest position difference on sTour but the smallest euclidean distance it is possible to cut the inner part of the tour out to get the contour.
POSTED BY: Udo Krause

If you don't mind me asking, what is the reason/purpose for this 'study'? I too have an interest in this field, as well as the microscopic anatomical images of different plants for the purpose of identification of unknown plants vs. 'Authentic' plants.

I am new to this Community, so am not sure if this is an appropriate inquiry, forgive me if not.

Sidney
POSTED BY: Sidney Sudberg

Ok, here is the trig polynomial. First get rid of the inner structure with a little unprofessional hand testing

Graphics[{Line[pts[[Last[sTour]]]], {Red, 
   Disk[pts[[Last[sTour][[1]]]], 7]}, {Blue, 
   Disk[pts[[Last[sTour][[4170]]]], 10]}, {Green, 
   Disk[pts[[Last[sTour][[1028]]]], 7]}}]

enter image description here

showing the outline is approximately

Clear[sOak]
sOak = Join[Take[Last[sTour], {1, 1028}], Take[Last[sTour], {4170, Length[Last[sTour]]}]];
Graphics[Line[pts[[sOak]]]]

Now one makes usage of Michael Trott's blog post Making Formulas… for Everything—From Pi to the Pink Panther to Sir Isaac Newton. Copied the relevant functions right off the CDF file of this post, calling them

fCs = fourierComponents[{pts[[sOak]]}, "OpenClose" -> Table["Closed", {Length[{pts[[sOak]]}]}]];
ParametricPlot[Evaluate[makeFourierSeries[#, t, 100] & /@ Cases[fCs, {"Closed", _}]], {t, -Pi, Pi}]

and the result is

enter image description here

pretty well shaped, I would say; and this is the Fourier series

Short[makeFourierSeries[#, t, 100] & /@ Cases[fCs, {"Closed", _}], 20]

must be given as picture because of the box formatting issues

enter image description here

Without Michael's functions you have a really bad time; most other explanations all over the web do not work very well.

Have fun with your family fête - the notebook is appended.

Consider to include the leaf curves into WolframAlpha if this is something people like to do at this time in the year.

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard
Be respectful. Review our Community Guidelines to understand your role and responsibilities. Community Terms of Use