Nothing
#' @title Remove a Calibration Function from a PAMpalSettings Object
#'
#' @description Remove a calibration function from the "calibration"
#' slot of a PAMpalSettings object
#'
#' @param pps a \linkS4class{PAMpalSettings} object to remove a calibration from
#' @param index index of the calibration function to remove. If \code{NULL}, user
#' will be prompted to select from a list. This can also be a vector to remove
#' multiple calibration functions at once.
#' @param module the module of the calibration function to remove, currently
#' not needed
#' @param verbose logical flag to show messages
#'
#' @return the same \linkS4class{PAMpalSettings} object as pps, with the calibration
#' function removed from the "calibration" slot
#'
#' @author Taiki Sakai \email{taiki.sakai@@noaa.gov}
#'
#' @examples
#'
#' pps <- new('PAMpalSettings')
#' calFile <- system.file('extdata', 'calibration.csv', package='PAMpal')
#' pps <- addCalibration(pps, calFile, all = TRUE, units=3)
#' calClick <- function(data, calibration=NULL) {
#' standardClickCalcs(data, calibration=calibration, filterfrom_khz = 0)
#' }
#' pps <- addFunction(pps, calClick, module = 'ClickDetector')
#' pps <- applyCalibration(pps, all=TRUE)
#' pps
#' removeCalibration(pps, index=1)
#'
#' @importFrom utils menu
#' @export
#'
removeCalibration <- function(pps, index=NULL, module='ClickDetector', verbose=TRUE) {
# if(is.null(module)) {
# modList <- names(pps@calibration)
# modix <- menu(choices = modList, title = 'Choose a module:')
# module <- modList[modix]
# }
calList <- names(pps@calibration[[module]])
if(length(calList) == 0) {
if(verbose) {
cat('No calibration functions to remove.')
}
return(pps)
}
if(is.null(index)) {
index <- menu(title = 'Which calibration function should we remove?',
choices = calList)
if(index==0) return(pps)
}
index <- sort(index) # needed for recursion with vector to work
dropName <- calList[index[1]]
pps@calibration[[module]] <- pps@calibration[[module]][-index[1]]
# Removing calibration from functions, set back to NULL
argList <- lapply(pps@functions[[module]], formals)
hasCal <- sapply(argList, function(x) {
'calibration' %in% names(x) &&
x[['calibration']] == dropName
})
if(length(hasCal) == 0) {
return(pps)
}
hasCal <- which(hasCal)
for(i in hasCal) {
thisArgs <- argList[[i]]
# this looks odd, but only way to set NULL without removing from list
whichCal <- which(names(thisArgs) == 'calibration')
thisArgs[whichCal] <- list(NULL)
formals(pps@functions[[module]][[i]]) <- thisArgs
if(verbose) {
cat('removed calibration from function', names(argList[i]), '\n')
}
}
# recursively remove if vector
if(length(index) > 1) {
return(removeCalibration(pps, index[-1]-1, module, verbose))
}
pps
}
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.