SHARE
TWEET

xkcd consensus new year

user42582 Jan 4th, 2019 26 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
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