Nothing
## ---- PAMpalSettings Class ----------------------------------------------------
#' @title \code{PAMpalSettings} Class
#' @description An S4 class that stores settings related to all processing and analysis steps
#' done in PAMpal. A PAMpalSettings object will be the main input to any major function
#' in the PAMpal package.
#'
#' @slot db the full path to a PamGuard database file
#' @slot binaries a list with items "folder" containing the directory of the
#' PamGuard binary files, and "list" containing the full path to each individual
#' binary file.
#' @slot functions a named list of functions to apply to data read in by PAMpal.
#' Should be named by the PamGuard module the function should be applied to.
#' Currently supports "ClickDetector", "WhistlesMoans", and "Cepstrum".
#' @slot calibration a named list of calibration functions to apply while
#' applying functions from the "functions" slot. Should named by the
#' PamGuard module, same as the "functions"
#' @slot settings a named list of settings, usually imported from Pamguard's
#' "Export XML Configuration"
#'
#' @author Taiki Sakai \email{taiki.sakai@@noaa.gov}
#' @export
#'
setClass('PAMpalSettings',
slots = c(
db = 'character',
binaries = 'list',
functions = 'list',
calibration = 'list',
settings = 'list'
),
prototype = prototype(
db = character(0),
binaries = list('folder'=character(0), 'list'=character(0)),
functions = list('ClickDetector'=list(), 'WhistlesMoans'=list(), 'Cepstrum'=list()),
calibration = list('ClickDetector'=list()),
settings = list(file=NA_character_,
sources=list(),
detectors=list(),
raw=NA_character_)
)
)
setValidity('PAMpalSettings',
function(object) {
valid <- TRUE
if(!all(c('folder', 'list') %in% names(object@binaries))) {
valid <- FALSE
cat('slot binaries must have items "folder" and "list"\n')
}
if(!all(c('ClickDetector', 'WhistlesMoans', 'Cepstrum') %in% names(object@functions))) {
valid <- FALSE
cat('slot functions must have items "ClickDetector", "WhistlesMoans", and "Cepstrum"\n')
}
valid
}
)
#' @importFrom utils str
#'
setMethod('show', 'PAMpalSettings', function(object) {
nBin <- length(object@binaries$list)
nBinDir <- length(object@binaries$folder)
nDb <- length(object@db)
nCal <- length(object@calibration$ClickDetector)
cat('PAMpalSettings object with:\n')
cat(nDb, 'database(s)')
if(nDb > 0) {
# showDb <- basename(object@db)
# if(nDb > 6) {
# showDb <- c(showDb[1:6], paste0('... (', nDb-6, ' more not shown)'))
# }
# cat(':\n ', paste(showDb, collapse='\n '))
cat(':\n ', printN(basename(object@db), n=6, collapse='\n '))
}
cat('\n', nBinDir, ' binary folder(s) ', sep = '')
if(nBinDir > 0) {
cat('containing', nBin, 'binary files\n')
} else {
cat('\n')
}
# Print function names and args for each module
for(m in seq_along(object@functions)) {
cat(length(object@functions[[m]]), ' function(s) for module type "',
names(object@functions)[m], '"\n', sep = '')
for(f in seq_along(object@functions[[m]])) {
cat(' "', names(object@functions[[m]])[f], '"\n ', sep = '')
cat(str(object@functions[[m]][[f]]))
}
}
cat(nCal, 'click calibration function(s)\n')
nSet <- length(object@settings)
if(nSet == 0) {
cat('0 settings files\n')
} else {
cat('1 settings file:\n ', basename(object@settings$file), '\n', sep=' ')
}
})
#' Check if an Object is a PAMpalSettings
#'
#' Function to check if an object is a PAMpalSettings
#'
#' @param x object to check
#'
#' @export
#'
is.PAMpalSettings <- function(x) {
inherits(x, 'PAMpalSettings')
}
## ---- AcousticEvent Class ---------------------------------------------------
# Acoustic event (obj) <--- this is really a list of AcEv? These need an ID for banter \acousticEvents
# Detector - named list [[detector name]] of lists \\detector
# Data.table of detections w/ id
# possible image
# Localization - named list[[loc. type name]] \\localization
# Data frame of positions
# Data Collection / Array Settings (obj) \\settings
# Hydro sens, sample rate, whatever. Make an object and we figure out what it needs
# Visual data (obj) \\visData
# Detection time, spp IDs, group size est, effort status. Multiple ways to read
# Behavioral (lul) \\behavior
# erddap \\erddap
# https://github.com/rmendels/Talks/blob/master/netCDF_Presentation/netcdf_opendap_erddap.Rmd
# Species classification - list of classifier objects \\species
# Method, prediction, assignment probabilities
# Duration? Files used? ID?
# setClassUnion('VisOrNULL', c('VisObsData', 'NULL'))
#' @title \code{AcousticEvent} Class
#' @description An S4 class storing acoustic detections from an Acoustic Event
#' as well as other related metadata
#'
#' @slot id unique id or name for this event
#' @slot detectors a list of data frames that have acoustic detections and
#' any measurements calculated on those detections. Each data frame is named
#' by the detector that made the detection
#' @slot localizations a named list storing localizations, named by method
#' @slot settings a list of recorder settings
#' @slot species a list of species classifications for this event, named by
#' classification method (ie. BANTER model, visual ID)
#' @slot files a list of files used to create this object, named by the type of
#' file (ie. binaries, database)
#' @slot ancillary a list of miscellaneous extra stuff. Store whatever you want here
#'
#' @author Taiki Sakai \email{taiki.sakai@@noaa.gov}
#' @export
#'
setClass('AcousticEvent',
slots = c(
id = 'character',
detectors = 'list',
localizations = 'list',
settings = 'list',
species = 'list',
files = 'list',
ancillary = 'list'),
prototype = prototype(id = character(), detectors=list(), localizations=list(),
settings=list(sr = NA_integer_), species=list(id=NA_character_),
files = list(), ancillary = list())
)
setValidity('AcousticEvent',
function(object) {
valid <- TRUE
valid
}
)
# Basic constructor
AcousticEvent <- function(id = character(), detectors=list(), localizations=list(),
settings=list(sr = NA_integer_),
species=list(id=NA_character_), files=list(), ancillary = list()) {
new('AcousticEvent', id = id, detectors=detectors, localizations=localizations, settings=settings,
species=species, files=files, ancillary = ancillary)
}
setMethod('show', 'AcousticEvent',
function(object) {
cat('AcousticEvent object "', id(object), '" with ',
length(object@detectors), ' detector(s): \n', sep='')
cat(paste(names(object@detectors), collapse=', '))
notes <- getNotes(object)
if(!is.null(notes)) {
cat('\nAnd ', length(unlist(notes)), ' notes:\n',
printN(formatNotes(notes, n=6), n=6, collapse='\n'),
sep = '')
}
}
)
#' Check if an Object is an AcousticEvent
#'
#' Function to check if an object is an AcousticEvent
#'
#' @param x object to check
#'
#' @export
#'
is.AcousticEvent <- function(x) {
inherits(x, 'AcousticEvent')
}
## ---- AcousticStudy Class ----------------------------------------------------------
# AcousticStudy class
# AcousticStudy (object)
# Files / folders (dbs, bins, vis, enviro) \folders
# GPS \gpsData
# Acoustic event (obj) <--- this is really a list of AcEv? These need an ID for banter \acousticEvents
# Detector - named list [[detector name]] of lists \\detector
# Data.table of detections w/ id
# possible image
# Localization - named list[[loc. type name]] \\localization
# Data frame of positions
# Data Collection / Array Settings (obj) \\settings
# Hydro sens, sample rate, whatever. Make an object and we figure out what it needs
# Visual data (obj) \\visData
# Detection time, spp IDs, group size est, effort status. Multiple ways to read
# Behavioral (lul) \\behavior
# erddap \\erddap
# Species classification - list of classifier objects \\species
# Method, prediction, assignment probabilities
# Detector settings - named list [[detector name]] \detectorSettings
# Localization settings - named list [[ loc. type]] \localizationSettings
# Some effort bullshit \effort
# ??????
# setOldClass(c('data.frame', 'data.table'))
#' @importClassesFrom data.table data.table
setClassUnion('dataframeORtable', members = c('data.frame', 'data.table'))
#' @title \code{AcousticStudy} Class
#' @description An S4 class storing acoustic data from an entire AcousticStudy
#' @slot id a unique id for the study
#' @slot events a list of \linkS4class{AcousticEvent} objects with
#' detections from the AcousticStudy
#' @slot files a list of folders and files containing the AcousticStudy data
#' @slot gps a data frame of gps coordinates for the entire AcousticStudy
#' @slot pps the \linkS4class{PAMpalSettings} object used to create this object
#' @slot settings a named list of various settings for detectors, localizers, etc.
#' @slot effort something about effort lol
#' @slot models a place to store any models run on your data
#' @slot ancillary miscellaneous extra data
#'
#' @author Taiki Sakai \email{taiki.sakai@@noaa.gov}
#'
#' @importFrom utils packageVersion
#' @export
#'
setClass('AcousticStudy',
slots = c(
id = 'character',
events = 'list',
files = 'list',
gps = 'dataframeORtable',
pps = 'PAMpalSettings',
settings = 'list',
effort = 'dataframeORtable',
models = 'list',
ancillary = 'list'),
prototype = prototype(
id = character(),
events=list(),
files=list(db='None', binaries='None', visual='None', enviro='None'),
gps=data.frame(),
pps = new('PAMpalSettings'),
settings=list(detectors=list(), localizations=list()),
effort=data.frame(),
models = list(),
ancillary=list())
)
setValidity('AcousticStudy',
function(object) {
valid <- TRUE
valid
}
)
# Constructor
AcousticStudy <- function(id=NULL,
events=list(),
files=list(db=NA_character_, binaries=NA_character_, visual=NA_character_, enviro=NA_character_),
gps=data.frame(),
pps=new('PAMpalSettings'),
settings=list(detectors=list(), localizations=list()),
effort=data.frame(),
models = list(),
ancillary=list()) {
if(is.null(id)) {
id <- Sys.Date()
message("No ID supplied for this AcousticStudy object, will use today's",
' date. Please assign a better name with id(study) <- "NAME"',
'\nIn the future it is recommended to set the "id" argument.')
}
id <- as.character(id)
fileTemp <- list(db=NA_character_, binaries=NA_character_, visual=NA_character_, enviro=NA_character_)
for(n in names(files)) {
fileTemp[[n]] <- files[[n]]
}
ancillary$version <- list(R = R.version.string,
PAMpal = packageVersion('PAMpal'))
ancillary$processDate <- Sys.time()
new('AcousticStudy', id=id, events=events, files=fileTemp, gps=gps,pps=pps,
settings=settings, effort=effort, models=models, ancillary=ancillary)
}
#' Check if an Object is an AcousticStudy
#'
#' Function to check if an object is an AcousticStudy
#'
#' @param x object to check
#'
#' @export
#'
is.AcousticStudy <- function(x) {
inherits(x, 'AcousticStudy')
}
setMethod('show', 'AcousticStudy',
function(object) {
cat('AcousticStudy object named ', id(object), ' with ',
length(events(object)), ' AcousticEvents.\n', sep='')
notes <- getNotes(object)
if(!is.null(notes)) {
cat('And ', length(unlist(notes)), ' notes:\n',
printN(formatNotes(notes, n=6), n=6, collapse='\n'),
sep='')
}
}
)
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.