World Chart 3D

extrude[pts_,h_]:=Module[{vb,vt,len=Length[pts],nh},
If[!NumericQ[h],nh=0.,nh=N@h];
vb=Table[{pts[[i,1]],pts[[i,2]],0},{i,len}];
vt=Table[{pts[[i,1]],pts[[i,2]],nh},{i,len}];
GraphicsComplex[Join[vb,vt],
{Polygon[Range[len]],
Polygon[Append[Table[{i,i+1,len+i+1,len+i},{i,len-1}],{len,1,len+1,2len}]],
Polygon[Range[len+1,2len]]}
]]

Manipulate[Module[{co=CountryData[],props,min,max,coords},
props=N[CountryData[#,p]&/@co/.Missing[_]:>0.];
min=Min[props];max=Max[props];
coords=(First@CountryData[#,{"SchematicPolygon","Robinson"}]&)/@co;
Style[
Grid[{{
Framed[Graphics3D[{
EdgeForm[],
Polygon[{{-240,-120,min},{240,-120,min},{240,120,min},{-240,120,min}},VertexColors->{RGBColor[0.6,0.6,1.],RGBColor[0.6,0.6,1.],LightGray,LightGray}],
Table[{
Darker[ColorData[col][1.-(props[[i]]-min)/(max-min)],.2],
extrude[#,props[[i]]]&/@coords[[i]]},{i,Length[co]}]
},BoxRatios->{2,1,.2},Boxed->False,Lighting->"Neutral",ImageSize->{400,250},
ViewAngle->.15,ViewPoint->{0,-2,2}],FrameStyle->LightGray,FrameMargins->None],
SpanFromLeft,SpanFromLeft,SpanFromLeft,SpanFromLeft,SpanFromLeft,SpanFromLeft},
{Spacer[{1,20}],SpanFromLeft,SpanFromLeft,SpanFromLeft,SpanFromLeft,SpanFromLeft,SpanFromLeft},
With[{mc=First@Extract[co,Position[props,max]]},
{Spacer[5],"Max. "<>p<>":",Style[max,Bold],Spacer[20],"Country:",Style[mc,Bold],Show[CountryData[mc,"Flag"],ImageSize->30]}]
},Alignment->{{{Center},Left}}],
10,FontFamily->"Helvetica"]
],
{{p,"Population","property"},{"ArableLandFraction","BirthRateFraction","GDP","GDPPerCapita","HIVAIDSFraction","InternetUsers","MilitaryExpenditureFraction","OilConsumption","Population","PopulationGrowth","UnemploymentFraction"}},
{{col,"SolarColors","colors"},Table[g->Show[ColorData[g,"Image"]/.Raster[x__]:>Rotate[Raster[x],Pi],ImageSize->50],{g,{"SolarColors","DeepSeaColors","LakeColors","StarryNightColors","BlueGreenYellow"}}]},
SaveDefinitions->True]

Discover various facts about countries in a 3D chart.

Contributed by: Yu-Sung Chang