In adamdsmith/MABMreportr: Function to generate annual reports for the USFWS Region 4's Mobile Acoustical Bat Monitoring (MABM) Program

```r}, echo=FALSE} station_short <- station %>% gsub("national wildlife refuge", "NWR", ., ignore.case = TRUE) %>% gsub("ecological services", "ES", ., ignore.case = TRUE)

route_info <- route_dat[which(route_dat$site == "{{route}}"), ] survey_info <- survey_dat[which(survey_dat$site == "{{route}}"), ] call_info <- call_dat[which(call_dat$site == "{{route}}"), ]

Make header

colon <- ifelse(!is.na(route_info$site_notes), paste(":", route_info$site_notes), "") route_header <- paste0(station_short, colon, " (", route_info$site, ") route")

# `r route_header`

```r}, results='asis'}
# Confirm data is available for route in requested year
has_data <- nrow(survey_info) > 0
if (!has_data) cat(paste0("No MABM data found for this route in ", params$year, "."))

```r}, eval = has_data}

Tally bat calls for each survey night

surv_calls <- call_info %>% dplyr::filter(surv_date %in% survey_info$surv_date) %>% dplyr::group_by(surv_date) %>% dplyr::count()

surv_log <- survey_info %>% dplyr::left_join(., surv_calls, by = "surv_date") %>% dplyr::select(surv_date, n, complete, gps, notes) %>% dplyr::mutate(surv_date = format(surv_date, format = "%d %b"), # Escape percent signs or they're interpreted as comments by TeX notes = gsub("%", "\\%", notes))

texble(surv_log, caption = paste0(year, " survey route (", route_info$site, ") summary."), col_names = c("Survey date", "\# bat \newline calls", "Route \newline completed?", "GPS \newline data?", "Survey notes"), col_widths = c(2.5, 1.5, 1.75, 1.5, 7), col_types = c("L", rep("C", 3), "L"), linespace = "5pt")

\vspace{0.25in}

```r}, eval = has_data, results='asis'}
# Confirm there is call data to accommodate survey route metadata
spp_calls <- call_info %>%
  dplyr::filter(surv_date %in% survey_info$surv_date) 
if (nrow(spp_calls) == 0) {
  has_data <- FALSE
  cat(paste("This route was surveyed, but no bat detection data were found along the route.", 
            "Either no bats were detected or the data have not been entered into the MABM database."))
}

```r}, eval = has_data}

Tally bat calls, by species, for each survey night in reporting year

spp_calls <- spp_calls %>% dplyr::group_by(spp, surv_date) %>% dplyr::count() %>% dplyr::ungroup() %>% tidyr::complete(spp, surv_date, fill = list(n = 0)) %>% dplyr::left_join(spp_info, by = "spp") %>% dplyr::select(spp_cn, surv_date, n) %>% dplyr::arrange(spp_cn) %>% dplyr::mutate(surv_date = format(surv_date, format = "%d %b"), spp_cn = ifelse(duplicated(spp_cn), "", spp_cn), det_rate = n / route_info$len_mi)

texble(spp_calls, digits = 2, caption = paste0(year, " survey route (", route_info$site, ") nightly species detection summary. ", "Total route length = ", route_info$len_mi, " miles."), col_names = c("Species", "Survey date", "\# bats \newline detected", "Bats/mile"), col_widths = c(4.5, 2.5, 1.5, 1.5), col_types = c("L", rep("C", 3)))

\clearpage

```r}, eval = has_data}
# Check if multiple years available
n_yrs <- dplyr::n_distinct(call_info$year)
sds_header <- paste0("## Species detection summary (", 
                     ifelse(n_yrs == 1, params$year, 
                            paste(params$stn_start_yr, params$year, sep = " - ")),
                     ")")

r if (has_data) sds_header

```r}, eval = has_data}

Tally bat calls, by species, for each year in the MABM database

surv_ns <- call_info %>% dplyr::filter(year <= params$year) %>% dplyr::group_by(year) %>% dplyr::mutate(n_survs = dplyr::n_distinct(surv_date)) %>% dplyr::select(year, n_survs) %>% unique() spp_calls <- call_info %>% dplyr::filter(year <= params$year) %>% dplyr::group_by(year) %>% dplyr::group_by(spp, year) %>% dplyr::count() %>% dplyr::ungroup() %>% tidyr::complete(spp, year, fill = list(n = 0)) %>% dplyr::left_join(surv_ns, by = "year") %>% dplyr::left_join(spp_info, by = "spp") %>% dplyr::select(spp_cn, year, n, n_survs) %>% dplyr::arrange(spp_cn) %>% dplyr::mutate(det_rate = n / (route_info$len_mi * n_survs))

Adjust common name column for nicer table

spp_table <- dplyr::mutate(spp_calls, spp_cn = ifelse(duplicated(spp_cn), "", spp_cn))

Generate table

texble(spp_table, digits = 2, longtable = TRUE, caption = paste0("Annual survey route (", route_info$site, ") species detection summary, ", "including classified calls without a spatial reference. ", "Total route length = ", route_info$len_mi, " miles."), col_names = c("Species", "Year", "Total \# \newline detected", "\# surveys", "Total \newline bats/mile"), col_widths = c(4.5, 1.5, 1.5, 1.5, 1.5), col_types = c("L", rep("C", 4)), tbl_float = "H")

```r}, fig.keep = "none", eval = has_data}
if (n_yrs > 1) {
  ggplot2::theme_set(ggplot2::theme_classic(base_size = 14))

  # Determine page orientation and figure dimensions
  lscape <- (dplyr::n_distinct(spp_calls$spp_cn) > 8)
  fig_wd <- ifelse(!lscape, 6, 9)
  nrows <- ceiling(dplyr::n_distinct(spp_calls$spp_cn)/ifelse(!lscape, 2, 3))
  reduce <- all(lscape, nrows > 3)
  asp <- ifelse(reduce, 0.48, 0.618)
  fig_ht <- max(3, 3 * nrows * asp)

  # Shift point labels accordingly
  spp_calls <- shift_point_y(spp_calls, "spp_cn", "det_rate", 
                             shift_prop = ifelse(reduce, 0.2, 0.15),
                             ymin = 0)

  # Now create plot
  yr_brks <- seq(min(spp_calls$year), max(spp_calls$year))
  gap_sz <- ceiling(length(yr_brks) / 6)
  yr_labs <- add_blanks(yr_brks, gap_sz) 
  p <- ggplot2::ggplot(spp_calls, ggplot2::aes(x = year, y = det_rate)) + 
    ggplot2::geom_line() +
    ggplot2::geom_point(ggplot2::aes(size = n_survs), shape = 21, fill = "white") +
    ggplot2::geom_text(ggplot2::aes(y = adj_y, label = n), hjust = 0.5, vjust = 0.5, size = 2.5) + 
    ggplot2::scale_size("# surveys", range = c(1,4), breaks = seq(max(spp_calls$n_survs)), 
               limits = c(1, max(spp_calls$n_survs)),
               guide = ggplot2::guide_legend(title.hjust =0.5, title.position = "top", nrow = 1)) +
    ggplot2::scale_x_continuous("Year", breaks = yr_brks, labels = yr_labs, expand = c(0.075, 0)) + 
    ggplot2::scale_y_continuous("# individuals / mile", limits = c(0, NA), 
                       expand = c(ifelse(reduce, 0.095, 0.075), 0)) +
    ggplot2::facet_wrap(~ spp_cn, ncol = ifelse(!lscape, 2, 3), scales = "free_y") +
    ggplot2::annotate("segment", x=-Inf, xend=Inf, y=-Inf, yend=-Inf) +
    ggplot2::annotate("segment", x=-Inf, xend=-Inf, y=-Inf, yend=Inf) +
    ggplot2::theme(legend.position = "top",
                   legend.background = ggplot2::element_blank(),
                   legend.key.width = ggplot2::unit(0.02, units = "npc"),
                   strip.background = ggplot2::element_blank())

  # Save to temp file
  tmp_fig <- tempfile(fileext = ".pdf")
  pdf(tmp_fig, width = fig_wd, height = fig_ht)
  print(p)
  invisible(dev.off())

  # Convert slashes to LaTeX can deal with them...
  tmp_fig <- normalizePath(tmp_fig, winslash = "/")

  res <- paste(c(if(lscape) "\\begin{landscape}",
                 "\\begin{figure}[H]",
                 "\\centering",
                 paste0("\\includegraphics[width = ", fig_wd, "in, height = ", fig_ht, "in]{",
                        tmp_fig, "}"),
                 paste0("\\caption{Figure version of the previous table.  ",
                        "Detection rates of bat species.  ", 
                        "Point size indicates the number of surveys conducted for the route.  ",
                        "The number associated with each point indicates the total number of individuals detected across all surveys.  ",
                        "Total route length = ", route_info$len_mi, " miles.}"),
                 "\\end{figure}",
                 if(lscape) "\\end{landscape}"),
               collapse = "\n")
  structure(res, format = "latex", class = "knitr_kable")
}

\clearpage

```r}, eval = has_data}

Check for internet connection

web <- curl::has_internet()

if (!web) { message("No internet connection detected. Map not created.\n") } else { # Check if map is necessary spp_calls <- call_info %>% dplyr::filter(surv_date %in% survey_info$surv_date)

# Pause and format survey dates for nicer plot date_levs <- format(unique(sort(spp_calls$surv_date)), format = "%d %b") spp_calls <- spp_calls %>% dplyr::mutate(surv_date = factor(format(surv_date, format = "%d %b"), levels = date_levs)) bat_coords <- spp_calls[, c("lon", "lat")]

# Find data and GIS directory shp_path <- file.path(dirname(out_dir), route_info$site) route_shp <- grep(pattern = "(?=.canonical)(?=.shp$)", list.files(shp_path), perl = TRUE, value = TRUE)

miss_ref <- unique(c(which(is.na(spp_calls$lat)), which(is.na(spp_calls$lon)))) n_NA <- length(miss_ref) if (n_NA > 0) spp_calls <- spp_calls[-miss_ref, ]

if (nrow(na.omit(spp_calls)) < 1) { message("No calls georeferenced or recorded. Map not created for ", paste(route_info$site, "route."), "\n") } else if (length(route_shp) == 0) { message("No canonical route shapefile found for ", paste(route_info$site, "route."), " Map not created.\n") } else { req_pckg <- c("sf") req_pckg <- sapply(req_pckg, requireNamespace, quietly = TRUE) req_pckg <- names(req_pckg)[!req_pckg] if (length(req_pckg) > 0) invisible(lapply(req_pckg, function(pckg) { message("The ", shQuote(pckg), " package is needed and will be installed.") install.packages(pckg, verbose = FALSE) }))

route_shp <- sf::st_read(file.path(shp_path,route_shp), quiet = TRUE)

# If necessary, reproject canonical route shapefile into geographic coordinates
if (!identical(sf::st_crs(route_shp)$epsg, 4326)) {
  route_shp <- sf::st_transform(route_shp, 4326)
}

shp_coords <- sf::st_coordinates(route_shp) %>% 
  as.data.frame()
names(shp_coords)[1:2] <- names(bat_coords)
ll_summary <- apply(dplyr::bind_rows(bat_coords, shp_coords[, 1:2]), 2, range, na.rm = TRUE)
ll_diffs <- apply(ll_summary, 2, diff)
ll_means <- apply(ll_summary, 2, mean)

zoomlon <- floor(log2(360 * 2/ll_diffs[1]))
zoomlat <- floor(log2(180 * 2/ll_diffs[2]))
zoom <- min(zoomlon, zoomlat)

suppressMessages(bm <- ggmap::get_map(c(lon = ll_means[1], lat = ll_means[2]), 
                                      maptype = "terrain", zoom = zoom,
                                      messaging = FALSE))
poss_shapes <- 21:25
ggplot2::theme_set(ggplot2::theme_classic(base_size = 16))

p <- ggmap::ggmap(bm, extent = "device", darken = 0.05) +
  ggplot2::geom_path(data = shp_coords, 
                     ggplot2::aes(x = lon, y = lat, group = L1), size = 0.5)

n_spp <- dplyr::n_distinct(spp_calls$spp)
cols <- c("#A6CEE3", "#1F78B4", "#B2DF8A", "#33A02C", "#FB9A99", "#E31A1C", 
          "#FDBF6F", "#FF7F00", "#CAB2D6", "#6A3D9A", "#FFFF99", "#B15928")
spp_cols <- cols[1:n_spp]

# Build it 
p1 <- p + ggplot2::geom_point(data = spp_calls,
                          ggplot2::aes(x = lon, y = lat, shape = surv_date, fill = spp_cn),
                          size = 2, color = "black") +
  ggplot2::scale_fill_manual("Species", values = spp_cols,
                             guide = ggplot2::guide_legend(title.hjust =0.5,
                                                           title.position = "top",
                                                           nrow = ceiling(n_spp / 2),
                                                           byrow = TRUE,
                                                           order = 1,
                                                           override.aes = list(shape = 21))) +
  ggplot2::scale_shape_manual("Survey date:",
                              values = poss_shapes[1:length(unique(spp_calls$surv_date))],
                              guide = ggplot2::guide_legend(direction = "horizontal",
                                                            order = 2)) +
  ggplot2::theme(legend.title = ggplot2::element_text(size = 12, hjust = 1),
                 legend.text = ggplot2::element_text(size = 11, hjust = 0),
                 legend.background = ggplot2::element_rect(color = "black",
                                                           fill = "gray95"),
                 legend.position = "top",
                 legend.justification = "top",
                 legend.box = "vertical",
                 legend.box.spacing = grid::unit(-1.5, "cm"),
                 panel.border = ggplot2::element_rect(colour = "black", fill=NA, size=2))


# Save to temp file
tmp_fig <- tempfile(fileext = ".pdf")
pdf(tmp_fig, width = 6.5, height = 7.5)
print(p1)
invisible(dev.off())

# Convert slashes to LaTeX can deal with them...
tmp_fig <- normalizePath(tmp_fig, winslash = "/")

res <- paste(c("\\begin{figure}[H]",
               "\\centering",
               paste0("\\includegraphics[width = 6.5in, height = 6.5in]{", tmp_fig, "}"),
               paste0("\\caption{", year, " georeferenced bat detections superimposed on the ",
                      route_info$site, " survey route.  ",
                      if (n_NA == 0) "All recorded calls are represented.  ",
                      if (n_NA > 0) paste(n_NA, "calls are not represented due to missing spatial information.  "),
                      "Total route length = ", route_info$len_mi, " miles.}"),
               "\\end{figure}"), collapse = "\n")
structure(res, format = "latex", class = "knitr_kable")

} } ```

\clearpage

adamdsmith/MABMreportr documentation built on Feb. 1, 2023, 11:17 p.m.