Message Boards Message Boards

GROUPS:

Climate Change in the United States

Posted 2 months ago
572 Views
|
4 Replies
|
8 Total Likes
|

The U.S. National Oceanic and Atmospheric Administration produces large datasets containing long-term time series of weather data for various geographical regions of the United States. I decided to use the most recent file of monthly average temperatures ("climdiv-tmpcst-v1 .0.0-20181204") to produce a map of climate change by State. The code works, but as there are often many ways to do the same thing in the Wolfram Language, I would be very interested to know if anyone can suggest faster, more compact or more readable methods of doing what I am doing here.

I begin by reading in the file,which consists of 13 space-delimited fields. The first encodes the region and year, and the next 12 are monthly average temperatures in degrees Fahrenheit. Additional information about the data is provided in ftp://ftp.ncdc.noaa.gov/pub/data/cirs/climdiv/state-readme.txt.

tdata = SemanticImport[
   "ftp://ftp.ncdc.noaa.gov/pub/data/cirs/climdiv/climdiv-tmpcst-v1.0.\
0-20181204", {"String", "Number", "Number", "Number", "Number", 
    "Number", "Number", "Number", "Number", "Number", "Number", 
    "Number", "Number"}];

The file has no headers, so I add some:

tdata = tdata[
   All, <|"Code" -> 1, "Jan" -> 2, "Feb" -> 3, "Mar" -> 4, 
    "Apr" -> 5, "May" -> 6, "Jun" -> 7, "Jul" -> 8, "Aug" -> 9, 
    "Sep" -> 10, "Oct" -> 11, "Nov" -> 12, "Dec" -> 13|>];

Next I add two columns to the dataset: "Region", which corresponds to the first three characters of the Code field, and "Year", which corresponds the last four digits of the Code:

tdata = tdata[
   All, #~Join~<|"Region" -> ToExpression[StringTake[#Code, 3]], 
      "Year" -> ToExpression[StringTake[#Code, -4]]|> &];

I then add "Tavg", the average annual temperature, which is a weighted average of the monthly temperatures. For the sake of accuracy I also account for leap years:

tdata = tdata[
   All, #~Join~<|
      "Tavg" -> (31*#Jan + 31*#Mar + 30*#Apr + 31*#May + 30*#Jun + 
          31*#Jul + 31*#Aug + 30*#Sep + 31*#Oct + 30*#Nov + 
          31 + #Dec + If[LeapYearQ[#Year], 29, 28]*#Feb)/
        If[LeapYearQ[#Year], 366, 365]|> &];

Region codes 1 through 48 correspond to the contiguous States. I am only interested in these, and in the years prior to 2018 (since the data is not yet complete for last year):

tdata = tdata[Select[#Region <= 48 && #Year < 2018 &]];

Next, I extract just the region code, the year and the average temperature:

tdata = tdata[All, {"Region", "Year", "Tavg"}];

This is a list of the 48 contiguous states:

contiguous = {"Alabama", "Arizona", "Arkansas", "California", 
   "Colorado", "Connecticut", "Delaware", "Florida", "Georgia", 
   "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", 
   "Louisiana", "Maine", "Maryland", "Massachusetts", "Michigan", 
   "Minnesota", "Mississippi", "Missouri", "Montana", "Nebraska", 
   "Nevada", "NewHampshire", "NewJersey", "NewMexico", "NewYork", 
   "NorthCarolina", "NorthDakota", "Ohio", "Oklahoma", "Oregon", 
   "Pennsylvania", "RhodeIsland", "SouthCarolina", "SouthDakota", 
   "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington", 
   "WestVirginia", "Wisconsin", "Wyoming"};

Given this list, we can add a new column containing Entity values for each of the States:

tdata = tdata[
   All, #~Join~<|
      "StateName" -> 
       Entity["AdministrativeDivision", {contiguous[[#Region]], 
         "UnitedStates"}]|> &];

There are of course any number of ways to characterize climate change. First, since annual average temperatures are somewhat noisy we need some type of smoothing. Here I chose a moving average with a window of ten years and plotted the change in the smoothed temperature over the past 100 years:

f[s_List] := 
 Module[{ma}, ma = MovingAverage[s, 10]; (Last[ma] - ma[[-100]])]

s = tdata[GroupBy["StateName"], f, "Tavg"];

GeoRegionValuePlot[s]

Change in average annual temperature over the past century in degrees Fahrenheit

The figure shows that over the past century, the southern states experienced the least warming, with more warming as one proceeds outward to the north, west and east. This is generally in line with other maps I have seen.

Questions: How do I put a title on this map? How do I label the legend?

Attachments:
4 Replies

The figure above is lacking the legend, which actually is a separate graphic: legend

Does this help point you in the right direction?

legend = SwatchLegend[
   Automatic, {"0\[Degree]C", "1\[Degree]C", "2\[Degree]C", 
    "3\[Degree]C"}, 
   LegendMarkers -> 
    Graphics[{EdgeForm[Black], Opacity[1], Rectangle[]}], 
   LegendLabel -> "Temp \[Degree]C", 
   LegendFunction -> (Framed[#, RoundingRadius -> 5] &), 
   LegendMargins -> 5];
GeoRegionValuePlot[s, Frame -> True, FrameTicks -> None, 
 FrameLabel -> {"Bottom Title", "Left Title", "Top Title", 
   "Right Title"}, PlotLegends -> Placed[legend, Right]]

Title Climate Map

Thanks Tim, this helps a lot!

I would be very interested to know if anyone can suggest faster, more compact or more readable methods of doing what I am doing here.

Not if you value your time in making such an alternate thing.

Maybe you should specify Hz if you need a framerate speed you are trying to reach.

You may experience delays with downloading map data from the wolfram server ... the answer there is to look into getting your own copy or speeding that up. It's pretty new how that all works and wolfram has been investigating ways to get the best of both worlds of convenience and options.

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract