R/genesis.r

Defines functions genesis

Documented in genesis

#' Generate a raster stack representing variables on a landscape
#'
#' This function generates a raster stack in which each layer represents a variable. Each variable can have one of several spatial patterns: linear, uniform, random, step, hinge, Gaussian, or sine. Random noise can also be added to any one of these patterns, and the layer pattern can be split in half (e.g., increasing in the "east" side and decreasing in the "west" side). The landscape can be circular or square. Layers can be rotated around their center to have different orientations relative to other rasters.
#' @param geography List object composed of lists, with one list per layer on the landscape. The name of the sublists correspond to the names of the layers to be generated. Each sublist has some of the following components (some are required, some optional).
#' \itemize{
	#' \item \code{type} (REQUIRED) Character, specifies the spatial pattern of the values of the variable. Depending on the type, different subsequent items in the list can be used to specify the parameters of the pattern:
	#' \itemize{
		#' \item \code{uniform}: Spatially uniform with all values equal to 1.
		#' \item \code{random}: Uniformly randomly drawn values across the range specified by:
		#' \itemize{
			#' \item \code{min} and \code{max}: Numeric, minimum and maximum value.
		#' }
		#' \item \code{linear}: Variable changes linearly across the landscape with these parameters:
		#' \itemize{
			#' \item \code{min} and \code{max}: Numeric, minimum and maximum value.
		#' }
		#' \item \code{step}: A step function pattern with these parameters:
		#' \itemize{
			#' \item \code{min} and \code{max}: Numeric, minimum and maximum value below and above the step.
			#' \item \code{at} Numeric, location of the step specified such that the bottom ("south") edge of the raster is at position -1 and the top ("north") edge is at position 1.
		#' }
		#' \item \code{hinge}: An area with a constant value adjacent to an area with a linearly increasing or decreasing value, which is in turn adjacent to an area with another constant value.
		#' \itemize{
			#' \item \code{min} and \code{max}: Numeric, minimum and maximum value below and above the step.
			#' \item \code{from} Numeric, location where the hinge "starts" such that the bottom ("south") edge of the raster is at position -1 and the top ("north") edge is at position 1.
			#' \item \code{to} Numeric, location where the hinge "ends" such that the bottom ("south") edge of the raster is at position -1 and the top ("north") edge is at position 1.
		#' }
		#' \item \code{gaussian}: A spatially Gaussian distribution with these parameters:
		#' \itemize{
			#' \item \code{center1} and \code{center2}: Numeric, position on (or off) the landscape where the center of the distribution lies where position -1 is at the "south" (\code{center1}) or "west" (\code{center2}) of the raster, and position 1 is at the "north" or "east" side of the raster.
			#' \item \code{sd1} and \code{sd2}: Numeric, standard deviation in the x- and y-directions.
			#' \item \code{rho} Numeric, rotation (interaction between x and y directions). A value of 0 yields no rotation with values closer to 1 collapsing into a univariate distribution in the x-direction and closer to -1 in the y-direction.
		#' }
		#' \item \code{sin} A sine wave with these parameters:
		#' \itemize{
			#' \item \code{freq} Numeric, frequency (assumes going from one edge of the landscape to the other is equal to one wavelength).
			#' \item \code{offset} Numeric, value to add/subtract from the position the the sine wave (when this is 0 then the value of \code{sine(0) = 1} is positioned at the edge of the landscape).
			#' \item \code{min} and \code{max} Numeric, amplitude of the sine wave.
		#' }
	#' }
	#' \item \code{rot} (Optional) Numeric, degrees by which to rotate the raster relative to "north". This is useful for manipulating the correlation between layers.
	#' \item \code{randOrient} (Optional) Logical, if \code{TRUE} then then rotate the raster in a random direction.
	#' \item \code{noise} (Optional) Numeric or \code{NULL}, if not equal to 0 or \code{NULL}, add random noise by randomly swapping values across cells after the pattern specified by \code{type} has been created. This element states gives the proportion of cells to swap, so much be in the range [0, 1]. Note that swapping ensures the original frequency distribution of the values of the variable is retained.
	#' \item \code{split} (Optional) Logical, if \code{TRUE} then before any rotation is performed swap values between the upper left ("northwest") corner and the lower right ("southeast") corners of the raster.
#' }
#' @param size Positive integer, number of rows/columns in each landscape raster.
#' @param circle Logical, if \code{TRUE} then the raster stack is cropped to a circle with values outside the circle left as \code{NA}. If \code{FALSE} (default), then the stack is left as a square.
#' @param verbose Logical, if \code{TRUE} display progress. Default is \code{FALSE}.
#' @param ... Other arguments (unused).
#' @return A raster stack.
#' @examples
#' geog1 <- list(
#' 	uniform=list(type='uniform'),
#' 	random=list(type='random', min=-1, max=1),
#' 	linear=list(type='linear', min=-1, max=1),
#' 	linearNoise=list(type='linear', min=-1, max=1, noise=0.3),
#' 	step=list(type='step', min=-1, max=1, at=0.5),
#' 	hinge=list(type='hinge', min=-1, max=1, from=-0.5, to=0),
#' 	gauss=list(type='gaussian', center1=0, center2=0.25,
#' 		sd1=0.5, sd2=0.25, rho=2/3),
#' 	sine=list(type='sin', freq=2, offset=0, min=-1, max=1)
#' )
#' 
#' # square landscape
#' land <- genesis(geography=geog1, size=201, circle=FALSE)
#' raster::plot(land)
#' 
#' # circular landscape
#' land <- genesis(geography=geog1, size=201)
#' raster::plot(land)
#' 
#' # layer rotation
#' geog2 <- list(
#' 	x1=list(type='linear', min=-1, max=1),
#' 	x2=list(type='linear', min=-1, max=1, rot=45)
#' )
#' land <- genesis(geog2, size=201, circle=TRUE)
#' raster::plot(land)
#' 
#' # fancy stuff
#' set.seed(123)
#' geog3 <- list(
#' 	control=list(type='linear', min=-1, max=1),
#' 	noisy=list(type='linear', min=-1, max=1, noise=0.3),
#' 	split=list(type='linear', min=-1, max=1, split=TRUE),
#' 	randOrient=list(type='linear', min=-1, max=1, randOrient=TRUE),
#' 	fancy=list(type='sine', min=-1, max=1, freq=0.2, offset=0, noise=0.3,
#'  split=TRUE, randOrient=TRUE)
#' )
#' land <- genesis(geog3, size=201)
#' raster::plot(land)
#' @export

genesis <- function(
	geography,
	size=1024,
	circle=TRUE,
	verbose=FALSE,
	...
) {

	# position rasters... needed if generating from scratch
	x <- matrix(rep(seq(-1, 1, length.out=size), size), nrow=size, byrow=TRUE)
	y <- matrix(rep(seq(1, -1, length.out=size), each=size), nrow=size, byrow=TRUE)

	# position rasters... needed if generating from scratch
	dist <- sqrt(x^2 + y^2)

	# position rasters... needed if generating from scratch
	template <- ifelse(dist <= 1, 1, NA)
	template <- raster::raster(template)

	if (verbose) omnibus::say('Creating landscape layer: ', post=0)
	
	# generate each raster or obtain from disk
	for (i in seq_along(geography)) {

		if (verbose) omnibus::say(i, ' (type: ', geography[[i]]$type, ')', post=0)
	
		if (any(names(unlist(geography[[i]])) %in% 'pregen')) {
			
			# get pre-generated raster
			if (geography[[i]]$pregen) {
				usepregen <- TRUE
			} else {
				usepregen <- FALSE
			}
			
		} else {
			usepregen <- FALSE
		}

		### use pre-generated raster
		if (usepregen) {

			mat <- raster::raster(
				paste0('./Simulated Landscape Rasters/',
					geography[[i]]$type,
					'From',
					sub(pattern='[-]', replacement='Neg', x=as.character(min)),
					'To',
					sub(pattern='[-]', replacement='Neg', x=as.character(max)),
					'Rotation',
					ifelse(any(names(unlist(geography[[i]])) %in% 'rot'), sub(as.character(geography[[i]]$rot), pattern='[.]', replacement='pt'), 0),
					ifelse(any(names(unlist(geography[[i]])) %in% 'split'), '_split', ''),
					'.tif'
				)
			)
		
		### generate raster from scratch
		} else {
				
			# uniform values
			mat <- if (geography[[i]]$type=='uniform') {
			
				matrix(rep(1, size^2), nrow=size)
		
			# random values
			} else if (geography[[i]]$type=='random') {

				matrix(stats::runif(n=size^2, min=geography[[i]]$min, max=geography[[i]]$max), nrow=size)

			# linear
			} else if (geography[[i]]$type=='linear') {
		
				matrix(rep(seq(geography[[i]]$max, geography[[i]]$min, length.out=size), each=size), nrow=size, byrow=T)
			
			# step
			} else if (geography[[i]]$type=='step') {
			
				(y >= geography[[i]]$at) * geography[[i]]$max + (y < geography[[i]]$at) * geography[[i]]$min
			
			# hinge
			} else if (geography[[i]]$type=='hinge') {
			
				(y >= geography[[i]]$to) * geography[[i]]$max +
				(y >= geography[[i]]$from & y < geography[[i]]$to) * (((geography[[i]]$max - geography[[i]]$min) / (geography[[i]]$to - geography[[i]]$from)) * (y - geography[[i]]$from) + geography[[i]]$min) +
				(y < geography[[i]]$from) * geography[[i]]$min
			
			# gaussian
			} else if (geography[[i]]$type=='gaussian') {

				gaussian(x1=x, x2=y, mu1=geography[[i]]$center1, mu2=geography[[i]]$center2, sigma1=geography[[i]]$sd1, sigma2=geography[[i]]$sd2, rho=geography[[i]]$rho)
			
			# sine
			} else if (geography[[i]]$type=='sin') {
			
				(geography[[i]]$max  - geography[[i]]$min) * ((sin(geography[[i]]$freq * pi * y - geography[[i]]$offset) + 1) / 2) + geography[[i]]$min
			
			}
			
			# split (swap) values of raster from top to bottom on one half of raster
			if (any(names(unlist(geography[[i]])) %in% 'split')) {

				if (geography[[i]]$split) mat[1:size, 1:round( 0.5 * ncol(mat))] <- mat[size:1, round( 0.5 * ncol(mat)):1]
				
			}
		
			# rotate raster
			if (any(names(geography[[i]])=='rot')) if (!is.na(geography[[i]]$rot)) mat <- omnibus::rotateMatrix(x=mat, rot=geography[[i]]$rot)
		
			# random orientation for rasters of "linear-ish" type
			if (any(names(geography[[i]])=='randOrient')) if (!is.na(geography[[i]]$randOrient)) {
				mat <- omnibus::rotateMatrix(mat, stats::runif(1, 0, 360 - omnibus::eps()))
			}
		
			if (class(mat)!='RasterLayer') mat <- raster::raster(mat)
			
			# trim values to circle
			if (circle) mat <- mat * template
			
			
		}

		# stack
		landscape <- if (!exists('landscape', inherits=FALSE)) { raster::stack(mat) } else { raster::stack(landscape, mat) }

	} # next raster

	# add noise to any raster that needs it
	landscape <- noisy(landscape, geography)

	# metadata
	raster::projection(landscape) <- '+proj=moll +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs' # Mollweide (equal area)
	landscape <- raster::setMinMax(landscape)
	
	# name landscape
	names(landscape) <- names(geography)
	
	if (verbose) omnibus::say('')
		
	landscape
	
}
adamlilith/enmSdmPredImport documentation built on Dec. 31, 2022, 5:40 p.m.