#*********************************************
#*********************************************
#' Writes beams files to simulation events based on resource files.
#'
#' @param event A list of the following elements: (1) 'path', giving the paths to the sub-events, (2) 'esnm', giving the names of the acoustic instruments in the events (same length as 'path'), and (3) 'name', giving the name of the event.
#' @param files An optional vector of file names to be read and written to the simulation events. If empty (default) the resource files of the echoIBM package are used.
#' @param maxrange The maximum range of the sonar in meters.
#' @param mode The mode of the sonar. See available modes with plslTable().
#' @param ... Data overriding the variables generated by the funciton.
#'
#' @return
#'
#' @examples
#' \dontrun{}
#'
#' @importFrom TSD read.TSD write.TSD
#' @importFrom utils head
#'
#' @export
#' @rdname echoIBM.setup
#'
echoIBM.setBeams <- function(
event,
files = NULL,
### bmmd = NULL,
maxrange = list(),
mode = "CWNormal",
### indp = NULL,
...){
############### LOG: ###############
# Start: 2017-03-29 - Clean version.
# Save the input variables:
dotList <- list(...)
#copyForOneEsnm <- function(i, event, files, data, bmmd, utim, numt, maxrange){
copyForOneEsnm <- function(i, event, files, dotList, utim, numt, maxrange, mode){
path <- event$path[[i]]
esnm <- event$esnm[[i]]
### bmmd <- bmmd[[esnm]]
# Match 'esnm' against the pre-defined systems, and get the corresponding file:
files <- getFileFromEsnm(files, esnm, type="beams", beforeUnderscore=TRUE)
# Read the resource beams file if there was a match. These files must have one time step per beam mode 'bmmd'. Use drop.out=FALSE to allow for selecting time steps using 'bmmd' below:
if(length(files)){
beams <- read.TSD(files[1], t="all", drop.out=FALSE)
}
else{
warning(paste0("No beam configuration files matching the specified system (", esnm, "). Available files are the following:", paste(basename(files), collapse="\n")))
}
# Add 'maxrange':
if(length(beams$rres)==0){
beams$rres <- beams$sint * beams$asps / 2
}
if(is.list(maxrange) && length(maxrange[[esnm]])>0){
maxrange <- maxrange[[esnm]]
}
if(length(maxrange) && is.numeric(maxrange)){
beams$lenb <- round(maxrange / matrix(beams$rres, ncol=ncol(beams$lenb), nrow=nrow(beams$lenb)))
# Set the pulse duration for fishery sonars:
if(sonR_implemented(esnm, type="OFS")){
beams$plsl <- plslTable(maxrange, mode)
}
}
# There is currently no support for unequal length of beams across time steps:
beams$lenb <- array(max(beams$lenb), dim=dim(beams$lenb))
### # The ping index 'indp', which is a link between each time step and the time steps of the beams file, have precedence over the beam mode 'bmmd':
### if(length(indp)){
### indp <- list(indp=rep(indp, length.out=numt))
### }
### else{
### # This bmmd is only used for matching in the indp file:
### if(length(bmmd)==0 && length(beams$bmmd)==0){
### bmmd <- rep(1, length.out=numt)
### }
### else if(length(bmmd)==0){
### bmmd <- rep(beams$bmmd, length.out=numt)
### }
### else{
### bmmd <- rep(bmmd, length.out=numt)
### }
### # Match against the beam modes in the beams data:
### indp <- list(indp=match(bmmd, beams$bmmd))
### }
# Add UNIX time to the indp file and change it in the beams file:
### indp$utim <- utim
beams$utim <- head(utim, ncol(beams$freq))
# Add data:
beams <- replaceKeepDim(beams, dotList, esnm)
# Repeat to maximum dimension:
beams <- repToExtreme(beams, ndim=2, skip.len=1)
# Redefine the number of beams:
beams$numb <- length(beams$freq)
# Warning if beams data not given
if(length(beams)==0){
stop("'data' must be given as a list of beam configuration data. One list per system (if not only one system is used) specifying variables such as those named by labl.TSD(\"rb\").")
}
# Write the indp file:
### indpfile <- file.path(path, paste0(event$name, "_", esnm, "_indp.beams"))
beamsfile <- file.path(path, paste0(event$name, "_", esnm, ".beams"))
### write.TSD(indp, indpfile, numt=numt)
write.TSD(beams, beamsfile)
#beams$files <- c(indpfile, beamsfile)
#beams[names(indp)] <- indp
#return(beams)
### return(c(indpfile, beamsfile))
return(beamsfile)
}
# Read the vessel data of one sub-event:
utim <- echoIBM.readFile(event$path[1], ext="vessel", t="all")$utim
numt <- length(utim)
# Loop through the acoustic instruments:
### out <- sapply(seq_along(event$path), copyForOneEsnm, event=event, files=files, data=data, bmmd=bmmd, utim=utim, numt=numt, maxrange=maxrange)
out <- sapply(seq_along(event$path), copyForOneEsnm, event=event, files=files, dotList=dotList, utim=utim, numt=numt, maxrange=maxrange, mode=mode)
names(out) <- event$esnm
return(out)
}
match_esnm <- function(files, esnm, beforeUnderscore=TRUE){
if(beforeUnderscore){
esnm <- strsplit(esnm, "_", fixed=TRUE)[[1]][1]
}
files[grep(esnm, basename(files), ignore.case=TRUE)]
}
getFileFromEsnm <- function(files, esnm, type, beforeUnderscore=TRUE){
# Match 'esnm' against the pre-defined systems:
if(length(files)==0){
dir <- system.file("extdata", type, package="echoIBM")
# Get available beams files:
files <- list.files(dir, full.names=TRUE)
# If there are no files:
if(length(files)==0){
warning(paste0("No files available in ", dir))
return(NULL)
}
# Pick out the relevnt file:
files <- match_esnm(files, esnm, beforeUnderscore=TRUE)
}
# If files are given in the input, asume these are given for all systems (change added on 2018-09-07):
else{
files <- files[[esnm]]
}
files
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.