<p><div><div><div><div data-width="100" data-show-faces="false" data-send="true" data-layout="button_count" data-height="21" data-href="http://www.r-bloggers.com/u-s-drought-animations-with-the-witchs-brew-purrr-broom-magick/"></div></div><div><a data-url="http://www.r-bloggers.com/u-s-drought-animations-with-the-witchs-brew-purrr-broom-magick/" data-counturl="http://www.r-bloggers.com/u-s-drought-animations-with-the-witchs-brew-purrr-broom-magick/" data-count="horizontal" data-text="U.S. Drought Animations with the “Witch’s Brew” (purrr + broom + magick)" class="twitter-share-button" data-via="rbloggers" href="https://twitter.com/share"></a></div><div></div></div><div></div></div>
<div>
(This article was first published on <strong><a href="https://rud.is/b/2016/07/27/u-s-drought-animations-with-the-witchs-brew-purrr-broom-magick/"> R – rud.is</a></strong>, and kindly contributed to <a rel="nofollow" href="http://www.r-bloggers.com/">R-bloggers)</a> </div>
<p>This is another <code>purrr</code>-focused post but it’s also an homage to the nascent <code>magick</code> package (R interface to ImageMagick) by <a target="_blank" href="http://twitter.com/opencpu">@opencpu</a>. </p>
<p>We’re starting to see/feel the impact of the increasing drought up here in southern Maine. I’ve used the data from the <a target="_blank" href="http://droughtmonitor.unl.edu/MapsAndData/GISData.aspx">U.S. Drought Monitor</a> before on the blog, but they also provide shapefiles and this seemed like a good opportunity to further demonstrate the utility of <code>purrr</code> and make animations directly using <code>magick</code>. Plus, I wanted to see the progression of the drought. Putting <code>library()</code> statements for <code>purrr</code>, <code>magick</code> and <code>broom</code> together was completely random, but I now feel compelled to find a set of functions to put into a <code>cauldron</code> package. But, I digress.</p>
<h3>What does this demonstrate?</h3>
<p>Apart from giving you an idea of the extent of the drought, working through this will help you:</p>
<ul>
<li>use the <code>quietly()</code> function (which automagically turns off warnings for a function)</li>
<li>see another example of a formula function</li>
<li>illustrate the utility <code>map_df()</code>, and</li>
<li>see how to create an animation pipeline for <code>magick</code></li>
</ul>
<p>Comments are in the code and the drought gif is at the end. I deliberately only had it loop once, so refresh the image if you want to see the progression again. Also, drop a note in the comments if anything needs more exposition. (NOTE: I was fairly bad and did virtually no file cleanup in the function, so you’ll have half a year’s shapefiles in your <code>getwd()</code>. Consider the cleanup an exercise for the reader <img alt="🙂" class="wp-smiley" src="https://s.w.org/images/core/emoji/72x72/1f642.png"></p>
<pre><code>library(rgdal)
library(sp)
library(albersusa) # devtools::install_github(&quot;hrbrmstr/albersusa&quot;)
library(ggplot2) # devtools::install_github(&quot;hadley/ggplot2&quot;)
library(ggthemes)
library(rgeos)

# the witch's brew
library(purrr)
library(broom)
library(magick)

#' Get a drought map shapefile and turn it into a PNG
drought_map &lt;- function(wk) {

  # need to hush some chatty functions
  hush_tidy &lt;- quietly(tidy)

  # some are more stubbon than others
  old_warn &lt;- getOption(&quot;warn&quot;)
  options(warn=-1)

  week &lt;- format(wk, &quot;%Y%m%d&quot;)

  # get the drought shapefile only if we don't have it already
  URL &lt;- sprintf(&quot;http://droughtmonitor.unl.edu/data/shapefiles_m/USDM_%s_M.zip&quot;, week)
  (fil &lt;- basename(URL))
  if (!file.exists(fil)) download.file(URL, fil)
  unzip(fil)

  # read in the shapefile and reduce the polygon complexity
  dr &lt;- readOGR(sprintf(&quot;USDM_%s.shp&quot;, week),
                sprintf(&quot;USDM_%s&quot;, week),
                verbose=FALSE,
                stringsAsFactors=FALSE)

  dr &lt;- SpatialPolygonsDataFrame(gSimplify(dr, 0.01, TRUE), dr@data)

  # turn separate out each drought level into its own fortified data.frame
  map(dr$DM, ~subset(dr, DM==.)) %>%
    map(hush_tidy) %>%
    map_df(&quot;result&quot;, .id=&quot;DM&quot;) -> m

  # get a conus base map (prbly cld have done map_data(&quot;usa&quot;), too)
  usa_composite() %>%
    subset(!(iso_3166_2 %in% c(&quot;AK&quot;, &quot;HI&quot;))) %>%
    hush_tidy() -> usa

  usa &lt;- usa$result # an artifact of using quietly()

  # this is all Ushey's fault. the utility of cmd-enter to run
  # the entire ggplot2 chain (in RStudio) turns out to have a
  # greater productity boost (i measured it) than my shortcuts for
  # gg &lt;- gg + snippets and hand-editing the &quot;+&quot; bits out when
  # editing old plot constructs. I'm not giving up on gg &lt;- gg + tho

  # Note putting the &quot;base&quot; layer on top since we don't really
  # want to deal with alpha levels of the drought polygons and
  # we're only plotting the outline of the us/states, not filling
  # the interior(s).

  ggplot() +
    geom_map(data=m, map=m,
             aes(long, lat, fill=DM, map_id=id),
             color=&quot;#2b2b2b&quot;, size=0.05) +
    geom_map(data=usa, map=usa, aes(long, lat, map_id=id),
             color=&quot;#2b2b2b88&quot;, fill=NA, size=0.1) +
    scale_fill_brewer(&quot;Drought Level&quot;, palette=&quot;YlOrBr&quot;) +
    coord_map(&quot;polyconic&quot;, xlim=c(-130, -65), ylim=c(25, 50)) +
    labs(x=sprintf(&quot;Week: %s&quot;, wk)) +
    theme_map() +
    theme(axis.title=element_text()) +
    theme(axis.title.x=element_text()) +
    theme(axis.title.y=element_blank()) +
    theme(legend.position=&quot;bottom&quot;) +
    theme(legend.direction=&quot;horizontal&quot;) -> gg

  options(warn=old_warn) # put things back the way they were

  outfil &lt;- sprintf(&quot;gg-dm-%s.png&quot;, wk)
  ggsave(outfil, gg, width=8, height=5)

  outfil

}

# - create a vector of weeks (minus the current one)
# - create the individual map PNGs
# - read the individual map PNGs into a list
# - join the images together
# - create the animated gif structure
# - write the gif to a file

seq(as.Date(&quot;2016-01-05&quot;), Sys.Date(), by=&quot;1 week&quot;) %>%
  head(-1) %>%
  map(drought_map) %>%
  map(image_read) %>%
  image_join() %>%
  image_animate(fps=2, loop=1) %>%
  image_write(&quot;drought.gif&quot;)</code></pre>
<p><center><a target="_blank" href="http://i1.wp.com/rud.is/dl/2016dm.gif?ssl=1"><img src="http://i1.wp.com/rud.is/dl/2016dm.gif?w=456&ssl=1" data-recalc-dims="1"></a></center></p>
<p><div><div><div><div data-width="55" data-show-faces="false" data-send="true" data-layout="box_count" data-height="62" data-href="http://www.r-bloggers.com/u-s-drought-animations-with-the-witchs-brew-purrr-broom-magick/"></div></div><div><a data-url="http://www.r-bloggers.com/u-s-drought-animations-with-the-witchs-brew-purrr-broom-magick/" data-counturl="http://www.r-bloggers.com/u-s-drought-animations-with-the-witchs-brew-purrr-broom-magick/" data-count="vertical" data-text="U.S. Drought Animations with the “Witch’s Brew” (purrr + broom + magick)" class="twitter-share-button" data-via="rbloggers" href="https://twitter.com/share"></a></div><div></div></div><div></div></div>
<div>
<div>To <strong>leave a comment</strong> for the author, please follow the link and comment on their blog: <strong><a href="https://rud.is/b/2016/07/27/u-s-drought-animations-with-the-witchs-brew-purrr-broom-magick/"> R – rud.is</a></strong>.</div>
<hr>
<a rel="nofollow" href="http://www.r-bloggers.com/">R-bloggers.com</a> offers <strong><a rel="nofollow" href="http://feedburner.google.com/fb/a/mailverify?uri=RBloggers">daily e-mail updates</a></strong> about <a title="The R Project for Statistical Computing" rel="nofollow" href="http://www.r-project.org/">R</a> news and <a title="R tutorials" rel="nofollow" href="http://www.r-bloggers.com/?s=tutorial">tutorials</a> on topics such as: <a title="Data science" rel="nofollow" href="http://www.r-bloggers.com/?s=data%20science">Data science</a>, <a title="Big Data" rel="nofollow" href="http://www.r-bloggers.com/?s=Big%20Data">Big Data, <a title="R jobs" rel="nofollow" href="http://www.r-users.com/">R jobs</a>, visualization (<a title="ggplot and ggplot2 tutorials" rel="nofollow" href="http://www.r-bloggers.com/?s=ggplot2">ggplot2</a>, <a title="Boxplots using lattice and ggplot2 tutorials" rel="nofollow" href="http://www.r-bloggers.com/?s=boxplot">Boxplots</a>, <a title="Maps and gis" rel="nofollow" href="http://www.r-bloggers.com/?s=map">maps</a>, <a title="Animation in R" rel="nofollow" href="http://www.r-bloggers.com/?s=animation">animation</a>), programming (<a title="RStudio IDE for R" rel="nofollow" href="http://www.r-bloggers.com/?s=RStudio">RStudio</a>, <a title="Sweave and literate programming" rel="nofollow" href="http://www.r-bloggers.com/?s=sweave">Sweave</a>, <a title="LaTeX in R" rel="nofollow" href="http://www.r-bloggers.com/?s=LaTeX">LaTeX</a>, <a title="SQL and databases" rel="nofollow" href="http://www.r-bloggers.com/?s=SQL">SQL</a>, <a title="Eclipse IDE for R" rel="nofollow" href="http://www.r-bloggers.com/?s=eclipse">Eclipse</a>, <a title="git and github, Version Control System" rel="nofollow" href="http://www.r-bloggers.com/?s=git">git</a>, <a title="Large data in R using Hadoop" rel="nofollow" href="http://www.r-bloggers.com/?s=hadoop">hadoop</a>, <a title="Web Scraping of google, facebook, yahoo, twitter and more using R" rel="nofollow" href="http://www.r-bloggers.com/?s=Web+Scraping">Web Scraping</a>) statistics (<a title="Regressions and ANOVA analysis tutorials" rel="nofollow" href="http://www.r-bloggers.com/?s=regression">regression</a>, <a title="principal component analysis tutorial" rel="nofollow" href="http://www.r-bloggers.com/?s=PCA">PCA</a>, <a title="Time series" rel="nofollow" href="http://www.r-bloggers.com/?s=time+series">time series</a>, <a title="finance trading" rel="nofollow" href="http://www.r-bloggers.com/?s=trading">trading</a>) and more...
<img height="1" alt="" width="1" src="http://feeds.feedburner.com/~r/RBloggers/~4/YaSnKizURkY"></a></div>