R/echoIBM.addRandomness.R

Defines functions echoIBM.addRandomness

Documented in echoIBM.addRandomness

#*********************************************
#*********************************************
#' This function adds randomness in the fish positions and to the fish velocities (given by the polarization).
#'
#' @param data		A list containing the dynamic fish data, as generated by e.g. \code{\link{echoIBM.generate_dynschool}}.
#' @param grsd_plHS	A list or data frame linking standard deviations and polarization values. If not given, this is read by grsd_plHS <- read.TSD(system.file("extdata", "grsd_plHS.TSD", package="echoIBM")).
#'
#' @return
#'
#' @examples
#' \dontrun{}
#'
#' @importFrom TSD read.TSD sph2car
#' @importFrom stats approx rnorm
#'
#' @export
#' @rdname echoIBM.addRandomness
#'
echoIBM.addRandomness <- function(data, grsd_plHS=NULL){
	
	# In this function the orientation of the school is used. Before 2018-09-16, both the heading and the orientation were indicated with the (thtS, phiS) pair, but this was changed to use (hazS, helS) for the heading (azimuth, elevation), and (oazS, oelS) for the orientation. Here (oazS, oelS) is used, and if missing interpreted from (thtS, phiS) if present:
	thtSphiS_present <- length(data$thtS)>0 && length(data$phiS)>0
	oazSoelS_present <- length(data$oazS)>0 && length(data$oelS)>0
	#if(!oazSoelS_present && thtSphiS_present){
	#	data$oazS <- data$thtS
	#	data$oelS <- data$phiS
	#}
	if(!oazSoelS_present){
		if(thtSphiS_present){
			data$oazS <- data$thtS
			data$oelS <- data$phiS
		}
		else{
			warnings("oazS and oelS missing, and was defaulted to 0 and pi/2 (orientation horizontally east)")
			data$oazS <- 0
			data$oelS <- pi/2
		}
	}
	
	
	# The fish positions psxf, psyf, pszf are assumed to be gridded:
	# Apply the default standard deviation value:
	if(all(sapply(data[c("SDxf","SDyf","SDzf")],length)==0)){
		data$SDxf <- 1
	}
	# Repeat the standard deviation value:
	u <- unlist(data[c("SDxf","SDyf","SDzf")])
	if(length(u)<3){
		u <- rep(u,length.out=3)
		data$SDxf <- u[1]
		data$SDyf <- u[2]
		data$SDzf <- u[3]
	}
	
	# Get the number of fish:
	data$nbfS <- length(data$psxf)
	
	# Set the seed of the school:
	set.seed(data$seed)

	# Add noise to the fish orientations. If the polarization is given, calculate the standard deviation on the positions:
	if(length(data$plHS)>0){
		if(length(grsd_plHS)==0){
			grsd_plHS <- read.TSD(system.file("extdata", "grsd_plHS.TSD", package="echoIBM"))
		}
		
		# Define standard deviations to use when generating the polarization:
		SD <- approx(grsd_plHS$plHS, grsd_plHS$grsd, data$plHS, rule=2)$y
	
		# Get the second positions of the fish, added noise and the movement of the school, used to calculate the velocities of the fish:
		# Displacement equal to 1 is used in "grsd_plHS.TSD":
		#displacement_car <- sph2car(cbind(1, data$thtS, data$phiS))
		displacement_car <- sph2car(cbind(1, data$oazS, data$oelS))
		data$psxf1 <- data$psxf + rnorm(data$nbfS, 0, SD)
		data$psyf1 <- data$psyf + rnorm(data$nbfS, 0, SD)
		data$pszf1 <- data$pszf + rnorm(data$nbfS, 0, SD)
		data$psxf2 <- data$psxf + rnorm(data$nbfS, 0, SD) + displacement_car[1]
		data$psyf2 <- data$psyf + rnorm(data$nbfS, 0, SD) + displacement_car[2]
		data$pszf2 <- data$pszf + rnorm(data$nbfS, 0, SD) + displacement_car[3]
		data$vlxf <- data$psxf2 - data$psxf1
		data$vlyf <- data$psyf2 - data$psyf1
		data$vlzf <- data$pszf2 - data$pszf1
	}
	# Set the fish to simulated omnidirectional if polarization is missing:
	else{
		data$vlxf <- rnorm(data$nbfS)
		data$vlyf <- rnorm(data$nbfS)
		data$vlzf <- rnorm(data$nbfS)
	}
	
	# Get the positions of the fish, added noise:
	data$psxf <- data$psxf + rnorm(data$nbfS, 0, data$SDxf)
	data$psyf <- data$psyf + rnorm(data$nbfS, 0, data$SDyf)
	data$pszf <- data$pszf + rnorm(data$nbfS, 0, data$SDzf)
	
	# Add rotation data:
	data[c("rtzf","rtxf")] <- vl2rt.TSD(data[c("rtzf","rtxf","vlxf","vlyf","vlzf")])[c("rtzf","rtxf")]
	
	# Add sizes of the fish:
	if(length(data$PDsz)==0){
		thisPDsz <- "rnorm"
	}
	else{
		thisPDsz <- data$PDsz[1]
	}
	data$size <- do.call(thisPDsz, list(data$nbfS, data$MEsz, data$SDsz))
	
	
	return(data)
}
arnejohannesholmin/echoIBM documentation built on April 14, 2024, 11:37 p.m.