The world was not as easy as I expected. Here are the steps I took to map it into the flattened icosahedron so I can print it out, cut it out, fold it and tape it to my shirt for Halloween.

Start out with the world in lat-long.

world2d = CountryData["World", "Polygon"];

Convert to 3d.

world3d = N[world2d[[1, 1]]] /. {x_Real, y_Real} :> ({Cos[#2] Cos[#], Sin[#2] Cos[#], Sin[#]} &[x*Degree,  y*Degree]);

Some modified data from PolyhedronData giving the two and three dimensional coordinates of the vertices and face indices.

v3 = PolyhedronData["Icosahedron", "VertexCoordinates"];
i3 = PolyhedronData["Icosahedron", "FaceIndices"];
f3 = v3[[#]] & /@ i3;
v2 = PolyhedronData["Icosahedron", "NetCoordinates"];
i2b = {{1, 6, 7}, {13, 6, 12}, {2, 7, 8}, {14, 7, 13}, {3, 8, 9}, {15, 8, 14}, {4, 9, 10}, {16, 9, 15}, {5, 10, 11}, {17, 10, 16}, {6, 13, 7}, {13, 12, 18}, {7, 14, 8}, {14, 13, 19}, {8, 15, 9}, {15, 14, 20}, {9, 16, 10}, {16, 15, 21}, {10, 17, 11}, {17, 16, 22}}
f2b = v2[[#]] & /@ i2b;
f3tof2b = {1, 3, 5, 7, 9, 18, 20, 12, 14, 16, 11, 13, 15, 17, 19, 8, 10, 2, 4, 6};

Convert 3d coordinates to the face index and local face 2d coordinates.

FacePlanes =  Apply[Function[{a, b, c}, {Cross[a, b], Cross[b, c], Cross[c, a]}],  N@f3, {1}];
FaceMeans = Apply[Function[{a, b, c}, Mean[{a, b, c}]], N@f3, {1}];
FaceInverses = Apply[Function[{a, b, c}, Inverse[{Mean[{a, b, c}], b - a, c - a}][[All, 2 ;; 3]]], N@f3, {1}];
FaceCoord[p_] := With[{coords = Select[Table[{i, FacePlanes[[i]].p}, {i, 20}], Min[#[[2]]] >= 0 &,1][[1]]}, 
{coords[[1]],  p.FaceInverses[[coords[[1]]]] (.571175/(p.FaceMeans[[coords[[1]]]]))}]

worldpattern0 = world3d /. {x_Real, y_Real, z_Real} :> FaceCoord[{x, y, z}];

Convert the index plus coordinates to the plane. Also split the lists of coordinates so that lines don't cross faces weirdly.

ProjCoord[{ind_, {x_, y_}}] := x (#2 - #) + y (#3 - #) + Mean[{##}] & @@ f2b[[f3tof2b[[ind]]]]

worldpattern1b = worldpattern0 /. list : {{_Integer, {__Real}} ..} :> Map[ProjCoord[#] {1, -1} &, SplitBy[list, First], {2}];

And finally,

Graphics[{Line /@ worldpattern1b, {Red, Point[{1, -1} # & /@ v2]}}]

Just cut the shape out, fold between the red dots which are the vertices, and tape it together. Does anyone know how to find a map of the Moon or Mars or Pluto?

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

Thanks, I am sure it will be fun. Every holiday should have a little math, and Halloween especially for anything scary (Some say math is scary, hah).

Udo, do you have a link to any Wolfram Alpha leaf shapes?

Next I need to make the world. Maybe I will try a stereographic projection onto the faces of the icosahedron instead of relying on the defaults.

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

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

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

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.

Attachments:

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

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.