# [GIF] Visualising climate change with a spiral animation

Posted 6 years ago
12275 Views
|
3 Replies
|
10 Total Likes
|
 I recently came across an article which features a visualisation of the change of the average global temperature. The data to reproduce that visualisation is readily available, and so it is quite straight forward to generate the animation in Mathematica. The data for this animation is imported like so: tempdata = Transpose[{Interpreter["Date"][#[[All, 1]]], #[[All, 2]]}] &@ Import["http://www.metoffice.gov.uk/hadobs/hadcrut4/data/current/time_series/HadCRUT.4.4.0.0.monthly_ns_avg.txt", "Data"]; Let's first generate the final frame: Show[ListLinePlot[#[[1]]*{Cos[-#[[2]] + Pi/2], Sin[-#[[2]] + Pi/2]} & /@ Transpose[{(Abs[#] + 1)^Sign[#] & /@ tempdata[[All, 2]], Mod[Pi/6 Range[0, 1994], 2 Pi]}][[1 ;; 1994]], AspectRatio -> 1, Background -> Black, Axes -> None, ColorFunction -> Function[{x, y}, ColorData["Temperature"][0.35 Norm[{x, y}]^2.2]], PlotRange -> {{-4, 4}, {-4, 4}}, ColorFunctionScaling -> False, ImageSize -> Large, Epilog -> {White, Text[Style[(Normal@tempdata[[1994, 1]])[[1]], 22], {-3.5, 3.5}]}], Graphics[{Function[{x, y}, ColorData["Temperature"][0.35 Norm[{x, y}]^2.2]][2.5, 0], Thickness[0.005], Circle[{0, 0}, 2.5]}], Graphics[{Function[{x, y}, ColorData["Temperature"][0.35 Norm[{x, y}]^2.2]][3, 0], Thickness[0.005], Circle[{0, 0}, 3]}], Graphics[{White, Rotate[Text[Style[#[[1]], 14], 3.5 {Cos[Pi/2 - #[[2]]], Sin[Pi/2 - #[[2]]]}], -#[[2]]] & /@ Transpose[{{"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}, Range[0, 2 Pi - Pi/6, Pi/6]}]}], Graphics[{Red, Text[Style["1.5\[Degree]C", 12], {0, 2.6}]}], Graphics[{Red, Text[Style["2.0\[Degree]C", 12], {0, 3.1}]}]] The idea is quite straight forward: we can think of this as a polar plot. The angle corresponds to the month of the year and the radius relates to the mean temperature, or in fact to the deviation from the "standard temperature". This deviation can be negative, but the radius cannot. So we use the following "scaling" for the radius: (Abs[#] + 1)^Sign[#] & If the temperature deviation from the standard is zero, this gives 1. If the temperature difference is positive the radius grows larger than 1. If the temperature is negative, this value is between 0 and smaller 1. The outer red rings indicate a 1.5 and a 2 degree temperature change which are critical values for a future climate change - we appear to be getting quite close now... Note that for the colours of the circles I needed to consider the scaling function from above, so that I need to feed the values 2.5 for 1.5 degrees and 3 for 2 degrees into the ColourFunction. It is very easy to generate all frames for the movie: Monitor[frames = Table[Show[ListLinePlot[#[[1]]*{Cos[-#[[2]] + Pi/2], Sin[-#[[2]] + Pi/2]} & /@ Transpose[{(Abs[#] + 1)^Sign[#] & /@ tempdata[[All, 2]], Mod[Pi/6 Range[0, 1994], 2 Pi]}][[1 ;; k]], AspectRatio -> 1, Background -> Black, Axes -> None, ColorFunction -> Function[{x, y}, ColorData["Temperature"][0.35 Norm[{x, y}]^2.2]], PlotRange -> {{-4, 4}, {-4, 4}}, ColorFunctionScaling -> False, ImageSize -> Large, Epilog -> {White, Text[Style[(Normal@tempdata[[k, 1]])[[1]], 22], {-3.5, 3.5}]}], Graphics[{Function[{x, y}, ColorData["Temperature"][0.35 Norm[{x, y}]^2.2]][2.5, 0], Thickness[0.005], Circle[{0, 0}, 2.5]}], Graphics[{Function[{x, y}, ColorData["Temperature"][0.35 Norm[{x, y}]^2.2]][3, 0], Thickness[0.005], Circle[{0, 0}, 3]}], Graphics[{White, Rotate[Text[Style[#[[1]], 14], 3.5 {Cos[Pi/2 - #[[2]]], Sin[Pi/2 - #[[2]]]}], -#[[2]]] & /@ Transpose[{{"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}, Range[0, 2 Pi - Pi/6, Pi/6]}]}], Graphics[{Red, Text[Style["1.5\[Degree]C", 12], {0, 2.6}]}], Graphics[{Red, Text[Style["2.0\[Degree]C", 12], {0, 3.1}]}]], {k,1, 1995, 6}];, k] Using ListAnimate[frames] one can animate this. I chose to export the frames: Monitor[Do[Export["~/Desktop/ClimateSpiral/frame" <> ToString[1000 + k] <> ".jpg", frames[[k]], ImageResolution -> 100], {k, 1, Length[frames], 2}], k] And then used the terminal (!!!) command convert -delay 5 -loop 0 frame*.jpg animated.gif to generate the animation. It is a bit long for a post (15MB), but if I make it smaller the resolution is not good enough. It is obviously quite tricky to determine the "mean temperature of the world", particularly because in some areas there is only very sparse data. There is beautiful maths to actually generate estimates. A slightly more standard visualisation would be this: DateListPlot[tempdata, PlotTheme -> "Marketing", LabelStyle -> Directive[Bold, Large], FrameLabel -> {"Year", "\[CapitalDelta]T"}, ImageSize -> Full] Cheers,MarcoPS: As a small variation you can change the interpolation order in the ListLinePlot function to 1, i.e. add the option InterpolationOrder->2 and you obtain the attached animation. Attachments:
3 Replies
Sort By:
Posted 6 years ago
 - another post of yours has been selected for the Staff Picks group, congratulations !We are happy to see you at the tops of the "Featured Contributor" board. Thank you for your wonderful contributions, and please keep them coming!
Posted 6 years ago
 I have just posted an alternative representation of this same dataset. I have opened a new thread because the gifs get quite large and I wanted to avoid having large load times of the pages. Cheers,Marco
Posted 1 year ago
 Hi Marco,How many weather stations did you use for plotting this animation? Or did you just consider only one station? Thank you so much.
Community posts can be styled and formatted using the Markdown syntax.