This representation implies that the climate obeys state boundaries, which is nonsense. I think a truer picture would result from creating a list of the centroids of the states, associating the temperature change data to these centroids, then create an Interpolation function bounded by the outer boundary of the US, then make a DensityPlot map of this interpolation, and then layer on the state boundaries if you must. You would hopefully eliminate goofy things like the jagged temperature change boundary across the central states.

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 suppose the following code would qualify for "compact" (tho it can certainly be compacted further), but tho I find it readable, other people might have different opinions:

(* U.S. states as Entity[] objects *)
continentalStates = 
           EntityList[EntityClass["AdministrativeDivision", "ContinentalUSStates"]];

(* abbreviated month names *)
months = Table[DateString[d, "MonthNameShort"], {d, DateRange[{0, 1}, {0, 12}, "Month"]}];

(* import data as a Dataset and add headers *)
ds = SemanticImport["ftp://ftp.ncdc.noaa.gov/pub/data/cirs/climdiv/climdiv-tmpcst-v1.0.0-20190408",
                    PadRight[{"String"}, 13, "Real"]];
ds = ds[All, AssociationThread[Prepend[months, "CODE"], Range[13]]];

(* per OP, select data corresponding to the continental states... *)
continentalStateData =
           ds[Select[Between[FromDigits[StringTake[#CODE, 3]], {1, 48}] &], All];

(* ...and then select data up to the past year *)
tempHistorical =
    continentalStateData[Select[FromDigits[StringTake[#CODE, -4]] <
                                DateValue[Now, "Year"] &]]

(* compute the weighted mean of the monthly temperatures;
   note the syntax for LeapYearQ[]! *)
meanTempHistorical = tempHistorical[All, <|"State" :> (FromDigits[StringTake[#CODE, 3]] &), 
                                           "MeanAnnualTemperature" :> 
         With[{ml = Slot /@ months}, 
         Function[Mean[WeightedData[ml,
                  {31, 28 + Boole[LeapYearQ[{FromDigits[StringTake[#CODE, -4]]}]], 
                   31, 30, 31, 30, 31, 31, 30, 31, 30, 31}]]]]|>];

(* moving average of mean annual temperatures *)
gwData = KeyMap[Indexed[continentalStates, #] &,
                Normal[meanTempHistorical[GroupBy["State"],
                With[{ma = MovingAverage[#, 10]}, Indexed[ma, -1] - Indexed[ma, -100]] &,
                     "MeanAnnualTemperature"]]];

GeoRegionValuePlot[gwData, PlotLabel -> "Temperature Rise Over 100 Years", 
                   PlotLegends -> SwatchLegend[Automatic,
                      {"0 °C", "1 °C", "2 °C", "3 °C"}, LegendFunction -> "Frame",
                      LegendLabel -> "Temp, °C"]]

I'll let someone else post the resulting picture, since my version of gedanken Mathematica does not have picture-rendering ability.

Hi John,

Nice analysis. I had to make a couple of changes to get it to work. Looks like the NOAA just has the most recent data on their FTP server. The latest data as of today is at ftp://ftp.ncdc.noaa.gov/pub/data/cirs/climdiv/climdiv-tmpcst-v1.0.0-20190408. I also had to change all of the Number in the SemanticImport to Real to avoid an odd error message:

MapThread::mptd: Object
Interpreter[Number][{0.00,-0.10,-0.20,0.20,-0.30,0.30,-0.40,0.40,-0.50,-0.60,0.60,-0.70,0.70,-0.80,0.80,-0.90,0.90,-1.00,1.00,10.00,-10.10,10.10,10.20,10.30,10.40,10.50,10.60,10.70,10.80,-10.90,10.90,1.10,11.00,11.10,11.20,11.30,11.40,11.50,11.60,11.70,-11.80,11.80,-11.90,11.90,-1.20,1.20,12.00,-12.10,12.10,12.20,<<731>>}] at position {2, 2} in
MapThread[Rule,{{0.00,-0.10,-0.20,0.20,-0.30,0.30,-0.40,0.40,-0.50,-0.60,0.60,-0.70,0.70,-0.80,0.80,-0.90,0.90,-1.00,1.00,10.00,-10.10,10.10,10.20,10.30,10.40,10.50,10.60,10.70,10.80,-10.90,10.90,1.10,11.00,11.10,11.20,11.30,11.40,11.50,11.60,11.70,-11.80,11.80,-11.90,11.90,-1.20,1.20,12.00,-12.10,12.10,12.20,<<731>>},Interpreter[Number][{<<1>>}]}]

has only 0 of required 1 dimensions.

Some observations

There is no need for ~Join~, associations implicitly join so this

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

is equivalent to

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

Another way to do the mapping from Region number to State entity

stateRegionMap = EntityList[
  EntityClass["AdministrativeDivision", "ContinentalUSStates"]] // 
 AssociationThread[Range[Length[#]], #] &    

tdata = tdata[All, <|#, "StateName" -> stateRegionMap[#Region]|> &]

Thanks Tim, this helps a lot!

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