Nothing
#' Aerial DAS sightings
#'
#' Extract sighting information from aerial DAS data
#'
#' @param x \code{airdas_df} object; output from \code{\link{airdas_process}},
#' or a data frame that can be coerced to a \code{airdas_df} object
#' @param ... ignored
#' @param angle.min numeric; the minimum (absolute value) angle
#' for which to consider a sighting a standard sighting. Default is 12
#'
#' @details AirDAS events contain specific information in the 'Data#' columns,
#' with the information depending on the event code and file type for that row.
#' This function extracts relevant data for sighting events, and returns a
#' data frame with dedicated columns for each piece of sighting information.
#' It can handle multiple file types in \code{x}; for instance,
#' \code{x} could be processed PHOCOENA and TURTLE data
#' combined using \code{\link[base:cbind]{rbind}}.
#' See \code{\link{airdas_format_pdf}} for more information about the expected
#' events and event formats, depending on the file type.
#'
#' All species codes are converted to lower case using \code{\link[base:chartr]{tolower}}.
#'
#' Abbreviations used in column names include: Gs = group size, Sp = species,
#' Mixed = mixed species (multi-species) sighting.
#' In addition, note that multi-species group sizes are rounded to
#' the nearest whole number using \code{round(, 0)}
#'
#' A 'sighting by a standard observer' ('ObsStd') is a sighting
#' made by ObsL, ObsB, or ObsR (not the data recorder or pilot).
#' A 'standard sighting' ('SightStd') is a sighting
#' that was made while on effort, by a standard observer,
#' and with the absolute value of the angle of declination
#' being greater than or equal to \code{angle.min}.
#' Resights (Events 's') are not considered standard events,
#' and thus both 'ObsStd' and 'SightStd' will be \code{NA} for 's' events.
#'
#' @return Data frame with 1) the columns from \code{x}, excluding the 'Data#' columns,
#' and 2) columns with sighting information extracted from 'Data#' columns as described below.
#' The data frame has one row for each sighting, or one row for each
#' species of each sighting if it is a multi-species (mixed) sighting.
#'
#' Added sighting information columns:
#' \tabular{lll}{
#' \emph{Sighting information} \tab \emph{Column name} \tab \emph{Notes}\cr
#' Sighting number \tab SightNo\cr
#' Observer that made the sighting \tab Obs\cr
#' Angle of declination \tab Angle \tab Left is negative\cr
#' Sighting by standard observer \tab ObsStd \tab Logical; described in Details\cr
#' Standard sighting \tab SightStd \tab Logical; described in Details\cr
#' Mixed species sighting \tab Mixed \tab Logical\cr
#' Species code \tab SpCode \tab All characters converted to lower case\cr
#' Group size of school \tab GsTotal \tab Only different from GsSp for mixed species sightings\cr
#' Group size of species \tab GsSp\cr
#' Turtle length (feet if numeric) \tab TurtleSize \tab \code{NA} for non-"t" events; may be character or numeric\cr
#' Turtle travel direction (degrees) \tab TurtleDirection \tab \code{NA} for non-"t" events\cr
#' Turtle tail visible? \tab TurtleTail \tab \code{NA} for non-"t" events\cr
#' }
#'
#' The TurtleSize will be of class character is there is any
#' CARETTA data in \code{x}, and of class numeric otherwise.
#'
#' @examples
#' y <- system.file("airdas_sample.das", package = "swfscAirDAS")
#' y.proc <- airdas_process(y)
#'
#' airdas_sight(y.proc)
#'
#' @export
airdas_sight <- function(x, ...) UseMethod("airdas_sight")
#' @name airdas_sight
#' @export
airdas_sight.data.frame <- function(x, ...) {
airdas_sight(as_airdas_df(x), ...)
}
#' @name airdas_sight
#' @export
airdas_sight.airdas_df <- function(x, angle.min = 12, ...) {
#----------------------------------------------------------------------------
### Filter for and extract sighting data
event.sight <- c("S", "s", "t")
event.sight.info <- "1"
### Filter for sighting-related data
sight.df <- x %>%
filter(.data$Event %in% c(event.sight, event.sight.info)) %>%
mutate(sight_cumsum = cumsum(.data$Event %in% event.sight))
stopifnot(
length(event.sight.info) == 1,
is.numeric(angle.min),
angle.min >= 0, angle.min <= 90
)
#----------------------------------------------------------------------------
### For every sighting event paired with a '1' event, split the sighting
### into multiple lines.
### If no '1' events, sight.mult will be list() and thus not change sight.df
sight.cumsum.mult <- sight.df$sight_cumsum[sight.df$Event %in% event.sight.info]
sight.mult <- lapply(sight.cumsum.mult, function(i, sight.df) {
curr.df <- sight.df %>% filter(.data$sight_cumsum == i)
stopifnot(identical(curr.df$Event, c("S", "1")))
# Extract species and group size info
gs.total <- as.numeric(curr.df$Data4[1])
sp.all <- c(curr.df$Data5[1], curr.df$Data6[1], curr.df$Data7[1])
sp.perc.all <- c(
as.numeric(curr.df$Data5[2]), as.numeric(curr.df$Data6[2]),
as.numeric(curr.df$Data7[2])
)
sp.num.all <- round(sp.perc.all / 100 * gs.total, 0)
# Warning if species percentages do not sum to 100
if (!isTRUE(all.equal(sum(sp.perc.all, na.rm = TRUE), 100)))
warning("The multispecies sightings percentages do not sum to 100 ",
"for the following sighting: ",
.print_file_line(curr.df$file_das, curr.df$line_num, 1))
# Create df with one row for each species
bind_rows(curr.df[1, ], curr.df[1, ], curr.df[1, ]) %>%
mutate(Data4 = as.character(sp.num.all), Data5 = sp.all,
Data6 = NA, Data7 = NA,
GsTotal = gs.total, Mixed = TRUE) %>%
filter(!is.na(.data$Data4))
}, sight.df = sight.df)
# Add multi-species sightings back into sight.df
sight.df <- sight.df %>%
filter(!(.data$sight_cumsum %in% sight.cumsum.mult)) %>%
mutate(GsTotal = ifelse(.data$Event == "S", as.numeric(.data$Data4), NA),
Mixed = ifelse(.data$Event == "s", NA, FALSE)) %>%
bind_rows(sight.mult) %>%
arrange(.data$sight_cumsum) %>%
mutate(idx = seq_along(.data$sight_cumsum)) %>%
select(-.data$sight_cumsum)
#----------------------------------------------------------------------------
stopifnot(all(sight.df$Event %in% event.sight))
### 1) Extract processed AirDAS variables
sight.info <- sight.df %>%
select(-!!paste0("Data", 1:7), -.data$GsTotal, -.data$Mixed)
### 2) Extract sighting information based on file type
sight.df.all <- bind_rows(
.airdas_sight_phocoena(filter(sight.df, .data$file_type == "phocoena"), angle.min),
.airdas_sight_caretta(filter(sight.df, .data$file_type == "caretta"), angle.min),
.airdas_sight_turtle(filter(sight.df, .data$file_type == "turtle"), angle.min)
)
# CARETTA data uses "l", "m", "s" code for TurtleSize
if (!any(sight.df$file_type == "caretta"))
sight.df.all$TurtleSize <- as.numeric(sight.df.all$TurtleSize)
#----------------------------------------------------------------------------
# Join data frames and return
sight.info %>%
left_join(sight.df.all, by = "idx") %>%
mutate(SpCode = tolower(.data$SpCode)) %>%
select(-.data$idx)
}
###############################################################################
# Helper functions, for consistency across .airdas_sight_ functions below
.obsStd_lgl <- function(Event, Obs, ObsL, ObsB, ObsR) {
if_else(Event == "s", na_lgl, Obs %in% c(ObsL, ObsB, ObsR))
}
.sightStd_lgl <- function(OnEffort, ObsStd, Event, Angle, angle.min) {
if_else(
Event == "s",
na_lgl,
OnEffort & ObsStd & (Event %in% c("S", "t")) & (abs(Angle) >= angle.min)
)
}
###############################################################################
# Extract sighting data from data created using PHOCOENA program
.airdas_sight_phocoena <- function(sight.df, angle.min) {
if (!all(sight.df$Event == "S"))
stop("Error in processing: not all sighitng rows with file_type ",
"PHOCOENA are Event S. ",
"Please reprocess data and/or submit an issue")
sight.df %>%
mutate(SightNo = .data$Data1,
SpCode = .data$Data2,
GsTotal = as.numeric(.data$Data3),
Angle = as.numeric(.data$Data4),
Obs = .data$Data5,
GsSp = .data$GsTotal,
ObsStd = pmap_lgl(list(.data$Event, .data$Obs, .data$ObsL,
.data$ObsB, .data$ObsR),
.obsStd_lgl),
SightStd = .sightStd_lgl(.data$OnEffort, .data$ObsStd, .data$Event,
.data$Angle, angle.min),
TurtleSize = NA_character_,
TurtleDirection = as.numeric(NA),
TurtleTail = NA_character_) %>%
select(.data$idx, .data$SightNo,
.data$Obs, .data$Angle, .data$ObsStd, .data$SightStd,
.data$Mixed, .data$SpCode, .data$GsTotal, .data$GsSp,
.data$TurtleSize, .data$TurtleDirection, .data$TurtleTail)
}
# Extract sighting data from data created using CARETTA program
.airdas_sight_caretta <- function(sight.df, angle.min) {
if (!all(sight.df$Event %in% c("S", "t", "s")))
stop("Error in sight function - incorrect codes. ",
"Please report this as an issue")
sight.info.all <- sight.df %>%
mutate(SightNo = .data$Data1,
Obs = case_when(.data$Event == "S" ~ .data$Data2,
.data$Event == "t" ~ .data$Data2),
Angle = as.numeric(case_when(.data$Event == "S" ~ .data$Data3,
.data$Event == "s" ~ .data$Data2,
.data$Event == "t" ~ .data$Data3)),
ObsStd = pmap_lgl(list(.data$Event, .data$Obs, .data$ObsL,
.data$ObsB, .data$ObsR),
.obsStd_lgl),
SightStd = .sightStd_lgl(.data$OnEffort, .data$ObsStd, .data$Event,
.data$Angle, angle.min),
SpCode = case_when(.data$Event == "S" ~ .data$Data5,
.data$Event == "t" ~ .data$Data5),
GsSp = case_when(.data$Event == "S" ~ as.numeric(.data$Data4),
.data$Event == "t" ~ as.numeric(.data$Data4)),
GsTotal = case_when(.data$Event == "S" ~ .data$GsTotal,
.data$Event == "t" ~ .data$GsSp)) %>%
select(.data$idx, .data$SightNo,
.data$Obs, .data$Angle, .data$ObsStd, .data$SightStd,
.data$Mixed, .data$SpCode, .data$GsTotal, .data$GsSp)
sight.info.t <- sight.df %>%
filter(.data$Event == "t") %>%
mutate(TurtleSize = .data$Data6,
TurtleDirection = as.numeric(NA),
TurtleTail = .data$Data7) %>%
select(.data$idx, .data$TurtleSize, .data$TurtleDirection,
.data$TurtleTail)
left_join(sight.info.all, sight.info.t, by = "idx")
}
# Extract sighting data from data created using TURTLE program
.airdas_sight_turtle <- function(sight.df, angle.min) {
if (!all(sight.df$Event %in% c("S", "t", "s")))
stop("Error in sight function - incorrect codes. ",
"Please report this as an issue")
sight.info.all <- sight.df %>%
mutate(SightNo = as.character(ifelse(.data$Event == "t", NA, .data$Data1)),
# ^ is for when there are 0 rows to ensure character class
Obs = case_when(.data$Event == "S" ~ .data$Data2,
.data$Event == "t" ~ .data$Data1),
Angle = as.numeric(case_when(.data$Event == "S" ~ .data$Data3,
.data$Event == "s" ~ .data$Data2,
.data$Event == "t" ~ .data$Data2)),
ObsStd = pmap_lgl(list(.data$Event, .data$Obs, .data$ObsL,
.data$ObsB, .data$ObsR),
.obsStd_lgl),
SightStd = .sightStd_lgl(.data$OnEffort, .data$ObsStd, .data$Event,
.data$Angle, angle.min),
SpCode = case_when(.data$Event == "S" ~ .data$Data5,
.data$Event == "t" ~ .data$Data3),
GsSp = case_when(.data$Event == "S" ~ as.numeric(.data$Data4),
.data$Event == "t" ~ 1),
GsTotal = case_when(.data$Event == "S" ~ .data$GsTotal,
.data$Event == "t" ~ 1)) %>%
select(.data$idx, .data$SightNo,
.data$Obs, .data$Angle, .data$ObsStd, .data$SightStd,
.data$Mixed, .data$SpCode, .data$GsTotal, .data$GsSp)
sight.info.t <- sight.df %>%
filter(.data$Event == "t") %>%
mutate(TurtleSize = .data$Data4,
TurtleDirection = as.numeric(.data$Data5),
TurtleTail = .data$Data6) %>%
select(.data$idx, .data$TurtleSize, .data$TurtleDirection,
.data$TurtleTail)
left_join(sight.info.all, sight.info.t, by = "idx")
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.