Interactive Acoustic/Radiotelemtry Data Abacus Plots

This tutorial illustrates how to create an abacus plot from raw acoustic detections from and array of several Vemco VR2W acoustic receivers.

Raw detection abacus plot

The example data is from an ongoing project and was masked (date vectors, receiver and transmitter ids and locations have been changed) for confidentiality reasons. It is freely available on https://github.com/rkbauer/interactive_abacus_plots_acoustic_data. The code can be applied to several types of acoustic or radio telemetry arrays such as fish passes, rivers, estuaries, or in linear coastal arrays.

library(here)
library(dplyr)
load(here::here("_posts/Interactive_raw_detections_abacus_plots/raw_detections_blackwater.rd"), verbose = TRUE) 

Loading objects:
  df

str(df,1)

'data.frame':   5211 obs. of  10 variables:
 $ Date.and.Time..UTC.: chr  "2019-05-03 12:05:28" "2019-05-03 12:06:15" "2019-05-03 12:07:15" "2019-05-03 12:08:10" ...
 $ Receiver           : chr  "VR2W-116162" "VR2W-116162" "VR2W-116162" "VR2W-116162" ...
 $ Transmitter        : chr  "A69-9001-6765" "A69-9001-6765" "A69-9001-6765" "A69-9001-6765" ...
 $ Transmitter.Name   : logi  NA NA NA NA NA NA ...
 $ Transmitter.Serial : logi  NA NA NA NA NA NA ...
 $ Sensor.Value       : int  NA NA NA NA NA NA NA NA NA NA ...
 $ Sensor.Unit        : chr  "" "" "" "" ...
 $ Station.Name       : chr  "BW 8" "BW 8" "BW 8" "BW 8" ...
 $ Latitude           : num  0.743 0.743 0.743 0.743 0.743 ...
 $ Longitude          : num  51.7 51.7 51.7 51.7 51.7 ...

First we need to transform the raw detection time series into a dygraphs format:

y <- "Station.Name"
id <- "A69-9001-6765"
input <- df %>% 
  filter(Transmitter %in% id) %>%
  mutate(datetime = as.POSIXct(Date.and.Time..UTC.,tz="UTC"),
         date = as.Date(datetime)) 

dat <- input[,c("datetime",y)]
dat[[y]] <- as.numeric(gsub("BW ","", dat[[y]]))

ds <- data.frame(dat[,y]); names(ds) <- y
dat_xts <- xts::xts(ds,order.by = dat$datetime)

Let’s start plotting:

# plot arguments:
drawPoints <- labelsUTC <- doRangeSelector <- T
pointSize <- 4; strokeWidth <- 0; col <- "blue"; label <- y

library(dygraphs)
dg <- dygraph(dat_xts)
dg <- dg %>% dyOptions(colors=col, drawPoints=drawPoints, pointSize=pointSize, 
                       labelsUTC=labelsUTC, strokeWidth = strokeWidth)
dg <- dg %>% dyAxis("y", label = "River Station")
if(doRangeSelector) dg <- dg %>% dyRangeSelector()

## the axisLabelFormatter option lets you specify a JavaScript function 
## to format the labels on axis tick marks for display.
dg <- dg %>% dyAxis(
  "y",
  axisLabelFormatter = 'function(d){return "BW" + d.toString()}',
  axisLabelWidth = 70
)

dg

How to add day-night shadings

The code below is adapted from the dy_DepthTS function of the RchivalTag package which can be used to illustrate depth time series data. In order to add day-night shadings to our figure, we need first to estimate the daily sunrise and sunset. To do this, we calculate the average position per day via the ddply function and fill position gaps in the time series (no detection periods) via a regression spline. Finally we can estimate daily sunrises and sunsets based on our positions via the get_DayTimeLimitsfunction fromRchivalTag`

names(input)

 [1] "Date.and.Time..UTC." "Receiver"            "Transmitter"        
 [4] "Transmitter.Name"    "Transmitter.Serial"  "Sensor.Value"       
 [7] "Sensor.Unit"         "Station.Name"        "Latitude"           
[10] "Longitude"           "datetime"            "date"               

library(plyr)
pos0 <- ddply(unique(input[,c("date","Longitude","Latitude")]),.(date), 
              Lon=mean(x$Longitude),Lat=mean(x$Latitude))
dates <- as.Date((min(input$date)-1):(max(input$date)+1),origin="1970-01-01")
pos <- merge(pos0, data.frame(date=dates),by="date",all.y = T)
pos$Lon <- spline(1:nrow(pos), y = pos$Lon, xout = 1:nrow(pos))$y
pos$Lat <- spline(1:nrow(pos), y = pos$Lat, xout = 1:nrow(pos))$y
pos$datetime <- RchivalTag:::.date2datetime(pos$date,tz = "UTC")
head(pos)

        date Longitude Latitude      Lon       Lat
1 2019-05-02        NA       NA 51.70997 0.7648896
2 2019-05-03  51.72089 0.743256 51.72089 0.7432560
3 2019-05-04  51.72089 0.743256 51.72089 0.7432560
4 2019-05-05  51.72089 0.743256 51.72089 0.7432560
5 2019-05-05  51.73002 0.726160 51.73002 0.7261600
6 2019-05-06  51.73002 0.726160 51.73002 0.7261600
             datetime
1 2019-05-02 12:00:00
2 2019-05-03 12:00:00
3 2019-05-04 12:00:00
4 2019-05-05 12:00:00
5 2019-05-05 12:00:00
6 2019-05-06 12:00:00

pos <- RchivalTag::get_DayTimeLimits(pos)

In the next step we need transform the periods into a dygraph format:

shade_periods <- c("sunrise","sunset","dawn.ast","dusk.ast")
shades <- unique(pos[,shade_periods])

shades_list <- list()
j <- 1

for(i in 1:nrow(shades)){
  add <- list(from=as.POSIXct(shades$sunrise[i],tz = "UTC"), 
              to=as.POSIXct(shades$sunset[i],tz = "UTC"),
              color="white")
  shades_list[[j]] <- add
  j <- j+1
  add <- list(from=as.POSIXct(shades$dawn.ast[i],tz = "UTC"), 
              to=as.POSIXct(shades$sunrise[i],tz = "UTC"),
              color="lightgrey")
  shades_list[[j]] <- add
  j <- j+1
  add <- list(from=as.POSIXct(shades$dusk.ast[i],tz = "UTC"), 
              to=as.POSIXct(shades$sunset[i],tz = "UTC"),
              color="lightgrey")
  shades_list[[j]] <- add
  j <- j+1
}

Now we can add the formated shadings to the existing dygraph object:

## set background to grey
dg <- dyShading(dg, 
                from = pos$datetime[1] , 
                to = tail(pos$datetime,1),
                color = "darkgrey" )

## add twilight and daytime shadings
for( period in shades_list ) {
  dg <- dyShading(dg, 
                  from = period$from , 
                  to = period$to,
                  color = period$color)
  dg <- dyAnnotation(dg, 
                     x = mean(c(period$from,period$to)), 
                     text = period$label, 
                     attachAtBottom=T)
}

dg

You can further edit the object dg of this plot via the dygraphs package (https://rstudio.github.io/dygraphs/).

Enjoy coding!