Muestre las poblaciones alrededor de parques de diversiones 

Indique el área alrededor de cada parque de diversiones en los Estados Unidos que contenga cerca de dos millones de personas.

muestre la entrada completa de Wolfram Languageoculte la entrada

In[1]:=

X allUSZIPCodes = EntityList[EntityClass["ZIPCode", {"Country", "UnitedStates"}]];

In[2]:=

X population = EntityValue[allUSZIPCodes, "Population"];

In[3]:=

X coordinates = EntityValue[allUSZIPCodes, "Position"];

In[4]:=

X data = Select[Transpose[{allUSZIPCodes, coordinates, population}], FreeQ[#, _Missing] &];

In[5]:=

X data3D = {GeoPositionXYZ[#[[2]]][[1]], #} & /@ data;

In[6]:=

X amusementParks = EntityValue["AmusementPark", "Entities"];

In[7]:=

X amusementParksUS = Cases[Transpose[{amusementParks, EntityValue[amusementParks, EntityProperty["AmusementPark", "Country"]]}], {_, Entity["Country", "UnitedStates"]}];

In[8]:=

X amusementParksUSCoords = Select[Transpose[{First /@ amusementParksUS, EntityValue[(First /@ amusementParksUS), EntityProperty["AmusementPark", "Position"]]}], FreeQ[#, _Missing, \[Infinity]] &];

In[9]:=

X interpolateDistance[{pos_, pop_}, {{pos1_, pop1_}, {pos2_, pop2_}}] := With[{dist1 = GeoDistance[pos, pos1], dist2 = GeoDistance[pos, pos2]}, (dist1 pop - dist2 pop + dist2 pop1 - dist1 pop2)/(pop1 - pop2)]

In[10]:=

X populationRadius[{ap_, pos_}, pop_] := Module[{pos3D, sortedZIPCodes, sortedZIPCodes2, accumulatedPop, posPop, accumulatedPopReduced}, pos3D = GeoPositionXYZ[pos][[1]]; sortedZIPCodes = SortBy[data3D, EuclideanDistance[pos3D, #[[1]]] &]; sortedZIPCodes2 = {#2[[2]], QuantityMagnitude[#2[[3]]]} & @@@ sortedZIPCodes; accumulatedPop = Transpose[{#1, Accumulate[#2]} & @@ Transpose[sortedZIPCodes2]]; posPop = Position[accumulatedPop, {_, _?(# >= pop &)}, {1}, 1 ]; accumulatedPopReduced = Take[accumulatedPop, Max[posPop]]; interpolateDistance[{pos, pop}, Take[accumulatedPopReduced, -2]] ]

In[11]:=

X Monitor[disks = Table[Tooltip[GeoDisk[amusementParksUSCoords[[j, 2]], populationRadius[amusementParksUSCoords[[j]], 2*10^6]], amusementParksUS[[j, 1]]], {j, Length[amusementParksUSCoords]}];, j]

In[12]:=

X GeoGraphics[{GeoStyling[], {Opacity[0.4], RandomColor[], #} & /@ disks}, GeoRange -> Entity["Country", "UnitedStates"]]

In[337]:=