G2A Many GEOs
SHARE
TWEET

xkcd consensus new year

user42582 Jan 4th, 2019 28 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. BeginPackage["prepPopYYYY`"]
  2.  
  3. plotPopYYYY::usage="plotPopYYYY[year, zone] retuns a plot and Missing[\"NotAvailable\"] when there are no available \"Population\" 'CountryData' for the input 'year'.";
  4.  
  5. Begin["`Private`"]
  6.  
  7. entry[name_,zone_,pop_]:=<|
  8. "name"->name,
  9. "zone"->zone,
  10. (* population density per zone *)
  11. "density"->pop
  12. |>
  13.  
  14. makeEntry[entity_,year_]:=Module[{zones=CountryData[entity,"TimeZones"],name=CountryData[entity,"Name"],pop},
  15. (* obvious oversimplification: population uniformly distributed over time zones in each country *)
  16. pop=If[
  17. (* is population missing for requested year? *)
  18. MissingQ[#],
  19. (* then return Missing *)
  20. #,
  21. (* else calc population density per zone *)
  22. #/Quantity[Length[zones],IndependentUnit["zone"]]//N
  23. ]&@CountryData[entity,{"Population",year}];
  24.  
  25. Select[entry[name,#,pop]&/@zones,FreeQ[#,Missing]&]
  26. ]
  27.  
  28. entriesByZone[year_]:=Module[{zf=#["zone"]&},
  29. (* sort (east to west) and gather up entries by zone *)
  30. GatherBy[
  31. SortBy[
  32. Flatten[makeEntry[#,year]&/@CountryData[]],(-zf[#]&)],zf]
  33. ]
  34.  
  35. (* --- *)
  36.  
  37. summaryEntry[countries_,count_,zone_,density_]:=<|
  38. "countries"->countries,
  39. "n"->count,
  40. "zone"->zone,
  41. "density"->density
  42. |>
  43.  
  44. (* input: list of entries by zone *)
  45. makeSummary[entries_List]:=Module[{countries,count,density,iCountries,zone},
  46. (* list of countries in the zone *)
  47. countries=Query[All,"name"][entries];
  48. count=Length[countries];
  49. (* population density by zone *)
  50. density=Query[Total,"density"][entries]Quantity[1,IndependentUnit["zone"]];
  51.  
  52. iCountries=Iconize[countries,"countries"];
  53. (* all entries are from the same zone... *)
  54. zone=Query[1,"zone"][entries];
  55.  
  56. (* output *)
  57. summaryEntry[iCountries,count,zone,density]
  58. ]
  59.  
  60. (* --- *)
  61.  
  62. accumulatedEntry[count_,zone_,density_,time_,y_]:=<|
  63. "n"->count,
  64. "zone"->zone,
  65. "density"->density,
  66. "time"->time,
  67. "y"->y
  68. |>
  69.  
  70. accumulateByZone[summary_,year_,zone_]:=Module[{entry,density,time,y,total},
  71.  
  72. (* total population *)
  73. total=Query[Total,"density"][summary];
  74.  
  75. density=Quantity[0,"People"];
  76. time={year,12,31,23,0,0};
  77. y=Quantity[0,"Percent"];
  78.  
  79. entry=accumulatedEntry[0,zone,density,time,y];
  80.  
  81. FoldList[
  82. accumulatedEntry[
  83. (* number of countries *)
  84. #1["n"]+#2["n"],
  85. (* zone *)
  86. #2["zone"],
  87. (* population density per zone - in persons *)
  88. #1["density"]+#2["density"],
  89. (* time *)
  90. DatePlus[#1["time"],{#1["zone"]-#2["zone"],"Hours"}],
  91. (* y *)
  92. Quantity[100(#1["density"]+#2["density"])/total ,"Percent"]
  93. ]&,entry,summary]//Rest
  94. ]
  95.  
  96. (* --- *)
  97.  
  98. plotPopYYYY[YEAR_:2009,ZONE_:2]:=Module[{s,offset,a,d,t,y,tfst,tlst,t50,tmdn,xticks,yticks,label,tspec},
  99.  
  100. s=makeSummary/@entriesByZone[YEAR-1];
  101.  
  102. (* check if there are available data *)
  103. If[
  104. s=!={},
  105.  
  106. offset=Query[1,"zone"][s]+1;
  107.  
  108. a=accumulateByZone[s,YEAR-1,offset];
  109. d=Values@Query[All,{"time","y"}][a];
  110. {t,y}=Transpose[d];
  111.  
  112. t=DatePlus[#,{ZONE-(offset-1),"Hours"}]&/@t;
  113.  
  114. d=Transpose[{t,y}];
  115.  
  116.  
  117. {tfst,tlst}=Through[{#[[1]]&,#[[-1]]&}[t]];
  118.  
  119. t50=First[Query[Select[#[[-1]]>=Quantity[50,"Percent"]&],First][d]];
  120.  
  121. tmdn={YEAR-1,12,31,24,0,0};
  122. xticks={tfst,t50,tmdn,tlst};
  123.  
  124. yticks=Quantity[#,"Percent"]&/@{0,50,100};
  125.  
  126. label=StringTemplate["PERCENTAGE OF WORLD'S POPULATION LIVING IN `Y` (UTC`Z`)"];
  127.  
  128. tspec={"Hour12",":","Minute", "AMPM","\n","MonthNameShort"," ","Day","\n","Year"};
  129.  
  130. DateListPlot[
  131.  
  132. d,
  133.  
  134. PlotStyle->Thick,
  135. DateTicksFormat->tspec,
  136. FrameTicksStyle->Directive[Large],
  137. FrameTicks->{{yticks,None},{xticks,None}},
  138. GridLines->{Automatic,yticks},
  139. FrameLabel->{{None,None},{None,label[<|"Y"->YEAR,"Z"->ZONE|>]}},
  140. FrameStyle->Directive[Large],
  141. PlotRange->Full,
  142. ImageSize->Full
  143. ],
  144.  
  145. (* report no data available *)
  146. Missing["NotAvailable"]
  147.  
  148. ]
  149.  
  150. ]
  151.  
  152. End[]
  153.  
  154. EndPackage[]
RAW Paste Data
Ledger Nano X - The secure hardware wallet
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top