Map Projection

Author

Eric W. Weisstein
February 19, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/MapProjections/MapProjection.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/MapProjection.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Initialization

<<MathWorld`MapProjections`

Globe

Show[Graphics3D[GlobePlot[]],Boxed->False,Lighting->False]

Projections

Projections

Add Airy, Hammer-Aitoff

Check Gnomonic

#[[1,1,1,0]]&/@DownValues[Projection]

Show[Graphics[ProjectionPlot[Projection[Bonne[]]]],AspectRatio->Automatic]

<<Miscellaneous`WorldPlot`

WorldPlot[World,
WorldProjection->Albers[0,60],WorldGridBehind->False,
WorldBorders->Red,WorldGridStyle->GrayLevel[.7]]

WorldPlot

Corrected Data

<<PolygonTriangulation`PolygonTessellation`;
<<PolygonTriangulation`SimplePolygonTriangulation`;

WorldData/:WorldData["Russia"]={{{2537,7842},{2600,7909},{2610,8108},{2907,8411},{3197,8485},{3259,8385},{3212,8239},{3259,8264},{3296,8113},{3554,8555},{3586,8977},{3534,9174},{3550,9311},{3593,9254},{3708,9449},{3706,9622},{3635,9608},{3668,9686},{3753,9796},{3747,9939},{3400,9357},{3053,9399},{3286,9727},{3372,9801},{3484,9716},{3602,9818},{3637,10153},{3595,10215},{3772,10619},{3737,10746},{3867,10691},{3881,10466},{3889,10769},{3985,-10751},{3855,-10391},{3942,-10371},{3968,-10183},{4028,-10421},{3978,-10468},{4193,10567},{4188,10233},{4125,10237},{4180,9746},{4112,9663},{4249,9555},{4247,9152},{4339,8896},{4300,8693},{4339,8816},{4341,8811},{4374,8439},{4288,8402},{4244,7861},{4414,7118},{4410,6809},{4357,6817},{4432,6678},{4367,6304},{4524,6823},{4605,6666},{4664,6244},{4583,6135},{4590,5929},{4510,6011},{4576,5928},
{4483,5152},(* {4379,5207},{4434,5207}, *)
{4414,4831},(* {4205,4990},{4303,4996}, *)
{4344,4711},{4295,4575},{4253,4707},{4294,4530},{4373,4500},{4225,4450},{4148,4428},{4134,4658},{4054,4743},
{4130,4593},(*{4139,4593},*)
{3973,4320},{4008,4138},{4063,4389},{4362,4370},{4360,4139},{4263,3997},{4099,4119},{4156,3903},{4100,3579},{4132,3193},{4012,2854},{4041,2695},{4108,2760},{4077,2648},{3952,2651},{3937,2391},{3872,2430},{3911,2211},{3829,2252},{3860,2120},{3873,2085},{3972,2050},{4030,1913},{3965,2278},{4032,2482},{4187,1847},{4188,1851},{4142,1741},{3775,1895},{3634,1671},{3598,1815},{3569,1682},{3469,1656},{3361,1686},{3350,1799},{3222,1903},{3124,1898},{3101,2033},{2971,2374},{2867,2396},{2827,2296},{2827,2363},{2800,2264},{2762,2314},{2711,2195},{2603,2400},{2563,2637},{2509,2778},{2473,2871},{2510,2915},{2671,2801},{2782,2953},{2965,2811},{3097,3064},{3067,3247},{3047,3653},{3246,3695},{3308,4238},{3227,4471},{3262,4638},{3086,4768},{3027,5012},{2946,5240},{2950,5271},{3052,5543},{2984,5840},{3129,5936},{3012,6199},{2960,6513},{2990,7003},{3001,7154},{3166,7202},{3205,7322},{3183,7537},{2988,7652},{2932,7840},{2862,7859},{2896,8084},{2707,7987},{2690,7857},{2545,7836},{2537,7842}},{{3320,1277},{3286,1373},{3242,1369},{3268,1178},{3297,1275},{3320,1277}},{{3189,8510},{2753,8525},{2782,8617},{2963,8595},{2918,8685},{3248,8581},{3189,8510}},{{3003,9314},{3047,9364},{3003,9314}},{{4433,8469},{4399,8609},{4433,8470}},{{4535,8790},{4508,9057},{4535,8790}},{{4488,8390},{4496,8622},{4531,8724},{4573,8324},{4516,8215},{4489,8404}},{{4677,5968},{4710,6322},{4766,6142},{4677,5967}},{{4755,5968},{4810,5852},{4773,5571},{4755,5967}},{{4307,3084},{4398,3226},{4390,3394},{4244,3458},{4308,3084}},{{4481,3419},{4402,3243},{4617,4110},{4481,3418}}};

WorldData/:WorldData["Mexico"]={{{1558,-5828},{1356,-5873},{1123,-5752},{1120,-5471},{1132,-5482},{1262,-5420},{1297,-5227},{1109,-5298},{1069,-5348},{1069,-5459},{966,-5426},{964,-5504},{873,-5535},
(*{905,-5567},{873,-5535},*)
{986,-5692},{958,-5867},{1100,-6209},{1195,-6327},{1352,-6343},{1538,-6564},{1738,-6730},{1874,-6785},{1917,-6902},{1697,-6772},{1388,-6571},{1484,-6726},{1664,-6901},{1711,-6844},{1952,-7027},{1963,-6883},{1880,-6543},{1907,-6391},{1760,-6243},{1757,-6050},{1584,-5945},{1558,-5828}}};

WorldData/:WorldData["USA"]={{{1952,-7027},{1980,-7037},{2074,-7237},{2251,-7349},{2281,-7285},{2336,-7422},{2520,-7451},{2777,-7444},{2904,-7483},
(*{2890,-7365},{2827,-7384},*)
{2939,-7365},{2940,-7364},{2940,-7022},{2940,-6962},{2940,-6240},{2940,-5832},{2880,-5375},{2792,-5048},{2581,-4945},{2553,-4959},{2501,-4962},{2575,-4735},{2586,-4744},{2596,-4744},{2669,-4548},{2701,-4401},{2701,-4290},{2718,-4265},{2848,-4154},{2711,-4032},{2584,-4245},{2572,-4249},{2491,-4267},{2490,-4268},{2491,-4267},{2479,-4311},{2460,-4419},{2431,-4455},{2337,-4491},{2400,-4502},{2388,-4526},{2307,-4502},{2281,-4522},{2228,-4557},{2278,-4539},{2311,-4574},{2375,-4550},{2283,-4579},{2328,-4621},{2334,-4624},{2290,-4628},{2225,-4576},{2239,-4637},{2193,-4551},{2147,-4531},{2203,-4556},{2157,-4604},{2137,-4545},{2132,-4623},{2093,-4580},{2032,-4713},{1921,-4853},{1843,-4890},{1607,-4802},{1507,-4865},{1795,-5021},{1817,-5251},{1823,-5304},{1811,-5371},{1809,-5426},{1803,-5362},{1736,-5365},{1800,-5628},{1799,-5627},{1672,-5851},{1558,-5828},{1584,-5945},{1757,-6050},{1760,-6243},{1907,-6391},{1880,-6543},{1963,-6883},{1952,-7027}},{{3355,-7800},{3286,-7841},{3366,-7861},{3345,-7936},{3568,-8120},{3492,-8109},{3603,-8370},{3677,-8863},{3591,-8979},{3557,-9119},{3690,-8955},{3523,-9207},{3360,-9506},{3288,-9800},{3450,-9444},{3549,-9407},{3533,-9609},{3519,-9730},{3642,-9713},{3588,-9820},{3654,-9813},{3687,-9901},{3695,-9972},{3793,-9865},{3811,-9669},{3896,-9659},{3939,-10088},{3996,-9857},{3959,-9708},{4017,-9749},{3984,-9614},{4101,-10010},{4212,-9704},{4284,-9388},{4179,-8461},{3618,-8460},{3588,-8128},{3355,-7801}},{{1216,-9349},{1172,-9288},{1135,-9340},{1216,-9349}},{{3480,-9196},{3446,-9140},{3441,-9288},{3480,-9196}}};

WorldData/:WorldData["Venezuela"]={{{512,-3599},{514,-3697},{566,-3651},{606,-3781},{645,-3711},{602,-3905},{641,-4098},{732,-4201},{686,-4188},{648,-4295},
(*{543,-4298},*)
{711,-4279},{551,-4403},{421,-4320},{372,-4047},{167,-4071},{73,-4012},{129,-3804},{257,-3888},{214,-3773},{256,-3691},{312,-3644},{357,-3683},{512,-3599}}};

World Data

world=WorldPlot[{World,RandomGrays},WorldProjection->Equirectangular];

polys=Cases[Graphics[world],_Polygon,∞];
Show[Graphics[{Hue[Random[]],#}&/@polys],Frame->True];

Union[First/@DeleteCases[Position[polys,_?(!FreeQ[#,Rational]&)],{}]]

polys1a = polys //. Polygon[ {a___, l1_, l2_, b___} ]:>
Polygon[{a,l1,b}]/; Max[Abs[l1-l2]] < 3;

polys1b=polys1a //. Polygon[ {l1_, a___, l2_} ]:> Polygon[{l1, a}]/; Max[Abs[l1-l2]] < 3;
Length[polys1b]

Select[polys1b,Length[#[[1]]]==1&]

polys1c=Select[polys1b,Length[#[[1]]]>1&];
Length[polys1c]

Tessellation

polys2=Table[Print[k];TessellatePolygons[polys1c[[k]]],{k,Length[polys1c]}];

Show[Graphics[{Hue[Random[]],#}&/@Flatten[polys2]],Frame->True];

Triangulation

polys3=Table[Print[k];TriangulateSimplePolygons[polys2[[k]]//N],{k,Length[polys2]}];

Show[Graphics[{Hue[Random[]],#}&/@polys3],Frame->True];

Show[Graphics[{Hue[Random[]],#}&/@Flatten[polys3]],Frame->True];

Problem Countries

Mexico

Show[Graphics[polys3[[164]]]]

mexico=Polygon/@Map[Reverse[If[#[[2]]<=0,#+{0,2 10769},#]]&,WorldData["Mexico"],{2}];

Show[Graphics[mexico]/.Polygon:>Line,AspectRatio->Automatic,Frame->True]

Show[Graphics[{
mexico/.Polygon:>Line}],Frame->True,AspectRatio->Automatic,PlotRange->{{-5750,-5250},{850,1000}}]

Define "corrected" coutry

mexico2=Polygon/@Map[Reverse[If[#[[2]]<=0,#+{0,2 10769},#]]&,WorldData["Mexico"],{2}];

Show[Graphics[{mexico2/.Polygon:>Line}],AspectRatio->Automatic,Frame->True,PlotRange->{{15750,16100},{800,1000}}]

Russia

Show[Graphics[polys3[[201]]]]

russia=Polygon/@Map[Reverse[If[#[[2]]<=0,#+{0,2 10769},#]]&,WorldData["Russia"],{2}];

Show[Graphics[russia]/.Polygon:>Line,AspectRatio->Automatic,Frame->True]

Show[Graphics[{russia/.Polygon:>Line,
PointSize[.02],
Point@Reverse@WorldData["Russia"][[1,#]]&/@{69,70,71,66,67,68,78,79,80,81,82}
}],AspectRatio->Automatic,Frame->True,PlotRange->{{4000,6000},{3800,4700}}]

Define "corrected" coutry

russia2=Polygon/@Map[Reverse[If[#[[2]]<=0,#+{0,2 10769},#]]&,WorldData["Russia"],{2}];

Show[Graphics[{russia2/.Polygon:>Line
}],AspectRatio->Automatic,Frame->True,PlotRange->{{4000,6000},{3800,4700}}]

USA

Show[Graphics[polys3[[244]]]]

usa=Polygon/@Map[Reverse[If[#[[2]]<=0,#+{0,2 10769},#]]&,WorldData["USA"],{2}];

Show[Graphics[usa]/.Polygon:>Line,AspectRatio->Automatic,Frame->True]

Show[Graphics[{usa/.Polygon:>Line,
PointSize[.02],
Point@{#[[2]]+2 10769,#[[1]]}&@WorldData["USA"][[1,#]]&/@{9,10}
}],AspectRatio->Automatic,Frame->True,PlotRange->{{14000,15000},{2600,3000}}]

Define "corrected" coutry

usa2=Polygon/@Map[Reverse[If[#[[2]]<=0,#+{0,2 10769},#]]&,WorldData["USA"],{2}];

Show[Graphics[{usa2/.Polygon:>Line}],AspectRatio->Automatic,Frame->True,PlotRange->{{14000,15000},{2600,3000}}]

Venezuela

Show[Graphics[polys3[[#]]&/@{252}],Frame->True]

venezuela=Polygon/@Map[Reverse[If[#[[2]]<=0,#+{0,2 10769},#]]&,WorldData["Venezuela"],{2}];

Show[Graphics[{venezuela/.Polygon:>Line,
PointSize[.02],
Point@{#[[2]]+2 10769,#[[1]]}&@WorldData["Venezuela"][[1,#]]&/@{9,10,11}
},AspectRatio->Automatic,Frame->True]]

Define "corrected" coutry

venezuela2=Polygon/@Map[Reverse[If[#[[2]]<=0,#+{0,2 10769},#]]&,WorldData["Venezuela"],{2}];

Show[Graphics[{venezuela2/.Polygon:>Line}],AspectRatio->Automatic,Frame->True]