R/echoIBM.setBeams.R

In arnejohannesholmin/echoIBM: Simulation of multibeam sonar data

#*********************************************
#*********************************************
#' 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
}