Nothing
check.line.design <- function(object){
# This functions checks the arguments of a line transect design.
# Arguments:
# object - object of class Line.Transect.Design
# Return:
# either the object which was passed in (potentially with some
# modifications) or a string value which will be displayed as an
# error
#
#Check how many strata there are
strata.count <- length(object@region@strata.name)
object <- check.design(object)
# Check if it's now a character (i.e. error), if so return
if(inherits(object, "character")){
return(object)
}
# SEGMENTED DESIGN CHECKS
if(inherits(object, "Segment.Transect.Design")){
# Find which strata have the segmented line design
index <- which(object@design %in% c("segmentedgrid","segmentedtrack"))
# And which don't
index.neg <- which(!object@design %in% c("segmentedgrid","segmentedtrack"))
# SEGMENT LENGTH
# Either one global value or one value per strata. All values should be
# numeric and greater than 0. Values should only be provided for strata
# where the design is of type 'segmentedgrid' or 'segmentedtrack'.
if(length(object@seg.length) == 1){
# Repeat global value for each stratum
seg.length <- object@seg.length
object@seg.length <- rep(seg.length, strata.count)
object@seg.length[index.neg] <- NA
}
if(length(object@seg.length) != strata.count){
return("Segment length argument has a different number of values than there are strata, please supply a single global value or one value per stratum.")
}
if(!is.numeric(object@seg.length)){
return("All segment length values must be numeric.")
}
if(any(na.omit(object@seg.length <= 0))){
return("All segment length values must be greater than zero.")
}
if(any(is.na(object@seg.length[index]))){
return("NA values have been provided for segment length in strata where a segmented grid design has been selected.")
}
if(any(!is.na(object@seg.length[index.neg]))){
warning("Non NA values have been provided for segment length in strata where a segmented grid design was NOT selected. These vaues will be ignored.", immediate. = TRUE, call. = FALSE)
object@seg.length[index.neg] <- NA
}
# SEGMENT THRESHOLD
# Either one global value or one value per strata. All values should be
# numeric and between 0 and 100. Values should only be provided for strata
# where the design is of type 'segmentedgrid' or 'segmentedtrack'.
if(length(object@seg.threshold) == 1){
# Repeat global value for each stratum
seg.threshold <- object@seg.threshold
object@seg.threshold <- rep(seg.threshold, strata.count)
object@seg.threshold[index.neg] <- NA
}
if(length(object@seg.threshold) != strata.count){
return("Segment threshold argument has a different number of values than there are strata, please supply a single global value or one value per stratum.)")
}
if(!is.numeric(object@seg.threshold)){
return("All segment threshold values must be numeric.")
}
if(any(na.omit(object@seg.threshold < 0)) || any(na.omit(object@seg.threshold > 100))){
return("Values for segment threshold for segmented grid design must be between 0 and 100.")
}
if(any(is.na(object@seg.threshold[index]))){
return("NA values have been provided for segment threshold in strata where a segmented grid design has been selected.")
}
if(any(!is.na(object@seg.threshold[index.neg]))){
warning("Non NA values have been provided for segment threshold in strata where a segmented grid design was NOT selected. These vaues will be ignored.", immediate. = TRUE, call. = FALSE)
object@seg.threshold[index.neg] <- NA
}
}
# CHECK BOUNDING SHAPE
# bounding shape must be supplied for strata where zigzag designs are
# selected. Values must either be 'convex hull' or 'rectangle'.
if(any(object@design %in% c("eszigzag", "eszigzagcom"))){
# Find which strata have the zigzag line design
index <- which(object@design %in% c("eszigzag", "eszigzagcom"))
index.neg <- which(!object@design %in% c("eszigzag", "eszigzagcom"))
if(length(object@bounding.shape) == 1){
# Repeat global value for each stratum
bounding.shape <- object@bounding.shape
object@bounding.shape <- rep(bounding.shape, strata.count)
object@bounding.shape[index.neg] <- NA
}
if(length(object@bounding.shape) != strata.count){
return("Bounding shape argument has a different number of values than there are strata, please supply a single global value or one value per stratum.")
}
if(any(!na.omit(object@bounding.shape) %in% c("convex.hull", "rectangle"))){
return("All bounding shape values must either be 'convex.hull' or 'rectangle'.")
}
if(any(is.na(object@bounding.shape[index]))){
return("NA values have been provided for bounding shape in strata where a zigzag design has been selected. Please supply valid values.")
}
if(any(!is.na(object@bounding.shape[index.neg]))){
warning("Non NA values have been provided for bounding shape in strata where a zigzag design was NOT selected. These vaues will be ignored.", immediate. = TRUE, call. = FALSE)
object@bounding.shape[index.neg] <- NA
}
}
# CHECK DESIGNS
# There should be one design value per stratum or a single global value supplied.
# Designs must be either: random, systematic, eszigzag, eszigzagcom, segmentedgrid or segmentedtrack
if(length(object@design) == 1){
# Repeat global value for each stratum
object@design <- rep(object@design, strata.count)
}
if(length(object@design) != strata.count){
return("Design description argument has a different number of values than there are strata, please supply a single global value or one value per stratum.")
}
if(any(!(object@design %in% c("random", "systematic", "eszigzag", "eszigzagcom", "segmentedgrid", "segmentedtrack")))){
index <- which(!object@design %in% c("random", "systematic", "eszigzag", "eszigzagcom", "segmentedgrid", "segmentedtrack"))
return(paste("Unrecognised designs: ", paste(object@design[index], collapse = ", "), sep = ""))
}
# CHECK EFFORT PARAMETERS
# Effort can be defined by either spacing, line.length or number of samplers.
# Only one of these values must be supplied for each stratum or alternatively
# a single global value. If multiple values are provided only the first
# parameter of (spacing, line.length or number of samplers) will be used.
# Spacing is not applicable for a random design.
# All values defining effort must be > 0
# Check if multiple types of effort values have been supplied
spacing.len <- length(object@spacing)
line.len <- length(object@line.length)
samplers.len <- length(object@samplers)
# Store these as separate objects to allow NA only values (not allowed in numeric slots)
spacing <- object@spacing
line.length <- object@line.length
samplers <- object@samplers
# Turn 0 length into NA for if comparisons
if(strata.count == 1){
if(spacing.len == 0){
spacing <- NA
}
if(line.len == 0){
line.length <- NA
}
if(samplers.len == 0){
samplers <- NA
}
}
# At least one type of effort descriptor must be supplied. If multiple types have
# been provided the lengths of the values must be equal to the number of strata.
if(spacing.len == 0 && line.len == 0 && samplers.len == 0){
# If no values supplied use default of 20 samplers
samplers <- 20
samplers.len <- 1
}
if(spacing.len > 0 && line.len > 0 ||
spacing.len > 0 && samplers.len > 0 ||
line.len > 0 && samplers.len > 0){
if(spacing.len > 0 && spacing.len != strata.count){
return("You have supplied more than one effort descriptor (spacing, line.length, samplers). The number of values for each must be equal to the number of strata.")
}
if(line.len > 0 && line.len != strata.count){
return("You have supplied more than one effort descriptor (spacing, line.length, samplers). The number of values for each must be equal to the number of strata.")
}
if(samplers.len > 0 && samplers.len != strata.count){
return("You have supplied more than one effort descriptor (spacing, line.length, samplers). The number of values for each must be equal to the number of strata.")
}
}
# Check if only a single value has been provided for one of the effort descriptors
# when there are multiple strata. Use this to set a flag for future checks
global.value <- FALSE
if(strata.count > 1){
if(spacing.len == 1){
global.value <- TRUE
spacing <- rep(object@spacing, strata.count)
if(line.len > 0 || samplers.len > 0){
warning("Multiple global effort parameters have been supplied (spacing, line length, samplers). Spacing will be used and the others ignored.", immediate. = TRUE, call. = FALSE)
line.length <- numeric(0)
samplers <- numeric(0)
}
}else if(line.len == 1){
global.value <- TRUE
if(spacing.len > 0){
warning("Both line length and samplers have been provided. The global line length will be used and samplers ignored.", immediate. = TRUE, call. = FALSE)
samplers <- numeric(0)
}
}else if(samplers.len == 1){
global.value <- TRUE
}
}
# If there is only a single value and it is spacing check that none of the designs
# are random.
if(global.value){
if(spacing.len == 1 && any(object@design == "random")){
return("Cannot specify a global spacing value when you have also selected a random design.")
}
# Otherwise iterate through the designs and effort parameters
}else{
# Iterate through strata and check
for(i in 1:strata.count){
# check that at least one effort has been provided for this stratum
if(is.na(spacing[i]) && is.na(line.length[i]) && is.na(samplers[i])){
return(paste("No sampler, spacing or line.length arguments have been specified for stratum ",i , ".", sep = "" ))
}
# Special checks for random design
if(object@design[i] == "random" && !is.na(spacing[i])){
if(is.na(line.length[i]) && is.na(samplers[i])){
return(paste("Spacing is not a valid effort argument for the random design in stratum ", i, ", please supply line length or samplers", sep = ""))
}else{
warning(paste("Spacing is not a valid effort argument for the random design in stratum ", i, ", it will be ignored.", sep = ""), immediate. = TRUE, call. = FALSE)
spacing[i] <- NA
}
}
# Now check that there is an effort parameter defined and give a warning if
# multiple effort measures have been supplied.
if(!is.na(samplers[i]) && !is.na(spacing[i]) && !is.na(line.length[i])){
warning("Spacing, samplers and line.length have been supplied for stratum ",i,", samplers and line.length arguments will be ignored.", immediate. = TRUE, call. = FALSE)
samplers[i] <- NA
line.length[i] <- NA
}else if(!is.na(samplers[i]) && !is.na(spacing[i])){
warning("Both spacing and samplers have been supplied for stratum ",i,", samplers argument will be ignored.", immediate. = TRUE, call. = FALSE)
samplers[i] <- NA
}else if(!is.na(line.length[i]) && !is.na(spacing[i])){
warning("Both spacing and line.length have been supplied for stratum ",i,", line.length argument will be ignored.", immediate. = TRUE, call. = FALSE)
line.length[i] <- NA
}else if(!is.na(line.length[i]) && !is.na(samplers[i])){
warning("Both sampers and line.length have been supplied for stratum ",i,", samplers argument will be ignored.", immediate. = TRUE, call. = FALSE)
samplers[i] <- NA
}
}
}
# Remove NA's when there is only one stratum
if(strata.count == 1){
if(is.na(spacing)){
spacing <- numeric(0)
}
if(is.na(line.length)){
line.length <- numeric(0)
}
if(is.na(samplers)){
samplers <- numeric(0)
}
}
# Replace values back in object
object@spacing <- spacing
object@line.length <- line.length
object@samplers <- samplers
# Check if effort.allocation is redundant
if(any(c(samplers.len, line.len) > 1) && length(object@effort.allocation) > 1){
warning("Effort allocation argument redundant as you have supplied stratum specific effort values, it will be ignored.", immediate. = TRUE, call. = FALSE)
object@effort.allocation <- numeric(0)
}
if(strata.count == 1 && length(object@effort.allocation) > 0){
warning("Effort allocation argument redundant as there is only one stratum, it will be ignored.", immediate. = TRUE, call. = FALSE)
object@effort.allocation <- numeric(0)
}
if(strata.count > 1 && # multiple strata
samplers.len == 1 && # single value for samplers
length(object@effort.allocation) == 0 && # no effort allocation values
!inherits(object, "Segment.Transect.Design") && # not a segmented design
# there are multiple designs or the design is random
(length(unique(object@design)) > 1 || "random" %in% object@design)){
warning("The default allocation of samplers to strata (i.e. the number of samplers per stratum are in proportion to stratum areas) may lead to an unequal effort design as average sampler lengths could vary between strata.", immediate. = TRUE, call. = FALSE)
}
if(spacing.len >= 1 && length(object@effort.allocation) != 0){
warning("Effort allocation not applicable when effort is determined by spacing, it will be ignored.", immediate. = TRUE, call. = FALSE)
object@effort.allocation <- numeric(0)
}
return(object)
}
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.