Monday 16 April 2018

SABAP2 The Movie maps in R

SABAP2 'The Movie' maps in R

Professor Les Underhill's vision for SABAP2 would be that it would continue to collect data in perpetuity in order to examine patterns in space and time: SABAP2 The Movie.

Now, with 10 years of data and counting, we can create these movies. There are many stories that wait to be told.

The existing SABAP2 map is static: it is the result of compounded lists across the 10 year history. This hides any dynamic patterns. The first and most obvious is seasonality, especially for migratory species. First, we will look at the monthly occurrence of a migratory species, building on what we did here:
http://bluehillescape.blogspot.co.za/2018/04/animated-sabap2-reporting-rate-timelines.html

# These are the packages required to run these scripts
library(ggplot2); library(dplyr); library(gganimate); library(animation) 
# gganimate is still only available via GitHub at this stage: https://github.com/dgrtwo/gganimate

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

# Tell R where ImageMagick lives:
magickPath = shortPathName("C:\\Program Files\\ImageMagick-7.0.7-Q16\\magick.exe") 
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)

# restrict the data to southern Africa (the region with the best coverage)
swallow = filter(swallow, lat<(-15))

# add reporting rate
 swallow$reporting_rate = swallow$cards_with_spp/swallow$cards

The new code starts here. First, we use the raw data to create a background map of where we have bird lists (coverage) using the atlas data. We then create a new dataframe of average reporting rate by month. Finally, we plot the black coverage map and overlay reporting rate (on a gradient from black with nothing, to red i.e. high reporting rate). Pentad size here is proportionally larger than in reality, which helps fill in atlasing holes. This is a movie after all, not an analysis.

#first, background pentad map
pentad_map_data = swallow%>%select(pentad, lat, lng)%>%distinct()

# now dataframe for mapping
annual_pattern = swallow%>%group_by(mnth, lng, lat)%>%summarise(rr=mean(reporting_rate))%>filter(rr>0)

swallow_space_time =
  (
    ggplot(pentad_map_data, aes(lng, lat))+
      geom_point(shape=15)+ylim(min(swallow$lat), -15)+xlim(min(swallow$lng), 37)+
      theme_bw(base_size = 15)+coord_equal()+xlab("Longitude")+ylab("Latitude")+

      geom_point(data=annual_pattern, aes(lng,lat, colour=rr, frame=mnth),shape=15)+
      scale_colour_gradient(low="black", high="#de2d26", guide="none")+
      ggtitle("Spatial distribution of Barn Swallow for month ")
  )

 suppressMessages(gganimate(swallow_space_time, interval=1))





A static map is also not appropriate if a species is nomadic: range will change from year to year depending on rainfall and resources. This is especially the case for several species of the arid zone. One of the most common and familiar is the Lark-like Bunting Emberiza impetuani. Here we examine year by year reporting rate for this species, revealing a remarkeably dynamic range (as you will see when we compare this to an endemic bird species below). SABAP2 data reveals an extraordinary irruption of Lark-like Bunting in 2013 that went largely unmentioned in South Africa's ornithological literature.

# get the data:
llbunting =
  read.csv("http://sabap2.adu.org.za/inc/species_data_download.php?spp=871&section=6", stringsAsFactors = F)

llbunting = filter(llbunting, !yrr%in%c(2007, 2018))
llbunting$reporting_rate = llbunting$cards_with_spp/llbunting$cards
annual_pattern = llbunting%>%group_by(yrr, lng, lat)%>%
summarise(rr=mean(reporting_rate))%>%filter(rr>0)

# now a spatial map

llbunting_space_time =
(
    ggplot(pentad_map_data, aes(lng, lat))+
    geom_point(shape=15)+ylim(min(llbunting$lat), -15)+xlim(min(llbunting$lng), 37)+
    theme_bw(base_size = 15)+coord_equal()+xlab("Longitude")+ylab("Latitude")+

    geom_point(data=annual_pattern, aes(lng,lat, colour=rr, frame=yrr),shape=15)+
    scale_colour_gradient(low="black", high="#de2d26", guide="none")+
    ggtitle("Spatial distribution of Lark-like bunting for year ")
  )

suppressMessages(gganimate(llbunting_space_time, interval=2))



By comparison, the 'movie' for Cape Sugarbird is far less interesting, with the exception of perhaps of the odd individual wondering out of range.

# get the data:
csb =
  read.csv("http://sabap2.adu.org.za/inc/species_data_download.php?spp=749&section=6", stringsAsFactors = F)

csb = filter(csb, !yrr%in%c(2007, 2018))
csb$reporting_rate = csb$cards_with_spp/csb$cards
annual_pattern = csb%>%group_by(yrr, lng, lat)%>%
summarise(rr=mean(reporting_rate))%>%filter(rr>0)
# now an animated spatial map csb_space_time = ( ggplot(pentad_map_data, aes(lng, lat))+ geom_point(shape=15)+ylim(min(csb$lat), -15)+xlim(min(csb$lng), 37)+ theme_bw(base_size = 15)+coord_equal()+xlab("Longitude")+ylab("Latitude")+ geom_point(data=annual_pattern, aes(lng,lat, colour=rr, frame=yrr),shape=15)+ scale_colour_gradient(low="black", high="#de2d26", guide="none")+
ggtitle("Spatial distribution of Cape Sugarbird for year ")
  )

suppressMessages(gganimate(csb_space_time, interval=2))



And finally, we watch the spread of atlasing coverage over the last decade, coupled with the presence of Pied Crow. This chart is a cumulative one: each year laid over the previous.

pied_crow =   read.csv("http://sabap2.adu.org.za/inc/species_data_download.php?spp=522&section=6", stringsAsFactors = F)

pied_crow$rr = with(pied_crow, (cards_with_spp/cards))

annual_pattern = pied_crow%>%group_by(yrr, lng, lat)%>%summarise(rr=mean(rr))


pied_crow_space_time = 
  (
    ggplot()+
      ylim(min(pied_crow$lat), -15)+xlim(min(pied_crow$lng), 37)+
      geom_point(data=annual_pattern, aes(lng,lat, colour=rr, frame=yrr, cumulative=T),shape=15)+

      theme_bw(base_size = 15)+coord_equal()+xlab("Longitude")+ylab("Latitude")+

      scale_colour_gradient(low="black", high="#de2d26")+
ggtitle("Coverage and Pied Crow CUMULATIVE year ")
  )

gganimate(pied_crow_space_time, interval = 1)


No comments:

Post a Comment

Related Posts Plugin for WordPress, Blogger...