Nothing
#### SeaSondeRCS ####
##### Init and Defaults #####
seasonder_defaultCSNoiseLevel <- function(){
list(numeric(0), numeric(0), numeric(0))
}
seasonder_defaultCSReference_noise_normalized_limits_estimation_interval <- function(){
list(low_limit = 0.9, high_limit = 1.00)
}
seasonder_SeaSondeRCS_dataMatrix_dimensionNames <- function(nRanges, nDoppler) {
dimension_names <- list(sprintf("range_%03d",1:nRanges),sprintf("doppler_%03d",0:(nDoppler - 1)))
return(dimension_names)
}
new_SeaSondeRCS_SSMatrix <- function(nRanges, nDoppler, name = NULL, data = NULL) {
dimension_names <- seasonder_SeaSondeRCS_dataMatrix_dimensionNames(nRanges, nDoppler)
data <- data %||% rep(NA_real_, nRanges * nDoppler)
matrix <- matrix(data, ncol = nDoppler, byrow = TRUE, dimnames = dimension_names)
out <- structure(matrix,
name = name,
class = c("SeaSondeRCS_SSMatrix",class(matrix)))
return(out)
}
new_SeaSondeRCS_QCMatrix <- function(nRanges, nDoppler, name = NULL, data = NULL) {
dimension_names <- seasonder_SeaSondeRCS_dataMatrix_dimensionNames(nRanges, nDoppler)
data <- data %||% rep(NA_real_, nRanges * nDoppler)
matrix <- matrix(data, ncol = nDoppler, byrow = TRUE, dimnames = dimension_names)
out <- structure(matrix,
name = name,
class = c("SeaSondeRCS_QCMatrix", class(matrix)))
return(out)
}
new_SeaSondeRCS_CSMatrix <- function(nRanges, nDoppler, name = NULL, data = NULL) {
dimension_names <- seasonder_SeaSondeRCS_dataMatrix_dimensionNames(nRanges, nDoppler)
data <- data %||% rep(complex(real = NA_real_, imaginary = NA_real_), nRanges * nDoppler)
matrix <- matrix(data, ncol = nDoppler, byrow = TRUE, dimnames = dimension_names)
out <- structure(matrix,
name = name,
class = c("SeaSondeRCS_CSMatrix", class(matrix)))
return(out)
}
#' Initialize Cross-Spectra Data Structure for SeaSondeR
#'
#' This function initializes a data structure for storing cross-spectra data
#' related to SeaSonde radar measurements. It creates a list of matrices,
#' each corresponding to different components of the SeaSonde data.
#'
#' @param nRanges Integer, number of range cells in the radar measurement.
#' Specifies the number of rows in each matrix.
#' @param nDoppler Integer, number of Doppler bins in the radar measurement.
#' Specifies the number of columns in each matrix.
#'
#' @return A list containing matrices for different cross-spectra components:
#' \itemize{
#' \item \code{SSA1}: Matrix for SSA1 component, filled with \code{NA_real_}.
#' \item \code{SSA2}: Matrix for SSA2 component, filled with \code{NA_real_}.
#' \item \code{SSA3}: Matrix for SSA3 component, filled with \code{NA_real_}.
#' \item \code{CS12}: Matrix for CS12 component, complex numbers with \code{NA_real_} real and imaginary parts.
#' \item \code{CS13}: Matrix for CS13 component, complex numbers with \code{NA_real_} real and imaginary parts.
#' \item \code{CS23}: Matrix for CS23 component, complex numbers with \code{NA_real_} real and imaginary parts.
#' \item \code{QC}: Quality control matrix, filled with \code{NA_real_}.
#' }s
seasonder_initCSDataStructure <- function(nRanges, nDoppler) {
list(
SSA1 = new_SeaSondeRCS_SSMatrix(nRanges, nDoppler, name = "SSA1"),
SSA2 = new_SeaSondeRCS_SSMatrix(nRanges, nDoppler, name = "SSA2"),
SSA3 = new_SeaSondeRCS_SSMatrix(nRanges, nDoppler, name = "SSA3"),
CS12 = new_SeaSondeRCS_CSMatrix(nRanges, nDoppler, name = "CS12"),
CS13 = new_SeaSondeRCS_CSMatrix(nRanges, nDoppler, name = "CS13"),
CS23 = new_SeaSondeRCS_CSMatrix(nRanges, nDoppler, name = "CS23"),
QC = new_SeaSondeRCS_QCMatrix(nRanges, nDoppler, name = "QC")
)
}
seasonder_initSeaSondeRCS_FORFromHeader <- function(seasonder_cs_object, FOR) {
out <- FOR
nRanges <- seasonder_getnRangeCells(seasonder_cs_object)
nNegBraggLeftIndex <- seasonder_getSeaSondeRCS_headerField(seasonder_cs_object, "nNegBraggLeftIndex")$data %||% seasonder_getCSHeaderByPath(seasonder_cs_object,c("header_csr","alim","lims"), warn_missing = FALSE)[,"LeftBraggLeftLimit"] %||% rep(0,nRanges)
if (any(nNegBraggLeftIndex > 0)) {
nNegBraggRightIndex <- seasonder_getSeaSondeRCS_headerField(seasonder_cs_object,"nNegBraggRightIndex")$data %||% seasonder_getCSHeaderByPath(seasonder_cs_object,c("header_csr","alim","lims"),warn_missing = FALSE)[,"LeftBraggRightLimit"] %||% rep(0,nRanges)
if (any(nNegBraggRightIndex > 0 & nNegBraggLeftIndex > 0)) {
out <- 1:nRanges %>% purrr::reduce(\(result,i) {
if(i <= length(nNegBraggLeftIndex)){
left_index <- nNegBraggLeftIndex[i]
right_index <- nNegBraggRightIndex[i]
if (left_index > 0 && right_index > 0 && left_index <= right_index) {
result[[i]]$negative_FOR <- seq(left_index+1, right_index+1)
}
}
return(result)
},.init = out)
}
}
nPosBraggLeftIndex <- seasonder_getSeaSondeRCS_headerField(seasonder_cs_object,"nPosBraggLeftIndex")$data %||% seasonder_getCSHeaderByPath(seasonder_cs_object,c("header_csr","alim","lims"), warn_missing = FALSE)[,"RightBraggLeftLimit"] %||% rep(0,nRanges)
if (any(nPosBraggLeftIndex > 0)) {
nPosBraggRightIndex <- seasonder_getSeaSondeRCS_headerField(seasonder_cs_object,"nPosBraggRightIndex")$data %||% seasonder_getCSHeaderByPath(seasonder_cs_object,c("header_csr","alim","lims"),warn_missing = FALSE)[,"RightBraggRightLimit"] %||% rep(0,nRanges)
if (any(nPosBraggRightIndex > 0 & nPosBraggLeftIndex > 0)) {
out <- 1:nRanges %>% purrr::reduce(\(result,i) {
if(i <= length(nNegBraggLeftIndex)){
left_index <- nPosBraggLeftIndex[i]
right_index <- nPosBraggRightIndex[i]
if (left_index > 0 && right_index > 0 && left_index <= right_index) {
result[[i]]$positive_FOR <- seq(left_index+1, right_index+1)
}
}
return(result)
},.init = out)
}
}
return(out)
}
seasonder_defaultFOR <- function(seasonder_cs_object){
nRanges <- seasonder_getnRangeCells(seasonder_cs_object)
nDoppler <- seasonder_getnDopplerCells(seasonder_cs_object)
dim_names <- seasonder_SeaSondeRCS_dataMatrix_dimensionNames(nRanges = nRanges, nDoppler = nDoppler)
out <- rep(list(list(negative_FOR = integer(0), positive_FOR = integer(0))), nRanges)
names(out) <- dim_names[[1]]
return(out)
}
seasonder_initSeaSondeRCS_FOR <- function(seasonder_cs_object) {
out <- seasonder_defaultFOR(seasonder_cs_object)
out <- seasonder_initSeaSondeRCS_FORFromHeader(seasonder_cs_object, out)
return(out)
}
##### Class #####
#' Create a New SeaSondeRCS Object
#'
#' This function constructs a new SeaSondeRCS object with the provided header and data information,
#' initializing default values for various attributes including processing steps, FOR and MUSIC data,
#' noise level, APM, and reference noise normalized limits estimation interval.
#'
#' @param header A list containing header information for the SeaSondeRCS object.
#' @param data A list containing the data fields for the SeaSondeRCS object.
#' @param seasonder_apm_object An optional object representing the APM (Antenna Pattern Matrix or similar metadata).
#' If provided, it is assigned to the SeaSondeRCS object; otherwise, the APM attribute is set to NULL.
#'
#' @seealso
#' \code{\link{seasonder_setSeaSondeRCS_header}},
#' \code{\link{seasonder_setSeaSondeRCS_data}},
#' \code{\link{seasonder_setFOR_parameters}},
#' \code{\link{seasonder_setSeaSondeRCS_FOR}}
#'
#' @return A SeaSondeRCS object with version 1 containing the specified header, data, and default-initialized attributes.
#'
#' @details
#' The object is created with the following components:
#' \itemize{
#' \item \code{header}: Initially set to an empty list, then populated by \code{seasonder_setSeaSondeRCS_header}.
#' \item \code{data}: Initially set to an empty list, then populated by \code{seasonder_setSeaSondeRCS_data}.
#' \item \code{version}: Set to \code{1}.
#' \item \code{ProcessingSteps}: A character vector to log processing steps.
#' \item \code{FOR_data} and \code{MUSIC_data}: Initialized as empty lists.
#' \item \code{NoiseLevel}: Set using \code{seasonder_defaultCSNoiseLevel()}.
#' \item \code{APM}: Set to \code{seasonder_apm_object} if provided.
#' \item \code{interpolated_doppler_cells_index}: An integer vector initialized as empty.
#' \item \code{reference_noise_normalized_limits_estimation_interval}: Set using \code{seasonder_defaultCSReference_noise_normalized_limits_estimation_interval()}.
#' \item The object's class is set to \code{c("SeaSondeRCS", "list")}.
#' }
#'
#' After constructing the base object, the function updates the header and data attributes,
#' initializes FOR parameters, and sets up the FOR configuration by calling
#' \code{seasonder_initSeaSondeRCS_FOR}. A processing step message is logged to indicate successful creation.
#'
new_SeaSondeRCS <- function(header, data, seasonder_apm_object = NULL) {
out <- structure(list(header = list(),
data = list()),
version = 1, # An integer indicating the version of the SeaSondeRCS object. Current is 1.
ProcessingSteps = character(0),
FOR_data = list(),
MUSIC_data = list(),
NoiseLevel = seasonder_defaultCSNoiseLevel(),
APM = seasonder_apm_object,
interpolated_doppler_cells_index = integer(0),
reference_noise_normalized_limits_estimation_interval =
seasonder_defaultCSReference_noise_normalized_limits_estimation_interval(),
class = c("SeaSondeRCS", "list"))
out %<>% seasonder_setSeaSondeRCS_header(header)
out %<>% seasonder_setSeaSondeRCS_data(data)
# Attempt to set FOR parameters and initialize FOR configuration; skip on error (e.g., degenerate example data)
try({
out %<>% seasonder_setFOR_parameters(list())
out %<>% seasonder_setSeaSondeRCS_FOR(seasonder_initSeaSondeRCS_FOR(out))
}, silent = TRUE)
seasonder_logAndMessage("new_SeaSondeRCS: SeaSondeRCS object created successfully.", "info")
return(out)
}
#' Create a SeaSondeRCS object
#'
#' This generic function creates a SeaSondeRCS object either from a file path or directly from a list
#' containing header and data. When \code{x} is a character string, the function determines the file type
#' (either "CS", "CSSY" or "CSSW") by analyzing the spectra file and reads it using the appropriate reading function.
#' If \code{specs_path} is not provided (or set to \code{rlang::zap()}), the default YAML specifications path
#' corresponding to the detected file type is used.
#'
#' @param x Either a character string specifying the path to the SeaSonde CS file or a list containing header and data.
#' @param specs_path A character string specifying the path to the YAML specifications for the CS file. Used only if \code{x} is a character string.
#' @param ... Additional parameters passed to the underlying functions.
#'
#' @return A SeaSondeRCS object.
#'
#' @details
#' For character inputs, the function first checks if the specified file exists.
#' It then determines the file type using \code{seasonder_find_spectra_file_type}. If the \code{specs_path}
#' parameter is not provided or is set to \code{rlang::zap()}, the default specifications file path is obtained
#' using \code{seasonder_defaultSpecsFilePath} based on the detected file type. The file is then read using the
#' appropriate reading function:
#' \itemize{
#' \item \code{seasonder_readSeaSondeCSFile} for CS files.
#' \item \code{seasonder_readSeaSondeRCSSYFile} for CSSY files.
#' \item \code{seasonder_readSeaSondeRCSSWFile} for CSSW files.
#' }
#' For list inputs, the SeaSondeRCS object is created directly from the provided header and data.
#' Additionally, a processing step is appended to the object using \code{seasonder_setSeaSondeRCS_ProcessingSteps}
#' with a creation step text that indicates the source.
#'
#' @seealso
#' \code{\link{new_SeaSondeRCS}},
#' \code{\link{seasonder_readSeaSondeCSFile}},
#' \code{\link{seasonder_readSeaSondeRCSSWFile}},
#' \code{\link{seasonder_setSeaSondeRCS_ProcessingSteps}}
#'
#' @importFrom rlang zap
#' @importFrom glue glue
#'
#' @examples
#' # Creating a SeaSondeRCS object from a list
#' cs_file <- system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' specs_path <- seasonder_defaultSpecsFilePath("CS")
#' temp_obj <- seasonder_readSeaSondeCSFile(cs_file, specs_path)
#' cs_list <- list(header = temp_obj$header, data = temp_obj$data)
#' rcs_object <- seasonder_createSeaSondeRCS(cs_list)
#'
#' # Creating a SeaSondeRCS object from a file path using default YAML specifications
#' rcs_object <- seasonder_createSeaSondeRCS(system.file("css_data/CSS_TORA_24_04_04_0700.cs",
#' package = "SeaSondeR"))
#'
#' # Creating a SeaSondeRCS object from a file path with a specified YAML specifications file
#' rcs_object <- seasonder_createSeaSondeRCS(
#' system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR"),
#' specs_path = seasonder_defaultSpecsFilePath("CS")
#' )
#' @export
seasonder_createSeaSondeRCS <- function(x, specs_path = NULL, ...) {
UseMethod("seasonder_createSeaSondeRCS")
}
#' Create a SeaSondeRCS object from a list
#'
#' This method creates a SeaSondeRCS object directly from a list containing the header and data.
#'
#' @param x A list with components \code{header} and \code{data} required for constructing the SeaSondeRCS object.
#' @param specs_path Not used for list inputs.
#' @param ... Additional parameters that may be used for setting object attributes.
#'
#' @return A SeaSondeRCS object.
#'
#' @details
#' The function creates a new SeaSondeRCS object using \code{new_SeaSondeRCS} with the provided header and data.
#' It then appends a processing step, generated by \code{SeaSondeRCS_creation_step_text("list")}, to the object via
#' \code{seasonder_setSeaSondeRCS_ProcessingSteps}.
#'
#' @seealso
#' \code{\link{new_SeaSondeRCS}},
#' \code{\link{seasonder_setSeaSondeRCS_ProcessingSteps}},
#' \code{\link{SeaSondeRCS_creation_step_text}}
#'
#' @examples
#' # Given a list with header and data, create a SeaSondeRCS object
#' cs_file <- system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' specs_path <- seasonder_defaultSpecsFilePath("CS")
#' temp_obj <- seasonder_readSeaSondeCSFile(cs_file, specs_path)
#' cs_list <- list(header = temp_obj$header, data = temp_obj$data)
#' rcs_object <- seasonder_createSeaSondeRCS(cs_list)
#' @export
seasonder_createSeaSondeRCS.list <- function(x, specs_path = NULL, ...) {
# Creating the SeaSondeRCS object
out <- new_SeaSondeRCS(x$header, x$data, ...)
out %<>% seasonder_setSeaSondeRCS_ProcessingSteps(SeaSondeRCS_creation_step_text("list"))
return(out)
}
#' Create a SeaSondeRCS object from a file path
#'
#' This method creates a SeaSondeRCS object by reading a file from the specified file path.
#' It verifies the file's existence, determines the file type ("CS", "CSSY" or "CSSW") using
#' \code{seasonder_find_spectra_file_type}, and then reads the file using the appropriate function.
#' If \code{specs_path} is not provided (or is set to \code{rlang::zap()}), the default YAML specifications
#' file path is retrieved using \code{seasonder_defaultSpecsFilePath} based on the detected file type.
#'
#' @param x A character string specifying the path to the SeaSonde CS file.
#' @param specs_path A character string specifying the path to the YAML specifications for the CS file.
#' If not provided or set to \code{rlang::zap()}, the default specifications path for the detected file type is used.
#' @param endian A character string indicating the byte order. Options are "big" (default) or "little".
#' @param ... Additional parameters passed to \code{new_SeaSondeRCS} for creating the object.
#'
#' @return A SeaSondeRCS object.
#'
#' @details
#' The function performs the following steps:
#' \enumerate{
#' \item Checks if the file specified by \code{x} exists; if not, it aborts with an error.
#' \item Determines the file type using \code{seasonder_find_spectra_file_type}.
#' \item If \code{specs_path} is not provided or is set to \code{rlang::zap()}, retrieves the default YAML
#' specifications path using \code{seasonder_defaultSpecsFilePath} based on the detected file type.
#' \item Reads the file using the appropriate function:
#' \itemize{
#' \item \code{seasonder_readSeaSondeCSFile} for CS files.
#' \item \code{seasonder_readSeaSondeRCSSYFile} for CSSY files.
#' \item \code{seasonder_readSeaSondeRCSSWFile} for CSSW files.
#' }
#' \item Creates a SeaSondeRCS object using \code{new_SeaSondeRCS} with the header and data obtained from the file.
#' \item Appends a processing step indicating the creation source via \code{seasonder_setSeaSondeRCS_ProcessingSteps}
#' with a creation step text generated by \code{SeaSondeRCS_creation_step_text(x)}.
#' }
#'
#' @seealso
#' \code{\link{new_SeaSondeRCS}},
#' \code{\link{seasonder_find_spectra_file_type}},
#' \code{\link{seasonder_defaultSpecsFilePath}},
#' \code{\link{seasonder_readSeaSondeCSFile}},
#' \code{\link{seasonder_readSeaSondeRCSSYFile}},
#' \code{\link{seasonder_readSeaSondeRCSSWFile}},
#' \code{\link{seasonder_setSeaSondeRCS_ProcessingSteps}},
#' \code{\link{SeaSondeRCS_creation_step_text}}
#'
#' @importFrom rlang zap
#' @importFrom glue glue
#'
#' @examples
#' # Create a SeaSondeRCS object from a file using the default YAML specifications
#' rcs_object <- seasonder_createSeaSondeRCS(
#' system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' )
#'
#' # Create a SeaSondeRCS object from a file with a specified YAML specifications file
#' rcs_object <- seasonder_createSeaSondeRCS(
#' system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR"),
#' specs_path = seasonder_defaultSpecsFilePath("CS")
#' )
#' @export
seasonder_createSeaSondeRCS.character <- function(x, specs_path = rlang::zap(), endian = "big", ...) {
# Checking if the file exists
if (!file.exists(x)) {
seasonder_logAndAbort(
glue::glue("File '{x}' does not exist."),
calling_function = "seasonder_createSeaSondeRCS.character",
class = "seasonder_CS_file_not_found_error"
)
}
# Determine the file type ("CS", "CSSY" or "CSSW") by analyzing the spectra file
file_type <- seasonder_find_spectra_file_type(x, endian = endian)
if (rlang::is_zap(specs_path)) {
# Retrieve the default specifications file path based on the detected file type
specs_path <- seasonder_defaultSpecsFilePath(type = file_type)
}
# Select the appropriate read function based on the file type
read_fun <- switch(file_type,
CS = seasonder_readSeaSondeCSFile,
CSSY = seasonder_readSeaSondeRCSSYFile,
CSSW = seasonder_readSeaSondeRCSSWFile)
# Read the SeaSonde file using the chosen function
result <- read_fun(x, specs_path, endian = endian)
# Create the SeaSondeRCS object using the header and data retrieved from the file
out <- new_SeaSondeRCS(result$header, result$data, ...)
# Append processing step information indicating the creation source
out %<>% seasonder_setSeaSondeRCS_ProcessingSteps(SeaSondeRCS_creation_step_text(x))
return(out)
}
##### Validation #####
#' Validate ProcessingSteps Attribute for a SeaSondeRCS Object
#'
#' This function validates if the provided ProcessingSteps is a character vector.
#'
#' @param steps The character vector to be validated.
#' @return Returns TRUE if the validation passes.
validate_SeaSondeRCS_ProcessingSteps <- function(steps) {
if (!is.character(steps)) {
seasonder_logAndAbort("ProcessingSteps must be a character vector.", calling_function = "validate_SeaSondeRCS_ProcessingSteps")
}
return(TRUE)
}
#' Validate the Header of CrossSpectra Data
#'
#' This function validates the structure of a header list that is expected to
#' represent the metadata for a cross spectra file. It checks if the header is
#' indeed a list and whether mandatory elements, such as the number of range cells
#' and the number of Doppler cells, are present.
#'
#' @param header A list representing the header metadata of a cross spectra file.
#'
#' @section Details:
#' The function primarily checks for two conditions:
#' - Whether the provided header argument is a list.
#' - Whether the nRangeCells and nDopplerCells are present in the header.
#'
#' @section Condition Management:
#' This function utilizes the `rlang` package to manage conditions and provide
#' detailed and structured condition messages:
#'
#' \strong{Condition Classes}:
#' \itemize{
#' \item \code{seasonder_CS_header_is_not_a_list}: Triggered when the header parameter is not a list.
#' \item \code{seasonder_CS_missing_nRange_nDoppler_error}: Triggered when either nRangeCells or nDopplerCells is missing from the header.
#' }
#'
#' @return Invisible NULL if the header structure is valid. Otherwise, an error is thrown.
#'
#' @examples
#' header <- list(nRangeCells = 100, nDopplerCells = 256)
#' seasonder_validateCSHeaderStructure(header)
#' @export
seasonder_validateCSHeaderStructure <- function(header) {
# TODO: test, document, vignette
if (!rlang::is_list(header)) {
seasonder_logAndAbort(glue::glue("The 'header' parameter must be a list"), calling_function = "seasonder_setSeaSondeRCS_Header", class = "seasonder_CS_header_is_not_a_list", seasonder_header = header)
}
# Checking if nRanges and nDoppler are present in the header
if (is.null(header$nRangeCells) || is.null(header$nDopplerCells)) {
seasonder_logAndAbort(glue::glue("The 'nRangeCells' or 'nDopplerCells' are not present in the header data."), calling_function = "seasonder_setSeaSondeRCS_Header", class = "seasonder_CS_missing_nRange_nDoppler_error", seasonder_nRange = header$nRangeCells, seasonder_nDoppler = header$nDopplerCells)
}
invisible(NULL)
}
#' Validate the Data Structure of CrossSpectra Data
#'
#' This function checks the validity of the `data` structure for CrossSpectra (CS) data. It ensures that all required fields are present,
#' the dimensions of the matrices are correct based on `nRanges` and `nDoppler`, and that the types of the data fields are as expected.
#'
#' @param data A list representing the CrossSpectra (CS) data. It should contain fields "SSA1", "SSA2", "SSA3", "CS12", "CS13", "CS23", and "QC".
#' @param nRanges An integer specifying the expected number of range cells.
#' @param nDoppler An integer specifying the expected number of Doppler cells.
#'
#' @details
#' The function expects the following structure for the `data` list:
#' \itemize{
#' \item `SSA1`, `SSA2`, `SSA3`, `QC`: Matrices with numeric values, with dimensions `nRanges` x `nDoppler`.
#' \item `CS12`, `CS13`, `CS23`: Matrices with complex values, with dimensions `nRanges` x `nDoppler`.
#' }
#'
#' @section Error Management:
#' This function utilizes the `rlang` package to manage errors and provide detailed and structured error messages:
#'
#' \strong{Condition Classes}:
#' \itemize{
#' \item \code{seasonder_CS_data_structure_validation_error}: An error class indicating a problem with the data structure of the CrossSpectra (CS) data.
#' }
#'
#' \strong{Condition Cases}:
#' \itemize{
#' \item Missing fields in the data.
#' \item Incorrect dimensions for the matrices in the data.
#' \item Incorrect data type for the fields in the data.
#' }
#'
#' @return Invisible NULL if the data structure is valid. Otherwise, an error is thrown.
#'
#' @export
#'
#' @examples
#' # Example with all required fields
#' data <- list(
#' SSA1 = matrix(rep(NA_real_, 10 * 20), ncol = 20, byrow = TRUE),
#' SSA2 = matrix(rep(NA_real_, 10 * 20), ncol = 20, byrow = TRUE),
#' SSA3 = matrix(rep(NA_real_, 10 * 20), ncol = 20, byrow = TRUE),
#' CS12 = matrix(complex(real = NA, imaginary = NA), nrow = 10, ncol = 20),
#' CS13 = matrix(complex(real = NA, imaginary = NA), nrow = 10, ncol = 20),
#' CS23 = matrix(complex(real = NA, imaginary = NA), nrow = 10, ncol = 20),
#' QC = matrix(rep(NA_real_, 10 * 20), ncol = 20, byrow = TRUE)
#' )
#' seasonder_validateCSDataStructure(data, 10, 20)
#'
seasonder_validateCSDataStructure <- function(data, nRanges, nDoppler) {
# Prepare a list of parameters to be passed in case an error is encountered.
# This provides detailed information about the context of the error.
conditions_params = list(calling_function = "seasonder_validateDataStructure",
class = "seasonder_CS_data_structure_validation_error",
seasonder_data = data,
seasonder_nRanges = nRanges,
seasonder_nDoppler = nDoppler)
# Define the required fields that should be present in the data.
required_fields <- c("SSA1", "SSA2", "SSA3", "CS12", "CS13", "CS23", "QC")
# Loop over each required field to check its existence, dimensions, and data type.
for (field in required_fields) {
# Check if the current field exists in the data.
if (!field %in% names(data)) {
rlang::inject(seasonder_logAndAbort(glue::glue("Missing field '{field}' in data."), !!!conditions_params))
}
# Check if the dimensions of the matrix for the current field match the expected nRanges and nDoppler.
if (dim(data[[field]])[1] != nRanges || dim(data[[field]])[2] != nDoppler) {
rlang::inject(seasonder_logAndAbort(glue::glue("Incorrect dimensions for field '{field}' in data."), !!!conditions_params))
}
# Check the data type of the current field.
# SSA1, SSA2, SSA3, and QC should contain numeric values.
# CS12, CS13, and CS23 should contain complex values.
if (field %in% c("SSA1", "SSA2", "SSA3", "QC")) {
if (!is.numeric(data[[field]])) {
rlang::inject(seasonder_logAndAbort(glue::glue("Field '{field}' should contain numeric values."), !!!conditions_params))
}
} else {
if (!is.complex(data[[field]])) {
rlang::inject(seasonder_logAndAbort(glue::glue("Field '{field}' should contain complex values."), !!!conditions_params))
}
}
}
}
##### Setters #####
#' Setter for header
#'
#' @param seasonder_cs_object SeaSondeRCS object
#' @param header new value
#'
#' @seealso
#' \code{\link{seasonder_validateCSHeaderStructure}}
#'
#' @return A SeaSondeRCS object with updated header.
#'
#' @examples
#' # Set sample file paths and create SeaSondeRCS object
#' cs_file <- system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' apm_file <- system.file("css_data/MeasPattern.txt", package = "SeaSondeR")
#' apm_obj <- seasonder_readSeaSondeRAPMFile(apm_file)
#' cs_obj <- seasonder_createSeaSondeRCS(cs_file, seasonder_apm_object = apm_obj)
#' # Retrieve and set header
#' new_header <- seasonder_getSeaSondeRCS_header(cs_obj)
#' cs_obj <- seasonder_setSeaSondeRCS_header(cs_obj, new_header)
#' print(seasonder_getSeaSondeRCS_header(cs_obj))
#' @export
seasonder_setSeaSondeRCS_header <- function(seasonder_cs_object, header) {
# TODO: test, document, vignette
seasonder_validateCSHeaderStructure(header)
out <- seasonder_cs_object
out[["header"]] <- header
return(out)
}
#' Setter for data
#'
#' @param seasonder_cs_object SeaSondeRCS object
#' @param data new value
#'
#' @seealso
#' \code{\link{seasonder_validateCSDataStructure}}
#'
#' @return A SeaSondeRCS object with updated data.
#'
#' @examples
#' # Minimal example for seasonder_setSeaSondeRCS_data
#' cs_file <- system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' apm_file <- system.file("css_data/MeasPattern.txt", package = "SeaSondeR")
#' apm_obj <- seasonder_readSeaSondeRAPMFile(apm_file)
#' cs_obj <- seasonder_createSeaSondeRCS(cs_file, seasonder_apm_object = apm_obj)
#' new_data <- seasonder_getSeaSondeRCS_data(cs_obj)
#' cs_obj <- seasonder_setSeaSondeRCS_data(cs_obj, new_data)
#' str(seasonder_getSeaSondeRCS_data(cs_obj))
#' @export
seasonder_setSeaSondeRCS_data <- function(seasonder_cs_object, data) {
# TODO: test, document, vignette
nRangeCells <- seasonder_getnRangeCells(seasonder_cs_object)
nDopplerCells <- seasonder_getnDopplerCells(seasonder_cs_object)
seasonder_validateCSDataStructure(data,nRanges = nRangeCells, nDoppler = nDopplerCells)
out <- seasonder_cs_object
out[["data"]] <- data
return(out)
}
#' Setter for ProcessingSteps
#'
#' @param seasonder_cs_object SeaSondeRCS object
#' @param processing_steps new value
#' @param append append the new step or replace previous steps? Default: TRUE
#'
#' @examples
#' # Create a valid SeaSondeRCS object for examples
#' cs_file <- system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' apm_file <- system.file("css_data/MeasPattern.txt", package = "SeaSondeR")
#' apm_obj <- seasonder_readSeaSondeRAPMFile(apm_file)
#' cs_obj <- seasonder_createSeaSondeRCS(cs_file, seasonder_apm_object = apm_obj)
#' # Define and append new processing steps
#' new_steps <- "Example processing step"
#' cs_obj <- seasonder_setSeaSondeRCS_ProcessingSteps(cs_obj, new_steps)
#' print(seasonder_getSeaSondeRCS_ProcessingSteps(cs_obj))
#' @return A SeaSondeRCS object with updated ProcessingSteps.
#' @export
seasonder_setSeaSondeRCS_ProcessingSteps <- function(seasonder_cs_object, processing_steps,append = TRUE) {
if (append) {
steps <- seasonder_getSeaSondeRCS_ProcessingSteps(seasonder_cs_object)
processing_steps <- c(steps,processing_steps)
}
validate_SeaSondeRCS_ProcessingSteps(processing_steps)
out <- seasonder_cs_object
attr(out,"ProcessingSteps") <- processing_steps
return(out)
}
#' Set APM for a SeaSondeRCS Object
#'
#' This function assigns the provided APM object to the SeaSondeRCS object by setting its "APM" attribute.
#' (Note: Validation of the APM object is to be implemented.)
#'
#' @param seasonder_cs_object A SeaSondeRCS object.
#' @param seasonder_apm_object An object representing the APM (Antenna Pattern Matrix or similar metadata)
#' to be assigned to the SeaSondeRCS object.
#'
#' @return The updated SeaSondeRCS object with the new APM attribute set.
#'
#' @details
#' The function simply sets the "APM" attribute of the provided SeaSondeRCS object to the given
#' APM object. Further validation of the APM object should be performed (TODO).
#'
#' @examples
#' # Minimal example for seasonder_setSeaSondeRCS_APM
#' cs_file <- system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' apm_file <- system.file("css_data/MeasPattern.txt", package = "SeaSondeR")
#' apm_obj <- seasonder_readSeaSondeRAPMFile(apm_file)
#' cs_obj <- seasonder_createSeaSondeRCS(cs_file, seasonder_apm_object = apm_obj)
#' cs_obj <- seasonder_setSeaSondeRCS_APM(cs_obj, apm_obj)
#' print(attr(cs_obj, "APM"))
#' @export
seasonder_setSeaSondeRCS_APM <- function(seasonder_cs_object, seasonder_apm_object){
# TODO: Valiate APM obj
attr(seasonder_cs_object, "APM") <- seasonder_apm_object
return(seasonder_cs_object)
}
#' Set Noise Level Estimation Interval for a SeaSondeRCS Object
#'
#' This function sets the noise level estimation interval for a SeaSondeRCS object by updating the object's
#' attribute and recalculating the reference noise normalized limits. It then updates the FOR parameters with the new noise limits.
#'
#' @param seasonder_cs_object A SeaSondeRCS object.
#' @param interval_value A list containing the noise level estimation interval with two elements:
#' \itemize{
#' \item \code{low_limit}: A numeric value between 0 and 1 representing the lower limit.
#' \item \code{high_limit}: A numeric value between 0 and 1 representing the upper limit.
#' }
#' The \code{low_limit} should be less than \code{high_limit}.
#'
#' @return The updated SeaSondeRCS object with the new noise level estimation interval and reference noise normalized limits.
#'
#' @details
#' The function updates the attribute \code{"reference_noise_normalized_limits_estimation_interval"} of the SeaSondeRCS
#' object with \code{interval_value}. It then computes new reference noise normalized limits by calling
#' \code{seasonder_estimateReferenceNoiseNormalizedLimits} with the provided lower and upper limits.
#' Finally, it sets the new noise limits in the FOR parameters using \code{seasonder_setFORParameter}.
#'
#' @examples
#' new_interval <- list(low_limit = 0.9, high_limit = 1.0)
#' # Prepare a SeaSondeRCS object with valid data
#' apm_file <- system.file("css_data/MeasPattern.txt", package = "SeaSondeR")
#' apm_obj <- seasonder_readSeaSondeRAPMFile(apm_file)
#' cs_file <- system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' cs_obj <- seasonder_createSeaSondeRCS(
#' cs_file,
#' specs_path = seasonder_defaultSpecsFilePath("CS"),
#' seasonder_apm_object = apm_obj
#' )
#' cs_obj <- seasonder_setNoiseLevelEstimationInterval(cs_obj, new_interval)
#' print(attr(cs_obj, "reference_noise_normalized_limits_estimation_interval"))
#' noise_limits <- seasonder_getFOR_parameters(cs_obj)$reference_noise_normalized_limits
#' print(noise_limits)
#' @export
seasonder_setNoiseLevelEstimationInterval <- seasonder_setSeaSondeRCS_reference_noise_normalized_limits_estimation_interval <- function(seasonder_cs_object, interval_value) {
# TODO: Validate interval_value to be of length 2 and each value between 0 and 1. The low_limit value should be less than high_limit value.
out <- seasonder_cs_object
attr(out,"reference_noise_normalized_limits_estimation_interval") <- interval_value
new_limits <- seasonder_estimateReferenceNoiseNormalizedLimits(out, low_limit = interval_value$low_limit, high_limit = interval_value$high_limit)
out <- seasonder_setFORParameter(out, "reference_noise_normalized_limits", new_limits)
return(out)
}
##### Getters #####
#' Getter for header
#'
#' @param seasonder_cs_object SeaSondeRCS object
#'
#' @importFrom rlang %||%
#'
#'
#' @return A list containing the header data of the SeaSondeRCS object.
#'
#'
#' @examples
#' # Create a minimal SeaSondeRCS object with a header attribute
#' cs_obj <- structure(list(data = list(a = 1, b = 2)), class = "SeaSondeRCS")
#' attr(cs_obj, "header") <- list(
#' nSiteCodeName = "Station1",
#' nDateTime = Sys.time(),
#' nDopplerCells = 2,
#' nRangeCells = 3
#' )
#' header_data <- seasonder_getSeaSondeRCS_header(cs_obj)
#' print(header_data)
#' @export
seasonder_getSeaSondeRCS_header <- function(seasonder_cs_object) {
# TODO: test, document, vignette
out <- seasonder_cs_object[["header"]] %||% list()
return(out)
}
#' Convert SeaSondeRCS Object to JSON
#'
#' This function extracts the header data from a `seasonder_cs_object`, representing a SeaSondeRCS object, and converts it into a JSON format. Optionally, it can write this JSON data to a specified file path.
#'
#' @param seasonder_cs_object A SeaSondeRCS object from which the header data will be extracted.
#' @param path Optional path to a file where the JSON output should be saved. If provided, the function will write the JSON data to this file. If NULL, the function will only return the JSON data as a string without writing it to a file.
#'
#' @return A character string in JSON format representing the header data of the provided SeaSondeRCS object. If a path is provided, the function also writes this data to the specified file.
#'
#' @export
#'
#' @seealso
#' \code{\link{seasonder_createSeaSondeRCS}}, \code{\link{seasonder_getSeaSondeRCS_header}}
#'
#' @examples
#' # Example: create a simple SeaSondeRCS object and convert its header to JSON
#' cs_obj <- structure(list(data = list(a = 1, b = 2)), class = "SeaSondeRCS")
#' attr(cs_obj, "header") <- list(
#' nSiteCodeName = "Station1",
#' nDateTime = Sys.time(),
#' nDopplerCells = 2,
#' nRangeCells = 3
#' )
#' json_header <- seasonder_asJSONSeaSondeRCSHeader(cs_obj)
#' print(json_header)
#' @note
#' If a path is provided and there is an issue writing to the file, the function logs an error message using `seasonder_logAndMessage` and returns the JSON data as a string.
seasonder_asJSONSeaSondeRCSHeader <- function(seasonder_cs_object, path = NULL) {
header <- seasonder_getSeaSondeRCS_header(seasonder_cs_object)
out <- jsonlite::toJSON(header, pretty = TRUE)
if (!is.null(path)) {
rlang::try_fetch(jsonlite::write_json(header, path, pretty = TRUE, auto_unbox = TRUE),
error = function(e) {
seasonder_logAndMessage(glue::glue("Error while trying to write JSON to path {path}"), "error", calling_function = "seasonder_asJSONSeaSondeRCSHeader", class = "seasonder_write_JSON_error", seasonder_path = path, seasonder_JSON = out, seasonder_cs_object = seasonder_cs_object)
})
}
return(out)
}
#' Convert SeaSondeRCS Object to JSON
#'
#' This function extracts the data from a `seasonder_cs_object`, representing a SeaSondeRCS object, and converts it into a JSON format. Optionally, it can write this JSON data to a specified file path.
#'
#' @param seasonder_cs_object A SeaSondeRCS object from which the data will be extracted.
#' @param path Optional path to a file where the JSON output should be saved. If provided, the function will write the JSON data to this file. If NULL, the function will only return the JSON data as a string without writing it to a file.
#'
#' @return A character string in JSON format representing the data of the provided SeaSondeRCS object. If a path is provided, the function also writes this data to the specified file.
#'
#' @export
#'
#' @seealso
#' \code{\link{seasonder_createSeaSondeRCS}}, \code{\link{seasonder_getSeaSondeRCS_data}}
#'
#' @examples
#' # Example: create a simple SeaSondeRCS object and convert its data to JSON
#' cs_obj <- structure(list(data = list(a = 1, b = 2)), class = "SeaSondeRCS")
#' json_output <- seasonder_asJSONSeaSondeRCSData(cs_obj)
#' print(json_output)
#'
#' @note
#' If a path is provided and there is an issue writing to the file, the function logs an error message using `seasonder_logAndMessage` and returns the JSON data as a string.
seasonder_asJSONSeaSondeRCSData <- function(seasonder_cs_object, path = NULL) {
data <- seasonder_getSeaSondeRCS_data(seasonder_cs_object)
out <- jsonlite::toJSON(data, pretty = TRUE)
if (!is.null(path)) {
rlang::try_fetch(jsonlite::write_json(data, path, pretty = TRUE, auto_unbox = TRUE),
error = function(e) {
seasonder_logAndMessage(glue::glue("Error while trying to write JSON to path {path}"), "error", calling_function = "seasonder_asJSONSeaSondeRCSHeader", class = "seasonder_write_JSON_error", seasonder_path = path, seasonder_JSON = out, seasonder_cs_object = seasonder_cs_object)
})
}
return(out)
}
#' Retrieve the APM Attribute from a SeaSondeRCS Object
#'
#' This function extracts the APM (Antenna Pattern Matrix or similar metadata) attribute from
#' a SeaSondeRCS object. This attribute is stored as an attribute named "APM" within the object.
#'
#' @param seasonder_cs_object A SeaSondeRCS object.
#'
#' @return The value of the "APM" attribute from the SeaSondeRCS object.
#'
#' @details
#' The function uses \code{attr(..., exact = TRUE)} to ensure that the correct attribute is retrieved.
#'
#' @examples
#' # Create a minimal SeaSondeRCS object
#' cs_obj <- structure(list(data = list(a = 1, b = 2)), class = "SeaSondeRCS")
#' apm_value <- seasonder_getSeaSondeRCS_APM(cs_obj)
#' print(apm_value)
#' @export
seasonder_getSeaSondeRCS_APM <- function(seasonder_cs_object){
out <- attr(seasonder_cs_object, "APM", exact = TRUE)
return(out)
}
#' Retrieve the Reference Noise Normalized Limits Estimation Interval
#'
#' This function extracts the reference noise normalized limits estimation interval from a
#' SeaSondeRCS object's attributes. These limits are stored under the attribute name
#' \code{"reference_noise_normalized_limits_estimation_interval"}.
#'
#' @param seasonder_cs_object A SeaSondeRCS object.
#'
#' @return The reference noise normalized limits estimation interval as stored in the object.
#'
#' @details
#' This interval is typically used during the noise level estimation process for the SeaSondeRCS object.
#'
#' @examples
#' # Create a minimal SeaSondeRCS object
#' cs_obj <- structure(list(data = list(a = 1, b = 2)), class = "SeaSondeRCS")
#' interval <- seasonder_getSeaSondeRCS_reference_noise_normalized_limits_estimation_interval(cs_obj)
#' print(interval)
#' @export
seasonder_getSeaSondeRCS_reference_noise_normalized_limits_estimation_interval <- function(seasonder_cs_object) {
return(attr(seasonder_cs_object,"reference_noise_normalized_limits_estimation_interval", exact = TRUE))
}
###### Data ######
#' Getter for data
#'
#' @param seasonder_cs_object SeaSondeRCS object
#'
#' @seealso
#' \code{\link{seasonder_getnRangeCells}}
#' \code{\link{seasonder_getnDopplerCells}}
#' \code{\link{seasonder_initCSDataStructure}}
#'
#' @importFrom rlang %||%
#'
#'
#' @return A list containing the data matrices for the SeaSondeRCS object. If the data is not set, it initializes
#' the data structure with the number of range and Doppler cells.
#' @examples
#' # Create a minimal SeaSondeRCS object
#' cs_obj <- structure(list(data = list(a = 1, b = 2)), class = "SeaSondeRCS")
#' data_list <- seasonder_getSeaSondeRCS_data(cs_obj)
#' print(data_list)
#' @export
seasonder_getSeaSondeRCS_data <- function(seasonder_cs_object) {
# TODO: test, document, vignette
out <- seasonder_cs_object[["data"]]
if (is.null(out)) {
nRangeCells <- seasonder_getnRangeCells(seasonder_cs_object)
nDopplerCells <- seasonder_getnDopplerCells(seasonder_cs_object)
if (!is.null(nRangeCells) && nRangeCells > 0 && !is.null(nDopplerCells) && nDopplerCells > 0) {
out <- seasonder_initCSDataStructure(nRanges = nRangeCells, nDoppler = nDopplerCells)
}
}
return(out)
}
#' Retrieve a Specific Data Matrix from a SeaSondeRCS Object
#'
#' This function extracts a specific data matrix from a SeaSondeRCS object. The available matrices
#' correspond to self-spectra and cross-spectra components used in SeaSonde radar processing.
#'
#' @param seasonder_cs_object A SeaSondeRCS object containing the spectral data.
#' @param matrix_name A string specifying the name of the matrix to retrieve. Must be one of:
#' \itemize{
#' \item \code{"SSA1"}: Self-spectra for antenna 1.
#' \item \code{"SSA2"}: Self-spectra for antenna 2.
#' \item \code{"SSA3"}: Self-spectra for antenna 3.
#' \item \code{"CS12"}: Cross-spectra between antennas 1 and 2.
#' \item \code{"CS13"}: Cross-spectra between antennas 1 and 3.
#' \item \code{"CS23"}: Cross-spectra between antennas 2 and 3.
#' \item \code{"QC"}: Quality control matrix.
#' }
#'
#' @return A matrix containing the requested spectral data. If the matrix name is invalid, an error is thrown.
#'
#' @details
#' The function first verifies that the provided \code{matrix_name} is valid. If the name is not
#' in the list of accepted values, it logs an error and aborts execution using \code{\link{seasonder_logAndAbort}}.
#' Once validated, the function extracts the requested matrix from the \code{data} component of the
#' SeaSondeRCS object.
#'
#' @seealso
#' \code{\link{seasonder_getSeaSondeRCS_data}} for retrieving the complete data structure.
#' \code{\link{seasonder_logAndAbort}} for error handling.
#'
#' @importFrom glue glue
#' @importFrom rlang %||%
#'
seasonder_getSeaSondeRCS_dataMatrix <- function(seasonder_cs_object, matrix_name) {
# Validate that the matrix_name is one of the expected values
matrix_name %in% c("SSA1", "SSA2", "SSA3", "CS12", "CS13", "CS23", "QC") ||
seasonder_logAndAbort(
glue::glue("Unknown data matrix name '{matrix_name}'"),
calling_function = "seasonder_getSeaSondeRCS_dataMatrix",
class = "seasonder_unknown_data_matrix_name",
seasonder_matrix_name = matrix_name
)
# Retrieve the full data list from the SeaSondeRCS object
data_list <- seasonder_getSeaSondeRCS_data(seasonder_cs_object = seasonder_cs_object)
# Extract the requested matrix
matrix <- data_list[[matrix_name]]
return(matrix)
}
##' Retrieve Self-Spectra Data for a Specific Antenna from a SeaSondeRCS Object
#'
#' This function extracts the self-spectra (SSA) data matrix for a given antenna from a SeaSondeRCS object.
#'
#' @param seasonder_cs_object A SeaSondeRCS object containing spectral data.
#' @param antenna An integer specifying the antenna number (1, 2, or 3).
#'
#' @return A matrix containing the self-spectra data for the specified antenna. If the antenna number
#' is invalid, an error is thrown.
#'
#' @details
#' The function constructs the matrix name dynamically by appending the antenna number to the prefix
#' \code{"SSA"} (e.g., \code{"SSA1"}, \code{"SSA2"}, or \code{"SSA3"}). It then retrieves the corresponding
#' matrix from the SeaSondeRCS data using \code{\link{seasonder_getSeaSondeRCS_dataMatrix}}.
#'
#' @seealso
#' \code{\link{seasonder_getSeaSondeRCS_dataMatrix}} for extracting specific data matrices.
#' \code{\link{seasonder_getSeaSondeRCS_data}} for retrieving the complete data structure.
#'
#' @importFrom glue glue
#' @importFrom rlang %||%
#'
seasonder_getSeaSondeRCS_antenna_SSdata <- function(seasonder_cs_object, antenna) {
# Construct the matrix name dynamically using the antenna number
matrix_name <- paste0("SSA", antenna)
# Retrieve the self-spectra matrix for the specified antenna
matrix <- seasonder_getSeaSondeRCS_dataMatrix(
seasonder_cs_object = seasonder_cs_object,
matrix_name = matrix_name
)
return(matrix)
}
seasonder_extractSeaSondeRCS_distRanges_from_SSdata <- function(SSmatrix, dist_ranges) {
# TODO: check that dist_ranges is in the matrix range
sliced_SSmatrix <- SSmatrix[dist_ranges,, drop = FALSE]
return(sliced_SSmatrix)
}
#' Extract Doppler Ranges from Self-Spectra Data Matrix
#'
#' This function slices a self-spectra data matrix by selecting the columns corresponding to the specified Doppler cells.
#'
#' @param SSmatrix A matrix containing self-spectra data, where columns represent Doppler bins.
#' @param doppler_cells A numeric vector specifying the indices of the Doppler bins to extract.
#'
#' @return A matrix containing only the columns corresponding to the selected Doppler cells.
#'
#' @details
#' The function extracts a subset of columns from the self-spectra matrix. No explicit validation is currently
#' performed to verify that the provided Doppler cell indices fall within the range of the matrix columns.
#'
seasonder_extractSeaSondeRCS_dopplerRanges_from_SSdata <- function(SSmatrix, doppler_cells) {
# TODO: check that doppler_cells is in the matrix range
sliced_SSmatrix <- SSmatrix[,doppler_cells, drop = FALSE]
return(sliced_SSmatrix)
}
#' Retrieve Self-Spectra Power Matrices for Specified Antenna, Range, and Doppler Intervals
#'
#' This function returns a list of power spectra extracted from a SeaSondeRCS object for each combination
#' of the specified antennae, range intervals, and Doppler intervals. It allows users to focus on subregions
#' of the self-spectra data. Additionally, the resulting nested list can be collapsed into a single-level list.
#'
#' @param seasonder_cs_object A SeaSondeRCS object containing spectral data.
#' @param antennae A vector specifying the antenna(s) from which to extract self-spectra. If not named,
#' the antennae will be automatically named as "A1", "A2", etc.
#' @param dist_ranges Optional. A list (or vector) of range cell indices or ranges of interest.
#' If not provided, it defaults to using the full range available.
#' @param doppler_ranges Optional. A list (or vector) of Doppler bin indices or ranges of interest.
#' If not provided, defaults to the complete Doppler range.
#' @param dist_in_km Logical; if \code{TRUE}, the distance ranges provided in kilometers are converted
#' into range cell numbers.
#' @param collapse Logical; if \code{TRUE}, the nested list structure of the output is flattened into a single list.
#' @param smoothed Logical; if \code{TRUE}, smoothed self-spectra data is used (via \code{seasonder_SmoothSS});
#' otherwise, raw self-spectra data is used.
#'
#' @return A (potentially nested) list of self-spectra power matrices corresponding to each combination
#' of antenna, range interval, and Doppler interval. If \code{collapse = TRUE}, the list is flattened.
#'
#' @details
#' The function operates as follows:
#' \enumerate{
#' \item If \code{doppler_ranges} is not provided, it sets a default list with the full Doppler range,
#' using the total number of Doppler cells.
#' \item If \code{dist_ranges} is not provided, it sets a default list with the full range, using the total number
#' of range cells.
#' \item If any of \code{antennae}, \code{dist_ranges}, or \code{doppler_ranges} are not named,
#' they are automatically named using a default naming scheme.
#' \item Based on the \code{smoothed} flag, the function retrieves either smoothed self-spectra data
#' via \code{seasonder_SmoothSS} or raw self-spectra data via \code{seasonder_getSeaSondeRCS_antenna_SSdata}.
#' \item If \code{dist_in_km} is \code{TRUE}, the distance ranges provided in kilometers are converted to
#' range cell numbers using \code{seasonder_rangeCellsDists2RangeNumber}.
#' \item For each self-spectra matrix, the function slices the matrix over the specified range and Doppler intervals.
#' \item Finally, if \code{collapse = TRUE}, the nested list is flattened into a single-level list.
#' }
#'
seasonder_getSeaSondeRCS_SelfSpectra <- function(seasonder_cs_object, antennae, dist_ranges = NULL, doppler_ranges = NULL, dist_in_km = FALSE, collapse = FALSE, smoothed =FALSE) {
out <- list()
doppler_ranges <- doppler_ranges %||% list(all_doppler = range(seq_len(seasonder_getnDopplerCells(seasonder_cs_object))))
dist_ranges <- dist_ranges %||% list(all_ranges = range(seq_len(seasonder_getnRangeCells(seasonder_cs_object))))
if (!rlang::is_list(dist_ranges)) {
dist_ranges <- list(dist_ranges)
}
if (!rlang::is_list(doppler_ranges)) {
doppler_ranges <- list(doppler_ranges)
}
if (!rlang::is_named(antennae)) {
antennae %<>% magrittr::set_names(sprintf("A%d",as.integer(antennae)))
}
if (!rlang::is_named(dist_ranges)) {
dist_ranges %<>% magrittr::set_names(sprintf("dist_range_%d",1:length(dist_ranges)))
}
if (!rlang::is_named(doppler_ranges)) {
doppler_ranges %<>% magrittr::set_names(sprintf("doppler_range_%d",1:length(doppler_ranges)))
}
# TODO: option for all antennae, all dist_ranges and all doppler_ranges
# TODO: wrappers for antenna + dist_ranges, antenna + doppler ranges, disr_ranges + doppler ranges, dist_ranges, antenna and doppler ranges.
if(smoothed){
SSMatrices <- antennae %>% purrr::map(\(antenna) seasonder_SmoothSS(seasonder_cs_object, antenna))
}else{
SSMatrices <- antennae %>% purrr::map(\(antenna) seasonder_getSeaSondeRCS_antenna_SSdata(seasonder_cs_object,antenna))
}
# Slice dist_ranges
if (dist_in_km) {
dist_ranges %<>% purrr::map(\(dists) {
dists <- seasonder_rangeCellsDists2RangeNumber(seasonder_cs_object, dists)
dists[1] <- floor(dists[1])
dists[2] <- ceiling(dists[2])
return(dists)
})
}
out <- SSMatrices %>% purrr::map(\(SSmatrix) {
sliced_matrix <- dist_ranges %>% purrr::map(\(dists) {
dist_slice <- seasonder_extractSeaSondeRCS_distRanges_from_SSdata(SSmatrix = SSmatrix, dist_ranges = seq(dists[1],dists[2]))
dist_doppler_slice <- doppler_ranges %>% purrr::map(\(doppler_cells) {
doppler_slice <- seasonder_extractSeaSondeRCS_dopplerRanges_from_SSdata(SSmatrix = dist_slice, doppler_cells = seq(doppler_cells[1], doppler_cells[2]))
return(doppler_slice)
})
return(dist_doppler_slice)
})
return(sliced_matrix)
})
if (collapse) {
out %<>% purrr::list_flatten(name_spec = "{outer}:{inner}") %>% purrr::list_flatten(name_spec = "{outer}:{inner}")
}
return(out)
}
###### Metadata ######
#' Getter for ProcessingSteps
#'
#' @param seasonder_cs_object SeaSonderCS object
#'
#' @return A list containing the processing steps of the SeaSondeRCS object.
#' @examples
#' # Create a SeaSondeRCS object for examples
#' cs_file <- system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' apm_file <- system.file("css_data/MeasPattern.txt", package = "SeaSondeR")
#' apm_obj <- seasonder_readSeaSondeRAPMFile(apm_file)
#' cs_obj <- seasonder_createSeaSondeRCS(cs_file, seasonder_apm_object = apm_obj)
#' # Retrieve processing steps
#' processing_steps <- seasonder_getSeaSondeRCS_ProcessingSteps(cs_obj)
#' print(processing_steps)
#' @export
seasonder_getSeaSondeRCS_ProcessingSteps <- function(seasonder_cs_object) {
return(attributes(seasonder_cs_object)$ProcessingSteps)
}
#' Get the version value from a SeaSondeRCS object
#'
#' @param seasonder_obj A SeaSondeRCS object.
#' @return The version value.
#' @examples
#' # Get version from a SeaSondeRCS object
#' cs_file <- system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' apm_file <- system.file("css_data/MeasPattern.txt", package = "SeaSondeR")
#' apm_obj <- seasonder_readSeaSondeRAPMFile(apm_file)
#' cs_obj <- seasonder_createSeaSondeRCS(cs_file, seasonder_apm_object = apm_obj)
#' value <- seasonder_getVersion(cs_obj)
#' print(value)
#' @export
seasonder_getVersion.SeaSondeRCS <- function(seasonder_obj) {
attr(seasonder_obj,"version",exact = TRUE)
}
###### Header Fields ######
#' Retrieve a value from the SeaSondeRCS header by a specific path
#'
#' This function retrieves a specific value from the SeaSondeRCS object's header based on the provided path.
#' The path can be a single field name or a list of nested field names.
#'
#' @param seasonder_obj A SeaSondeRCS object.
#' @param path A character vector specifying the field or nested fields to retrieve.
#' @param warn_missing Logical; if \code{TRUE}, a warning is issued if the specified path is not found in the header.
#'
#' @return The value at the specified path in the header. If the path is not found, NULL is returned and a warning is thrown.
#'
#' @section Condition Management:
#' This function utilizes the `rlang` package to manage errors and conditions, and provide detailed and structured condition messages:
#'
#' \strong{Condition Classes}:
#' \itemize{
#' \item \code{seasonder_SeaSonderCS_field_not_found_in_header}: Indicates that the specified path was not found in the header.
#' }
#'
#' \strong{Condition Cases}:
#' \itemize{
#' \item Field or nested fields specified by the path are not found in the header.
#' }
#'
#' @examples
#' # Minimal example for seasonder_getCSHeaderByPath
#' cs_file <- system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' apm_file <- system.file("css_data/MeasPattern.txt", package = "SeaSondeR")
#' apm_obj <- seasonder_readSeaSondeRAPMFile(apm_file)
#' cs_obj <- seasonder_createSeaSondeRCS(cs_file, seasonder_apm_object = apm_obj)
#' field_value <- seasonder_getCSHeaderByPath(cs_obj, c("nRangeCells"))
#' print(field_value)
#' @export
seasonder_getCSHeaderByPath <- function(seasonder_obj, path, warn_missing = TRUE) {
header <- seasonder_getSeaSondeRCS_header(seasonder_obj)
# Use purrr::pluck to extract the value from the header
result <- rlang::inject(purrr::pluck(header, !!!path))
# If the result is NULL, log a warning
if (is.null(result) && warn_missing) {
path_str <- paste0(path, collapse = "/")
warning_msg <- glue::glue("Field '{path_str}' not found in header.", path_str = path_str)
seasonder_logAndMessage(warning_msg, "error", calling_function = "seasonder_getCSHeaderByPath", class = "seasonder_SeaSonderCS_field_not_found_in_header")
}
return(result)
}
#' Retrieve a Specific Field from a SeaSondeRCS Header
#'
#' This function extracts a specific field from the header of a SeaSondeRCS object.
#'
#' @param seasonder_cs_object A SeaSondeRCS object.
#' @param field A string specifying the field name to retrieve from the header.
#'
#' @return The value of the specified field from the header. If the field is not found, NULL is returned.
#'
#' @details
#' This function first retrieves the full header using \code{\link{seasonder_getSeaSondeRCS_header}}
#' and then attempts to extract the requested field using \code{\link[purrr]{pluck}}. The header is
#' flattened before extraction to accommodate nested structures.
#'
#' @seealso
#' \code{\link{seasonder_getSeaSondeRCS_header}} for retrieving the full header.
#' \code{\link[purrr]{pluck}} for selective element extraction.
#'
#' @importFrom purrr pluck list_flatten
#'
seasonder_getSeaSondeRCS_headerField <- function(seasonder_cs_object, field) {
# Retrieve the header from the SeaSondeRCS object
header <- seasonder_getSeaSondeRCS_header(seasonder_cs_object)
if(field %in% names(header)){
value <- header[[field]]
}else{
# Flatten the header structure to allow direct access to nested fields
header_flattened <- purrr::list_flatten(header, name_spec = "{inner}")
# Extract the requested field using purrr::pluck
value <- purrr::pluck(header_flattened, field)
}
return(value)
}
#' Get the nRangeCells value from a SeaSondeRCS object
#'
#' @param seasonder_obj A SeaSondeRCS object.
#' @return The nRangeCells value.
#' @examples
#' # Minimal example for seasonder_getnRangeCells
#' cs_file <- system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' apm_file <- system.file("css_data/MeasPattern.txt", package = "SeaSondeR")
#' apm_obj <- seasonder_readSeaSondeRAPMFile(apm_file)
#' cs_obj <- seasonder_createSeaSondeRCS(cs_file, seasonder_apm_object = apm_obj)
#' n_range_cells <- seasonder_getnRangeCells(cs_obj)
#' print(n_range_cells)
#' @export
seasonder_getnRangeCells <- function(seasonder_obj) {
return(seasonder_getSeaSondeRCS_headerField(seasonder_obj, "nRangeCells"))
}
#' Get the nDopplerCells value from a SeaSondeRCS object
#'
#' @param seasonder_obj A SeaSondeRCS object.
#' @examples
#' # Minimal example for seasonder_getnDopplerCells
#' cs_file <- system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' apm_file <- system.file("css_data/MeasPattern.txt", package = "SeaSondeR")
#' apm_obj <- seasonder_readSeaSondeRAPMFile(apm_file)
#' cs_obj <- seasonder_createSeaSondeRCS(cs_file, seasonder_apm_object = apm_obj)
#' n_doppler_cells <- seasonder_getnDopplerCells(cs_obj)
#' print(n_doppler_cells)
#' @return The nDopplerCells value.
#' @export
seasonder_getnDopplerCells <- function(seasonder_obj) {
out <- seasonder_getSeaSondeRCS_headerField(seasonder_obj, "nDopplerCells")
return(out)
}
seasonder_getCellsDistKm <- function(seasonder_cs_object) {
return(seasonder_getSeaSondeRCS_headerField(seasonder_cs_object, "CellsDistKm"))
}
#' Retrieve Center Frequency in MHz
#'
#' This function extracts the center frequency (in MHz) from the header of a
#' SeaSondeRCS object. It accesses the header field named "CenterFreq" using
#' \code{seasonder_getSeaSondeRCS_headerField}.
#'
#' @param seasonder_cs_object A SeaSondeRCS object containing header information.
#'
#' @return A numeric value representing the center frequency in MHz.
#'
seasonder_getCenterFreqMHz <- function(seasonder_cs_object) {
return(seasonder_getSeaSondeRCS_headerField(seasonder_cs_object, "CenterFreq"))
}
seasonder_getnCsFileVersion <- function(seasonder_cs_object){
return(seasonder_getSeaSondeRCS_headerField(seasonder_cs_object, "nCsFileVersion"))
}
seasonder_getfLongitude <- function(seasonder_cs_object){
out <- NULL
if( seasonder_getnCsFileVersion(seasonder_cs_object) >= 6) {
out <- seasonder_getSeaSondeRCS_headerField(seasonder_cs_object, "fLongitude")
}
return(out)
}
seasonder_getfLatitude <- function(seasonder_cs_object){
out <- NULL
if( seasonder_getnCsFileVersion(seasonder_cs_object) >= 6) {
out <- seasonder_getSeaSondeRCS_headerField(seasonder_cs_object, "fLatitude")
}
return(out)
}
###### + Derived parameters ######
#' Retrieve Receiver Gain in Decibels
#'
#' This function retrieves the receiver gain value (in decibels) from the header
#' of a given `SeaSondeRCS` object. If the receiver gain field is missing or NULL,
#' a default value of -34.2 dB is returned.
#'
#' @param seasonder_cs_object A `SeaSondeRCS` object containing header information
#' about the radar system.
#'
#' @return A numeric value representing the receiver gain in decibels (dB).
#'
#' @details
#' The function extracts the value of the header field \code{fReferenceGainDB}
#' using \code{\link{seasonder_getSeaSondeRCS_headerField}}. If the field is not
#' present or has a NULL value, the function defaults to a receiver gain of -34.2 dB (CODAR, 2016).
#'
#' @references
#' Cross Spectra File Format Version 6, CODAR. (2016).
#'
#' @seealso
#' \code{\link{seasonder_getSeaSondeRCS_headerField}} to retrieve specific fields from
#' the `SeaSondeRCS` header.
#'
seasonder_getReceiverGain_dB <- function(seasonder_cs_object) {
# Retrieve the receiver gain from the SeaSondeRCS object's header field "fReferenceGainDB".
# If the field is missing or NULL, a default value of -34.2 dB is used.
receiver_gain <- seasonder_getCSHeaderByPath(seasonder_cs_object, c("RCVI","fReferenceGainDB"),warn_missing =FALSE) %||% 34.2
# Return the receiver gain in decibels.
return(receiver_gain)
}
#' Compute the Center Doppler Bin
#'
#' This function calculates the center Doppler bin for a SeaSondeRCS object
#' based on the total number of Doppler bins. The center bin corresponds to
#' the bin representing zero Doppler frequency.
#'
#' @param seasonder_cs_object A `SeaSondeRCS` object containing metadata about
#' Doppler bins and other radar parameters.
#' @param nDoppler An integer representing the total number of Doppler bins.
#'
#' @return A numeric value representing the center Doppler bin. The calculation
#' assumes zero-based indexing from CODAR data files, but note that R
#' uses one-based indexing, which may result in differences compared to
#' CODAR's Radia Suite outputs.
#'
#' @details
#' The center Doppler bin is computed as:
#' \eqn{center\_bin = nDoppler/2}
#' where nDoppler is the total number of Doppler bins. This represents
#' the bin at zero Doppler frequency in a zero-indexed system. Since R uses
#' one-based indexing, users might observe an offset when comparing the output
#' of this function to CODAR's Radia Suite programs.
#'
#' @seealso
#' \code{\link{seasonder_getSeaSondeRCS_MUSIC_nDopplerCells}} to retrieve the number
#' of Doppler cells from a SeaSondeRCS object.
#'
seasonder_computeCenterDopplerBin <- function(seasonder_cs_object, nDoppler) {
# Calculate the center Doppler bin. This assumes that the Doppler cells are zero-indexed
# in the original CODAR data files, but R indexing starts at one. Therefore, this result
# might differ from the outputs of Radia Suite programs by CODAR.
center_bin <- nDoppler / 2
# Return the computed center bin.
return(center_bin)
}
#' Retrieve Center Doppler Bin
#'
#' This function calculates the center Doppler bin index for a SeaSondeRCS object.
#' It obtains the total number of Doppler cells from the object using
#' \code{seasonder_getnDopplerCells} and computes the center bin with
#' \code{seasonder_computeCenterDopplerBin}.
#'
#' @param seasonder_cs_object A SeaSondeRCS object containing metadata about Doppler bins.
#'
#' @return A numeric value representing the center Doppler bin.
#'
#' @details
#' The center Doppler bin is computed by retrieving the total number of Doppler cells
#' (via \code{seasonder_getnDopplerCells}) and then processing that value with
#' \code{seasonder_computeCenterDopplerBin}. Note that while CODAR data files might use
#' zero-based indexing, R uses one-based indexing.
#'
seasonder_getCenterDopplerBin <- function(seasonder_cs_object) {
nDoppler <- seasonder_getnDopplerCells(seasonder_cs_object)
out <- seasonder_computeCenterDopplerBin(seasonder_cs_object, nDoppler)
return(out)
}
#' Calculate the Radar Wavelength
#'
#' This function computes the radar wavelength based on the center frequency
#' of the SeaSonde radar system. The wavelength is derived using the speed of
#' light and the radar's center frequency.
#'
#' @param seasonder_cs_object A `SeaSondeRCS` object containing metadata about
#' the radar system, including its center frequency.
#'
#' @return A numeric value representing the radar wavelength in meters (m).
#'
#' @details
#' The radar wavelength \eqn{\lambda} is calculated using the formula:
#' \eqn{\lambda = \frac{c}{f}}
#' where:
#' - \eqn{c} is the speed of light (approximately \eqn{3 * 10^8} m/s),
#' - \eqn{f} is the radar's center frequency in Hz, retrieved from the SeaSondeRCS object.
#'
#' The center frequency is initially stored in MHz and is converted to Hz by multiplying
#' it by \eqn{10^6}.
#'
#' @seealso
#' \code{\link{seasonder_getCenterFreqMHz}} to retrieve the radar's center frequency.
#'
seasonder_getRadarWaveLength <- function(seasonder_cs_object) {
# Retrieve the radar's center frequency in MHz from the SeaSondeRCS object
# and convert it to Hz by multiplying by 1,000,000.
CenterFreq <- seasonder_getCenterFreqMHz(seasonder_cs_object) * 1000000
# Retrieve the speed of light constant (c0) from the constants package.
c <- constants::syms$c0
# Calculate the radar wavelength using the formula wavelength = c / CenterFreq,
# where c is the speed of light (m/s) and CenterFreq is the radar frequency (Hz).
l <- c / CenterFreq
# Return the calculated wavelength in meters.
return(l)
}
#' Calculate the Radar Wave Number
#'
#' This function computes the radar wave number \eqn{k} for a SeaSonde radar
#' system based on its wavelength. The wave number represents the spatial frequency
#' of the radar wave.
#'
#' @param seasonder_cs_object A `SeaSondeRCS` object containing the necessary data
#' to compute the radar wavelength.
#'
#' @return A numeric value representing the radar wave number \eqn{k} in
#' radians per meter.
#'
#' @details
#' The radar wave number \eqn{k} is calculated using the formula:
#' \eqn{k = \frac{2 \pi}{\lambda}}
#' where:
#' - \eqn{\lambda} is the radar wavelength in meters, calculated using
#' \code{\link{seasonder_getRadarWaveLength}}.
#' - \eqn{2 \pi} represents the relationship between the wavelength and wave number.
#'
#' The wave number is an essential parameter for analyzing radar signals and
#' their interaction with the medium being measured.
#'
#' @seealso
#' \code{\link{seasonder_getRadarWaveLength}} to compute the radar wavelength.
#'
seasonder_getRadarWaveNumber <- function(seasonder_cs_object) {
# Retrieve the radar wavelength in meters from the SeaSondeRCS object
l <- seasonder_getRadarWaveLength(seasonder_cs_object)
# Calculate the radar wave number using the formula k = 2 * pi / wavelength
k <- 2 * pi / l
# Return the calculated wave number
return(k)
}
#' Calculate the Bragg Wavelength
#'
#' This function computes the Bragg wavelength \eqn{\lambda_B} for a SeaSonde radar
#' system. The Bragg wavelength is defined as half the radar wavelength and is used
#' to identify the fundamental scattering mechanisms in oceanographic radar measurements.
#'
#' @param seasonder_cs_object A `SeaSondeRCS` object containing the necessary data
#' to compute the radar wavelength.
#'
#' @return A numeric value representing the Bragg wavelength (in meters).
#'
#' @details
#' The Bragg wavelength \eqn{\lambda_B} is calculated as:
#' \eqn{\lambda_B = \frac{\lambda}{2}}
#' where:
#' - \eqn{\lambda} is the radar wavelength in meters, obtained using
#' \code{\link{seasonder_getRadarWaveLength}}.
#'
#' The Bragg wavelength is a critical parameter in interpreting the resonance
#' scattering from the sea surface, which is fundamental to the operation of
#' HF radar systems.
#'
#' @seealso
#' \code{\link{seasonder_getRadarWaveLength}} to compute the radar wavelength.
#'
seasonder_getBraggWaveLength <- function(seasonder_cs_object) {
# Retrieve the radar wavelength in meters from the SeaSondeRCS object
l <- seasonder_getRadarWaveLength(seasonder_cs_object)
# Calculate the Bragg wavelength as half of the radar wavelength
lB <- l / 2
# Return the calculated Bragg wavelength
return(lB)
}
#' Calculate the Bragg Doppler Angular Frequency
#'
#' This function computes the Bragg Doppler angular frequencies for a SeaSonde radar
#' system. These frequencies represent the characteristic Doppler shifts due to
#' wave resonance at the Bragg wavelength.
#'
#' @param seasonder_cs_object A `SeaSondeRCS` object containing the necessary data
#' to compute the radar wave number.
#'
#' @return A numeric vector of length two, containing the negative and positive
#' Bragg Doppler angular frequencies (in radians per second).
#'
#' @details
#' The Bragg Doppler angular frequency \eqn{\omega_B} is calculated using the formula
#' \eqn{\omega_B = \sqrt{2 \cdot g \cdot k}}
#' where:
#' - \eqn{g} is the gravitational acceleration (approximately \eqn{9.8 \, m/s^2}),
#' - \eqn{k} is the radar wave number in radians per meter.
#'
#' The returned vector contains the negative (\eqn{-\omega_B}) and positive (\eqn{+\omega_B}) angular frequencies.
#'
#' @seealso
#' \code{\link{seasonder_getRadarWaveNumber}} to compute the radar wave number.
#'
seasonder_getBraggDopplerAngularFrequency <- function(seasonder_cs_object) {
# Debugging: Check if a debug point for this function is enabled
if (seasonder_is_debug_point_enabled("seasonder_getBraggDopplerAngularFrequency")) {
browser() # Enable debugging at this point
}
# Retrieve the radar wave number from the SeaSondeRCS object
k <- seasonder_getRadarWaveNumber(seasonder_cs_object = seasonder_cs_object)
# Calculate the Bragg Doppler angular frequency using the formula
# wb = sqrt(2 * g * k) / (2 * pi) * [-1, 1]
# where g is the gravitational acceleration and k is the radar wave number
wb <- sqrt(2 * constants::syms$gn * k) / (2 * pi) * c(-1, 1)
# Return the Bragg Doppler angular frequencies as a vector
return(wb)
}
#' Calculate the Doppler Spectrum Resolution
#'
#' This function computes the Doppler spectrum resolution for a given SeaSondeRCS
#' object. The resolution reflects the frequency difference between consecutive
#' Doppler bins in the spectrum.
#'
#' @param seasonder_cs_object A `SeaSondeRCS` object containing the necessary data
#' and metadata for Doppler spectrum analysis.
#'
#' @return A numeric value representing the Doppler spectrum resolution in Hertz (Hz).
#'
#' @details
#' The Doppler spectrum resolution is calculated using the formula:
#' \eqn{SpectralResolution = SweepRate / NumberOfDopplerCells}
#' where:
#' - SweepRate is the frequency repetition rate of the radar, obtained
#' from the field \code{fRepFreqHz} in the object's header.
#' - NumberOfDopplerCells is the total number of Doppler bins in the spectrum.
#'
#' This calculation is fundamental for understanding the frequency spacing between
#' adjacent Doppler bins in the radar spectrum.
#'
#' @seealso
#' \code{\link{seasonder_getnDopplerCells}} to retrieve the number of Doppler cells.
#' \code{\link{seasonder_getSeaSondeRCS_headerField}} to access specific header fields.
#'
seasonder_getDopplerSpectrumResolution <- function(seasonder_cs_object) {
# Verifica si el punto de depuración para esta función está habilitado y, si es asÃ, inicia una sesión de depuración
if (seasonder_is_debug_point_enabled("seasonder_getDopplerSpectrumResolution")) {
browser() # Punto de depuración, no eliminar
}
# Obtiene el número total de celdas Doppler desde el objeto SeaSondeRCS
nDoppler <- seasonder_getnDopplerCells(seasonder_cs_object)
# Obtiene la tasa de barrido (Sweep Rate) en Hz desde los campos del encabezado
SweepRate <- seasonder_getSeaSondeRCS_headerField(seasonder_cs_object, "fRepFreqHz")
# Calcula la resolución espectral como la relación entre la tasa de barrido y el número de celdas Doppler
spectral_resolution <- SweepRate / nDoppler
# Retorna la resolución espectral calculada
return(spectral_resolution)
}
#' Get Bragg Line Doppler Bins
#'
#' This function calculates the Doppler bin indices corresponding to the first-order
#' Bragg frequencies (-1 and 1) for a SeaSonde Cross Spectra (CS) object.
#'
#' @param seasonder_cs_object A SeaSonde Cross Spectra (CS) object created by \code{seasonder_createSeaSondeRCS()}.
#' This object contains the metadata required for the computation, including
#' the normalized Doppler frequencies and their mapping to Doppler bins.
#'
#' @return A numeric vector of length 2, where:
#' \itemize{
#' \item The first value is the Doppler bin corresponding to the -1 Bragg frequency.
#' \item The second value is the Doppler bin corresponding to the 1 Bragg frequency.
#' }
#'
#' @details
#' This function uses the normalized Doppler frequencies for the first-order Bragg peaks
#' (\eqn{-1} and \eqn{1}) and maps them to their corresponding Doppler bin indices.
#' The mapping is performed using the helper function \code{seasonder_NormalizedDopplerFreq2Bins()},
#' which converts normalized frequencies to bin indices based on the spectral resolution
#' and the Doppler range of the radar system.
#'
#' The bins are critical for identifying the Doppler shifts associated with the first-order
#' Bragg scattering in HF radar systems, which correspond to surface waves with wavelengths
#' half that of the transmitted radar signal.
#'
#' @seealso
#' \code{\link{seasonder_NormalizedDopplerFreq2Bins}} for the frequency-to-bin mapping logic.
#'
seasonder_getBraggLineBins <- function(seasonder_cs_object) {
# Convert the normalized Doppler frequencies for the first-order Bragg peaks (-1 and 1)
# into their corresponding Doppler bin indices.
bins <- seasonder_NormalizedDopplerFreq2Bins(seasonder_cs_object, c(-1, 1))
# Return the computed Doppler bin indices corresponding to the first-order Bragg peaks.
return(bins)
}
#' Compute Doppler Bins Frequencies
#'
#' This function computes the Doppler frequencies associated with each Doppler bin
#' in a SeaSondeRCS object. The output can be normalized by the positive Bragg
#' frequency if specified.
#'
#' @param seasonder_cs_object A SeaSonde CS object created by \code{seasonder_createSeaSondeRCS()}.
#' This object contains the necessary metadata, such as Doppler resolution and
#' center bin, for frequency computation.
#' @param nDoppler Integer. The total number of Doppler bins.
#' @param center_bin Numeric. The index of the central Doppler bin corresponding to 0 Hz.
#' @param spectra_res Numeric. The spectral resolution in Hz for each Doppler bin.
#' @param normalized Logical. If \code{TRUE}, the frequencies are normalized by dividing
#' them by the positive Bragg frequency. Default is \code{FALSE}.
#'
#' @return A numeric vector representing the Doppler frequencies for each bin. If
#' \code{normalized = TRUE}, the values are dimensionless and relative to the
#' positive Bragg frequency. Otherwise, they are in Hz.
#'
#' @details
#' Doppler frequencies are calculated using the formula:
#' \deqn{\text{frequency}_i = (\text{bin index}_i - \text{center bin}) \times \text{resolution}}
#' For normalized frequencies:
#' \deqn{\text{frequency}_i = \frac{\text{frequency}_i}{\text{positive Bragg frequency}}}
#'
#' The center bin is typically determined using \code{seasonder_getCenterDopplerBin()},
#' and the resolution is obtained from \code{seasonder_getDopplerSpectrumResolution()}.
#' Normalization is based on the positive Bragg frequency calculated by
#' \code{seasonder_getBraggDopplerAngularFrequency()}.
#'
#' @seealso \code{\link{seasonder_getCenterDopplerBin}},
#' \code{\link{seasonder_getDopplerSpectrumResolution}},
#' \code{\link{seasonder_getBraggDopplerAngularFrequency}}
#'
seasonder_computeDopplerBinsFrequency <- function(seasonder_cs_object, nDoppler, center_bin, spectra_res, normalized = FALSE) {
# Check if debugging is enabled for this function
if (seasonder_is_debug_point_enabled("seasonder_computeDopplerBinsFrequency")) {
browser() # Pause execution here for debugging if enabled
}
# Calculate Doppler frequencies for each bin
# This uses the formula: (bin index - center bin) * resolution
frequencies <- (seq(1, nDoppler) - center_bin) * spectra_res
# If normalization is requested, adjust frequencies
if (normalized) {
# Obtain the second Bragg frequency
bragg_freq <- seasonder_getBraggDopplerAngularFrequency(seasonder_cs_object)[2]
# Normalize frequencies by dividing by the second Bragg frequency
frequencies <- frequencies / bragg_freq
}
# Return the calculated frequencies
return(frequencies)
}
#' Get Doppler Bins Frequency
#'
#' This function calculates the frequency limits for each Doppler bin within a SeaSonde Cross Spectrum (CS) object. It can return frequencies either in their original Hz values or normalized by the second Bragg frequency. The frequencies are calculated as the high limit of each Doppler bin interval, similar to what is displayed in SpectraPlotterMap.
#'
#' @param seasonder_cs_object A SeaSonde Cross Spectrum (CS) object created by `seasonder_createSeaSondeRCS()`. This object contains the necessary metadata and spectral data to compute Doppler bin frequencies.
#' @param normalized A logical value indicating if the returned frequencies should be normalized by the second Bragg frequency. When `TRUE`, frequencies are divided by the second Bragg frequency, returning dimensionless values relative to it. Default is `FALSE`, returning frequencies in Hz.
#'
#' @return A numeric vector of frequencies representing the high limit of each Doppler bin interval. If `normalized` is TRUE, these frequencies are dimensionless values relative to the second Bragg frequency; otherwise, they are in Hz.
#'
#' @details The function internally utilizes several helper functions such as `seasonder_getCenterDopplerBin()`, `seasonder_getnDopplerCells()`, and `seasonder_getDopplerSpectrumResolution()` to calculate the Doppler bin frequencies. Furthermore, when normalization is requested, it uses `seasonder_getBraggDopplerAngularFrequency()` to obtain the second Bragg frequency for normalization purposes.
#'
#' @importFrom dplyr last
seasonder_getDopplerBinsFrequency <- function(seasonder_cs_object, normalized = FALSE) {
if(seasonder_is_debug_point_enabled("seasonder_getDopplerBinsFrequency")){
browser() # Debug point, do not remove
}
center_bin <- seasonder_getCenterDopplerBin(seasonder_cs_object) # Freq 0
nDoppler <- seasonder_getnDopplerCells(seasonder_cs_object)
spectra_res <- seasonder_getDopplerSpectrumResolution(seasonder_cs_object)
out <- seasonder_computeDopplerBinsFrequency(seasonder_cs_object, nDoppler, center_bin, spectra_res, normalized = normalized)
return(out)
}
#' Compute Radial Velocities for Doppler Bins
#'
#' This function calculates the radial velocities corresponding to the Doppler bins
#' in a SeaSondeRCS object, based on the provided Doppler frequencies. The calculation
#' uses the radar's wave number and Bragg angular frequencies.
#'
#' @param seasonder_cs_object A `SeaSondeRCS` object containing data and metadata
#' necessary for the calculation of Doppler bin frequencies and velocities.
#' @param freq A numeric vector representing the Doppler frequencies for which
#' the radial velocities are to be calculated.
#'
#' @return A numeric vector containing the radial velocities (in meters per second, m/s)
#' corresponding to the provided Doppler frequencies.
#'
#' @details
#' The radial velocity \eqn{v} for each Doppler bin is computed using the formula:
#' \deqn{v = \frac{\text{Freq} - \text{BraggFreq}}{2 \cdot k_0}}
#' where:
#' - \eqn{\text{Freq}} is the Doppler frequency of the bin.
#' - \eqn{\text{BraggFreq}} is the Bragg Doppler angular frequency for the bin.
#' - \eqn{k_0} is the radar wave number divided by \eqn{2\pi}.
#'
#' The Bragg frequency is negative for bins with frequencies below zero and positive
#' for bins with frequencies above zero.
#'
#' @seealso
#' \code{\link{seasonder_getBraggDopplerAngularFrequency}} to retrieve the Bragg angular frequencies.
#' \code{\link{seasonder_getRadarWaveNumber}} to obtain the radar wave number.
#'
seasonder_computeBinsRadialVelocity <- function(seasonder_cs_object, freq) {
# Retrieve the Bragg Doppler angular frequencies from the SeaSondeRCS object
bragg_freq <- seasonder_getBraggDopplerAngularFrequency(seasonder_cs_object)
# Retrieve the radar wave number and convert it to k0 by dividing by 2*pi
k0 <- seasonder_getRadarWaveNumber(seasonder_cs_object) / (2 * pi)
# Calculate radial velocities for negative and positive frequency components
# For frequencies <= 0, subtract the first Bragg frequency; for > 0, subtract the second
v <- c((freq[freq <= 0] - bragg_freq[1]) / (2 * k0),
(freq[freq > 0] - bragg_freq[2]) / (2 * k0))
# Return the computed radial velocities
return(v)
}
#' Calculate Radial Velocities for Each Doppler Bin
#'
#' Computes the radial velocities for each Doppler bin interval's high boundary
#' for a SeaSonde radar cross-section (CS) object, as typically visualized in
#' SpectraPlotterMap. This function utilizes the Doppler shift frequency alongside
#' the radar's wave number and Bragg frequency to transform frequency measurements
#' into radial velocities. The calculation is based on the relationship
#' between the Doppler shift frequency and the velocity of surface currents
#' within the radar's field of view.
#'
#' Specifically, the radial velocity \eqn{v = (Freq - BraggFreq)/(2 * k_0)}
#' is used, where \eqn{v} is the radial velocity, \eqn{Freq} is the Doppler
#' shift frequency for the bin, \eqn{BraggFreq} is the Bragg frequency
#' (negative for frequencies below 0 and positive for frequencies equal or above 0),
#' and \eqn{k_0} is the radar wave number divided by 2\eqn{\pi}.
#'
#' @param seasonder_cs_object A SeaSondeRCS object created using `seasonder_createSeaSondeRCS`.
#' This object contains the necessary data for calculating the Doppler bins
#' frequencies and, subsequently, radial velocities.
#'
#' @return A numeric vector containing the radial velocities (in m/s) for each
#' Doppler bin, calculated for the high boundary of each Doppler bin interval.
#' The velocities provide insight into the scatterers' radial movement within the
#' radar's observation area.
#'
#' @seealso \code{\link{seasonder_getDopplerBinsFrequency}},
#' \code{\link{seasonder_getBraggDopplerAngularFrequency}},
#' \code{\link{seasonder_getRadarWaveNumber}}
seasonder_getBinsRadialVelocity <- function(seasonder_cs_object) {
freq <- seasonder_getDopplerBinsFrequency(seasonder_cs_object)
out <- seasonder_computeBinsRadialVelocity(seasonder_cs_object, freq)
return(out)
}
#' Calculate Radial Velocity Resolution
#'
#' Computes the radial velocity resolution for a SeaSonde radar cross-section (CS) object.
#' This measurement indicates the smallest change in velocity that the radar can
#' discern between different targets or scatterers within its observation area.
#' The calculation is based on the Doppler spectrum resolution and the radar wave
#' number, providing a crucial parameter for analyzing the radar's capability to
#' distinguish between velocities.
#'
#' The radial velocity resolution \eqn{v_{res}} is determined using the formula:
#' \deqn{v_{res} = \frac{\text{SpectraRes}}{2 \cdot k_0}}
#' where \eqn{v_{res}} is the radial velocity resolution, \eqn{\text{SpectraRes}} is
#' the Doppler spectrum resolution, and \eqn{k_0} is the radar wave number divided
#' by \eqn{2\pi}. This formula reflects the relationship between the
#' frequency resolution of the radar's Doppler spectrum and the corresponding
#' velocity resolution, taking into account the wave number which is a fundamental
#' characteristic of the radar system.
#'
#' @param seasonder_cs_object A SeaSondeRCS object created using `seasonder_createSeaSondeRCS`. This object
#' contains the necessary data to calculate the Doppler spectrum resolution and, subsequently, the
#' radial velocity resolution.
#'
#' @return A single numeric value representing the radial velocity resolution in meters per second (m/s),
#' indicating the radar's ability to differentiate between closely spaced velocities.
#'
#' @seealso \code{\link{seasonder_getDopplerSpectrumResolution}},
#' \code{\link{seasonder_getRadarWaveNumber}}
seasonder_getRadialVelocityResolution <- function(seasonder_cs_object) {
spectra_res <- seasonder_getDopplerSpectrumResolution(seasonder_cs_object)
k0 <- seasonder_getRadarWaveNumber(seasonder_cs_object)/(2*pi)
vel_res <- spectra_res / (2*k0)
return(vel_res)
}
##### Utils #####
seasonder_rangeCellsDists2RangeNumber <- function(seasonder_cs_object,cells_dists) {
# TODO: check that the cs file version is at least V4
fRangeCellDistKm <- seasonder_getSeaSondeRCS_headerField(seasonder_cs_object, "fRangeCellDistKm")
nFirstRangeCell <- seasonder_getSeaSondeRCS_headerField(seasonder_cs_object, "nFirstRangeCell")
# NOTE: based on File_Cross_Spectra_V6 page 4
range_numbers <- cells_dists/fRangeCellDistKm - nFirstRangeCell + 1
return(range_numbers)
}
# Start SEAS-109
#' Convert dB Values to Self-Spectra Power
#'
#' This function converts power values expressed in decibels (dB) to linear self-spectra power values. The conversion is based on the given receiver gain, which accounts for the radar system's amplification effects.
#'
#' @param dB_values A numeric vector. The power values in decibels (dB).
#' @param receiver_gain A numeric scalar. The receiver gain in decibels (dB).
#'
#' @return A numeric vector of self-spectra power values in linear scale.
#'
#' @details
#' The conversion from decibels to linear power follows the equation:
#' \deqn{P = 10^{(dB + G)/10}}
#' where:
#' \itemize{
#' \item \( P \) is the self-spectra power in linear scale,
#' \item \( dB \) represents the power values in decibels,
#' \item \( G \) is the receiver gain in decibels.
#' }
#'
#' @seealso
#' \code{\link{self_spectra_to_dB}} for the inverse operation.
#'
#'
dB_to_self_spectra <- function(dB_values, receiver_gain){
# Convert decibels to linear self-spectra power
spectrum_values <- 10 ^ ((dB_values + receiver_gain)/10)
return(spectrum_values)
}
#' Convert Self-Spectra Power to dB
#'
#' This function converts self-spectra power values from a linear scale to decibels (dB). The transformation considers the receiver gain to adjust the power measurements accordingly.
#'
#' @param spectrum_values A numeric vector. The power values in linear scale.
#' @param receiver_gain A numeric scalar. The receiver gain in decibels (dB).
#'
#' @return A numeric vector of power values in decibels (dB).
#'
#' @details
#' The conversion follows the equation:
#' \deqn{dB = 10 \log_{10}(|P|) - G}
#' where:
#' \itemize{
#' \item \( dB \) is the power in decibels,
#' \item \( P \) is the self-spectra power in linear scale,
#' \item \( G \) is the receiver gain in decibels.
#' }
#'
#' Absolute values of power are used to ensure valid logarithmic calculations.
#'
#' @seealso
#' \code{\link{dB_to_self_spectra}} for the reverse conversion.
#'
#'
self_spectra_to_dB <- function(spectrum_values, receiver_gain){
# Convert linear self-spectra power to decibels
spectrum_dB <- 10 * log10(abs(spectrum_values)) - receiver_gain
return(spectrum_dB)
}
# End SEAS-109
#' Convert Self-Spectra to dB Using a SeaSondeR Object
#'
#' This function transforms self-spectra power values into decibels (dB) by retrieving the receiver gain from a given \code{SeaSondeR} object.
#'
#' @param seasonder_cs_object A \code{SeaSondeR} cross-spectral object.
#' @param spectrum_values A numeric vector. The power values in linear scale.
#'
#' @return A numeric vector of power values in decibels (dB).
#'
#' @details
#' This function first extracts the receiver gain in decibels from the \code{seasonder_cs_object} using \code{\link{seasonder_getReceiverGain_dB}} and then applies the conversion using:
#' \deqn{dB = 10 \log_{10}(|P|) - G}
#' where:
#' \itemize{
#' \item \( dB \) is the power in decibels,
#' \item \( P \) is the self-spectra power in linear scale,
#' \item \( G \) is the receiver gain in decibels.
#' }
#'
#' This function ensures consistency by obtaining the receiver gain directly from the \code{SeaSondeR} object.
#'
#' @seealso
#' \code{\link{self_spectra_to_dB}} for a generic power-to-dB transformation.
#'
#'
seasonder_SelfSpectra2dB <- function(seasonder_cs_object, spectrum_values) {
# Retrieve the receiver gain from the SeaSondeR object
receiver_gain <- seasonder_getReceiverGain_dB(seasonder_cs_object)
# Convert self-spectra power to decibels
spectrum_dB <- self_spectra_to_dB(spectrum_values, receiver_gain)
return(spectrum_dB)
}
#' Convert Doppler Bins to Normalized Doppler Frequency
#'
#' This function retrieves the normalized Doppler frequencies corresponding to the specified bins in a given \code{SeaSondeR} object.
#'
#' @param seasonder_cs_object A \code{SeaSondeR} cross-spectral object containing Doppler bin metadata.
#' @param bins A numeric vector specifying the Doppler bin indices.
#'
#' @return A numeric vector of normalized Doppler frequencies corresponding to the specified bins.
#'
#' @details
#' This function first retrieves the Doppler bin frequencies in normalized form using \code{\link{seasonder_getDopplerBinsFrequency}}. It then selects the normalized Doppler frequencies corresponding to the specified bin indices.
#'
#' **Normalized Doppler Frequency Calculation:**
#' The normalized Doppler frequency is typically defined as:
#' \deqn{f_{norm} = \frac{f_{doppler}}{f_{bragg}}}
#' where:
#' \itemize{
#' \item \eqn{f_{norm}} is the normalized Doppler frequency,
#' \item \eqn{f_{doppler}} is the Doppler frequency of a given bin,
#' \item \eqn{f_{bragg}} is the Bragg frequency, computed based on radar wavelength.
#' }
#'
#' @seealso
#' \code{\link{seasonder_getDopplerBinsFrequency}} for retrieving Doppler bin frequencies.
#'
seasonder_Bins2NormalizedDopplerFreq <- function(seasonder_cs_object, bins) {
# Retrieve normalized Doppler frequencies from the SeaSondeR object
normalized_doppler_freqs <- seasonder_getDopplerBinsFrequency(seasonder_cs_object, normalized = TRUE)
# Return the normalized frequencies for the specified bins
return(normalized_doppler_freqs[bins])
}
#' Convert Normalized Doppler Frequencies to Doppler Bins
#'
#' This function converts a set of normalized Doppler frequencies into their corresponding Doppler bin indices within a \code{SeaSondeR} object.
#'
#' @param seasonder_cs_object A \code{SeaSondeR} cross-spectral object containing metadata about the Doppler bins.
#' @param doppler_values A numeric vector specifying the normalized Doppler frequencies to be converted into bin indices.
#'
#' @return An integer vector indicating the Doppler bin indices corresponding to the input normalized Doppler frequencies. Values that fall outside the valid bin range are assigned \code{NA}.
#'
#' @details
#' This function first retrieves the list of normalized Doppler frequencies from the given \code{SeaSondeR} object using \code{\link{seasonder_getDopplerBinsFrequency}}.
#' The bin boundaries are computed using the first-order difference of these frequencies.
#'
#' The function then applies \code{\link{findInterval}} to determine the corresponding bin index for each input Doppler frequency. The search process is affected by the following options:
#' \itemize{
#' \item \code{rightmost.closed = TRUE}: The last bin interval is closed on the right, ensuring that the maximum normalized frequency is included in the last bin.
#' \item \code{all.inside = FALSE}: Values that fall outside the range of the computed boundaries are assigned values below 1 or above the maximum bin index.
#' \item \code{left.open = TRUE}: The left interval is open, meaning that values exactly equal to a boundary are assigned to the higher bin.
#' }
#'
#' After \code{findInterval} determines the bin indices, values that are out of range (\code{bins < 1} or \code{bins > nDoppler}) are set to \code{NA}.
#'
#' @seealso
#' \code{\link{seasonder_Bins2NormalizedDopplerFreq}} for the inverse operation.
#'
#' @importFrom magrittr %>%
#'
seasonder_NormalizedDopplerFreq2Bins <- function(seasonder_cs_object, doppler_values) {
# Check if debug mode is enabled and trigger a browser session if true
if(seasonder_is_debug_point_enabled("seasonder_NormalizedDopplerFreq2Bins")){
browser() # Debug point, do not remove
}
# Retrieve the normalized Doppler frequencies associated with the Doppler bins
normalized_doppler_freqs <- seasonder_getDopplerBinsFrequency(seasonder_cs_object, normalized = TRUE)
# Compute the step size (delta) between consecutive Doppler frequencies
delta_freq <- normalized_doppler_freqs %>% diff()
# Construct the bin boundaries by extending the range of Doppler frequencies
# The leftmost boundary is adjusted by subtracting the first delta value
boundaries <- c(normalized_doppler_freqs[1] - delta_freq[1], normalized_doppler_freqs)
# Find the bin index for each input Doppler frequency
# rightmost.closed = TRUE ensures that the last interval includes its upper boundary
# all.inside = FALSE allows values outside the range to be assigned values < 1 or > max bin index
# left.open = TRUE ensures that values exactly equal to a boundary go to the higher bin
bins <- findInterval(doppler_values, boundaries, rightmost.closed = TRUE, all.inside = FALSE, left.open = TRUE)
# Retrieve the number of Doppler bins in the SeaSondeR object
nDoppler <- seasonder_getnDopplerCells(seasonder_cs_object)
# Set bins that fall outside the valid range to NA
bins[bins < 1 | bins > nDoppler] <- NA_integer_
return(bins)
}
#' Convert Doppler Frequencies to Doppler Bins
#'
#' This function converts a set of Doppler frequency values into their corresponding Doppler bin indices using predefined Doppler frequency bins and frequency step size.
#'
#' @param seasonder_cs_object A \code{SeaSondeR} cross-spectral object.
#' @param doppler_values A numeric vector specifying the Doppler frequencies to be converted into bin indices.
#' @param doppler_freqs A numeric vector containing the Doppler frequencies corresponding to each bin.
#' @param delta_freq A numeric scalar specifying the frequency step size (difference between consecutive Doppler bins).
#' @param nDoppler An integer indicating the total number of Doppler bins.
#'
#' @return An integer vector of Doppler bin indices corresponding to the input Doppler frequencies. Values that fall outside the valid bin range are assigned \code{NA}.
#'
#' @details
#' The function constructs a set of bin boundaries using the Doppler frequencies. The leftmost boundary is adjusted by subtracting \code{delta_freq} from the first Doppler frequency to extend the range.
#'
#' The function then applies \code{\link{findInterval}} to determine the corresponding bin index for each input Doppler frequency. The bin assignment process follows these rules:
#' \itemize{
#' \item \code{rightmost.closed = TRUE}: The last bin interval includes its upper boundary.
#' \item \code{all.inside = FALSE}: Values outside the defined frequency range are assigned indices below 1 or above \code{nDoppler}.
#' \item \code{left.open = TRUE}: The left interval is open, meaning values exactly equal to a boundary are assigned to the higher bin.
#' }
#'
#' After determining the bin indices, values that are out of range (\code{bins < 1} or \code{bins > nDoppler}) are set to \code{NA}.
#'
#' @seealso
#' \code{\link{seasonder_Bins2NormalizedDopplerFreq}} for converting bins back to normalized Doppler frequencies.
#' \code{\link{findInterval}} for details on interval-based bin selection.
#'
#' @importFrom magrittr %>%
#'
seasonder_computeDopplerFreq2Bins <- function(seasonder_cs_object, doppler_values, doppler_freqs, delta_freq, nDoppler){
# Construct bin boundaries by extending the range with delta_freq
boundaries <- c(doppler_freqs[1] - delta_freq, doppler_freqs)
# Find the bin index for each Doppler frequency
# rightmost.closed = TRUE ensures the last bin interval includes its upper boundary
# all.inside = FALSE allows values outside the boundaries to be assigned indices below 1 or above nDoppler
# left.open = TRUE ensures values exactly at a boundary are assigned to the higher bin
bins <- findInterval(doppler_values, boundaries, rightmost.closed = TRUE, all.inside = FALSE, left.open = TRUE)
# Set bins that fall outside the valid range to NA
bins[bins < 1 | bins > nDoppler] <- NA_integer_
return(bins)
}
#' Convert Doppler Frequencies to Doppler Bins
#'
#' This function converts a set of Doppler frequency values into their corresponding Doppler bin indices within a \code{SeaSondeR} object.
#'
#' @param seasonder_cs_object A \code{SeaSondeR} cross-spectral object containing metadata about the Doppler bins.
#' @param doppler_values A numeric vector specifying the Doppler frequencies to be converted into bin indices.
#'
#' @return An integer vector of Doppler bin indices corresponding to the input Doppler frequencies. Values that fall outside the valid bin range are assigned \code{NA}.
#'
#' @details
#' This function first retrieves the Doppler frequency bins from the given \code{SeaSondeR} object using \code{\link{seasonder_getDopplerBinsFrequency}} in non-normalized form.
#' The spectral resolution, which defines the frequency step size (\eqn{\Delta f}), is obtained using \code{\link{seasonder_getDopplerSpectrumResolution}}.
#'
#' The number of Doppler bins is then determined using \code{\link{seasonder_getnDopplerCells}}.
#'
#' With this information, the function calls \code{\link{seasonder_computeDopplerFreq2Bins}} to determine the corresponding bin indices for each input Doppler frequency.
#'
#'
#' @seealso
#' \code{\link{seasonder_Bins2NormalizedDopplerFreq}} for the reverse operation.
#' \code{\link{seasonder_computeDopplerFreq2Bins}} for the core computation logic.
#'
#'
seasonder_DopplerFreq2Bins <- function(seasonder_cs_object, doppler_values) {
# Retrieve the Doppler frequency bins in non-normalized form
doppler_freqs <- seasonder_getDopplerBinsFrequency(seasonder_cs_object, normalized = FALSE)
# Get the spectral resolution (frequency step size in Hz)
delta_freq <- seasonder_getDopplerSpectrumResolution(seasonder_cs_object)
# Retrieve the number of Doppler bins
nDoppler <- seasonder_getnDopplerCells(seasonder_cs_object)
# Compute the corresponding Doppler bin indices
out <- seasonder_computeDopplerFreq2Bins(seasonder_cs_object, doppler_values, doppler_freqs, delta_freq, nDoppler)
return(out)
}
#' Convert Doppler Bins to Doppler Frequencies
#'
#' This function retrieves the Doppler frequency values corresponding to the specified bin indices in a given \code{SeaSondeR} object.
#'
#' @param seasonder_cs_object A \code{SeaSondeR} cross-spectral object containing Doppler bin metadata.
#' @param bins A numeric vector specifying the Doppler bin indices.
#'
#' @return A numeric vector of Doppler frequencies (in Hz) corresponding to the specified bins.
#'
#' @details
#' This function retrieves the full set of Doppler bin frequencies using \code{\link{seasonder_getDopplerBinsFrequency}} in non-normalized form.
#' It then selects the Doppler frequencies corresponding to the specified bin indices.
#'
#'
#' @seealso
#' \code{\link{seasonder_DopplerFreq2Bins}} for the reverse operation.
#' \code{\link{seasonder_getDopplerBinsFrequency}} for retrieving the full set of Doppler frequencies.
#'
#'
seasonder_Bins2DopplerFreq <- function(seasonder_cs_object, bins) {
# Retrieve the Doppler bin frequencies in non-normalized form (Hz)
doppler_freqs <- seasonder_getDopplerBinsFrequency(seasonder_cs_object, normalized = FALSE)
# Return the Doppler frequencies corresponding to the specified bins
return(doppler_freqs[bins])
}
#' Convert Doppler Frequencies to Normalized Doppler Frequencies
#'
#' This function converts Doppler frequencies (in Hz) into their corresponding normalized Doppler frequencies within a \code{SeaSondeR} object.
#'
#' @param seasonder_cs_object A \code{SeaSondeR} cross-spectral object containing metadata about the Doppler bins.
#' @param doppler_values A numeric vector specifying the Doppler frequencies (in Hz) to be converted into normalized Doppler frequencies.
#'
#' @return A numeric vector of normalized Doppler frequencies corresponding to the input Doppler values.
#'
#' @details
#' The function follows these steps:
#' \enumerate{
#' \item Calls \code{\link{seasonder_DopplerFreq2Bins}} to convert the input Doppler frequencies into Doppler bin indices.
#' \item Calls \code{\link{seasonder_Bins2NormalizedDopplerFreq}} to obtain the corresponding normalized Doppler frequencies.
#' }
#'
#' The normalized Doppler frequency is computed as:
#' \deqn{f_{doppler} = f_{norm} \times f_{bragg}}
#' where:
#' \itemize{
#' \item \eqn{f_{doppler}} is the Doppler frequency in Hz,
#' \item \eqn{f_{norm}} is the normalized Doppler frequency,
#' \item \eqn{f_{bragg}} is the Bragg frequency, computed based on radar wavelength.
#' }
#'
#' This function ensures consistency by mapping input frequencies to their closest bin representation before normalization.
#'
#' @seealso
#' \code{\link{seasonder_DopplerFreq2Bins}} for converting Doppler frequencies to bin indices.
#' \code{\link{seasonder_Bins2NormalizedDopplerFreq}} for converting bin indices to normalized frequencies.
#'
#'
seasonder_DopplerFreq2NormalizedDopplerFreq <- function(seasonder_cs_object, doppler_values) {
# Convert Doppler frequencies to Doppler bin indices
bins <- seasonder_DopplerFreq2Bins(seasonder_cs_object, doppler_values)
# Convert Doppler bin indices to normalized Doppler frequencies
normalized_doppler_freq <- seasonder_Bins2NormalizedDopplerFreq(seasonder_cs_object, bins)
return(normalized_doppler_freq)
}
#' Convert Normalized Doppler Frequencies to Doppler Frequencies
#'
#' This function converts normalized Doppler frequencies into their corresponding Doppler frequencies (in Hz) within a \code{SeaSondeR} object.
#'
#' @param seasonder_cs_object A \code{SeaSondeR} cross-spectral object containing metadata about the Doppler bins.
#' @param doppler_values A numeric vector specifying the normalized Doppler frequencies to be converted into Doppler frequencies (Hz).
#'
#' @return A numeric vector of Doppler frequencies (in Hz) corresponding to the input normalized Doppler frequencies.
#'
#' @details
#' The function follows these steps:
#' \enumerate{
#' \item Calls \code{\link{seasonder_NormalizedDopplerFreq2Bins}} to convert the input normalized Doppler frequencies into Doppler bin indices.
#' \item Calls \code{\link{seasonder_Bins2DopplerFreq}} to obtain the corresponding Doppler frequencies in Hz.
#' }
#'
#' The relationship between the normalized and absolute Doppler frequencies is defined as:
#' \deqn{f_{doppler} = f_{norm} \times f_{bragg}}
#' where:
#' \itemize{
#' \item \eqn{f_{doppler}} is the Doppler frequency in Hz,
#' \item \eqn{f_{norm}} is the normalized Doppler frequency,
#' \item \eqn{f_{bragg}} is the Bragg frequency, computed based on radar wavelength.
#' }
#'
#' @seealso
#' \code{\link{seasonder_NormalizedDopplerFreq2Bins}} for converting normalized Doppler frequencies to bin indices.
#' \code{\link{seasonder_Bins2DopplerFreq}} for converting bin indices to Doppler frequencies in Hz.
#'
#'
seasonder_NormalizedDopplerFreq2DopplerFreq <- function(seasonder_cs_object, doppler_values) {
# Convert normalized Doppler frequencies to Doppler bin indices
bins <- seasonder_NormalizedDopplerFreq2Bins(seasonder_cs_object, doppler_values)
# Convert Doppler bin indices to absolute Doppler frequencies (Hz)
doppler_freq <- seasonder_Bins2DopplerFreq(seasonder_cs_object, bins)
return(doppler_freq)
}
#' Convert Between Different Doppler Frequency Units
#'
#' This function converts Doppler-related values between different units, including normalized Doppler frequency, Doppler bins, and absolute Doppler frequency (Hz), within a \code{SeaSondeR} object.
#'
#' @param seasonder_cs_object A \code{SeaSondeR} cross-spectral object containing Doppler bin metadata.
#' @param values A numeric vector specifying the Doppler values to be converted.
#' @param in_units A character string specifying the current unit of \code{values}. Must be one of:
#' \itemize{
#' \item \code{"normalized doppler frequency"}: Values are normalized by the Bragg frequency.
#' \item \code{"bins"}: Values represent Doppler bin indices.
#' \item \code{"doppler frequency"}: Values are in Hz.
#' }
#' @param out_units A character string specifying the target unit for conversion. Must be one of the same three options as \code{in_units}.
#'
#' @return A numeric vector with the converted Doppler values in the specified output unit.
#'
#' @details
#' The function first validates that the input and output units are among the allowed options.
#' If \code{in_units} and \code{out_units} are the same, the function returns the original values without modification.
#'
#' The unit conversions follow this logic:
#' \enumerate{
#' \item If converting from \code{"normalized doppler frequency"}:
#' \itemize{
#' \item To \code{"bins"}: Uses \code{\link{seasonder_NormalizedDopplerFreq2Bins}}.
#' \item To \code{"doppler frequency"}: Uses \code{\link{seasonder_NormalizedDopplerFreq2DopplerFreq}}.
#' }
#' \item If converting from \code{"bins"}:
#' \itemize{
#' \item To \code{"normalized doppler frequency"}: Uses \code{\link{seasonder_Bins2NormalizedDopplerFreq}}.
#' \item To \code{"doppler frequency"}: Uses \code{\link{seasonder_Bins2DopplerFreq}}.
#' }
#' \item If converting from \code{"doppler frequency"}:
#' \itemize{
#' \item To \code{"bins"}: Uses \code{\link{seasonder_DopplerFreq2Bins}}.
#' \item To \code{"normalized doppler frequency"}: Uses \code{\link{seasonder_DopplerFreq2NormalizedDopplerFreq}}.
#' }
#' }
#'
#' Overall, the functions used for Doppler units conversion mimic the implementation of Doppler units displayed in SpectraPlotterMap 12 in Radial Suite R8
#'
#' @seealso
#' \code{\link{seasonder_NormalizedDopplerFreq2Bins}}, \code{\link{seasonder_Bins2NormalizedDopplerFreq}}, \code{\link{seasonder_DopplerFreq2Bins}}, and related functions for unit-specific conversions.
#'
#' @references
#'
#' COS. SeaSonde Radial Suite Release 8; CODAR Ocean Sensors (COS): Mountain View, CA, USA, 2016.
#'
#' @importFrom glue glue
#'
seasonder_SwapDopplerUnits <- function(seasonder_cs_object, values, in_units, out_units) {
# Define allowed Doppler unit options
doppler_units_options <- c("normalized doppler frequency", "bins", "doppler frequency")
# Validate input unit
in_units %in% doppler_units_options ||
seasonder_logAndAbort(glue::glue("in_units is '{in_units}', but should be one of {paste0(doppler_units_options, collapse=', ')}"),
calling_function = "seasonder_SwapDopplerUnits")
# Validate output unit
out_units %in% doppler_units_options ||
seasonder_logAndAbort(glue::glue("out_units is '{out_units}', but should be one of {paste0(doppler_units_options, collapse=', ')}"),
calling_function = "seasonder_SwapDopplerUnits")
# If the input and output units are the same, return values unchanged
if (in_units == out_units) {
return(values)
}
# Define conversion functions for different Doppler unit transformations
swap_functions <- list(
"normalized doppler frequency" = list(
"bins" = seasonder_NormalizedDopplerFreq2Bins,
"doppler frequency" = seasonder_NormalizedDopplerFreq2DopplerFreq
),
"bins" = list(
"normalized doppler frequency" = seasonder_Bins2NormalizedDopplerFreq,
"doppler frequency" = seasonder_Bins2DopplerFreq
),
"doppler frequency" = list(
"bins" = seasonder_DopplerFreq2Bins,
"normalized doppler frequency" = seasonder_DopplerFreq2NormalizedDopplerFreq
)
)
# Select the appropriate conversion function based on input and output units
swap_fun <- swap_functions[[in_units]][[out_units]]
# Perform the conversion
out <- swap_fun(seasonder_cs_object, values)
return(out)
}
##### Plot #####
#' Plot Self-Spectrum for a SeaSondeRCS Object
#'
#' This function generates a plot of the self-spectrum (in dB) for a specified antenna and range cell
#' from a SeaSondeRCS object. The Doppler frequencies are converted to the desired units before plotting.
#' Optionally, it overlays additional elements such as smoothed self-spectrum lines, first-order region (FOR)
#' vertical lines, and noise level lines.
#'
#' @param seasonder_cs_object A SeaSondeRCS object containing spectral and metadata.
#' @param antenna An integer or vector specifying the antenna(s) to extract the self-spectrum from.
#' @param range_cell An integer indicating the range cell to extract the spectrum.
#' @param doppler_units A character string specifying the desired Doppler units for the plot.
#' Commonly "normalized doppler frequency" or "doppler frequency" (Hz). Default is "normalized doppler frequency".
#' @param plot_FORs Logical. If \code{TRUE}, the function overlays elements related to the first order region (FOR)
#' such as vertical lines at the FOR boundaries and the smoothed self-spectrum. Default is \code{FALSE}.
#'
#' @return A ggplot object representing the self-spectrum plot.
#'
#' @details
#' The function performs the following steps:
#' \enumerate{
#' \item Retrieves the self-spectrum data for the given antenna and range cell using \code{seasonder_getSeaSondeRCS_SelfSpectra}.
#' \item Converts the Doppler bin frequencies to the specified units using \code{seasonder_SwapDopplerUnits}.
#' \item Converts the self-spectrum to dB using \code{seasonder_SelfSpectra2dB} and combines it with the Doppler values.
#' \item Retrieves the Bragg Doppler angular frequency for plotting a reference vertical line.
#' \item If \code{plot_FORs} is \code{TRUE}, overlays:
#' \itemize{
#' \item An orange line for the smoothed self-spectrum.
#' \item Blue vertical lines for FOR boundaries.
#' \item Red lines indicating the noise level across the Doppler spectrum.
#' }
#' \item Finally, returns the ggplot object.
#' }
#'
#' @examples
#' # Prepare a SeaSondeRCS object for plotting self-spectrum
#' apm_file <- system.file("css_data/MeasPattern.txt", package = "SeaSondeR")
#' apm_obj <- seasonder_readSeaSondeRAPMFile(apm_file)
#' cs_file <- system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' cs_obj <- seasonder_createSeaSondeRCS(cs_file, seasonder_apm_object = apm_obj)
#' # Plot self-spectrum for antenna 1, range cell 5
#' p <- seasonder_SeaSondeRCS_plotSelfSpectrum(cs_obj, antenna = 1, range_cell = 5)
#' print(p)
#'
#' @export
seasonder_SeaSondeRCS_plotSelfSpectrum <- function(seasonder_cs_object, antenna, range_cell, doppler_units = "normalized doppler frequency", plot_FORs = FALSE) {
SS <- doppler <- xintercept <- rlang::zap()
spectrum <- seasonder_getSeaSondeRCS_SelfSpectra(seasonder_cs_object = seasonder_cs_object, antennae = antenna,dist_ranges = c(range_cell,range_cell), collapse = TRUE)[[1]] %>% t() %>% as.data.frame() %>% magrittr::set_colnames("SS")
doppler_values <- seasonder_SwapDopplerUnits(seasonder_cs_object,seasonder_getDopplerBinsFrequency(seasonder_cs_object), in_units = "doppler frequency", out_units = doppler_units)
spectrum %<>% dplyr::mutate(doppler = doppler_values, SS = seasonder_SelfSpectra2dB(seasonder_cs_object, SS))
Bragg_freq <- seasonder_getBraggDopplerAngularFrequency(seasonder_cs_object)
if (doppler_units == "normalized doppler frequency") {
Bragg_freq <- c(-1,1)
}
out <- ggplot2::ggplot(spectrum, ggplot2::aes(y = SS, x = doppler)) + ggplot2::geom_line() + ggplot2::geom_vline(xintercept = Bragg_freq, color = "red") + ggplot2::theme_bw()
if (plot_FORs) {
smoothed_spectrum <- seasonder_getSeaSondeRCS_FOR_SS_Smoothed(seasonder_cs_object)[range_cell,, drop = TRUE]
if (!is.null(smoothed_spectrum)) {
smoothed_data <- data.frame(SS = seasonder_SelfSpectra2dB(seasonder_cs_object,smoothed_spectrum), doppler = doppler_values)
out <- out + ggplot2::geom_line(data = smoothed_data, color = "orange", size = 1)
}
FOR <- seasonder_getSeaSondeRCS_FOR(seasonder_cs_object)[[range_cell]]
if (!is.null(FOR)) {
FOR %<>% unlist()
FOR <- seasonder_SwapDopplerUnits(seasonder_cs_object, FOR, "bins", doppler_units)
FOR_data <- data.frame(xintercept = FOR)
out <- out + ggplot2::geom_vline(data = FOR_data, ggplot2::aes(xintercept = xintercept), color = "blue", alpha = 0.1)
}
noise_level <- seasonder_getSeaSondeRCS_NoiseLevel(seasonder_cs_object, dB = TRUE)[range_cell] %>% magrittr::set_names(NULL)
reference_noise_normalized_limits <- seasonder_getSeaSondeRCS_FOR_reference_noise_normalized_limits(seasonder_cs_object)
if (!is.null(noise_level) && !is.null(reference_noise_normalized_limits)) {
positive_noise_range <- seasonder_SwapDopplerUnits(seasonder_cs_object, reference_noise_normalized_limits, in_units = "normalized doppler frequency", out_units = doppler_units)
negative_noise_range <- seasonder_SwapDopplerUnits(seasonder_cs_object,-1 * reference_noise_normalized_limits, in_units = "normalized doppler frequency", out_units = doppler_units)
positive_noise_data <- data.frame(SS = noise_level, doppler = c(positive_noise_range))
negative_noise_data <- data.frame(SS = noise_level, doppler = c(negative_noise_range))
out <- out + ggplot2::geom_line(data = positive_noise_data, color = "red", size = 2) + ggplot2::geom_line(data = negative_noise_data, color = "red", size = 2)
}
}
return(out)
}
#### Processing_steps ####
#' Generate Creation Step Text
#'
#' This function generates a text message indicating the time an CS object was created based on the current system time and the provided file path.
#'
#' @param file_path A character string specifying the path to the file.
#'
#' @return
#' A character string with the formatted message indicating the time of creation and the file path.
#'
SeaSondeRCS_creation_step_text <- function(file_path) {
# Use glue to format the message with the current system time and the provided file path
glue::glue("{Sys.time()}: Created from {file_path}.")
}
#### Read CS File ####
#' Validate SeaSondeR CS File Data
#'
#' This function performs multiple validation checks on a provided CS file in the SeaSondeR system.
#' It checks the file for various conditions to determine if it meets the SeaSondeR standards.
#'
#' @param filepath A character string indicating the path to the CS file to validate.
#' @param header A list containing header information of the CS file.
#'
#' @details The function performs the following validation checks:
#' \enumerate{
#' \item Verifies that the file size is greater than 10 bytes.
#' \item Validates the `nCsFileVersion` field in the header to ensure it's between 1 and 32.
#' \item Depending on the `nCsFileVersion`, verifies the appropriate file size, and the extent of various version headers (`nV1Extent`, `nV2Extent`, etc.).
#' \item Validates the `nRangeCells` and `nDopplerCells` fields to ensure they are within permissible ranges.
#' \item Depending on the `nCsKind` value, validates the file size against expected sizes based on `nRangeCells`, `nSpectraChannels`, and `nDopplerCells`.
#' }
#'
#' @section Condition Management:
#' This function utilizes the `rlang` package to manage conditions and provide detailed and structured condition messages:
#'
#' \strong{Condition Classes}:
#' \itemize{
#' \item \code{seasonder_validate_cs_file_error}: An error class that indicates a validation requirement was not met.
#' }
#'
#' \strong{Condition Cases}:
#' \itemize{
#' \item Failure on any validation test.
#' }
#'
#' @return NULL invisibly. The function mainly serves to validate and will stop execution and log an error using `seasonder_logAndAbort` if any condition fails.
#'
#'
#' @references Cross Spectra File Format Version 6. CODAR. 2016
seasonder_validateCSFileData <- function(filepath, header) {
conditions_params <- list(calling_function = "seasonder_validateCSFileData",class = "seasonder_validate_cs_file_error",seasonder_cs_filepath = filepath, seasonder_cs_header = header)
# Validations
file_size <- file.info(filepath)$size
header_size <- header$nV1Extent + 10
if (file_size <= 10) rlang::inject(seasonder_logAndAbort(glue::glue("Invalid file size {file_size} in file {filepath}."),!!!conditions_params))
if (header$nCsFileVersion < 1 || header$nCsFileVersion > 32) rlang::inject(seasonder_logAndAbort(glue::glue("Invalid nCsFileVersion {header$nCsFileVersion} in file {filepath}."),!!!conditions_params))
if (header$nCsFileVersion == 1 && (file_size <= 10 || header$nV1Extent < 0)) rlang::inject(seasonder_logAndAbort(glue::glue("Invalid file for version 1 in file {filepath}. size: {file_size}, header extent V1 {header$nV1Extent}."),!!!conditions_params))
if (header$nCsFileVersion == 2 && (file_size <= 16 || header$nV1Extent < 6 || header$nV2Extent < 0)) rlang::inject(seasonder_logAndAbort(glue::glue("Invalid file for version 2 in file {filepath}. size: {file_size}, header extent V1 {header$nV1Extent}, V2 {header$nV2Extent}."),!!!conditions_params))
if (header$nCsFileVersion == 3 && (file_size <= 24 || header$nV1Extent < 14 || header$nV2Extent < 8 || header$nV3Extent < 0)) rlang::inject(seasonder_logAndAbort(glue::glue("Invalid file for version 3 in file {filepath}. size: {file_size}, header extent V1 {header$nV1Extent}, V2 {header$nV2Extent}, V3 {header$nV3Extent}."),!!!conditions_params))
if (header$nCsFileVersion == 4 && (file_size <= 72 || header$nV1Extent < 62 || header$nV2Extent < 56 || header$nV3Extent < 48 || header$nV4Extent < 0)) rlang::inject(seasonder_logAndAbort(glue::glue("Invalid file for version 4 in file {filepath}. size: {file_size}, header extent V1 {header$nV1Extent}, V2 {header$nV2Extent}, V3 {header$nV3Extent}, V4 {header$nV4Extent}."),!!!conditions_params))
if (header$nCsFileVersion >= 5 && (file_size <= 100 || header$nV1Extent < 90 || header$nV2Extent < 84 || header$nV3Extent < 76 || header$nV4Extent < 28 || header$nV5Extent < 0)) rlang::inject(seasonder_logAndAbort(glue::glue("Invalid file for version >= 5 in file {filepath}. size: {file_size}, header extent V1 {header$nV1Extent}, V2 {header$nV2Extent}, V3 {header$nV3Extent}, V4 {header$nV4Extent}, V5 {header$nV5Extent}."),!!!conditions_params))
if (header$nCsFileVersion >= 6 && header$nV5Extent < header$nCS6ByteSize + 4) rlang::inject(seasonder_logAndAbort(glue::glue("Invalid file for version >= 6 in file {filepath}. size: {file_size}, header extent V5 {header$nV5Extent}, V6 {header$nCS6ByteSize}."),!!!conditions_params))
if (header$nRangeCells <= 0 || header$nRangeCells > 8192 || header$nDopplerCells <= 0 || header$nDopplerCells > 32768) rlang::inject(seasonder_logAndAbort(glue::glue("Invalid nRangeCells or nDopplerCells in file {filepath}. nRangeCells: {header$nRangeCells}, nDopplerCells: {header$nDopplerCells}."),!!!conditions_params))
# CODAR documentation is not correct, they are double counting the number of spectra channels when they multiply by nSpectraChannels and by 36 or 40
if (header$nCsKind == 1 && file_size < (header_size + header$nRangeCells * header$nDopplerCells * 36)) rlang::inject(seasonder_logAndAbort(glue::glue("Invalid file size for nCsKind 1 in file {filepath}. Expected >= {(header_size + header$nRangeCells * header$nDopplerCells * 36)}, actual: {file_size}."),!!!conditions_params))
if (header$nCsKind == 2 && file_size < (header_size + header$nRangeCells * header$nDopplerCells * 40)) rlang::inject(seasonder_logAndAbort(glue::glue("Invalid file size for nCsKind 2 in file {filepath}. Expected >= {(header_size + header$nRangeCells* header$nDopplerCells * 40)}, actual: {file_size}."),!!!conditions_params))
return(NULL)
}
#' Skip SeaSonde Cross Spectra (CS) File Reading
#'
#' This function serves as a restart for `seasonder_readSeaSondeCSFile`. When invoked, it provides a
#' mechanism to gracefully handle file reading errors by logging an error message and skipping the current file processing.
#'
#' @param cond The condition or error that occurred during the file reading process. This is used
#' to log a detailed error message indicating the reason for skipping the file.
#'
#' @details
#' This function is meant to be used within a custom condition handler. When a problematic condition
#' arises during the processing of a SeaSonde CS file, you can call `seasonder_skip_cs_file(cond)` to
#' trigger this restart, which allows for a graceful degradation by logging an error message and returning a specified value.
#'
#' The effect of invoking this restart is twofold:
#' 1. An error message detailing the reason for skipping the file is logged.
#' 2. The calling function (`seasonder_readSeaSondeCSFile`) will immediately return a list with `header = NULL` and `data = NULL`.
#'
#'
#' @return A list with header = NULL and data = NULL.
#' @examples
#' # Example: Skip file reading using a withRestarts handler to return NULL header and data
#' result <- withRestarts(
#' seasonder_skip_cs_file(simpleError("test error")),
#' seasonder_skip_cs_file = function(cond) list(header = NULL, data = NULL)
#' )
#' print(result)
#' @export
seasonder_skip_cs_file <- function(cond) {
invokeRestart("seasonder_skip_cs_file",cond)
}
#' Read SeaSonde Cross Spectra (CS) File
#'
#' This function reads and processes a SeaSonde CS file, extracting both its header and data.
#'
#' @param filepath A character string specifying the path to the SeaSonde CS file.
#' @param specs_path A character string specifying the path to the YAML specifications for the CS file.
#' @param endian Character string indicating the byte order. Options are "big" (default) or "little".
#'
#' @details
#' The function starts by establishing a connection to the CS file specified by \code{filepath}.
#' It then reads the necessary metadata and header specifications from the \code{specs_path}.
#' Based on the CS file version determined from its header, it applies specific adjustments
#' to the header data. After processing the header, the function validates the CS file data
#' using \code{\link{seasonder_validateCSFileData}} and then reads the data itself via
#' \code{\link{seasonder_readSeaSondeCSFileData}}.
#'
#' @section Condition Management:
#' This function utilizes the `rlang` package to manage conditions and provide detailed and structured condition messages:
#'
#' \strong{Condition Classes}:
#' \itemize{
#' \item \code{seasonder_read_cs_file_error}: An error class that indicates a general problem when attempting to read the SeaSonde CS file.
#' \item \code{seasonder_cs_file_skipped}: Condition indicating that the processing of a CS file was skipped due to an error.
#' }
#'
#' \strong{Condition Cases}:
#' \itemize{
#' \item Failure to open a connection to the file.
#' \item Unsupported version found in the specs file.
#' \item Any other error that can arise from dependent functions such as `seasonder_readSeaSondeCSFileHeader` and `seasonder_readSeaSondeCSFileData`.
#' }
#'
#' \strong{Restart Options}:
#' This function provides a structured mechanism to recover from errors during its execution using the `rlang::withRestarts` function. The following restart option is available:
#'
#' \describe{
#' \item{\code{seasonder_skip_cs_file(cond)}}{This allows for the graceful handling of file reading errors. If this restart is invoked, the function will log an error message indicating that the processing of a specific CS file was skipped and will return a list with `header = NULL` and `data = NULL`. The restart takes one argument: \code{cond} (the condition or error that occurred).
#' \itemize{
#' \item \strong{Usage}: In a custom condition handler, you can call \code{seasonder_skip_cs_file(cond)} to trigger this restart and skip the processing of the current CS file.
#' \item \strong{Effect}: If invoked, the function logs an error message detailing the reason for skipping the file and then returns a list with both the header and data set to NULL.
#' }}
#'}
#' @return A list containing two components:
#' \itemize{
#' \item \code{header}: A list containing the processed header information of the CS file.
#' \item \code{data}: A list containing the processed data of the CS file. The structure
#' of this list depends on the content of the CS file and can contain components such as
#' `SSA*`, `CSxy`, and `QC`.
#' }
#'
#' @seealso
#' \code{\link{seasonder_skip_cs_file}},
#' \code{\link{seasonder_validateCSFileData}},
#' \code{\link{seasonder_readSeaSondeCSFileHeader}},
#' \code{\link{seasonder_readSeaSondeCSFileData}},
#' \code{\link{seasonder_readYAMLSpecs}}
#'
#' @references Cross Spectra File Format Version 6. CODAR. 2016
#' @examples
#' spec_file <- seasonder_defaultSpecsFilePath("CS")
#' cs_file <- system.file("css_data/CSS_TORA_24_04_04_0700.cs", package = "SeaSondeR")
#' cs <- seasonder_readSeaSondeCSFile(cs_file, spec_file, endian = "big")
#' str(cs)
#' @export
#'
seasonder_readSeaSondeCSFile <- function(filepath, specs_path, endian = "big") {
conditions_params <- list(calling_function = "seasonder_readSeaSondeCSFile",class = "seasonder_read_cs_file_error",seasonder_cs_filepath = filepath,seasonder_cs_specs_path = specs_path)
withRestarts(
seasonder_skip_cs_file = function(cond) {
seasonder_logAndMessage(glue::glue("An issue happened while processing the file {cond$seasonder_cs_filepath %||% ''}, skipping. Issue: {conditionMessage(cond)}"),"error",calling_function = "seasonder_readSeaSondeCSFile",class = "seasonder_cs_file_skipped",parent = cond)
return(list(header = NULL,data = NULL))
},
{
connection <- rlang::try_fetch(
suppressWarnings(file(filepath, "rb")),
error = function(e) {
rlang::inject(seasonder_logAndAbort(glue::glue("Could no open connection to file {filepath %||% ''}. Reason: {conditionMessage(e)}."),!!!conditions_params,parent = e))
}
)
on.exit(close(connection), add = TRUE)
specs_metadata <- seasonder_readYAMLSpecs(specs_path, "metadata")
specs_header <- seasonder_readYAMLSpecs(specs_path, "header")
yaml_version <- specs_metadata$version
if (!(yaml_version %in% seasonder_the$valid_yaml_seasondecs_versions)) {
rlang::inject(seasonder_logAndAbort(glue::glue("Unsupported version {yaml_version} found in specs file {specs_path}."),!!!conditions_params))
}
header <- seasonder_readSeaSondeCSFileHeader(specs_header, connection, endian = endian)
if (header$nCsFileVersion < 4) {
header$nRangeCells <- 32
header$nDopplerCells <- 512
}
if (header$nCsFileVersion < 5) {
header$nSpectraChannels <- 3
}
seasonder_validateCSFileData(filepath, header)
data <- seasonder_readSeaSondeCSFileData(connection, header, endian = endian)
return(list(header = header, data = data))
})
}
#' Convert an integer to raw bytes using a 64-bit representation
#'
#' This function converts an integer to a raw byte representation using a 64-bit (8-byte) format.
#' It leverages the `bit64` package to handle the 64-bit integer representation and conversion.
#'
#' @param x An integer to be converted to raw bytes.
#'
#' @return A raw vector representing the 64-bit format of the provided integer.
#'
#' @details
#' The function follows these steps:
#' 1. Convert the integer to a 64-bit format using `bit64::as.integer64`.
#' 2. Convert the 64-bit integer to a bit string.
#' 3. Split the bit string into individual bits.
#' 4. Reorder the bits into groups of 8, reversing the order within each group.
#' 5. Convert the reordered bits back to raw bytes.
#'
#'
#' @importFrom bit64 as.integer64
seasonder_int_to_raw <- function(x) {
# Convert the integer to a 64-bit bitstring
x_bitstr <- bit64::as.bitstring(bit64::as.integer64(x))
# Split the bitstring into individual bits
x_bits <- strsplit(x_bitstr, "")[[1]]
# Convert the bits to integers and reorder them
x_integers <- as.integer(x_bits)
x_integers_mtrx_rev <- matrix(x_integers, ncol = 8, byrow = TRUE)[, 8:1]
x_integers_mtrx_rev_transposed <- t(x_integers_mtrx_rev)
# Flatten the matrix into a vector
x_int_vect <- c(x_integers_mtrx_rev_transposed)
# Convert the bit sequence to raw bytes
x_packed <- packBits(x_int_vect, "raw")
out <- as.raw(x_packed)
return(out)
}
#' Convert a Raw Vector to a 64-bit Integer
#'
#' This function converts a raw vector to a 64-bit integer,
#' handling both signed and unsigned conversions.
#'
#' @param r A raw vector to be converted.
#' @param signed Logical, indicating whether the conversion should consider the value as signed (default is FALSE for unsigned).
#' @return A 64-bit integer representation of the raw vector.
seasonder_raw_to_int <- function(r,signed =FALSE) {
# Convert raw values to bits and collapse into a single bit string.
bit_str <- sapply(r,FUN = function(x) rev(rawToBits(x))) %>% as.integer() %>% paste0(collapse = "")
class(bit_str) <- "bitstring"
# Convert the bit string into a 64-bit integer.
int_val <- bit64::as.integer64(bit_str)
return(int_val)
}
#' Skip Reading a CSField and Return a Specified Value
#'
#' This function is a convenience mechanism to invoke the `seasonder_skip_cs_field` restart option. It can be used in custom condition handlers when reading a CSField from a binary connection encounters an error or condition. When called, it indicates the intention to skip reading the current CSField and return a specific value.
#'
#' @param cond A condition or error that occurred while reading the CSField.
#' @param value The desired return value to use in place of the CSField reading that encountered an error.
#'
#' @details
#' During the execution of the `seasonder_readCSField` function, errors or conditions can occur. To provide a structured mechanism to handle such cases, the function utilizes the `rlang::withRestarts` mechanism, offering a restart option named `seasonder_skip_cs_field`. This restart allows the function to gracefully handle reading errors by logging a relevant error message and returning a specified value.
#'
#' The `seasonder_skip_cs_field` function provides an easy way to invoke this restart. When called within a custom condition handler, it signals the intention to skip the current CSField reading due to an error and specifies a return value.
#'
#' @return The value specified in the 'value' parameter.
#'
#'
#' @examples
#' # Example: Skip reading a CSField using a withRestarts handler to return a default value
#' r <- withRestarts(
#' seasonder_skip_cs_field(simpleError("test error"), "default"),
#' seasonder_skip_cs_field = function(cond, value) value
#' )
#' print(r)
#' @export
seasonder_skip_cs_field <- function(cond,value) {
invokeRestart("seasonder_skip_cs_field",cond,value)
}
#' Read a CSField from a Binary Connection
#'
#' This function reads specific data types from a binary connection,
#' supporting various types including integer, float, double, complex, and strings.
#'
#' @param con A connection object to a binary file.
#' @param type A character string identifying the type of data to read.
#' @param endian A character string indicating the byte order. Options are "big" and "little" (default is "big").
#' @return The value obtained from reading the CSField according to the specified type.
#' @importFrom rlang !!!
#' @seealso
#' \code{\link{seasonder_skip_cs_field}},
#' \code{\link{seasonder_raw_to_int}}
#'
#' @section Supported Data Types:
#' This function provides support for reading a variety of data types from a binary connection. The following data types are recognized and can be used for the \code{type} argument:
#'
#' \describe{
#' \item{\code{CharN}}{Reads N characters from the connection where N is a positive integer. For example, \code{Char5} would read five characters.}
#'
#' \item{\code{UInt8}}{Reads an 8-bit unsigned integer.}
#'
#' \item{\code{SInt8}}{Reads an 8-bit signed integer.}
#'
#' \item{\code{UInt16}}{Reads a 16-bit unsigned integer.}
#'
#' \item{\code{SInt16}}{Reads a 16-bit signed integer.}
#'
#' \item{\code{UInt32}}{Reads a 32-bit unsigned integer.}
#'
#' \item{\code{SInt32}}{Reads a 32-bit signed integer.}
#'
#' \item{\code{Float}}{Reads a single-precision floating-point number.}
#'
#' \item{\code{Double}}{Reads a double-precision floating-point number.}
#'
#' \item{\code{UInt64}}{Reads a 64-bit unsigned integer.}
#'
#' \item{\code{SInt64}}{Reads a 64-bit signed integer.}
#'
#' \item{\code{Complex}}{Reads a complex number by separately reading the real and imaginary parts, which are each represented as double-precision floating-point numbers.}
#'
#' \item{\code{String}}{Reads a null-terminated string.}
#'}
#'
#' If the provided \code{type} does not match any of the supported data types, the function raises an error.
#'
#' @section Condition Management:
#' This function utilizes the `rlang` package to manage conditions and provide detailed and structured condition messages:
#'
#' \strong{Condition Classes}:
#' \itemize{
#' \item \code{seasonder_cs_field_reading_error}: General error related to reading a CSField from the binary connection.
#' \item \code{seasonder_cs_field_skipped}: Condition that indicates a CSField was skipped due to a reading error.
#' }
#'
#' \strong{Condition Cases}:
#' \itemize{
#' \item Connection is not open.
#' \item Error while reading value from connection.
#' \item Read value of length 0 from connection (likely reached end of file).
#' \item Unrecognized data type specified.
#' }
#'
#' \strong{Restart Options}:
#' This function provides a structured mechanism to recover from errors during its execution using the `rlang::withRestarts` function. The following restart option is available:
#'
#' \describe{
#' \item{\code{seasonder_skip_cs_field(cond, value)}}{This allows for the graceful handling of reading errors. If this restart is invoked, the function will log an error message indicating that a specific CSField reading was skipped and will return the value specified. The restart takes two arguments: \code{cond} (the condition or error that occurred) and \code{value} (the value to return if this CSField reading is skipped). To invoke this restart during a condition or error, you can use the helper function \code{seasonder_skip_cs_field(cond, value)}.
#' \itemize{
#' \item \strong{Usage}: In a custom condition handler, you can call \code{seasonder_skip_cs_field(cond, yourDesiredReturnValue)} to trigger this restart and skip the current CSField reading.
#' \item \strong{Effect}: If invoked, the function logs an error message detailing the reason for skipping, and then returns the value specified in the restart function call.
#' }}
#'}
seasonder_readCSField <- function(con, type, endian = "big") {
# Parameters used for error messages and logging.
conditions_params <- list(calling_function = "seasonder_readCSField",class = "seasonder_cs_field_reading_error",seasonder_cs_field_type = type,seasonder_cs_endian = endian)
out <- withRestarts(seasonder_skip_cs_field = function(cond,value) {
# Log the error message and skip the CS field.
seasonder_logAndMessage(glue::glue("Skipping CS field, returning {value}: {conditionMessage(cond)}"), "error", calling_function = "seasonder_readCSField", class = "seasonder_cs_field_skipped", parent = cond, seasonder_cs_field_value = value)
return(value)
},
{
# Ensure the connection is open before proceeding.
open_con <- try(isOpen(con), silent = TRUE)
if (!inherits(open_con, "try-error")) {
if (!open_con) {
rlang::inject(seasonder_logAndAbort("Connection is not open.", !!!conditions_params))
}
} else {
rlang::inject(seasonder_logAndAbort("Connection is not open.", !!!conditions_params,parent = attr(open_con,"condition")))
}
# Helper function to safely read from the connection.
read_values <- function(bytes, format, n = 1, signed = TRUE) {
res <- rlang::try_fetch({
out <- readBin(con, what = format, n = n, size = bytes, endian = endian, signed = signed)
# If nothing is read, it could be the end of the file.
if (length(out) == 0) {
rlang::abort("Read value of length 0. Possibly reached end of file.")
}
out
},
error = function(e) {
rlang::inject(seasonder_logAndAbort(glue::glue("Error while reading value: {conditionMessage(e)}"), !!!conditions_params, parent = e))
})
return(res)
}
# Process data types that involve reading character strings.
if (grepl("^Char[0-9]+$", type)) {
# Extract the number of characters to read.
char_length <- as.integer(sub("^Char", "", type))
chars <- read_values(1, "raw", char_length)
# Convert raw bytes to characters, handling embedded nul bytes
out <- rawToChar(chars)
return(out)
}
# Determine and read the specific data type from the connection.
switch(type,
"UInt8" = as.integer(read_values(1, "raw", signed =FALSE)),
"SInt8" = as.integer(read_values(1, "integer")),
"UInt16" = as.integer(read_values(2, "int", signed =FALSE)),
"SInt16" = as.integer(read_values(2, "int")),
"UInt32" = bitops::bitAnd(read_values(4, "integer"),0xFFFFFFFF),
"SInt32" = as.integer(read_values(4, "int")),
"Float" = as.numeric(read_values(4, "numeric")),
"Double" = as.numeric(read_values(8, "double")),
"UInt64" = {
v <- read_values(1, "raw", n = 8, signed =FALSE)
seasonder_raw_to_int(v, signed = FALSE)
},
"SInt64" = {
v <- read_values(1, "raw", n = 8)
seasonder_raw_to_int(v, signed = TRUE)
},
"Complex" = {
# Read both the real and imaginary components.
real_part <- as.numeric(read_values(4, "double"))
imag_part <- as.numeric(read_values(4, "double"))
complex(real = real_part, imaginary = imag_part)
},
"String" = {
# Keep reading characters until a null terminator is found.
chars <- NULL
out <- character(0)
repeat {
char <- read_values(1, "raw")
if (char == as.raw(0)) break
chars <- c(chars, char)
}
if(length(chars) >0){
out <- rawToChar(do.call(c, list(chars)))
}
return(out)
},
{
# Raise an error for unknown data types.
rlang::inject(seasonder_logAndAbort(glue::glue("Type Unknown: '{type}'."), !!!conditions_params))
})
})
return(out)
}
#' Structured Restart for Quality Control
#'
#' Provides a structured restart mechanism to rerun the quality control (QC) function
#' with an alternative function during the execution of `read_and_qc_field`.
#' This allows for a flexible error recovery strategy when the initial QC function fails
#' or is deemed inadequate.
#'
#' This function is meant to be used within custom condition handlers for the
#' `read_and_qc_field` function.
#'
#' @param cond The condition object captured during the execution of the
#' `read_and_qc_field` function.
#' @param qc_fun An alternate quality control function to apply. This function should accept
#' the value from the field as its sole argument and return a QC-applied value.
#'
#' @return The value returned by the alternate quality control function.
#' @examples
#' # Example (expected to error due to missing restart):
#' val <- try(
#' seasonder_rerun_qc_with_fun(
#' list(seasonder_value = 42),
#' function(x) x * 2
#' ),
#' silent = TRUE
#' )
#' print(val)
#' @export
seasonder_rerun_qc_with_fun <- function(cond,qc_fun) {
invokeRestart("seasonder_rerun_qc_with_fun",cond,qc_fun)
}
#' Read and Quality Control a Single Field
#'
#' This auxiliary function reads a field from a binary file using a provided specification and
#' applies a quality control function on the retrieved data. The expectations and functioning of the
#' quality control functions are described in detail in the documentation for `seasonder_readSeaSondeCSFileBlock`.
#'
#' @param field_spec A list containing the specifications for the field to read.
#' It should contain:
#' * `type`: the type of data to read, passed to `seasonder_readCSField`.
#' * `qc_fun`: the name of a quality control function. As detailed in `seasonder_readSeaSondeCSFileBlock`,
#' this function should be present in the shared environment `seasonder_the` and must accept
#' `field_value` as its first argument, followed by any other arguments specified in `qc_params`.
#' * `qc_params`: a list of additional parameters to pass to the quality control function. See
#' `seasonder_readSeaSondeCSFileBlock` for detailed expectations of the QC function behavior.
#' @param connection A connection to the binary file.
#' @param endian A character string indicating the byte order. Options are "big" and "little" (default is "big").
#'
#'
#' @return The value of the field after applying quality control.
#'
#'
#' @section Condition Management:
#' This function utilizes the `rlang` package to manage conditions and provide detailed and structured condition messages:
#'
#' \strong{Condition Classes}:
#' \itemize{
#' \item \code{seasonder_cs_field_skipped}: Condition that indicates a CSField was skipped during reading.
#' \item \code{seasonder_cs_field_qc_fun_rerun}: Condition that indicates a rerun of the quality control function was triggered.
#' \item \code{seasonder_cs_field_qc_fun_not_defined_error}: Error raised when the quality control function specified is not found in the shared environment `seasonder_the`.
#' \item \code{seasonder_cs_field_qc_fun_error}: Error raised when an issue occurs while applying the quality control function.
#' }
#'
#' \strong{Condition Cases}:
#' \itemize{
#' \item If a CSField is skipped during reading, the condition \code{seasonder_cs_field_skipped} is used to skip QC and then is re-signaled.
#' \item If an alternate QC is rerun using the \code{seasonder_rerun_qc_with_fun} restart, the condition \code{seasonder_cs_field_qc_fun_rerun} is signaled.
#' \item If the quality control function specified is not found in the shared environment `seasonder_the`, the error \code{seasonder_cs_field_qc_fun_not_defined_error} is raised.
#' \item If there's an issue applying the quality control function, the error \code{seasonder_cs_field_qc_fun_error} is raised.
#' }
#'
#' \strong{Restart Options}:
#' The function provides structured mechanisms to recover from errors/conditions during its execution using `withRestarts`. The following restart options are available:
#'
#' \itemize{
#' \item \code{seasonder_rerun_qc_with_fun}: Allows for rerunning QC with an alternate function.
#' \itemize{
#' \item \strong{Usage}: In a custom condition handler, you can call \code{seasonder_rerun_qc_with_fun(cond, alternateQCfunction)} to trigger this restart and run an alternate QC using \code{alternateQCfunction}. \code{alternateQCfunction} will be used as follows alternateQCfunction(x) being x the value. No extra parameters are passed.
#' \item \strong{Effect}: If invoked, the function logs an info message detailing the reason of the rerun, and then returns the value returned by \code{alternateQCfunction}.
#' }
#' }
#'
#' @seealso
#' \code{\link{seasonder_rerun_qc_with_fun}},
#' \code{\link{seasonder_readCSField}}
#'
#' It's also important to note that within `read_and_qc_field`, the function `seasonder_readCSField` is used. This function has its own error management and restart options, which are detailed in its documentation.
read_and_qc_field <- function(field_spec, connection, endian = "big") {
# Parameters used for error messages and logging.
conditions_params <- list(calling_function = "read_and_qc_field")
# Extract the field type from the specifications
field_type <- field_spec$type
# Extract the quality control function name from the specifications
qc_fun_name <- field_spec$qc_fun
# Extract the quality control parameters from the specifications
qc_params <- field_spec$qc_params
# Read the field using the helper function
fs_env <- new.env()
fs_env$field_skipped <- FALSE
field_value <- rlang::try_fetch(
seasonder_readCSField(connection, field_type, endian = endian),
seasonder_cs_field_skipped = function(cond) {
fs_env$field_skipped <- TRUE # asignación local al entorno fs_env
rlang::cnd_signal(cond)
cond$seasonder_cs_field_value
}
)
if (!fs_env$field_skipped) {
field_value_after_qc <- withRestarts(
seasonder_rerun_qc_with_fun = function(cond,qc_fun) {
value <- cond$seasonder_value
rlang::inject(seasonder_logAndMessage(glue::glue("Rerunning QC on value {value}."),"info",class = "seasonder_cs_field_qc_fun_rerun",!!!conditions_params,parent = cond))
return(qc_fun(value))
},
{
# Apply quality control
if (!qc_fun_name %in% names(seasonder_the$qc_functions)) {
rlang::inject(seasonder_logAndAbort(glue::glue("QC function '{qc_fun_name}' not defined."),!!!conditions_params,class = "seasonder_cs_field_qc_fun_not_defined_error",seasonder_value = field_value))
}
# Get the quality control function from the shared environment
qc_fun <- seasonder_the$qc_functions[[qc_fun_name]]
# Call the quality control function with the field value and the specified parameters
field_value_after_qc <- rlang::try_fetch(
rlang::inject(qc_fun(field_value,!!!qc_params)),
error = function(e) rlang::inject(seasonder_logAndAbort(glue::glue("An issue happened while applying QC function '{qc_fun_name}'."),!!!conditions_params,class = "seasonder_cs_field_qc_fun_error",seasonder_value = field_value,parent = e))
)
field_value_after_qc
})
# Return the value after quality control
return(field_value_after_qc)
}else{
return(field_value)
}
}
#' Read and Apply Quality Control to a Block of Fields
#'
#' Reads a block of fields from a binary file based on provided specifications. Each field is read
#' and then processed with a specified quality control function.
#'
#' @param spec A named list of specifications for fields to read. Each specification should be in
#' the form:
#' list(type = "data_type", qc_fun = "qc_function_name", qc_params = list(param1 = value1, ...))
#' Where:
#' * `type`: is the data type to read, which will be passed to `seasonder_readCSField`.
#' * `qc_fun`: is the name of a quality control function. This function should be present in the
#' shared environment `seasonder_the` and must accept `field_value` as its first argument,
#' followed by any other arguments specified in `qc_params`.
#' * `qc_params`: is a list of additional parameters to pass to the quality control function.
#' @param connection A connection to the binary file.
#' @param endian A character string indicating the byte order. Options are "big" and "little" (default is "big").
#'
#' @details
#' The quality control (QC) functions (`qc_fun`) specified within `spec` play a pivotal role in ensuring the
#' reliability of the data that's read. Here's the expected behavior of these QC functions:
#'
#' - **Input**:
#' * `field_value`: Value of the field that has been read from the binary file using the `seasonder_readCSField` function.
#' * `...`: Additional parameters specified in `qc_params` that are passed to `qc_fun` for quality control.
#'
#' - **Functioning**:
#' The QC function receives a read value and performs checks or transformations based on defined rules or parameters.
#'
#' * **On QC failure**:
#' - The QC function itself is responsible for determining the action to take. It can log an error, return a default
#' value, impute the value, and more.
#' - For critical errors, the QC function could halt the execution. However, note that logging is managed by the QC
#' function and won't necessarily halt execution in every case.
#' * **On success**:
#' The QC function will return the value (either unchanged or transformed).
#'
#' - **Output**:
#' Value that has been validated or transformed based on quality control rules.
#'
#' - **Additional Notes**:
#' - The action on QC failure is directly implemented within the QC function.
#' - Reading errors are managed by the `seasonder_readCSField` function, which returns NULL in the case of an error. It
#' is up to the QC function to decide what to do if it receives a NULL.
#'
#' @seealso
#' \code{\link{read_and_qc_field}}
#'
#' @return A named list where each entry corresponds to a field that has been read. Each key is
#' the field name, and its associated value is the data for that field after quality control.
#' @examples
#' spec <- list(field1 = list(type = "UInt8", qc_fun = "qc_check_unsigned", qc_params = list()))
#' con <- rawConnection(as.raw(c(0x01)))
#' block <- seasonder_readSeaSondeCSFileBlock(spec, con, endian = "big")
#' print(block)
#' close(con)
#' @export
seasonder_readSeaSondeCSFileBlock <- function(spec, connection,endian = "big") {
# Use purrr::map to apply the read_and_qc_field function to each field specification
results <- withCallingHandlers(
purrr::map(spec, \(field_spec)
read_and_qc_field(field_spec = field_spec,connection = connection, endian = endian)),
purrr_error_indexed = function(err) {
parent_err <- err$parent
parent_err$message <- glue::glue("Field {names(spec)[err$location]}: {err$parent$message}")
rlang::cnd_signal(parent_err)
})
# Return the results
return(results)
}
#' Validate Field Specifications
#'
#' This function checks if the provided specifications (`specs`) contain entries for all the required fields listed in `fields`.
#'
#' @param specs A list containing field specifications.
#' @param fields A character vector of field names to be checked in the `specs`.
#'
#' @details
#' The function iterates over each field in the `fields` vector and checks if there is an associated entry in the `specs` list.
#' If any field is missing, an error is thrown using `seasonder_logAndAbort` indicating the missing field specification.
#'
#' @section Condition Management:
#' This function utilizes the `rlang` package to manage conditions, and provide detailed and structured condition messages:
#'
#' \strong{Condition Classes}:
#' \itemize{
#' \item \code{spsr_field_specification_missing_error}: This error is thrown when a required field specification is missing from the `specs` list.
#' }
#'
#' \strong{Condition Cases}:
#' \itemize{
#' \item Required field specification is missing.
#' }
#'
#'
#' @return Invisibly returns NULL.
seasonder_check_specs <- function(specs, fields) {
# Use purrr::walk to iterate over each field and check its presence in the specs
fields %>% purrr::walk(function(field) {
# Check if the field is present in the specs
if (is.null(purrr::pluck(specs, field))) {
# If not, throw an error indicating the missing field specification
seasonder_logAndAbort(glue::glue("Specifications for field '{field}' not provided"),
calling_function = "seasonder_check_specs",
class = "spsr_field_specification_missing_error")
}
})
}
#' Read SeaSonde File Header (Version 1)
#'
#' Reads the header of a SeaSonde file (Version 1) based on the provided specifications.
#' Transforms the date-time fields and returns the results.
#'
#' @param specs A list containing specifications for reading the file.
#' @param connection Connection object to the file.
#' @param endian Character string specifying the endianness. Default is "big".
#' @param prev_data previous header data
#'
#' @seealso
#' \code{\link{seasonder_check_specs}}
#' \code{\link{seasonder_readSeaSondeCSFileBlock}}
#'
#' @return A list with the read and transformed results.
seasonder_readSeaSondeCSFileHeaderV1 <- function(specs, connection, endian = "big", prev_data = NULL) {
# Step 1: Specification Validation
# This step ensures that the provided specs contain the necessary information
# for the fields "nCsFileVersion", "nDateTime", and "nV1Extent".
seasonder_check_specs(specs, c("nCsFileVersion","nDateTime","nV1Extent"))
# Step 2: Field Reading
# This step reads the specified fields from the connection (e.g., file)
# based on the provided specs and returns the results as a list.
results <- seasonder_readSeaSondeCSFileBlock(specs, connection, endian)
# Step 3: Data Transformation
# The date-time field "nDateTime" is read as an integer. This step converts it
# to a POSIXct object, using "1904-01-01" as the origin, and sets the time zone to UTC.
# The reason for the origin "1904-01-01" is specific to SeaSonde data formats.
results$nDateTime <- as.POSIXct(results$nDateTime, origin = "1904-01-01", tz = "UTC")
# Return the final results, including the transformed date-time field.
return(results)
}
#' Read SeaSonde File Header (Version 2)
#'
#' Reads the header of a SeaSonde file (Version 2) based on the provided specifications.
#'
#' @param specs A list containing specifications for reading the file.
#' @param connection Connection object to the file.
#' @param endian Character string specifying the endianness. Default is "big".
#' @param prev_data previous header data
#'
#' @seealso
#' \code{\link{seasonder_check_specs}}
#' \code{\link{seasonder_readSeaSondeCSFileBlock}}
#'
#' @return A list with the read results.
seasonder_readSeaSondeCSFileHeaderV2 <- function(specs, connection, endian = "big", prev_data = NULL) {
# Step 1: Specification Validation
# This step ensures that the provided specs contain the necessary information
# for the fields "nCsKind" and "nV2Extent".
seasonder_check_specs(specs, c("nCsKind","nV2Extent"))
# Step 2: Field Reading
# This step reads the specified fields from the connection (e.g., file)
# based on the provided specs and returns the results as a list.
results <- seasonder_readSeaSondeCSFileBlock(specs, connection, endian)
# Return the read results.
return(results)
}
#' Read SeaSonde File Header (Version 3)
#'
#' Reads the header of a SeaSonde file (Version 3) based on the provided specifications.
#' Adds nRangeCells, nDopplerCells, and nFirstRangeCell as constant values to the results.
#'
#' @param specs A list containing specifications for reading the file.
#' @param connection Connection object to the file.
#' @param endian Character string specifying the endianness. Default is "big".
#' @param prev_data previous header data
#'
#' @seealso
#' \code{\link{seasonder_check_specs}}
#' \code{\link{seasonder_readSeaSondeCSFileBlock}}
#'
#' @return A list with the read results.
seasonder_readSeaSondeCSFileHeaderV3 <- function(specs, connection, endian = "big", prev_data = NULL) {
# Step 1: Specification Validation
# This step ensures that the provided specs contain the necessary information
# for the fields "nSiteCodeName" and "nV3Extent".
seasonder_check_specs(specs, c("nSiteCodeName","nV3Extent"))
# Step 2: Field Reading
# This step reads the specified fields from the connection (e.g., file)
# based on the provided specs and returns the results as a list.
results <- seasonder_readSeaSondeCSFileBlock(specs, connection, endian)
# Step 3: Data Addition
# Add constant values to the results.
results$nRangeCells <- 31L
results$nDopplerCells <- 512L
results$nFirstRangeCell <- 1L
# Return the final results
return(results)
}
#' Read SeaSonde File Header (Version 4)
#'
#' Reads the header of a SeaSonde file (Version 4) based on the provided specifications.
#' Transforms the CenterFreq field and returns the results.
#'
#' @param specs A list containing specifications for reading the file.
#' @param connection Connection object to the file.
#' @param endian Character string specifying the endianness. Default is "big".
#' @param prev_data previous header data
#'
#' @seealso
#' \code{\link{seasonder_check_specs}}
#' \code{\link{seasonder_readSeaSondeCSFileBlock}}
#'
#' @return A list with the read and transformed results.
seasonder_readSeaSondeCSFileHeaderV4 <- function(specs, connection, endian = "big", prev_data = NULL) {
# Step 1: Specification Validation
# This step ensures that the provided specs contain the necessary information.
required_fields <- c("nCoverMinutes", "bDeletedSource", "bOverrideSrcInfo",
"fStartFreqMHz", "fRepFreqHz", "fBandwidthKHz", "bSweepUp",
"nDopplerCells", "nRangeCells", "nFirstRangeCell",
"fRangeCellDistKm", "nV4Extent")
seasonder_check_specs(specs, required_fields)
# Step 2: Field Reading
# This step reads the specified fields from the connection (e.g., file)
# based on the provided specs and returns the results as a list.
results <- seasonder_readSeaSondeCSFileBlock(specs, connection, endian)
# Step 3: Data Transformation
# Calculate CenterFreq using the provided formula.
results$CenterFreq <- results$fStartFreqMHz + (results$fBandwidthKHz/1000)/2 * -1^(results$bSweepUp == 0)
results$CellsDistKm <- (seq(1:results$nRangeCells) - 1 + results$nFirstRangeCell) * results$fRangeCellDistKm
# Return the final results, including the CenterFreq.
return(results)
}
#' Read SeaSonde File Header (Version 5)
#'
#' Reads the header of a SeaSonde file (Version 5) based on the provided specifications.
#' Performs applicable transformations and returns the results.
#'
#' @param specs A list containing specifications for reading the file.
#' @param connection Connection object to the file.
#' @param endian Character string specifying the endianness. Default is "big".
#' @param prev_data previous header data
#'
#' @seealso
#' \code{\link{seasonder_check_specs}}
#' \code{\link{seasonder_readSeaSondeCSFileBlock}}
#'
#' @return A list with the read and transformed results.
seasonder_readSeaSondeCSFileHeaderV5 <- function(specs, connection, endian = "big", prev_data = NULL) {
# Step 1: Specification Validation
seasonder_check_specs(specs, c("nOutputInterval", "nCreateTypeCode", "nCreatorVersion", "nActiveChannels",
"nSpectraChannels", "nActiveChanBits", "nV5Extent"))
# Step 2: Field Reading
results <- seasonder_readSeaSondeCSFileBlock(specs, connection, endian)
# Step 3: Data Transformation
# Convert the bits into a vector of active antennas
results$ActiveChannels <- which(intToBits(results$nActiveChanBits)[1:32] == TRUE)
# Return the final results.
return(results)
}
#' Read Version 6 Block Data
#'
#' This function reads and processes regular and repeated blocks of data
#' based on provided specifications. Regular blocks are read directly, while
#' repeated blocks are processed recursively based on a set of loops provided
#' in the specifications.
#'
#' @param specs A list. Specifications detailing the structure and content of the data blocks.
#' Contains variable names, types, quality check functions, and other related attributes.
#' For repeated blocks, a 'repeat' key is added which details the loop structure and
#' nested specifications.
#' @param connection A connection object. Represents the connection to the data source. It's passed
#' to the lower-level reading function.
#' @param endian A character string. Specifies the byte order to be used. Default is "big".
#' Passed to the lower-level reading function.
#' @param prev_data A list. Previous data or metadata that might be required to inform the reading
#' process, such as loop lengths for repeated blocks. Default is NULL.
#' @param remaining_loops A character vector. Details the remaining loops to be processed for
#' repeated blocks. Internally used for recursive processing. Default is NULL.
#' If provided, it should always be in sync with the repeat specifications.
#' @return A list. Contains the read and processed data based on the provided specifications.
#' Regular variables are returned at the top level. Repeated blocks are nested lists with
#' 'loop' and 'data' keys detailing the loop variable and corresponding data.
#' @importFrom purrr list_transpose map
#'
#' @seealso
#' \code{\link{readV6BlockData}}
#'
#'
#' @examples
#' # Example: read a single UInt8 value using internal helper
#' specs <- list(
#' field1 = list(
#' type = "UInt8",
#' qc_fun = "qc_check_unsigned",
#' qc_params = list()
#' )
#' )
#' con <- rawConnection(as.raw(c(10)), "rb")
#' result <- readV6BlockData(specs, con, endian = "big")
#' print(result)
#' close(con)
#' @export
readV6BlockData <- function(specs, connection, endian = "big", prev_data = NULL, remaining_loops = NULL) {
# browser(expr = "nReceiverModel" %in% names(specs))
# If there are remaining loops to process, handle the repeated block recursively
if (length(remaining_loops) > 0) {
# Get the current loop variable and its repetition count from prev_data
loop_var <- remaining_loops[1]
num_repeats <- prev_data[[loop_var]]
# Update the list of remaining loops by removing the current one
remaining_loops <- remaining_loops[-1]
# Initialize a list to store data from repeated blocks
repeated_data <- vector("list", num_repeats)
# Recursively call readV6BlockData for each iteration of the current loop
for (i in seq_len(num_repeats)) {
repeated_data[[i]] <- readV6BlockData(specs, connection, endian, prev_data, remaining_loops)
}
# Transpose the list to group by variable rather than by loop iteration
repeated_data <- purrr::list_transpose(repeated_data)
# Add loop information to the data
repeated_data %<>% purrr::map(\(x) list(loop = loop_var, data = x))
return(repeated_data)
}
# If there are no remaining loops, handle the regular block
# Filter out repeated block specifications
regular_specs <- specs[names(specs) != "repeat"]
# Initialize an output list
out <- list()
# If there are regular specs, read the regular block data
if (length(regular_specs) > 0) {
regular_block <- seasonder_readSeaSondeCSFileBlock(regular_specs, connection, endian)
out <- c(out, regular_block)
}
# If the specs contain a "repeat" key, handle the repeated block
if ("repeat" %in% names(specs)) {
repeat_specs <- specs[["repeat"]]
remaining_loops <- repeat_specs$how_many
# Recursively call readV6BlockData for the repeated block
repeat_result <- readV6BlockData(repeat_specs$what, connection, endian, prev_data, remaining_loops)
# Merge the repeated block data into the output
out <- c(out, repeat_result)
}
# Return the merged regular and repeated block data
return(out)
}
#' Trigger Restart for Skipping Transformation
#'
#' This function provides a mechanism to invoke a restart during the reading and
#' transformation process of the SeaSonde CS File Version 6 header. It allows users
#' to skip transformations that may have caused errors and proceed with a provided value.
#'
#' @param cond The condition object that triggered the restart.
#' @param value The provided value to be used when the transformation is skipped.
#'
#' @details
#' This function specifically triggers the `seasonder_v6_skip_transformation` restart
#' that allows for skipping a block transformation in the reading process of the
#' SeaSonde CS File Version 6 header. When triggered, it logs an error message,
#' skips the problematic transformation, and returns the provided value for the block.
#'
#' @section Integration with SeaSonde CS File Reading:
#'
#' The restart mechanism of this function is integrated within the
#' \code{seasonder_readSeaSondeCSFileHeaderV6} function. If an error occurs during
#' the transformation process of a specific block, the restart provides users with
#' an option to skip the problematic transformation and proceed with a fallback value.
#'
#'
#' @return This function triggers a restart and does not return a usual value.
#' @examples
#' # Example: Skip transformation using a restart handler
#' res <- withRestarts(
#' seasonder_v6_skip_transformation(simpleError("test error"), "default"),
#' seasonder_v6_skip_transformation = function(cond, value) value
#' )
#' print(res)
#' @export
seasonder_v6_skip_transformation <- function(cond, value) {
invokeRestart("seasonder_v6_skip_transformation", cond, value)
}
#' Read SeaSonde CS File Header V6
#'
#' This function reads the header of a SeaSonde CS File Version 6.
#' It sequentially reads blocks based on the provided specifications and returns the read data.
#'
#' @param specs A list of specifications for reading the file header. It should contain three main elements:
#' `nCS6ByteSize`, `block_spec`, and `blocks`, each containing further specifications for reading various parts of the header.
#' @param connection A connection object to the SeaSonde CS file.
#' @param endian The byte order for reading the file. Default is "big".
#' @param prev_data Previous data, if any, that might affect the current reading. Default is NULL.
#'
#' @return A list containing the read data, organized based on the block keys.
#'
#' @section Condition Management:
#' This function utilizes the `rlang` package to manage conditions and provide detailed and structured condition messages:
#'
#' \strong{Condition Classes}:
#' \itemize{
#' \item \code{seasonder_v6_block_transformacion_skipped}: Triggered when a transformation for a specific block is skipped.
#' \item \code{seasonder_v6_transform_function_error}: Triggered when there's an error while applying the transformation function for a V6 header block.
#' \item \code{seasonder_v6_skip_block_error}: Triggered when there's an error while skipping a block.
#'}
#'
#' \strong{Condition Cases}:
#'
#' The following are the scenarios when errors or conditions are raised:
#'
#'\itemize{
#' \item Transformation Failure: If there's a recognized block key and the transformation function associated with it fails.
#' \item Error in Transformation Function Application: If there's an error while applying the transformation function for a recognized V6 header block.
#' \item Error in Skipping Block: If there's an error while skipping a block when the block key is not recognized.
#'}
#'
#' \strong{Restart Options}:
#'
#' The function provides the following restart option:
#'
#' \code{seasonder_v6_skip_transformation}: This restart allows users to skip the transformation for a specific block and instead return the provided value.
#'
#' \strong{Effects of Restart Options}:
#'
#' Using the \code{seasonder_v6_skip_transformation} restart:
#' \itemize{
#' \item The error message gets logged.
#' \item The transformation that caused the error gets skipped.
#' \item The provided value for that block is returned.
#'}
#'
#' Proper error management ensures the integrity of the reading process and provides detailed feedback to users regarding issues and potential resolutions.
#'
#' @seealso
#' \code{\link{seasonder_check_specs}}
#' \code{\link{seasonder_readSeaSondeCSFileBlock}}
#' \code{\link{readV6BlockData}}
#' \code{\link{seasonder_v6_skip_transformation}}
#'
#'
seasonder_readSeaSondeCSFileHeaderV6 <- function(specs, connection, endian = "big", prev_data = NULL) {
conditions_params <- list(calling_function = "seasonder_readSeaSondeCSFileHeaderV6")
# Step 1: Specification Validation
seasonder_check_specs(specs, c("nCS6ByteSize","block_spec"))
# Step 2: Field Reading
nCS6ByteSize <- seasonder_readSeaSondeCSFileBlock(specs["nCS6ByteSize"], connection, endian)$nCS6ByteSize
results <- list(nCS6ByteSize = nCS6ByteSize)
# Continue reading as long as there are bytes left in the CS6 Byte Size
while (nCS6ByteSize > 0) {
# Read the block key and block data size
block <- seasonder_readSeaSondeCSFileBlock(specs$block_spec, connection, endian)
# If the block key is recognized:
if (!is.null(specs$blocks[[block$nBlockKey]])) {
# Read block data using readV6BlockData
block_data <- readV6BlockData(specs$blocks[[block$nBlockKey]], connection, endian, prev_data)
# Apply transformations if they exist
if (!is.null(seasonder_the$transform_functions[[block$nBlockKey]])) {
block_data <- withRestarts(
seasonder_v6_skip_transformation = function(cond, value) {
# Log the error message and skip the CS field.
rlang::inject(seasonder_logAndMessage(glue::glue("Skipping transformation for block '{block$nBlockKey}', returning provided value: {conditionMessage(cond)}"), "error", !!!conditions_params, class = "seasonder_v6_block_transformacion_skipped", parent = cond, new_seasonder_block_data = value))
return(value)
},
rlang::try_fetch(
seasonder_the$transform_functions[[block$nBlockKey]](block_data),
error = function(err) {
rlang::inject(seasonder_logAndAbort(glue::glue("Error while applying transform function for V6 header block '{block$nBlockKey}': {conditionMessage(err)}"),!!!conditions_params, class = "seasonder_v6_transform_function_error",parent = err, seasonder_block_data = block_data))
})
)
}
# Store the results
results[[block$nBlockKey]] <- block_data
} else {
# If the block key is not recognized, skip bytes as per the block data size
rlang::try_fetch(
seek(connection, where = block$nBlockDataSize, origin = "current", rw = "read"),
error = function(err) {
rlang::inject(seasonder_logAndAbort(glue::glue("Error while skipping block '{block$nBlockKey}': {conditionMessage(err)}"),!!!conditions_params, parent = err, class = "seasonder_v6_skip_block_error"))
})
}
# Subtract the current read size from nCS6ByteSize
nCS6ByteSize <- nCS6ByteSize - 8 - block$nBlockDataSize
}
# Return the results
return(results)
}
##' Process a Specific Version of the SeaSonde File Header
#'
#' This function processes a specified version of the SeaSonde file header. It identifies the
#' appropriate header function for the given version, processes the header, and then updates
#' the accumulating pool of header data. Specifically:
#'
#' 1. For fields in the current header that overlap with the accumulated pool, the
#' current header's values overwrite those in the pool.
#' 2. Fields that are unique to the current header are appended to the pool.
#'
#' @section Assumptions:
#' This function assumes that the desired version-specific `seasonder_readSeaSondeCSFileHeaderV*`
#' functions are available in the global environment.
#'
#' @param pool List. An accumulating list of processed headers from prior versions.
#' @param version Integer. The specific version of the header to be processed. E.g., for version 3,
#' the function `seasonder_readSeaSondeCSFileHeaderV3` should be present.
#' @param specs List. Header specifications for each version. Each entry should correspond to
#' a version number and contain the required information to process that version's header.
#' @param connection Connection object. The file connection pointing to the SeaSonde file.
#' @param endian Character string. Specifies the byte order for reading data. Can be "big" (default)
#' @param prev_data previous header data
#' or "little". Use the appropriate value depending on the system architecture and the
#' file's source.
#'
#' @seealso
#' \code{\link{seasonder_readSeaSondeCSFileHeaderV2}}
#' \code{\link{seasonder_readSeaSondeCSFileHeaderV3}}
#' \code{\link{seasonder_readSeaSondeCSFileHeaderV4}}
#' \code{\link{seasonder_readSeaSondeCSFileHeaderV5}}
#' \code{\link{seasonder_readSeaSondeCSFileHeaderV6}}
#'
#' @return List. A combination of the initial `pool` and the processed header for the given `version`.
#' Fields in the current header will overwrite or append to the pool as described above.
process_version_header <- function(pool, version, specs, connection, endian = "big", prev_data = NULL) {
# Construct the function name based on the provided version
function_name <- paste0("seasonder_readSeaSondeCSFileHeaderV", version)
# Access the appropriate function from the global environment
header_function <- get(function_name)
# Process the current version header
current_header <- header_function(specs[[paste0("V", version)]], connection, endian, prev_data = prev_data)
# Overwrite overlapping fields from the pool with the current header
overlapping_keys <- intersect(names(pool), names(current_header))
pool[overlapping_keys] <- current_header[overlapping_keys]
# Add new fields from the current header to the pool
new_keys <- setdiff(names(current_header), names(pool))
pool <- c(pool, current_header[new_keys])
return(pool)
}
#' Read the SeaSonde CS File Header
#'
#' This function reads and processes the header of a SeaSonde CS file. It initially reads
#' the general header (Version 1) to determine the file version. Subsequent headers are processed
#' based on the file version.
#'
#' @param specs List of header specifications for each version.
#' @param connection The file connection.
#' @param endian Character string indicating the byte order, either "big" (default) or "little".
#'
#' @seealso
#' \code{\link{seasonder_readSeaSondeCSFileHeaderV1}}
#' \code{\link{process_version_header}}
#'
##' @return A combined list of all processed headers up to the file version.
seasonder_readSeaSondeCSFileHeader <- function(specs, connection, endian = "big") {
# Read the general header (Version 1)
withCallingHandlers({
header_v1 <- seasonder_readSeaSondeCSFileHeaderV1(specs$V1, connection, endian)
},
error = function(err) {
err$message <- glue::glue("Header version 1: {conditionMessage(err)}")
rlang::cnd_signal(err)
}
)
# Extract the file version to determine subsequent headers to process
file_version <- header_v1$nCsFileVersion
# Create a list of header versions to process
versions_to_process <- 2:file_version
# Reduce the list of versions to process them sequentially
header_pool <- withCallingHandlers(
purrr::reduce(versions_to_process, \(pool, version) {
out <- process_version_header(pool = pool, version = version, specs = specs, connection = connection, endian = endian, prev_data = pool)
out
}, .init = header_v1),
purrr_error_indexed = function(err) {
parent_err <- err$parent
parent_err$message <- glue::glue("Header version {versions_to_process[err$location]}: {conditionMessage(err$parent)}")
rlang::cnd_signal(parent_err)
})
return(header_pool)
}
#' Read SeaSonde Cross Spectra (CS) File Data
#'
#' This function reads the SeaSonde CS file data based on the provided header information.
#' The CS file data includes the antenna voltage squared self spectra (`SSA*`) and the
#' antenna cross spectra (`CSxy`). Additionally, a quality matrix (`QC`) is read when the header's
#' `nCsKind` is greater than or equal to 2.
#'
#' @param connection A connection object to the CS file.
#' @param header A list containing the header information. This is typically the output
#' of the `seasonder_readSeaSondeCSFileHeader` function.
#' @param endian Character string indicating the byte order. Options are "big" (default) or "little".
#'
#' @details
#' - `SSA*`: Represents the Antenna * voltage squared self spectra. These are matrices
#' where each row corresponds to a range and each column to a Doppler cell.
#' - `CSxy`: Represents the cross spectra between two antennas x and y. These are complex matrices.
#' - `QC`: Quality matrix with values ranging from zero to one. A value less than one indicates
#' that the SpectraAverager skipped some data during averaging.
#' @section Condition Management:
#' This function utilizes the `rlang` package to manage errors and conditions, providing detailed and structured messages:
#'
#' \strong{Error Classes}:
#' \itemize{
#' \item \code{"seasonder_cs_data_reading_error"}: This error is thrown when there is a problem reading the CS file data. This could be due to issues with the connection object or the file itself.
#' \item \code{"seasonder_cs_missing_header_info_error"}: Thrown if essential header information such as `nRangeCells`, `nDopplerCells`, or `nCsKind` is missing or invalid.
#' }
#'
#' \strong{Error Cases}:
#' \itemize{
#' \item Connection object is not properly opened or is invalid.
#' \item Header information is incomplete or improperly formatted.
#' \item File read operations fail due to incorrect data size, type, or unexpected end of file.
#' \item Non-numeric values encountered where numeric spectra data is expected.
#' }
#'
#' @return A list containing the processed CS file data including matrices for SSA*, CSxy, and QC (if applicable).
#'
#'
#' @examples
#' con <- rawConnection(as.raw(rep(0, 300)))
#' header <- list(nRangeCells = 1, nDopplerCells = 5, nCsKind = 2)
#' data <- seasonder_readSeaSondeCSFileData(con, header, endian = "big")
#' print(data)
#' close(con)
#' @export
seasonder_readSeaSondeCSFileData <- function(connection, header, endian = "big") {
conditions_params <- list(calling_function = "seasonder_readSeaSondeCSFileData",class = "seasonder_cs_data_reading_error")
# Extracting information from the header
nRanges <- header$nRangeCells
nDoppler <- header$nDopplerCells
nCSKind <- header$nCsKind
# Initialize matrices for the spectra
out <- seasonder_initCSDataStructure(nRanges, nDoppler)
# Helper function to read complex vectors
read_complex_vector <- function(connection, n, endian) {
cplx_data <- readBin(connection, what = "numeric", n = n * 2, size = 4, endian = endian)
complex(real = cplx_data[rep(c(TRUE, FALSE), n/2)], imaginary = cplx_data[rep(c(FALSE, TRUE), n/2)])
}
# Read data for each range
for (i in seq_len(nRanges)) {
out$SSA1[i,] <- rlang::try_fetch(error = function(cond) {
rlang::inject(seasonder_logAndAbort(glue::glue("Error while reading SSA1 data for range cell {i}: {conditionMessage(cond)}"),!!!conditions_params, parent = cond, seasonder_range_cell = i,seasonder_data_component = "SSA1"))
},
readBin(connection, what = "numeric", n = nDoppler, size = 4, endian = endian))
out$SSA2[i,] <- rlang::try_fetch(error = function(cond) {
rlang::inject(seasonder_logAndAbort(glue::glue("Error while reading SSA2 data for range cell {i}: {conditionMessage(cond)}"),!!!conditions_params, parent = cond, seasonder_range_cell = i,seasonder_data_component = "SSA2"))
},
readBin(connection, what = "numeric", n = nDoppler, size = 4, endian = endian))
out$SSA3[i,] <- rlang::try_fetch(error = function(cond) {
rlang::inject(seasonder_logAndAbort(glue::glue("Error while reading SSA3 data for range cell {i}: {conditionMessage(cond)}"),!!!conditions_params, parent = cond, seasonder_range_cell = i,seasonder_data_component = "SSA3"))
},
readBin(connection, what = "numeric", n = nDoppler, size = 4, endian = endian))
out$CS12[i,] <- rlang::try_fetch(error = function(cond) {
rlang::inject(seasonder_logAndAbort(glue::glue("Error while reading CS12 data for range cell {i}: {conditionMessage(cond)}"),!!!conditions_params, parent = cond, seasonder_range_cell = i,seasonder_data_component = "CS12"))
},
read_complex_vector(connection, nDoppler, endian))
out$CS13[i,] <- rlang::try_fetch(error = function(cond) {
rlang::inject(seasonder_logAndAbort(glue::glue("Error while reading CS13 data for range cell {i}: {conditionMessage(cond)}"),!!!conditions_params, parent = cond, seasonder_range_cell = i,seasonder_data_component = "CS13"))
},
read_complex_vector(connection, nDoppler, endian))
out$CS23[i,] <- rlang::try_fetch(error = function(cond) {
rlang::inject(seasonder_logAndAbort(glue::glue("Error while reading CS23 data for range cell {i}: {conditionMessage(cond)}"),!!!conditions_params, parent = cond, seasonder_range_cell = i,seasonder_data_component = "CS23"))
},
read_complex_vector(connection, nDoppler, endian))
if (nCSKind >= 2) {
out$QC[i,] <- rlang::try_fetch(error = function(cond) {
rlang::inject(seasonder_logAndAbort(glue::glue("Error while reading QC data for range cell {i}: {conditionMessage(cond)}"),!!!conditions_params, parent = cond, seasonder_range_cell = i,seasonder_data_component = "QC"))
},
readBin(connection, what = "numeric", n = nDoppler, size = 4, endian = endian))
}
}
return(out)
}
#### Transform functions ####
seasonder_the$transform_functions <- list()
seasonder_the$transform_functions[["TIME"]] <- function(x) {
x$nTimeMark %<>% factor(levels = c(0L,1L,2L),labels = c("start","center time","end time"))
x
}
seasonder_the$transform_functions[["RCVI"]] <- function(x) {
x$nReceiverModel %<>% factor(levels = c(0L,1L,2L,3L,4L,5L),labels = c("Unknown", "Awg3/Rcvr2 Chassis AC", "Awg3/Rcvr2 Chassis DC", "AllInOne", "Awg4 Chassis AC","Awg4 Chassis DC"))
x$nRxAntennaModel %<>% factor(levels = c(0L,1L,2L,3L,4L,5L),labels = c("Unknown", "Box Loops","2","3", "Dome Loops","TR Dome Loops"))
x
}
seasonder_the$transform_functions[["GLRM"]] <- function(x) {
x$nReceiverModel %<>% factor(levels = c(0L,1L,2L,3L,4L),labels = c("Off","Point","Range","Range&Point", "SubDCOnly"))
x
}
seasonder_the$transform_functions[["SUPI"]] <- function(x) {
x$nMethod %<>% factor(levels = c(0L,1L),labels = c("Off","Normal"))
x$nMode %<>% factor(levels = c(0L,1L,2L,3L),labels = c("Light","Heavy","MaxLight","MaxHeavy"))
x$nDebugMode %<>% factor(levels = c(0L,1L),labels = c("Off","On"))
x
}
seasonder_the$transform_functions[["FWIN"]] <- function(x) {
x$nRangeWindowType %<>% factor(levels = c(0L,1L,2L,3L),labels = c("None","Blackman", "Hamming", "Tukey"))
x$nDopplerWindowType %<>% factor(levels = c(0L,1L,2L,3L),labels = c("None","Blackman", "Hamming", "Tukey"))
x
}
seasonder_the$transform_functions[["IQAP"]] <- function(x) {
x$nRangeWindowType %<>% factor(levels = c(0L,1L,2L),labels = c("Off","Measured","Corrected"))
x
}
seasonder_the$transform_functions[["FILL"]] <- function(x) {
x$nRangeMethod %<>% factor(levels = c(0L,1L,2L),labels = c("None", "Linear", "FFTPadding"))
x$nDopplerMethod %<>% factor(levels = c(0L,1L,2L),labels = c("None", "Linear", "FFTPadding"))
x
}
seasonder_the$transform_functions[["BRGR"]] <- function(x) {
x$nBraggReject$data %<>% factor(levels = c(0L,1L,2L,3L),labels = c("OK", "RejectNegBragg", "RejectPosBragg", "RejectBoth"))
x
}
#### QC functions ####
seasonder_the$qc_functions <- list()
#' Quality Control - Check Type
#'
#' This function verifies if a given value is of the expected type.
#'
#' @param field_value The value whose type needs to be checked.
#' @param expected_type The expected type of the field_value.
#'
#' @return The original field_value if it matches the expected_type; otherwise, an error is raised.
qc_check_type <- function(field_value, expected_type) {
if (!inherits(field_value, expected_type)) {
seasonder_logAndAbort(glue::glue("QC Error: Value does not have the expected type: {expected_type}"))
}
return(field_value)
}
#' Quality Control - Check Range and Type
#'
#' This function verifies if a given value lies within a specified range
#' and matches the expected type, if provided.
#'
#' @param field_value The value to be checked.
#' @param min Minimum allowable value for field_value.
#' @param max Maximum allowable value for field_value.
#' @param expected_type (optional) The expected type of the field_value. Default is NULL.
#'
#' @return The original field_value if it's within range and matches the expected_type; otherwise, an error is raised.
qc_check_range <- function(field_value, min, max, expected_type = NULL) {
# Si se proporciona un tipo esperado, verifica el tipo antes de comprobar el rango
if (!is.null(expected_type)) {
field_value <- qc_check_type(field_value, expected_type)
}
if (field_value < min || field_value > max) {
seasonder_logAndAbort(glue::glue("QC Error: Value out of range. Expected between {min} and {max}"))
}
return(field_value)
}
#' Quality Control Check for Unsigned Values
#'
#' This function performs a quality control check to ensure that a given field value
#' is an unsigned number (i.e., a non-negative number). Optionally, it can also
#' check if the field value matches a specified data type before performing the
#' unsigned check.
#'
#' @param field_value The value to be checked. The function verifies if this value
#' is non-negative. It can be of any type but is typically expected to be a
#' numeric value.
#' @param expected_type An optional parameter specifying the expected data type of
#' `field_value`. If provided, the function first checks if `field_value`
#' matches the expected type before verifying if it is unsigned. Default is NULL,
#' which means no type check is performed.
#'
#' @return Returns the `field_value` if it passes the checks: it is of the expected
#' type (if `expected_type` is not NULL) and is non-negative. If any of the
#' checks fail, the function logs an error message and aborts execution.
qc_check_unsigned <- function(field_value, expected_type = NULL) {
if (!is.null(expected_type)) {
field_value <- qc_check_type(field_value, expected_type)
}
if (field_value < 0) {
seasonder_logAndAbort(glue::glue("QC Error: Value is negative. Expected unsigned value"))
}
return(field_value)
}
seasonder_load_qc_functions <- function() {
seasonder_the$qc_functions[["qc_check_type"]] <- qc_check_type
seasonder_the$qc_functions[["qc_check_range"]] <- qc_check_range
seasonder_the$qc_functions[["qc_check_unsigned"]] <- qc_check_unsigned
}
seasonder_load_qc_functions()
#### print ####
#' Print Method for SeaSondeRCS Object
#'
#'
#' This method provides a formatted printout of the SeaSondeRCS object, displaying
#' the station code, date/time, number of Doppler cells, and number of range cells.
#' It is designed for interactive use, allowing users to quickly inspect the object.
#' @param x An object of class "SeaSondeRCS". This object should contain at least a header list
#' with metadata (such as station name, date/time, and cell counts).
#' @param ... Additional arguments. Currently not used, but supplied for compatibility with
#' generic print methods.
#' @details The function uses the `whisker` package to render a template string with the
#' header information.
#' @method print SeaSondeRCS
#' @export
#'
#' @return Invisibly returns the original SeaSondeRCS object.
#'
#' @examples
#' obj <- list(header = list(nSiteCodeName = "Station1",
#' nDateTime = Sys.time(),
#' nDopplerCells = 256,
#' nRangeCells = 100))
#' class(obj) <- "SeaSondeRCS"
#' print(obj)
print.SeaSondeRCS <- function(x, ...){
template <- "Station Code: {{{nSiteCodeName}}}\nTime: {{{nDateTime}}}\nN Doppler Cells: {{{nDopplerCells}}}\nN Range Cells: {{{nRangeCells}}}\n"
render_data <- x$header
cat(whisker::whisker.render(template,data = render_data))
invisible(x)
}
#### summary ####
#' Summary Method for SeaSondeRCS Object
#'
#' Provides a concise summary of a SeaSondeRCS object by printing the processing steps
#' that have been applied to the data contained in the object.
#'
#' @param object An object of class "SeaSondeRCS". This object should contain
#' at least a header list with metadata (such as station name, date/time, and cell counts)
#' and processing step information retrieved by the function
#' seasonder_getSeaSondeRCS_ProcessingSteps.
#' @param ... Additional arguments. Currently not used, but supplied for compatibility with
#' generic summary methods.
#'
#' @return Invisibly returns the original SeaSondeRCS object.
#'
#' @details This method first validates that the input object inherits from the "SeaSondeRCS" class.
#' It then retrieves the processing steps applied to the data using seasonder_getSeaSondeRCS_ProcessingSteps,
#' formats them into a readable string, and outputs the result via the cat function.
#' The function is designed for interactive use, and its output facilitates quick inspection of the object.
#'
#' @method summary SeaSondeRCS
#' @export
#'
#' @examples
#' obj <- list(header = list(nSiteCodeName = "Station1",
#' nDateTime = Sys.time(),
#' nDopplerCells = 256,
#' nRangeCells = 100))
#' class(obj) <- "SeaSondeRCS"
#' summary(obj)
summary.SeaSondeRCS <- function(object, ...) {
# Check if the object is of class SeaSondeRCS
if (!inherits(object, "SeaSondeRCS")) {
stop("The object must be of class 'SeaSondeRCS'")
}
processing_steps <- seasonder_getSeaSondeRCS_ProcessingSteps(object) %>% paste0(collapse = "\n")
# Print the summary of the header
cat("Processing steps:\n")
cat(processing_steps)
cat("\n")
invisible(object)
}
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.