Climate Change in the United States

Posted 12 days ago
244 Views
|
4 Replies
|
6 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] 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
Sort By:
Posted 12 days ago
 The figure above is lacking the legend, which actually is a separate graphic:
Posted 12 days ago
 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]]