Nothing
#' Read Self Spectra Sign Information from a Connection
#'
#' This function reads a raw binary stream from a provided connection, expecting a specific format
#' that contains the sign bits for self spectra values. The data is divided into 3 groups corresponding
#' to: \code{cs1a}, \code{cs2a}, and \code{cs3a}.
#'
#' @param connection A binary connection to read raw bytes from.
#' @param key A list containing:
#' \describe{
#' \item{size}{An integer specifying the total number of bytes to be read. It must equal 3 times the number
#' of bytes per group.}
#' \item{key}{A string identifier (expected to be \code{"asign"}).}
#' }
#'
#' @return A named list of 3 vectors, each containing bits as integers (0 or 1) for self spectra sign data.
#'
#' @details The function performs the following steps:
#' \itemize{
#' \item Reads \code{key$size} bytes from the specified connection.
#' \item Verifies that the number of bytes read matches the expected size.
#' \item Checks that the total number of bytes is divisible by 3, allowing equal distribution among the groups.
#' \item Splits the raw byte vector into 3 groups based on the calculated number of bytes per group.
#' \item Converts each byte into its 8-bit binary representation (using \code{rawToBits}) and flattens the results for each group.
#' }
#'
seasonder_CSSW_read_asign <- function(connection, key) {
# Determine the total number of bytes to read from the connection based on key$size.
total_bytes <- key$size
# Read the specified number of raw bytes from the connection using readBin.
raw_data <- readBin(connection, what = "raw", n = total_bytes)
# Check if the number of bytes read is less than the expected total_bytes; if so, throw an error.
if (length(raw_data) < total_bytes) {
stop("Not enough bytes in connection")
}
# Validate that the total number of bytes is divisible by 3 to form 3 equal groups.
if (total_bytes %% 3 != 0) {
stop("Invalid total size: not divisible by 3")
}
# Calculate the number of bytes allocated for each group.
group_bytes_count <- total_bytes / 3
# Define the names for each of the three groups.
group_names <- c("cs1a", "cs2a", "cs3a")
# Initialize an empty list to store each group's bit vectors, assigning the group names.
result <- stats::setNames(vector("list", length(group_names)), group_names)
# Loop over each group to extract its corresponding bytes and convert them to bit vectors.
for (i in seq_along(group_names)) {
# Calculate the start and end indices for the current group's slice in the raw_data vector.
start_index <- (i - 1) * group_bytes_count + 1
end_index <- i * group_bytes_count
# Extract the raw bytes corresponding to the current group.
group_raw <- raw_data[start_index:end_index]
# Convert each byte in the group to its 8-bit binary representation using rawToBits,
# then convert the raw bits to integers and flatten the resulting list into a vector.
group_bits <- unlist(lapply(group_raw, function(byte) as.integer(rawToBits(byte))))
# Store the resulting bit vector in the result list at the corresponding group name.
result[[i]] <- group_bits
}
# Return the list containing the bit vectors for each group.
return(result)
}
#' Read CSSW Fields
#'
#' Processes a block of keys from the binary connection according to provided specifications.
#'
#' @param connection A binary connection.
#' @param specs A list specifying the expected keys.
#' @param endian A character indicating byte order.
#' @param parent_key Optional parent key information.
#' @return A named list as returned by seasonder_readSeaSondeCSFileBlock consistent with the provided specifications.
#'
seasonder_readCSSWFields <- function(connection, specs, endian, parent_key= NULL){
variable_char_types <- purrr::map_lgl(specs, \(x) x$type == "CharX")
if(any(variable_char_types)){
variable_char_types_index <- which(variable_char_types)
specs <- purrr::reduce(variable_char_types_index, \(spcs_so_far, i){
spcs_so_far[[i]]$type <- glue::glue("Char{size}", size = parent_key$size)
spcs_so_far
}, .init = specs )
}
# browser(expr = parent_key$key == "scal")
out <- seasonder_readSeaSondeCSFileBlock(specs, connection, endian)
return(out)
}
#' Apply Scaling to SeaSondeRCSSW Data
#'
#' This function applies scaling to each vector of integer values contained in the list `values` by converting them to floating point
#' voltage values using a specified scaling procedure. For each integer value:
#' - If the value equals 0xFFFFFFFF, it returns NaN;
#' - Otherwise, it computes an intermediate value using the formula:
#' intermediate = value * (fmax - fmin) / fscale + fmin
#' and then converts it to a voltage via:
#' voltage = 10^((intermediate + dbRef) / 10)
#'
#' The function processes each vector in the input list and returns a new list having the same structure, but with each value converted
#' into its corresponding voltage value. It also performs several validations regarding input types and values.
#'
#' @param values A list of numeric vectors containing integer values to be scaled. Each vector is expected to contain values read
#' from a binary CSSW values block.
#' @param fmax A numeric value representing the maximum scaling value. Used to compute the linear scaling factor.
#' @param fmin A numeric value representing the minimum scaling value. Acts as an offset for the scaling.
#' @param fscale A numeric value representing the scaling factor. Must not be zero as it determines the divisor in the scaling formula.
#' @param dbRef A numeric value representing the decibel reference to be added before the voltage conversion step.
#' @param computeVoltage A logical value indicating whether to compute the voltage from the scaled values. If FALSE, it returns the intermediate scaled values.
#'
#' @return A list with the same structure as `values`, where each numeric vector has been transformed to a vector of floating point
#' voltage values. Special integer values equal to 0xFFFFFFFF are converted to NaN.
#'
#' @details
#' The scaling process performs the following steps for each input value:
#' 1. Checks whether the value equals 0xFFFFFFFF. If so, it returns NaN immediately because this value indicates a
#' missing or invalid measurement.
#' 2. Otherwise, it computes the intermediate scaled value by applying a linear transformation:
#' intermediate = value * (fmax - fmin) / fscale + fmin
#' 3. Finally, it converts the intermediate value to a voltage using:
#' voltage = 10^((intermediate + dbRef) / 10)
#'
#' The function includes input validation to ensure that `values` is a list, and that `fmax`, `fmin`, `fscale`, and `dbRef`
#' are numeric. It also checks that no element in `values` is non-numeric and that `fscale` is non-zero to prevent division errors.
seasonder_SeaSondeRCSSWApplyScaling <- function(values, fmax, fmin, fscale, dbRef, computeVoltage = TRUE) {
# Validate that 'values' is a list
if (!is.list(values)) {
stop("The input 'values' must be a list of numeric vectors.")
}
# Validate that the scaling parameters and reference are numeric
if (!is.numeric(fmax) || !is.numeric(fmin) || !is.numeric(fscale) || !is.numeric(dbRef)) {
stop("Parameters 'fmax', 'fmin', 'fscale', and 'dbRef' must be numeric.")
}
# Prevent division by zero by ensuring fscale is not zero
if (fscale == 0) {
stop("'fscale' must not be zero.")
}
# Process each vector in the input list 'values'
scaled_values <- lapply(values, function(vec) {
# Validate that the current element is a numeric vector
if (!is.numeric(vec)) {
stop("Each element in 'values' must be a numeric vector.")
}
# Apply scaling to each value in the numeric vector
sapply(vec, function(value) {
# Check if the current value equals the special marker 0xFFFFFFFF (indicating missing/invalid data)
if (value == 0xFFFFFFFF) {
# Return NaN for invalid measurement
return(NaN)
} else {
# Compute the intermediate scaled value using the linear transformation
intermediate <- value * (fmax - fmin) / fscale + fmin
if(computeVoltage){
# Convert the intermediate value to voltage using the decibel conversion formula
voltage <- 10^((intermediate + dbRef) / 10)
# Return the computed voltage value
return(voltage)
}else{
return(intermediate)
}
}
})
})
# Return the list containing the scaled voltage vectors, preserving the structure of 'values'
return(scaled_values)
}
#' Read a Body Range Cell and Apply Scaling if Required
#'
#' This function processes a block of keys from a binary connection according to a provided specification
#' ('specs'). Each key is interpreted by reading it with \code{seasonder_readSeaSondeCSFileBlock} and processing
#' it based on its key name. The key processing follows these rules:
#'
#' - **Scaling Block ('scal')**: Reads scaling parameters (fmax, fmin, fscale, dbRef) using
#' \code{seasonder_readCSSWFields} and stores them for later use.
#'
#' - **Reduced Data Blocks (e.g., 'cs1a', 'cs2a', 'cs3a', 'c13m', 'c13a', etc.)**:
#' Reads the block using \code{seasonder_read_reduced_encoded_data}. If scaling parameters were set by a
#' preceding 'scal' block, the raw data is converted to voltage values using \code{seasonder_SeaSondeRCSSWApplyScaling};
#' otherwise, the raw data is returned.
#'
#' - **Other Keys (e.g., 'csgn' and 'asgn')**: These keys invoke their specialized read functions for processing.
#'
#' The function continues reading keys until it detects the 'END ' marker or a repeated 'indx' key, which signals
#' the end of the block.
#'
#' @param connection A binary connection from which keys and data are read.
#' @param specs A list defining the expected keys and their formats.
#' @param dbRef A numeric value providing the dB reference used in scaling.
#' @param endian A string specifying the byte order ("big" or "little"). Defaults to "big".
#' @param specs_key_size Optional specification for the key size block.
#'
#' @return A list with elements named after the keys read. For reduced data blocks, each element contains either
#' the raw decoded data or the scaled voltage values if a 'scal' block had been applied.
#'
seasonder_readCSSWBodyRangeCell <- function(connection, specs, dbRef, endian = "big", specs_key_size = NULL){
indx_read <- FALSE # Flag indicating whether 'indx' has been encountered
scaling_params <- NULL # Storage for scaling parameters read from a 'scal' block
out <- list()
while(TRUE){
key <- seasonder_readSeaSondeCSFileBlock(specs_key_size, connection, endian)
if(!key$key %in% names(specs)){
# Skip keys not defined in the specifications
seek(connection, key$size, origin = "current")
} else if(key$key == "END "){
# End-of-block marker encountered
break
} else if(key$key == "indx" && indx_read){
# A repeated 'indx' indicates end of the block; rewind if necessary
seek(connection, -8, origin = "current")
break
} else if(key$key == "scal"){
# 'scal' block encountered: read and store scaling parameters
scaling_params <- seasonder_readCSSWFields(connection, purrr::chuck(specs, key$key),
endian, parent_key = key)
out <- append(out, list(scaling_params) %>% magrittr::set_names(key$key))
} else if(key$key %in% c("cs1a", "cs2a", "cs3a", "c13m", "c13a", "c23m", "c23a", "c12m", "c12a", "csqf")){
# Reduced data block: read the block; apply scaling if parameters are available
data_block <- seasonder_read_reduced_encoded_data(connection, key, endian)
if(!is.null(scaling_params)){
data_block <- seasonder_SeaSondeRCSSWApplyScaling(list(data_block),
fmax = scaling_params$fmax,
fmin = scaling_params$fmin,
fscale = scaling_params$fscale,
dbRef = dbRef,
computeVoltage = !key$key %in% c("c13a","c12a","c23a"))[[1]]
}
out <- append(out, list(data_block) %>% magrittr::set_names(key$key))
} else if(key$key %in% c("asgn")){
# Process self spectra sign information
out <- append(out, list(seasonder_CSSW_read_asign(connection, key)) %>% magrittr::set_names(key$key))
} else {
# For all other keys, process them as simple field blocks
out <- append(out, list(seasonder_readCSSWFields(connection, purrr::chuck(specs, key$key),
endian, parent_key = key)) %>%
magrittr::set_names(key$key))
if(key$key == "indx"){
indx_read <- TRUE
}
}
}
return(out)
}
#' Read CSSW Body
#'
#' Reads the body section of a CSSW file, processing each cell block until the designated endpoint.
#'
#' @param connection A binary connection from which the body is read.
#' @param specs A list specifying the body keys and formats.
#' @param size The total number of bytes to read for the body section.
#' @param dbRef Numeric decibel reference used for scaling.
#' @param endian A character specifying byte order.
#' @param specs_key_size Optional specification for the key size block.
#' @return A list of processed body cells with applied sign corrections.
#'
seasonder_readCSSWBody <- function(connection, specs, size, dbRef, endian = "big", specs_key_size = NULL){
end_point <- seek(connection) + size
out <- list()
while(seek(connection) < end_point){
out <- append(out, list(seasonder_readCSSWBodyRangeCell(connection, specs, dbRef,endian = endian, specs_key_size = specs_key_size)))
}
out <- seasonder_applyCSSWSigns(out)
return(out)
}
#' Read CSSW Limits
#'
#' Reads a specified number of 32-bit unsigned integers from a binary connection and reshapes them into a matrix representing CSSW limits.
#'
#' @param connection A binary connection.
#' @param n_values The number of 32-bit unsigned integers to read.
#' @param endian A string specifying byte order ("big" or "little").
#' @return A numeric matrix with four columns: LeftBraggLeftLimit, LeftBraggRightLimit, RightBraggLeftLimit, and RightBraggRightLimit.
#'
seasonder_readCSSWLims <- function(connection, n_values, endian = "big") {
# Read n_values of 32-bit unsigned integers
uint_values <- readBin(connection, what = "integer", n = n_values, size = 4, endian = endian, signed = FALSE)
lims_matrix <- matrix(uint_values, ncol = 4, byrow = TRUE)
colnames(lims_matrix) <- c("LeftBraggLeftLimit", "LeftBraggRightLimit", "RightBraggLeftLimit", "RightBraggRightLimit")
return(lims_matrix)
}
#' Read CSSW File Header
#'
#' This function reads the header section of a CSSW file from a binary connection. The CSSW file header
#' contains a set of key blocks formatted according to the SeaSonde CSSW specification. The header section
#' is processed recursively and terminates when one of the following conditions is met:
#' \itemize{
#' \item A key with name "BODY" is encountered. In this case, the connection is rewound by 8 bytes
#' to allow subsequent processing of the body.
#' \item A key that is not defined in \code{current_specs} but is already present in the
#' \code{keys_so_far} vector is encountered (indicative of repeated keys), which triggers termination.
#' }
#'
#' When no subkeys are specified in \code{current_specs} (i.e. \code{current_specs} comprises only
#' simple field definitions), the function delegates the processing to \code{seasonder_readCSSWFields}.
#'
#' @param connection A binary connection from which to read the CSSW file header.
#' @param current_specs A list representing the specification for the header; may contain nested subkeys.
#' @param endian A character string indicating the byte order for reading numeric values ("big" or "little").
#' @param parent_key (Optional) A list with information from the parent key block, used when processing nested keys.
#' @param keys_so_far A character vector of keys already processed, used to avoid recursive loops. Defaults to c("CSSW", "HEAD").
#' @param specs_key_size A specification for reading the key size block, often obtained from YAML specs.
#'
#' @return A list containing the parsed CSSW header information. The returned list may be empty if a termination
#' condition is encountered.
#'
#' @details The function processes the CSSW header recursively:
#' \itemize{
#' \item If \code{current_specs} contains only field definitions, \code{seasonder_readCSSWFields} is called.
#' \item When a key named "BODY" is encountered, it signifies the beginning of the body section; the
#' function rewinds the connection 8 bytes and stops processing further keys.
#' \item If a key is encountered that is not defined in \code{current_specs} but is already present in
#' \code{keys_so_far}, the function also rewinds the connection 8 bytes and terminates header reading.
#' \item Otherwise, the function updates \code{keys_so_far}, handles special cases (e.g., key "cs4h"), and
#' calls itself recursively to process nested keys.
#' }
#'
#' @importFrom purrr map_lgl chuck reduce
#' @importFrom magrittr set_names
#' @import glue
#'
seasonder_readCSSWHeader <- function(connection, current_specs, endian = "big", parent_key = NULL, keys_so_far = c("CSSW", "HEAD"), specs_key_size = NULL){
# Initialize an empty output list for accumulating header values
out <- list()
# Determine if the current specifications define subkeys or only simple fields
has_subkeys <- !all(purrr::map_lgl(current_specs, \(x) "type" %in% names(x)))
if(!has_subkeys){
# When there are no subkeys, delegate reading to seasonder_readCSSWFields
out <- seasonder_readCSSWFields(connection, current_specs, endian, parent_key)
} else {
# Read the next key block from the binary connection
key <- seasonder_readSeaSondeCSFileBlock(specs_key_size, connection, endian)
# Termination condition: if the key is "BODY", rewind 8 bytes and terminate header reading
if(key$key == "BODY"){
seek(connection, -8, origin = "current")
return(out)
} else if(!key$key %in% names(current_specs) && !key$key %in% keys_so_far){
# If key is unknown (not in current_specs and not already seen), skip it by advancing connection by key$size bytes
seek(connection, key$size, origin = "current")
} else if(!key$key %in% names(current_specs) && key$key %in% keys_so_far){
# If key is not defined in current_specs but already encountered, rewind 8 bytes and finish header reading
seek(connection, -8, origin = "current")
return(out)
} else {
# Update keys_so_far to include the names defined in the current specification
keys_so_far <- unique(c(keys_so_far, names(current_specs)))
if(key$key == "cs4h"){
# Special handling: for key 'cs4h', read the CS file header using its respective specifications
CSHSpecs <- seasonder_readYAMLSpecs(seasonder_defaultSpecsFilePath("CS"), "header")
out <- list(seasonder_readSeaSondeCSFileHeader(CSHSpecs, connection, endian)) %>% magrittr::set_names(key$key)
} else if(key$key %in% c("alim","wlim")){
out <- seasonder_readCSSWHeader(connection, purrr::chuck(current_specs, key$key), endian, parent_key = key, keys_so_far = keys_so_far, specs_key_size = specs_key_size)
out$lims <- seasonder_readCSSWLims(connection, out$nRange*4,endian = endian)
out <- list(out) %>% magrittr::set_names(key$key)
}else{
# Recursively process the key using the sub-specs defined in current_specs
out <- list(seasonder_readCSSWHeader(connection, purrr::chuck(current_specs, key$key), endian, parent_key = key, keys_so_far = keys_so_far, specs_key_size = specs_key_size)) %>% magrittr::set_names(key$key)
}
}
# Continue recursive processing of the header for any remaining keys
out <- c(out, seasonder_readCSSWHeader(connection, current_specs, endian, keys_so_far = keys_so_far, specs_key_size = specs_key_size))
}
return(out)
}
#' Transform CSSW Header to SeaSonde CS Header
#'
#' Extracts the 'cs4h' component from a CSSW header and reorganizes the remaining header information under 'header_csr'.
#'
#' @param header A list representing the CSSW header, which must contain a 'cs4h' component.
#' @return A transformed list representing a valid SeaSonde CS header with embedded CSSW header information.
#'
seasonder_CSSW2CSHeader <- function(header) {
if (is.null(header$cs4h)) {
seasonder_logAndAbort("CSSW header does not contain a cs4h component")
}
header_cs <- header$cs4h # Extract the valid CS header
header_csr <- header # Copy the original header
header_csr$cs4h <- NULL # Remove the cs4h component from the original header
header_cs$header_csr <- header_csr # Embed the remaining header
return(header_cs)
}
#' Transform CSSW Body to SeaSonde CS Data Structure
#'
#' This function converts the body structure of a CSSW file into a list of matrices that conform
#' to the data structure required for creating a SeaSondeRCS object. The conversion is performed
#' by mapping specific fields:
#' \describe{
#' \item{SSA1, SSA2, SSA3}{Matrices are built using the numeric vectors found in the \code{cs1a}, \code{cs2a}
#' and \code{cs3a} fields respectively.}
#' \item{CS12, CS13, CS23}{Each complex cross-spectra matrix is formed by combining the real parts
#' from \code{c12m}, \code{c13m} and \code{c23m} with the corresponding imaginary parts
#' from \code{c12a}, \code{c13a} and \code{c23a}.}
#' \item{QC}{The quality control matrix is obtained directly from the \code{csqf} field.}
#' }
#'
#' Each row in the output matrices corresponds to the index provided by \code{cell$indx$index} in the input list.
#'
#' @param body A list representing the body of a CSSW file. Each element of the list is expected to be a
#' cell containing the following fields: \code{indx} (which includes an \code{index}), \code{cs1a}, \code{cs2a}, \code{cs3a},
#' \code{c12m}, \code{c12a}, \code{c13m}, \code{c13a}, \code{c23m}, \code{c23a} and \code{csqf}.
#'
#' @return A list with the following components:
#' \describe{
#' \item{SSA1}{A numeric matrix containing self-spectra from \code{cs1a}.}
#' \item{SSA2}{A numeric matrix containing self-spectra from \code{cs2a}.}
#' \item{SSA3}{A numeric matrix containing self-spectra from \code{cs3a}.}
#' \item{CS12}{A complex matrix formed by pairing \code{c12m} (real) and \code{c12a} (imaginary).}
#' \item{CS13}{A complex matrix formed by pairing \code{c13m} (real) and \code{c13a} (imaginary).}
#' \item{CS23}{A complex matrix formed by pairing \code{c23m} (real) and \code{c23a} (imaginary).}
#' \item{QC}{A numeric matrix containing the quality control data from \code{csqf}.}
#' }
#'
#' @details
#' The function first determines the maximum index among the cells in the body, which defines the number of rows
#' for the matrices. Then, it calculates the number of columns for each matrix based on the length of the corresponding
#' vectors from the first cell where they appear. Finally, each cell's data is inserted into the appropriate row
#' of the matrices as indicated by the cell's \code{indx$index} value.
#'
#' @examples
#' # Example with a single cell
#' cell <- list(
#' indx = list(index = 1),
#' cs1a = c(1, 2, 3),
#' cs2a = c(4, 5, 6),
#' cs3a = c(7, 8, 9),
#' c12m = c(10, 11, 12),
#' c12a = c(13, 14, 15),
#' c13m = c(16, 17, 18),
#' c13a = c(19, 20, 21),
#' c23m = c(22, 23, 24),
#' c23a = c(25, 26, 27),
#' csqf = c(28, 29, 30)
#' )
#' body <- list(cell)
#' transformed <- seasonder_CSSW2CSData(body)
#' print(transformed)
#'
#' @export
seasonder_CSSW2CSData <- function(body) {
# Validate the input to ensure it's a non-empty list
if (!is.list(body) || length(body) == 0) stop("Invalid body: must be a non-empty list")
# Extract the row indices from each cell using cell$indx$index
indices <- sapply(body, function(cell) cell$indx$index)
max_index <- max(indices)
# Helper function: for a given field, determine the number of columns based on the first cell that contains that field
get_ncols <- function(field) {
for (cell in body) {
if (!is.null(cell[[field]])) {
return(length(cell[[field]]))
}
}
return(0)
}
# Determine the number of columns for self spectra (SSA), quality control (QC) and cross-spectra (for CS matrices)
ncols_SSA1 <- get_ncols("cs1a")
ncols_SSA2 <- get_ncols("cs2a")
ncols_SSA3 <- get_ncols("cs3a")
ncols_QC <- get_ncols("csqf")
ncols_CS12 <- get_ncols("c12m") # assume c12m and c12a have same length
ncols_CS13 <- get_ncols("c13m")
ncols_CS23 <- get_ncols("c23m")
# Create empty matrices for each required field. Each matrix will have 'max_index' rows (provided by cell$indx$index)
# and a number of columns as determined by the helper function above.
SSA1 <- matrix(NA_real_, nrow = max_index, ncol = ncols_SSA1)
SSA2 <- matrix(NA_real_, nrow = max_index, ncol = ncols_SSA2)
SSA3 <- matrix(NA_real_, nrow = max_index, ncol = ncols_SSA3)
QC <- matrix(NA_real_, nrow = max_index, ncol = ncols_QC)
# Initialize complex matrices for cross spectra
CS12 <- matrix(NA_complex_, nrow = max_index, ncol = ncols_CS12)
CS13 <- matrix(NA_complex_, nrow = max_index, ncol = ncols_CS13)
CS23 <- matrix(NA_complex_, nrow = max_index, ncol = ncols_CS23)
# Iterate over each cell and assign the corresponding data to the appropriate row in the matrices
for (cell in body) {
row <- cell$indx$index
if (!is.null(cell$cs1a)) SSA1[row, ] <- cell$cs1a
if (!is.null(cell$cs2a)) SSA2[row, ] <- cell$cs2a
if (!is.null(cell$cs3a)) SSA3[row, ] <- cell$cs3a
if (!is.null(cell$csqf)) QC[row, ] <- cell$csqf
# For cross spectra, combine the real and imaginary parts to create complex numbers
if (!is.null(cell$c12m) && !is.null(cell$c12a)) {
CS12[row, ] <- complex(real = cell$c12m * cos(cell$c12a * pi / 180),imaginary = cell$c12m * sin(cell$c12a * pi / 180))
}
if (!is.null(cell$c13m) && !is.null(cell$c13a)) {
CS13[row, ] <- complex(real = cell$c13m * cos(cell$c13a * pi / 180),imaginary = cell$c13m * sin(cell$c13a * pi / 180))
}
if (!is.null(cell$c23m) && !is.null(cell$c23a)) {
CS23[row, ] <- complex(real = cell$c23m * cos(cell$c23a * pi / 180),imaginary = cell$c23m * sin(cell$c23a * pi / 180))
}
}
# Return a list containing all the matrices required for a SeaSondeRCS object
list(
SSA1 = SSA1,
SSA2 = SSA2,
SSA3 = SSA3,
CS12 = CS12,
CS13 = CS13,
CS23 = CS23,
QC = QC
)
}
#' Apply CSSW Sign Corrections
#'
#' Applies sign corrections to both cross-spectra and auto-spectra fields within a list of CSSW data cells.
#'
#' @param cs_data A list of CSSW data cells, where each cell may include fields for cross-spectra ('c12m', 'c12a', 'c13m', 'c13a', 'c23m', 'c23a') and auto-spectra ('cs1a', 'cs2a', 'cs3a') signs.
#' @return The modified list of CSSW data cells with sign corrections applied.
#'
seasonder_applyCSSWSigns <- function(cs_data) {
for (i in seq_along(cs_data)) {
cell <- cs_data[[i]]
# Apply auto-spectra sign correction if 'asgn' exists
if (!is.null(cell$asgn)) {
auto_fields <- c("cs1a", "cs2a", "cs3a")
for (field in auto_fields) {
if (!is.null(cell[[field]])) {
asgn <- cell$asgn[[field]] *-2 +1
cell[[field]] <- cell[[field]] * asgn
}
}
}
cs_data[[i]] <- cell
}
return(cs_data)
}
#' Read SeaSonde RCSSW File and Create SeaSondeRCS Object
#'
#' This function reads a SeaSonde RCSSW file from a specified file path and parses its content
#' into a SeaSondeRCS object. The file is processed by reading its header and body sections using
#' CSSW specifications provided via a YAML file.
#'
#' @param filepath A character string specifying the path to the SeaSonde RCSSW file.
#' @param specs_path A character string specifying the path to the YAML file containing CSSW specifications.
#' Defaults to the output of \code{seasonder_defaultSpecsFilePath("CSSW")}.
#' @param endian A character string indicating the byte order used in the file. Defaults to \code{"big"}.
#'
#' @return A SeaSondeRCS object containing the parsed header and data.
#'
#' @details
#' The function executes the following steps:
#' \enumerate{
#' \item Sets up error handling parameters specific to the function.
#' \item Retrieves YAML specifications for the key size block from the CSSW spec file.
#' \item Attempts to open the file in binary mode ("rb") with warnings suppressed.
#' \item Reads the file key and uses it to extract file specs.
#' \item Reads the header key, retrieves header specs, and parses the CSSW header.
#' \item Converts the CSSW header into a valid SeaSondeRCS header.
#' \item Reads the body key, retrieves body specs, and parses the CSSW body.
#' \item Transforms the CSSW body into a SeaSondeRCS data structure.
#' \item Combines the header and data into a SeaSondeRCS object.
#' }
#'
seasonder_readSeaSondeRCSSWFile <- function(filepath, specs_path = seasonder_defaultSpecsFilePath("CSSW"), endian = "big"){
# Set up error handling parameters with function name, error class, and file path
conditions_params <- list(
calling_function = "seasonder_readSeaSondeRCSSWFile",
class = "seasonder_read_cs_file_error",
seasonder_cs_filepath = filepath
)
# Retrieve YAML specifications for the key size block from the CSSW specifications file
specs <- seasonder_readYAMLSpecs(specs_path)
# Attempt to open the file in binary mode ("rb") with warnings suppressed
connection <- rlang::try_fetch(
suppressWarnings(file(filepath, "rb")),
error = function(e) {
# Abort if the file connection cannot be opened, including the error message
rlang::inject(
seasonder_logAndAbort(
glue::glue("Could no open connection to file {filepath %||% ''}. Reason: {conditionMessage(e)}."),
!!!conditions_params,
parent = e
)
)
}
)
# Ensure the file connection is closed when the function exits
on.exit(close(connection), add = TRUE)
specs_key_size <- purrr::chuck(specs, "key_size_block")
file_key <- seasonder_readSeaSondeCSFileBlock(specs_key_size, connection, endian)
file_specs <- specs %>% purrr::chuck(file_key$key)
header_key <- seasonder_readSeaSondeCSFileBlock(specs_key_size, connection, endian)
header_specs <- file_specs %>% purrr::chuck(header_key$key)
header <- seasonder_readCSSWHeader(connection, header_specs,endian, specs_key_size = specs_key_size)
dbRef <- header$dbrf$dBmReference
header <- seasonder_CSSW2CSHeader(header) # Transform CSSW header to valid CS header
body_key <- seasonder_readSeaSondeCSFileBlock(specs_key_size, connection, endian)
body_specs <- file_specs %>% purrr::chuck(body_key$key)
body <- seasonder_readCSSWBody(connection, body_specs, size = body_key$size, dbRef = dbRef, endian = endian, specs_key_size = specs_key_size)
data <- seasonder_CSSW2CSData(body)
cs_list <- list(header = header , data = data)
out <- seasonder_createSeaSondeRCS.list(cs_list)
return(out)
}
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.