Friday, 13 April 2018

Animated SABAP2 reporting rate timelines

Making animated monthly reporting rate charts from SABAP2 public data in R

Currently you can get a lot of information from the SABAP2 website. For example, go here to find information on Barn Swallow Hirundo rustica.

http://sabap2.adu.org.za/species_info.php?spp=493#menu_left

The aim of this post is to animate the current static monthly reporting rate chart to the right of the map. As there are now many years of data, it is hard to understand what is going on in the static chart now.

For this exercise you will need the data at the link marked “Pentad level summary (monthly)” under the Data downloads options. Note this file is fairly large (8 Mb), so download can take a minute or two, depending on your bandwidth.

You will need to download and install the free image processing software ImageMagick: https://www.imagemagick.org/script/download.php

In addition gganimate is currently only available on github


# These are the packages required to run these scripts
library(ggplot2); library(dplyr); library(gganimate); library(animation) 

# For me (but maybe not for you), I need to tell R where ImageMagick lives:
magickPath <- shortPathName("C:\\Program Files\\ImageMagick-7.0.7-Q16\\magick.exe") 
#update your path as necessary
ani.options(convert=magickPath)
# Download your data here by replacing the 493 here with the species code of your choice (or pasting the link)
swallow <- read.csv("http://sabap2.adu.org.za/inc/species_data_download.php?spp=493&section=6", stringsAsFactors = F)

Have you got the data?

Here is a quick chart to make sure you have the data, a histogram of the number of full protocol cards submitted by year


hist(swallow$yrr)


Since SABAP2 now extends into Africa on a fairly ad-hoc basis, you may wish to restrict your analysis to the southern African region by running swallow <- filter(swallow, lat<(-15)).
Most of the atlased area (currently in your data frame) may well be outside the range of the species, especially if you are dealing with a range-restricted or endemic species. If we use all data, then we will have very low reporting rates. This is likely not what you want: you want to know reporting rate from within a species range. So this step restricts the dataset to the set of pentads where the species has ever been recorded.

occurrence <- group_by(swallow, pentad) %>%
  summarise(ok=sum(cards_with_spp))

# now get rid of pentads with ok ==0 i.e non occurrence. 
occurrence <- filter(occurrence, ok!=0) 
Unlike some of the data sets available for download, this one does not come with reporting rate. So we need to calculate that. It will be a proportion (between 0 and 1).

 swallow$reporting_rate <- swallow$cards_with_spp/swallow$cards
 hist(swallow$reporting_rate) 
#lots of 0 and 1: artefacts of coverage where pentads surveyed only once can only be 0 or 1


This is something like what the chart on the SABAP2 website currently looks like:

ggplot(data = group_by(swallow, yrr,mnth)%>%
    filter(pentad%in%occurrence$pentad)%>%
    summarise(mean_reporting_rate=mean(reporting_rate))
  , aes(mnth, mean_reporting_rate,colour=factor(yrr)))+geom_line()



So lets animate that.

# we need a time series value that combines year and month

swallow$yrr_mnth <- swallow$yrr+round(swallow$mnth/100, 2)

# Now create the chart
p <- ggplot(data = group_by(swallow, yrr, mnth, yrr_mnth)%>%
    filter(pentad%in%occurrence$pentad  & yrr%in%c(2009, 2012, 2015, 2017))%>% # displaying only a few years for clarity
    summarise(mean_reporting_rate=mean(reporting_rate)),
  aes(mnth, mean_reporting_rate,colour=factor(yrr), frame=yrr_mnth,cumulative=T, size=yrr/2009))+
  scale_size(guide='none')+
  geom_path(alpha=0.5)+ggtitle("Monthly reporting rates for Barn Swallow for ") +
  xlab("Month")+
  theme_bw(base_size = 14)

# Display the animated plot. Interval controls the speed. 
suppressMessages(gganimate(p, interval=0.5))
If you want to save the chart as a gif file run this. Various other formats exist: check the animation package documentation.

suppressMessages(gganimate(p, interval=0.5, "barn_swallow_time_series.gif"))

No comments:

Post a comment

Related Posts Plugin for WordPress, Blogger...