diff --git a/DESCRIPTION b/DESCRIPTION index 8b7ed4b..7d02bf3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,4 +1,5 @@ Package: dssd +Depends: R (>= 3.6.0) Imports: sf, ggplot2, @@ -27,7 +28,6 @@ Description: Creates survey designs for distance sampling surveys. These BugReports: https://github.com/DistanceDevelopment/dssd/issues License: GPL (>=2) Encoding: UTF-8 -RoxygenNote: 7.3.2 Collate: 'Class.Constructors.R' 'Coverage.Grid.R' @@ -63,3 +63,4 @@ Collate: 'point.coords.as.dataframe.R' 'run.coverage.R' 'write.transects.R' +Config/roxygen2/version: 8.0.0 diff --git a/R/Class.Constructors.R b/R/Class.Constructors.R index 53c2eb9..c83fea1 100644 --- a/R/Class.Constructors.R +++ b/R/Class.Constructors.R @@ -68,7 +68,7 @@ make.region <- function(region.name = "region", } if(length(strata.name) < length(shape) && length(shape) > 1){ strata.name <- LETTERS[1:length(shape)] - warning("Automatically naming strata as insufficient strata names provided. Assigned strata names:", paste(strata.name, collapse = ", "), call. = F, immediate. = T) + warning("Automatically naming strata as insufficient strata names provided. Assigned strata names:", paste(strata.name, collapse = ", "), call. = FALSE) }else if(length(strata.name) == 0 && length(shape) == 1){ strata.name <- region.name }else if(length(strata.name) > length(shape)){ @@ -99,7 +99,7 @@ make.region <- function(region.name = "region", }else if(strata.count != length(strata.name)){ if(length(sf.shape) <= 26){ strata.name <- LETTERS[1:length(sf.shape[[sf.column]])] - warning("Automatically naming strata as no (or incorrect number of) strata names provided. Assigned strata names: ", paste(strata.name, collapse = ", "), call. = F, immediate. = T) + warning("Automatically naming strata as no (or incorrect number of) strata names provided. Assigned strata names: ", paste(strata.name, collapse = ", "), call. = FALSE) }else{ stop("Too many strata (>26) for strata names to be assigned default names, please provide the correct number of strata names.", call. = FALSE) } @@ -375,7 +375,7 @@ make.design <- function(region = make.region(), transect.type = "line", design = }else if(transect.type %in% c("Point", "point", "Point Transect", "point transect")){ # Check line length not supplied if(length(line.length) > 0){ - warning("Argument line.length not applicable to point transect designs.", immediate. = TRUE, call. = FALSE) + warning("Argument line.length not applicable to point transect designs.", call. = FALSE) } #Create point transect object design <- new(Class="Point.Transect.Design", region, truncation, design, spacing, samplers, effort.allocation, design.angle, edge.protocol, coverage.grid) @@ -423,7 +423,7 @@ make.coverage <- function(region = make.region(), } if(length(spacing) > 0 && length(n.grid.points) > 0){ if(n.grid.points != 1000){ - warning("Both spacing and n.grid.points specified, n.grid.point will be disregarded.", call. = FALSE, immediate. = TRUE) + warning("Both spacing and n.grid.points specified, n.grid.point will be disregarded.", call. = FALSE) } n.grid.points <- numeric(0) } diff --git a/R/Coverage.Grid.R b/R/Coverage.Grid.R index 4f28799..9abe8fd 100644 --- a/R/Coverage.Grid.R +++ b/R/Coverage.Grid.R @@ -70,7 +70,7 @@ setMethod( sf.column <- attr(x@grid, "sf_column") plot(x@grid[[sf.column]], add = add, col = col, pch = pch) }else{ - warning("No grid points to plot", call. = F, immediate. = F) + warning("No grid points to plot", call. = FALSE) } invisible(x) } diff --git a/R/Line.Transect.Design.R b/R/Line.Transect.Design.R index 176255e..d71ad2e 100644 --- a/R/Line.Transect.Design.R +++ b/R/Line.Transect.Design.R @@ -233,7 +233,7 @@ gt.LT.fun.body <- function(object, quiet, ...){ #Need to retain transect IDs as well as strata for lines if(length(transects) == 0){ if(!quiet){ - warning("No samplers generated.", immediate. = T, call. = FALSE) + warning("No samplers generated.", call. = FALSE) } return(NULL) } diff --git a/R/Line.Transect.R b/R/Line.Transect.R index d2ce305..bd6b7b0 100644 --- a/R/Line.Transect.R +++ b/R/Line.Transect.R @@ -91,7 +91,7 @@ setMethod( #} plot(x@samplers[[sf.column.samps]], add = add, col = col, lwd = lwd) }else{ - warning("No samplers to plot", call. = F, immediate. = F) + warning("No samplers to plot", call. = FALSE) } invisible(x) } @@ -113,45 +113,45 @@ setMethod( title <- paste("\n Strata ", strata.names[strat], ":", sep = "") len.title <- nchar(title) underline <- paste(" ", paste(rep("_", (len.title-3)), collapse = ""), sep = "") - cat(title, fill = T) - cat(underline, fill = T) + cat(title, fill = TRUE) + cat(underline, fill = TRUE) design <- switch(object@design[strat], "random" = "randomly located transects", "systematic" = "systematically spaced parallel transects", "eszigzag" = "equal spaced zigzag", "eszigzagcom" = "complementaty equal spaced zigzags", "segmentedgrid" = "segmented grid") - cat("Design: ", design, fill = T) + cat("Design: ", design, fill = TRUE) if(object@design[strat] %in% c("systematic", "eszigzag", "eszigzagcom", "segmentedgrid")){ - cat("Spacing: ", object@spacing[strat], fill = T) + cat("Spacing: ", object@spacing[strat], fill = TRUE) } - cat("Line length:", object@line.length[strat], fill = T) + cat("Line length:", object@line.length[strat], fill = TRUE) if(object@design[strat] == "segmentedgrid"){ - cat("Segment length: ", object@seg.length[strat], fill = T) - cat("Segment threshold: ", object@seg.threshold[strat], fill = T) + cat("Segment length: ", object@seg.length[strat], fill = TRUE) + cat("Segment threshold: ", object@seg.threshold[strat], fill = TRUE) } - cat("Trackline length:", object@trackline[strat], fill = T) - cat("Cyclic trackline length:", object@cyclictrackline[strat], fill = T) - cat("Number of samplers: ", object@samp.count[strat], fill = T) - cat("Design angle: ", object@design.angle[strat], fill = T) - cat("Edge protocol: ", object@edge.protocol[strat], fill = T) - cat("Covered area: ", object@cov.area[strat], fill = T) - cat("Strata coverage: ", round((object@cov.area[strat]/object@strata.area[strat])*100,2), "%", fill = T, sep = "") - cat("Strata area: ", object@strata.area[strat], fill = T) + cat("Trackline length:", object@trackline[strat], fill = TRUE) + cat("Cyclic trackline length:", object@cyclictrackline[strat], fill = TRUE) + cat("Number of samplers: ", object@samp.count[strat], fill = TRUE) + cat("Design angle: ", object@design.angle[strat], fill = TRUE) + cat("Edge protocol: ", object@edge.protocol[strat], fill = TRUE) + cat("Covered area: ", object@cov.area[strat], fill = TRUE) + cat("Strata coverage: ", round((object@cov.area[strat]/object@strata.area[strat])*100,2), "%", fill = TRUE, sep = "") + cat("Strata area: ", object@strata.area[strat], fill = TRUE) } #Now print totals - cat("\n Study Area Totals:", fill = T) - cat(" _________________", fill = T) - cat("Line length:", sum(object@line.length, na.rm = T), fill = T) - cat("Trackline length:", sum(object@trackline, na.rm = T), fill = T) - cat("Cyclic trackline length:", sum(object@cyclictrackline, na.rm = T), fill = T) - cat("Number of samplers: ", sum(object@samp.count, na.rm = T), fill = T) + cat("\n Study Area Totals:", fill = TRUE) + cat(" _________________", fill = TRUE) + cat("Line length:", sum(object@line.length, na.rm = TRUE), fill = TRUE) + cat("Trackline length:", sum(object@trackline, na.rm = TRUE), fill = TRUE) + cat("Cyclic trackline length:", sum(object@cyclictrackline, na.rm = TRUE), fill = TRUE) + cat("Number of samplers: ", sum(object@samp.count, na.rm = TRUE), fill = TRUE) if(length(object@effort.allocation) > 0){ - cat("Effort allocation: ", paste(object@effort.allocation*100, collapse = "%, "), "%", fill = T, sep = "") + cat("Effort allocation: ", paste(object@effort.allocation*100, collapse = "%, "), "%", fill = TRUE, sep = "") } - cat("Covered area: ", sum(object@cov.area, na.rm = T), fill = T) + cat("Covered area: ", sum(object@cov.area, na.rm = TRUE), fill = TRUE) index <- which(!is.na(object@cov.area)) - cat("Average coverage: ", round((sum(object@cov.area[index])/sum(object@strata.area))*100,2), "%", fill = T, sep = "") + cat("Average coverage: ", round((sum(object@cov.area[index])/sum(object@strata.area))*100,2), "%", fill = TRUE, sep = "") invisible(object) } ) diff --git a/R/Point.Transect.Design.R b/R/Point.Transect.Design.R index 4d438f9..05bd9e3 100644 --- a/R/Point.Transect.Design.R +++ b/R/Point.Transect.Design.R @@ -166,7 +166,7 @@ setMethod( } if(length(transects) == 0){ if(!quiet){ - warning("No samplers generated.", immediate. = T, call. = FALSE) + warning("No samplers generated.", call. = FALSE) } index <- numeric(0) }else{ diff --git a/R/Point.Transect.R b/R/Point.Transect.R index b440860..9d856a8 100644 --- a/R/Point.Transect.R +++ b/R/Point.Transect.R @@ -66,7 +66,7 @@ setMethod( if(length(x@samplers) > 0){ plot(x@samplers[[sf.column]], add = add, col = col, pch = pch) }else{ - warning("No samplers to plot", call. = F, immediate. = F) + warning("No samplers to plot", call. = FALSE) } invisible(x) } @@ -87,32 +87,32 @@ setMethod( title <- paste("\n Strata ", strata.names[strat], ":", sep = "") len.title <- nchar(title) underline <- paste(" ", paste(rep("_", (len.title-3)), collapse = ""), sep = "") - cat(title, fill = T) - cat(underline, fill = T) + cat(title, fill = TRUE) + cat(underline, fill = TRUE) design <- switch(object@design[strat], "random" = "randomly located transects", "systematic" = "systematically spaced transects") - cat("Design: ", design, fill = T) + cat("Design: ", design, fill = TRUE) if(object@design[strat] == "systematic"){ - cat("Spacing: ", object@spacing[strat], fill = T) + cat("Spacing: ", object@spacing[strat], fill = TRUE) } - cat("Number of samplers: ", object@samp.count[strat], fill = T) - cat("Design angle: ", object@design.angle[strat], fill = T) - cat("Edge protocol: ", object@edge.protocol[strat], fill = T) - cat("Covered area: ", object@cov.area[strat], fill = T) - cat("Strata coverage: ", round((object@cov.area[strat]/object@strata.area[strat])*100,2), "%", fill = T, sep = "") - cat("Strata area: ", object@strata.area[strat], fill = T) + cat("Number of samplers: ", object@samp.count[strat], fill = TRUE) + cat("Design angle: ", object@design.angle[strat], fill = TRUE) + cat("Edge protocol: ", object@edge.protocol[strat], fill = TRUE) + cat("Covered area: ", object@cov.area[strat], fill = TRUE) + cat("Strata coverage: ", round((object@cov.area[strat]/object@strata.area[strat])*100,2), "%", fill = TRUE, sep = "") + cat("Strata area: ", object@strata.area[strat], fill = TRUE) } #Now print totals - cat("\n Study Area Totals:", fill = T) - cat(" _________________", fill = T) - cat("Number of samplers: ", sum(object@samp.count, na.rm = T), fill = T) + cat("\n Study Area Totals:", fill = TRUE) + cat(" _________________", fill = TRUE) + cat("Number of samplers: ", sum(object@samp.count, na.rm = TRUE), fill = TRUE) if(length(object@effort.allocation) > 0){ - cat("Effort allocation: ", paste(object@effort.allocation*100, collapse = "%, "), "%", fill = T, sep = "") + cat("Effort allocation: ", paste(object@effort.allocation*100, collapse = "%, "), "%", fill = TRUE, sep = "") } - cat("Covered area: ", sum(object@cov.area, na.rm = T), fill = T) + cat("Covered area: ", sum(object@cov.area, na.rm = TRUE), fill = TRUE) index <- which(!is.na(object@cov.area)) - cat("Average coverage: ", round((sum(object@cov.area[index])/sum(object@strata.area))*100,2), "%", fill = T, sep = "") + cat("Average coverage: ", round((sum(object@cov.area[index])/sum(object@strata.area))*100,2), "%", fill = TRUE, sep = "") invisible(object) } ) diff --git a/R/Region.R b/R/Region.R index c9921d2..fd2d4de 100644 --- a/R/Region.R +++ b/R/Region.R @@ -50,7 +50,7 @@ setMethod( if(!is.na(tmp)){ if(is.null(tmp$units)){ units <- units - warning("Coordinate reference system detected but no units can be found. Has this shape been projected - shapefiles must be projected on to a flat plane before surveys are designed. dssd is unstable and may generate errors when working with unprojected regions.", call. = FALSE, immediate. = TRUE) + warning("Coordinate reference system detected but no units can be found. Has this shape been projected - shapefiles must be projected on to a flat plane before surveys are designed. dssd is unstable and may generate errors when working with unprojected regions.", call. = FALSE) }else units <- tmp$units }else{ @@ -137,7 +137,7 @@ setMethod( definition=function(x, y, main = "", region.col = "default", strata = "all", line.col = gray(.2), legend.params = list()){ # Warn of depreications if(length(legend.params) > 0){ - warning("legend.params argument is deprecated since version 0.2.3", immediate. = TRUE, call. = FALSE) + warning("legend.params argument is deprecated since version 0.2.3", call. = FALSE) } # Tidy up space to keep ggplot happy suppressWarnings(invisible(gc())) @@ -213,7 +213,7 @@ setMethod( definition=function(x, y, main = "", region.col = "default", strata = "all", line.col = gray(.2), col = "blue", lwd = 1, covered.area = FALSE, legend.params = list()){ # Warn of depreications if(length(legend.params) > 0){ - warning("legend.params argument is deprecated since version 0.2.3", immediate. = TRUE, call. = FALSE) + warning("legend.params argument is deprecated since version 0.2.3", call. = FALSE) } # Tidy up space to keep ggplot happy suppressWarnings(invisible(gc())) diff --git a/R/Survey.Design.R b/R/Survey.Design.R index e285f87..c571d69 100644 --- a/R/Survey.Design.R +++ b/R/Survey.Design.R @@ -148,54 +148,54 @@ setMethod( title <- paste("\n Strata ", strata.names[strat], ":", sep = "") len.title <- nchar(title) underline <- paste(" ", paste(rep("_", (len.title-3)), collapse = ""), sep = "") - cat(title, fill = T) - cat(underline, fill = T) + cat(title, fill = TRUE) + cat(underline, fill = TRUE) design <- switch(object@design[strat], "random" = "randomly located transects", "systematic" = "systematically spaced transects", "eszigzag" = "equal spaced zigzag", "eszigzagcom" = "complementaty equal spaced zigzags", "segmentedgrid" = "segmented grid") - cat("Design: ", design, fill = T) + cat("Design: ", design, fill = TRUE) if(object@design[strat] %in% c("systematic", "eszigzag", "eszigzagcom", "segmentedgrid")){ - cat("Spacing: ", object@spacing[strat], fill = T) + cat("Spacing: ", object@spacing[strat], fill = TRUE) } if(length(object@samplers) == 1){ - cat("Number of samplers: ", object@samplers, " (shared across strata)", fill = T) + cat("Number of samplers: ", object@samplers, " (shared across strata)", fill = TRUE) }else{ - cat("Number of samplers: ", object@samplers[strat], fill = T) + cat("Number of samplers: ", object@samplers[strat], fill = TRUE) } line.length <- try(object@line.length, silent = TRUE) if(!inherits(line.length, "try-error")){ if(length(line.length) == 1){ - cat("Line length: ", line.length, " (shared across strata)", fill = T) + cat("Line length: ", line.length, " (shared across strata)", fill = TRUE) }else if(length(line.length) == length(strata.names)){ - cat("Line length: ", line.length[strat], fill = T) + cat("Line length: ", line.length[strat], fill = TRUE) }else{ - cat("Line length: NA", fill = T) + cat("Line length: NA", fill = TRUE) } } if(object@design[strat] %in% c("segmentedgrid")){ - cat("Segment length: ", object@seg.length[strat], fill = T) - cat("Segment threshold: ", object@seg.threshold[strat], fill = T) + cat("Segment length: ", object@seg.length[strat], fill = TRUE) + cat("Segment threshold: ", object@seg.threshold[strat], fill = TRUE) } - cat("Design angle: ", object@design.angle[strat], fill = T) - cat("Edge protocol: ", object@edge.protocol[strat], fill = T) + cat("Design angle: ", object@design.angle[strat], fill = TRUE) + cat("Edge protocol: ", object@edge.protocol[strat], fill = TRUE) } dp <- ifelse(any(object@region@area < 10), 3, 0) - cat("\nStrata areas: ", paste(round(object@region@area, dp), collapse = ", "), fill = T) + cat("\nStrata areas: ", paste(round(object@region@area, dp), collapse = ", "), fill = TRUE) if(length(object@region@units) > 0){ if(!inherits(line.length, "try-error")){ - cat("Region and effort units: ", object@region@units, fill = T) + cat("Region and effort units: ", object@region@units, fill = TRUE) }else{ - cat("Region units: ", object@region@units, fill = T) + cat("Region units: ", object@region@units, fill = TRUE) } } if(length(object@effort.allocation) > 0){ - cat("Effort allocation across strata: ", paste(object@effort.allocation*100, collapse = "%, "), "%", sep = "", fill = T) + cat("Effort allocation across strata: ", paste(object@effort.allocation*100, collapse = "%, "), "%", sep = "", fill = TRUE) } if(length(object@coverage.scores) > 0){ - cat("Coverage Simulation repetitions: ", object@coverage.reps, fill = T) + cat("Coverage Simulation repetitions: ", object@coverage.reps, fill = TRUE) } design.stats <- object@design.statistics @@ -208,31 +208,31 @@ setMethod( "line.length" = "Line length:", "trackline" = "Trackline length:", "cyclictrackline" = "Cyclic trackline length:") - cat("\n ", title, fill = T) + cat("\n ", title, fill = TRUE) underline <- paste(rep("", (nchar(title)-3)), collapse = "") - cat(" ", underline, fill = T) + cat(" ", underline, fill = TRUE) print(design.stats[[i]]) } if(!all(is.na(object@coverage.scores))){ title <- "Coverage Score Summary:" - cat("\n ", title, fill = T) + cat("\n ", title, fill = TRUE) underline <- paste(rep("", (nchar(title)-3)), collapse = "") - cat(" ", underline, fill = T) + cat(" ", underline, fill = TRUE) cov.scores <- array(NA, dim = c(5, (length(strata.names)+1)), dimnames = list(c("Minimum", "Mean", "Median", "Maximum", "sd"), c(strata.names, "Total"))) for(i in seq(along = strata.names)){ cov.strat <- get.coverage(object, i) - cov.scores["Minimum",i] <- min(cov.strat, na.rm = T) - cov.scores["Mean",i] <- mean(cov.strat, na.rm = T) - cov.scores["Median",i] <- median(cov.strat, na.rm = T) - cov.scores["Maximum",i] <- max(cov.strat, na.rm = T) - cov.scores["sd",i] <- sd(cov.strat, na.rm = T) + cov.scores["Minimum",i] <- min(cov.strat, na.rm = TRUE) + cov.scores["Mean",i] <- mean(cov.strat, na.rm = TRUE) + cov.scores["Median",i] <- median(cov.strat, na.rm = TRUE) + cov.scores["Maximum",i] <- max(cov.strat, na.rm = TRUE) + cov.scores["sd",i] <- sd(cov.strat, na.rm = TRUE) } #Add in total column - cov.scores["Minimum","Total"] <- min(object@coverage.scores, na.rm = T) - cov.scores["Mean","Total"] <- mean(object@coverage.scores, na.rm = T) - cov.scores["Median","Total"] <- median(object@coverage.scores, na.rm = T) - cov.scores["Maximum","Total"] <- max(object@coverage.scores, na.rm = T) - cov.scores["sd","Total"] <- sd(object@coverage.scores, na.rm = T) + cov.scores["Minimum","Total"] <- min(object@coverage.scores, na.rm = TRUE) + cov.scores["Mean","Total"] <- mean(object@coverage.scores, na.rm = TRUE) + cov.scores["Median","Total"] <- median(object@coverage.scores, na.rm = TRUE) + cov.scores["Maximum","Total"] <- max(object@coverage.scores, na.rm = TRUE) + cov.scores["sd","Total"] <- sd(object@coverage.scores, na.rm = TRUE) print(cov.scores) } } diff --git a/R/calculate.trackline.segl.R b/R/calculate.trackline.segl.R index 4d47c47..cb5eff2 100644 --- a/R/calculate.trackline.segl.R +++ b/R/calculate.trackline.segl.R @@ -56,10 +56,10 @@ calculate.trackline.segl <- function(transects){ cyclic.track.length <- st_length(cyclictrack.ls) #last.row <- nrow(coord.mat) #track.length+ sqrt(abs(coord.mat[16,1]-coord.mat[1,1])^2+abs(coord.mat[16,2]-coord.mat[1,2])^2) - #plot(cyclictrack.ls, add = T, col = 4) - #plot(track.ls, add = T, col = 4) + #plot(cyclictrack.ls, add = TRUE, col = 4) + #plot(track.ls, add = TRUE, col = 4) #for(i in 1){ - # plot(transects[[i]], add = T, col = 3, lwd = 3) + # plot(transects[[i]], add = TRUE, col = 3, lwd = 3) #} return(list(trackline = track.length, cyclictrackline = cyclic.track.length)) } diff --git a/R/check.design.R b/R/check.design.R index bf40c0c..4673c67 100644 --- a/R/check.design.R +++ b/R/check.design.R @@ -15,7 +15,7 @@ check.design <- function(object){ # Effort allocation values if supplied should sum to 1 and there should # be no missing values and one value per stratum. if(length(object@effort.allocation) > 0){ - if(sum(object@effort.allocation, na.rm = T) != 1){ + if(sum(object@effort.allocation, na.rm = TRUE) != 1){ return("Effort allocation should either be omitted or sum to 1.") } if(any(is.na(object@effort.allocation))){ @@ -30,7 +30,7 @@ check.design <- function(object){ # Only one global truncation distance should be supplied and it must be # numeric and greater than 0. if(length(object@truncation) > 1){ - warning("You have supplied more than one truncation value. Currently the same truncation value must be applied across the entire study region. Using only the first value supplied.", call. = FALSE, immediate. = TRUE) + warning("You have supplied more than one truncation value. Currently the same truncation value must be applied across the entire study region. Using only the first value supplied.", call. = FALSE) object@truncation <- object@truncation[1] }else if(object@truncation <= 0){ return("The truncation distance must be > 0.") diff --git a/R/check.line.design.R b/R/check.line.design.R index 120fe8b..dd65e7b 100644 --- a/R/check.line.design.R +++ b/R/check.line.design.R @@ -47,7 +47,7 @@ check.line.design <- function(object){ 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) + 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.", call. = FALSE) object@seg.length[index.neg] <- NA } @@ -74,7 +74,7 @@ check.line.design <- function(object){ 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) + 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.", call. = FALSE) object@seg.threshold[index.neg] <- NA } } @@ -104,7 +104,7 @@ check.line.design <- function(object){ 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) + warning("Non NA values have been provided for bounding shape in strata where a zigzag design was NOT selected. These vaues will be ignored.", call. = FALSE) object@bounding.shape[index.neg] <- NA } } @@ -182,14 +182,14 @@ check.line.design <- function(object){ 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) + warning("Multiple global effort parameters have been supplied (spacing, line length, samplers). Spacing will be used and the others ignored.", 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) + warning("Both line length and samplers have been provided. The global line length will be used and samplers ignored.", call. = FALSE) samplers <- numeric(0) } }else if(samplers.len == 1){ @@ -216,24 +216,24 @@ check.line.design <- function(object){ 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) + warning(paste("Spacing is not a valid effort argument for the random design in stratum ", i, ", it will be ignored.", sep = ""), 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) + warning("Spacing, samplers and line.length have been supplied for stratum ",i,", samplers and line.length arguments will be ignored.", 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) + warning("Both spacing and samplers have been supplied for stratum ",i,", samplers argument will be ignored.", 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) + warning("Both spacing and line.length have been supplied for stratum ",i,", line.length argument will be ignored.", 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) + warning("Both sampers and line.length have been supplied for stratum ",i,", samplers argument will be ignored.", call. = FALSE) samplers[i] <- NA } } @@ -258,11 +258,11 @@ check.line.design <- function(object){ # 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) + warning("Effort allocation argument redundant as you have supplied stratum specific effort values, it will be ignored.", 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) + warning("Effort allocation argument redundant as there is only one stratum, it will be ignored.", call. = FALSE) object@effort.allocation <- numeric(0) } if(strata.count > 1 && # multiple strata @@ -271,10 +271,10 @@ check.line.design <- function(object){ !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) + 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.", 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) + warning("Effort allocation not applicable when effort is determined by spacing, it will be ignored.", call. = FALSE) object@effort.allocation <- numeric(0) } diff --git a/R/check.point.design.R b/R/check.point.design.R index c40e9d9..d32c135 100644 --- a/R/check.point.design.R +++ b/R/check.point.design.R @@ -81,7 +81,7 @@ check.point.design <- function(object){ global.value <- TRUE spacing <- rep(spacing, strata.count) if(samplers.len > 0){ - warning("Multiple global effort parameters have been supplied (spacing, samplers). Samplers will be ignored.", immediate. = TRUE, call. = FALSE) + warning("Multiple global effort parameters have been supplied (spacing, samplers). Samplers will be ignored.", call. = FALSE) samplers <- numeric(0) } }else if(samplers.len == 1){ @@ -108,14 +108,14 @@ check.point.design <- function(object){ if(is.na(samplers[i])){ return(paste("Spacing is not a valid effort argument for the random design in stratum ", i, ", please supply 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) + warning(paste("Spacing is not a valid effort argument for the random design in stratum ", i, ", it will be ignored.", sep = ""), 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])){ - warning("Both spacing and samplers have been supplied for stratum ",i,", samplers argument will be ignored.", immediate. = TRUE, call. = FALSE) + warning("Both spacing and samplers have been supplied for stratum ",i,", samplers argument will be ignored.", call. = FALSE) samplers[i] <- NA } } @@ -132,15 +132,15 @@ check.point.design <- function(object){ # Check if effort.allocation is redundant if(any(samplers.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) + warning("Effort allocation argument redundant as you have supplied stratum specific effort values, it will be ignored.", 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) + warning("Effort allocation argument redundant as there is only one stratum, it will be ignored.", call. = FALSE) object@effort.allocation <- numeric(0) } 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) + warning("Effort allocation not applicable when effort is determined by spacing, it will be ignored.", call. = FALSE) object@effort.allocation <- numeric(0) } diff --git a/R/check.shape.R b/R/check.shape.R index 79bf958..af531e5 100644 --- a/R/check.shape.R +++ b/R/check.shape.R @@ -27,7 +27,7 @@ check.shape <- function(sf.shape, dist.for.win){ if(any(!compare)){ #Re-order strata new.shape <-sf.shape[index, ] - warning("The LinkID values were not in sequential order in the shapefile attribute table, dssd is reordering the strata to match that which Distance for Windows uses. This is a necessary step if you are running simulations from Distance for Windows. If you are running simulations directly in R and would like to switch this option off please set dist.for.win to FALSE in make.region.", immediate. = TRUE, call. = FALSE) + warning("The LinkID values were not in sequential order in the shapefile attribute table, dssd is reordering the strata to match that which Distance for Windows uses. This is a necessary step if you are running simulations from Distance for Windows. If you are running simulations directly in R and would like to switch this option off please set dist.for.win to FALSE in make.region.", call. = FALSE) return(new.shape) }else{ #If they are in the right order already don't need to do anything diff --git a/R/dssd-package.R b/R/dssd-package.R index 52d1855..df8eb36 100644 --- a/R/dssd-package.R +++ b/R/dssd-package.R @@ -21,8 +21,9 @@ #' @aliases dssd-package dssd #' @author Laura Marshall #' @keywords package -#' "_PACKAGE" #' +"_PACKAGE" + NULL diff --git a/R/generate.eqspace.zigzags.R b/R/generate.eqspace.zigzags.R index 814bb59..8089912 100644 --- a/R/generate.eqspace.zigzags.R +++ b/R/generate.eqspace.zigzags.R @@ -26,7 +26,7 @@ generate.eqspace.zigzags <- function(design, strata.id, samplers, line.length, s if(design@design[strata.id] == "eszigzag"){ if(line.length < width){ if(!quiet){ - warning("Line length in strata ", strata.id, " is not sufficient to carry out an equal spaced zigzag design. No samplers generated for this strata.", immediate. = TRUE, call. = FALSE) + warning("Line length in strata ", strata.id, " is not sufficient to carry out an equal spaced zigzag design. No samplers generated for this strata.", call. = FALSE) } return(NULL) } @@ -34,7 +34,7 @@ generate.eqspace.zigzags <- function(design, strata.id, samplers, line.length, s }else{ if(line.length/2 < width){ if(!quiet){ - warning("Line length in strata ", strata.id, " is not sufficient to carry out a complementary equal spaced zigzag design. No samplers generated for this strata.", immediate. = TRUE, call. = FALSE) + warning("Line length in strata ", strata.id, " is not sufficient to carry out a complementary equal spaced zigzag design. No samplers generated for this strata.", call. = FALSE) } return(NULL) } @@ -50,7 +50,7 @@ generate.eqspace.zigzags <- function(design, strata.id, samplers, line.length, s } if(spacing > (bbox[["xmax"]]-bbox[["xmin"]])){ if(!quiet){ - warning(paste("Spacing larger than x-range cannot generate samplers in strata ", strata.id, sep = ""), immediate. = T, call. = F) + warning(paste("Spacing larger than x-range cannot generate samplers in strata ", strata.id, sep = ""), call. = FALSE) } return(NULL) } @@ -181,7 +181,7 @@ generate.eqspace.zigzags <- function(design, strata.id, samplers, line.length, s areas <- unlist(lapply(polys.tmp[intsec], sf::st_area)) to.rem <- c(to.rem, intsec[which(areas == min(areas))]) #if(min(areas) > sf::st_area(rot.strata)/50000){ - # warning("Removing covered area greater than 50,000th of the strata area.", immediate. = TRUE, call. = FALSE) + # warning("Removing covered area greater than 50,000th of the strata area.", call. = FALSE) #} } } diff --git a/R/generate.parallel.lines.R b/R/generate.parallel.lines.R index 18476e0..24c6a2c 100644 --- a/R/generate.parallel.lines.R +++ b/R/generate.parallel.lines.R @@ -13,7 +13,7 @@ generate.parallel.lines <- function(design, strata.id, samplers, line.length, sp rot.strata <- mat.mult(strata, rot.mat) #Buffer strata for plus sampling? if(design@edge.protocol[strata.id] == "plus"){ - rot.strata <- st_buffer(rot.strata, design@truncation) + rot.strata <- sf::st_buffer(rot.strata, design@truncation) } #Find the minimum and maximum x and y values bbox <- sf::st_bbox(rot.strata) @@ -26,14 +26,14 @@ generate.parallel.lines <- function(design, strata.id, samplers, line.length, sp samplers <- line.length/ave.line.height if(samplers < 1){ if(!quiet){ - warning(paste("Line length is less than the average transect length cannot generate samplers in strata ", strata.id, sep = ""), immediate. = T, call. = F) + warning(paste("Line length is less than the average transect length cannot generate samplers in strata ", strata.id, sep = ""), call. = FALSE) } return(NULL) } }else if(!by.spacing && !is.na(samplers)){ if(samplers < 1){ if(!quiet){ - warning(paste("Number of samplers < 1, cannot allocate samplers in strata ", strata.id, sep = ""), immediate. = T, call. = F) + warning(paste("Number of samplers < 1, cannot allocate samplers in strata ", strata.id, sep = ""), call. = FALSE) } return(NULL) } @@ -46,7 +46,7 @@ generate.parallel.lines <- function(design, strata.id, samplers, line.length, sp if(design@design[strata.id] == "systematic"){ if(spacing > (bbox[["xmax"]]-bbox[["xmin"]])){ if(!quiet){ - warning(paste("Spacing larger than x-range cannot generate samplers in strata ", strata.id, sep = ""), immediate. = T, call. = F) + warning(paste("Spacing larger than x-range cannot generate samplers in strata ", strata.id, sep = ""), call. = FALSE) } return(NULL) } @@ -111,7 +111,7 @@ generate.parallel.lines <- function(design, strata.id, samplers, line.length, sp areas <- unlist(lapply(polys.tmp[intsec], sf::st_area)) to.rem <- c(to.rem, intsec[which(areas == min(areas))]) #if(min(areas) > sf::st_area(rot.strata)/50000){ - # warning("Removing covered area greater than 50,000th of the strata area.", immediate. = TRUE, call. = FALSE) + # warning("Removing covered area greater than 50,000th of the strata area.", call. = FALSE) #} } } diff --git a/R/generate.random.points.R b/R/generate.random.points.R index 1cc60a3..a417fff 100644 --- a/R/generate.random.points.R +++ b/R/generate.random.points.R @@ -2,7 +2,7 @@ generate.random.points <- function(design, strata.id, samplers, calc.cov.area = #Check positive number of samplers if(samplers <= 0){ if(!quiet){ - warning(paste("No samplers allocated to strata ", strata.id, ". Cannot generate samplers.", sep = ""), call. = FALSE, immediate. = TRUE) + warning(paste("No samplers allocated to strata ", strata.id, ". Cannot generate samplers.", sep = ""), call. = FALSE) } return(NULL) } diff --git a/R/generate.segmented.grid.R b/R/generate.segmented.grid.R index c1a9579..631a293 100644 --- a/R/generate.segmented.grid.R +++ b/R/generate.segmented.grid.R @@ -15,7 +15,7 @@ generate.segmented.grid <- function(design, strata.id, samplers, line.length, sp rot.strata <- mat.mult(strata, rot.mat) #Buffer strata for plus sampling? if(design@edge.protocol[strata.id] == "plus"){ - rot.strata <- st_buffer(rot.strata, design@truncation) + rot.strata <- sf::st_buffer(rot.strata, design@truncation) } #Find the minimum and maximum x and y values bbox <- sf::st_bbox(rot.strata) @@ -25,14 +25,14 @@ generate.segmented.grid <- function(design, strata.id, samplers, line.length, sp samplers <- line.length/seg.length if(samplers < 1){ if(!quiet){ - warning(paste("Line length is less than the average transect length cannot generate samplers in strata ", strata.id, sep = ""), immediate. = T, call. = F) + warning(paste("Line length is less than the average transect length cannot generate samplers in strata ", strata.id, sep = ""), call. = FALSE) } return(NULL) } }else if(!by.spacing && !is.na(samplers)){ if(samplers < 1){ if(!quiet){ - warning(paste("Number of samplers < 1, cannot allocate samplers in strata ", strata.id, sep = ""), immediate. = T, call. = F) + warning(paste("Number of samplers < 1, cannot allocate samplers in strata ", strata.id, sep = ""), call. = FALSE) } return(NULL) } @@ -50,13 +50,13 @@ generate.segmented.grid <- function(design, strata.id, samplers, line.length, sp #Check spacings are reasonable if(spacing.x > (bbox[["xmax"]]-bbox[["xmin"]])){ if(!quiet){ - warning(paste("Spacing larger than x-range cannot generate samplers in strata ", strata.id, sep = ""), immediate. = T, call. = F) + warning(paste("Spacing larger than x-range cannot generate samplers in strata ", strata.id, sep = ""), call. = FALSE) } return(NULL) } if(spacing.x > (bbox[["ymax"]]-bbox[["ymin"]])){ if(!quiet){ - warning(paste("Spacing larger than y-range not generating samplers in strata ", strata.id, sep = ""), immediate. = T, call. = F) + warning(paste("Spacing larger than y-range not generating samplers in strata ", strata.id, sep = ""), call. = FALSE) } return(NULL) } @@ -92,7 +92,7 @@ generate.segmented.grid <- function(design, strata.id, samplers, line.length, sp to.keep <- to.keep[is.over.threshold] #Check there are some transects if(length(to.keep) == 0){ - warning(paste("No transects generated in stratum ", strata.id, sep = ""), immediate. = TRUE, call. = FALSE) + warning(paste("No transects generated in stratum ", strata.id, sep = ""), call. = FALSE) return(NULL) } #Calculate covered region - do it here as easier before unrotating! @@ -138,7 +138,7 @@ generate.segmented.grid <- function(design, strata.id, samplers, line.length, sp areas <- unlist(lapply(polys.tmp[intsec], sf::st_area)) to.rem <- c(to.rem, intsec[which(areas == min(areas))]) #if(min(areas) > sf::st_area(rot.strata)/50000){ - # warning("Removing covered area greater than 50,000th of the strata area.", immediate. = TRUE, call. = FALSE) + # warning("Removing covered area greater than 50,000th of the strata area.", call. = FALSE) #} } } diff --git a/R/generate.systematic.points.R b/R/generate.systematic.points.R index 87251ad..8bc4f86 100644 --- a/R/generate.systematic.points.R +++ b/R/generate.systematic.points.R @@ -23,7 +23,7 @@ generate.systematic.points <- function(design, strata.id, spacing, samplers, cov #Check spacing is appropriate if(sspace > (bbox[["xmax"]]-bbox[["xmin"]]) || sspace > (bbox[["ymax"]]-bbox[["ymin"]])){ if(!quiet){ - warning(paste("The spacing allocated to strata ", strata.id, " is larger than either one or both of the x / y dimensions of the region. Cannot generate samplers in this strata.", sep = ""), call. = FALSE, immediate. = TRUE) + warning(paste("The spacing allocated to strata ", strata.id, " is larger than either one or both of the x / y dimensions of the region. Cannot generate samplers in this strata.", sep = ""), call. = FALSE) } return(NULL) }else{ diff --git a/R/run.coverage.R b/R/run.coverage.R index 4021e74..7924c06 100644 --- a/R/run.coverage.R +++ b/R/run.coverage.R @@ -22,13 +22,17 @@ #' @param save.transects a directory where the shapefiles for the #' transects can be saved. The shapefile names will be S1, S2, ... #' existing files in the directory will not be overwritten. +#' @param run.parallel logical option to use multiple processors. +#' @param max.cores integer maximum number of cores to use, if not +#' specified then one less than the number available will be used. #' @param quiet when TRUE no progress counter is displayed. #' @return this function returns the survey design object passed in #' and it will now include the coverage and design statistics. #' @seealso \link{make.design} #' @export #' @importFrom stats median sd -run.coverage <- function(design, reps = 10, save.transects = "", quiet = FALSE){ +run.coverage <- function(design, reps = 10, save.transects = "", run.parallel = FALSE, + max.cores = NA, quiet = FALSE){ #Calculates the coverage scores for the design supplied #Also stores summary statistics #All values are returned within the design object @@ -39,7 +43,7 @@ run.coverage <- function(design, reps = 10, save.transects = "", quiet = FALSE){ } #Check that the coverage grid has a grid! if(length(design@coverage.grid@grid) == 0){ - warning("No coverage grid, generating a default grid with 1000 points.", immediate. = TRUE, call. = FALSE) + warning("No coverage grid, generating a default grid with 1000 points.", call. = FALSE) design@coverage.grid <- make.coverage(region = design@region) } coverage <- design@coverage.grid @@ -58,41 +62,102 @@ run.coverage <- function(design, reps = 10, save.transects = "", quiet = FALSE){ #Store values cov.area <- transect.count <- line.length <- trackline <- cyclictrackline <- matrix(rep(NA, reps*strata.count), ncol = strata.count, dimnames = list(1:reps, strata.names)) total.hits <- rep(0, grid.count) - for(rep in 1:reps){ - #Generate transects + run.single.coverage.rep <- function(rep, design, pts, grid.count, save.transects){ transects <- generate.transects(design, quiet = TRUE) - #if the user wants the transects saved write them to file + if(is.null(transects)){ + return(list(success = FALSE)) + } if(save.transects != ""){ suppressMessages(write.transects(transects, paste(save.transects, "/S", rep, ".shp", sep = ""))) } - if(is.null(transects)){ - warning("No transects generated, coverage run cancelled. Please check your design.", immediate. = T, call. = FALSE) - return(design) - } - #Check coverage hits polys <- transects@cov.area.polys$geometry hits <- lapply(polys, FUN = inout, pts = pts) hits <- matrix(unlist(hits), nrow = grid.count) hits <- apply(hits, FUN = sum, MARGIN = 1) - #Allows the user to switch between coverage assessment methods - #if(method == "inclusion"){ - # hits <- ifelse(hits > 1, 1, hits) - #} - total.hits <- total.hits + hits - #Harvest statistics - #Coverered Area - cov.area[rep,] <- transects@cov.area - #Number of transects - transect.count[rep,] <- transects@samp.count - #Transect Length + out <- list(success = TRUE, + hits = hits, + cov.area = transects@cov.area, + transect.count = transects@samp.count) if(inherits(design, "Line.Transect.Design")){ - line.length[rep,] <- transects@line.length - trackline[rep,] <- transects@trackline - cyclictrackline[rep,] <- transects@cyclictrackline + out$line.length <- transects@line.length + out$trackline <- transects@trackline + out$cyclictrackline <- transects@cyclictrackline } + return(out) + } + + n.cores <- 1 + if(run.parallel){ + available.cores <- parallel::detectCores() + if(is.na(available.cores)){ + warning("Could not detect number of cores. Running coverage in serial mode.", call. = FALSE) + run.parallel <- FALSE + }else{ + if(is.na(max.cores)){ + n.cores <- max(1, available.cores - 1) + }else{ + n.cores <- min(max.cores, available.cores) + } + if(n.cores <= 1){ + warning("Only one core available/requested. Running coverage in serial mode.", call. = FALSE) + run.parallel <- FALSE + } + } + } + + rep.results <- vector("list", reps) + if(run.parallel){ if(!quiet){ - percent.complete <- round((rep/reps)*100, 1) - message("\r ", percent.complete, "% complete \r", appendLF = FALSE) + message("Running coverage in parallel with ", n.cores, " cores; progress bar is disabled.") + } + my.cluster <- parallel::makeCluster(n.cores) + on.exit(parallel::stopCluster(my.cluster), add = TRUE) + parallel::clusterEvalQ(my.cluster, library(dssd)) + worker.state <- list(design = design, + pts = pts, + grid.count = grid.count, + save.transects = save.transects) + parallel::clusterExport(my.cluster, + varlist = c("worker.state", "run.single.coverage.rep", "inout"), + envir = environment()) + worker.fun <- function(i){ + run.single.coverage.rep(rep = i, + design = worker.state$design, + pts = worker.state$pts, + grid.count = worker.state$grid.count, + save.transects = worker.state$save.transects) + } + parallel::clusterExport(my.cluster, varlist = "worker.fun", envir = environment()) + rep.results <- parallel::parLapplyLB(my.cluster, X = as.list(1:reps), fun = worker.fun) + parallel::stopCluster(my.cluster) + on.exit() + }else{ + for(rep in 1:reps){ + rep.results[[rep]] <- run.single.coverage.rep(rep = rep, + design = design, + pts = pts, + grid.count = grid.count, + save.transects = save.transects) + if(!quiet){ + percent.complete <- round((rep/reps)*100, 1) + message("\r ", percent.complete, "% complete \r", appendLF = FALSE) + } + } + } + + for(rep in 1:reps){ + rep.result <- rep.results[[rep]] + if(is.null(rep.result) || !isTRUE(rep.result$success)){ + warning("No transects generated, coverage run cancelled. Please check your design.", call. = FALSE) + return(design) + } + total.hits <- total.hits + rep.result$hits + cov.area[rep,] <- rep.result$cov.area + transect.count[rep,] <- rep.result$transect.count + if(inherits(design, "Line.Transect.Design")){ + line.length[rep,] <- rep.result$line.length + trackline[rep,] <- rep.result$trackline + cyclictrackline[rep,] <- rep.result$cyclictrackline } } #Calculate summary statistics @@ -102,7 +167,7 @@ run.coverage <- function(design, reps = 10, save.transects = "", quiet = FALSE){ sampler.summary[3,1:strata.count] <- apply(transect.count, 2, median) sampler.summary[4,1:strata.count] <- apply(transect.count, 2, max) sampler.summary[5,1:strata.count] <- apply(transect.count, 2, sd) - sampler.totals <- apply(transect.count, 1, FUN = sum, na.rm = T) + sampler.totals <- apply(transect.count, 1, FUN = sum, na.rm = TRUE) sampler.summary[1,(strata.count+1)] <- min(sampler.totals) sampler.summary[2,(strata.count+1)] <- mean(sampler.totals) sampler.summary[3,(strata.count+1)] <- median(sampler.totals) @@ -117,7 +182,7 @@ run.coverage <- function(design, reps = 10, save.transects = "", quiet = FALSE){ cov.area.summary[3,1:strata.count] <- apply(cov.area, 2, median) cov.area.summary[4,1:strata.count] <- apply(cov.area, 2, max) cov.area.summary[5,1:strata.count] <- apply(cov.area, 2, sd) - cov.area.totals <- apply(cov.area, 1, FUN = sum, na.rm = T) + cov.area.totals <- apply(cov.area, 1, FUN = sum, na.rm = TRUE) cov.area.summary[1,(strata.count+1)] <- min(cov.area.totals) cov.area.summary[2,(strata.count+1)] <- mean(cov.area.totals) cov.area.summary[3,(strata.count+1)] <- median(cov.area.totals) @@ -132,7 +197,7 @@ run.coverage <- function(design, reps = 10, save.transects = "", quiet = FALSE){ cov.area.percent[3,1:strata.count] <- (apply(cov.area, 2, median)/areas)*100 cov.area.percent[4,1:strata.count] <- (apply(cov.area, 2, max)/areas)*100 cov.area.percent[5,1:strata.count] <- (apply(cov.area, 2, sd)/areas)*100 - cov.area.totals <- apply(cov.area, 1, FUN = sum, na.rm = T)/sum(areas)*100 + cov.area.totals <- apply(cov.area, 1, FUN = sum, na.rm = TRUE)/sum(areas)*100 cov.area.percent[1,(strata.count+1)] <- min(cov.area.totals) cov.area.percent[2,(strata.count+1)] <- mean(cov.area.totals) cov.area.percent[3,(strata.count+1)] <- median(cov.area.totals) @@ -151,7 +216,7 @@ run.coverage <- function(design, reps = 10, save.transects = "", quiet = FALSE){ line.len.summary[3,1:strata.count] <- apply(line.length, 2, median) line.len.summary[4,1:strata.count] <- apply(line.length, 2, max) line.len.summary[5,1:strata.count] <- apply(line.length, 2, sd) - line.len.totals <- apply(line.length, 1, FUN = sum, na.rm = T) + line.len.totals <- apply(line.length, 1, FUN = sum, na.rm = TRUE) line.len.summary[1,(strata.count+1)] <- min(line.len.totals) line.len.summary[2,(strata.count+1)] <- mean(line.len.totals) line.len.summary[3,(strata.count+1)] <- median(line.len.totals) @@ -166,7 +231,7 @@ run.coverage <- function(design, reps = 10, save.transects = "", quiet = FALSE){ trackline.summary[3,1:strata.count] <- apply(trackline, 2, median) trackline.summary[4,1:strata.count] <- apply(trackline, 2, max) trackline.summary[5,1:strata.count] <- apply(trackline, 2, sd) - trackline.totals <- apply(trackline, 1, FUN = sum, na.rm = T) + trackline.totals <- apply(trackline, 1, FUN = sum, na.rm = TRUE) trackline.summary[1,(strata.count+1)] <- min(trackline.totals) trackline.summary[2,(strata.count+1)] <- mean(trackline.totals) trackline.summary[3,(strata.count+1)] <- median(trackline.totals) @@ -181,7 +246,7 @@ run.coverage <- function(design, reps = 10, save.transects = "", quiet = FALSE){ cyclictrackline.summary[3,1:strata.count] <- apply(cyclictrackline, 2, median) cyclictrackline.summary[4,1:strata.count] <- apply(cyclictrackline, 2, max) cyclictrackline.summary[5,1:strata.count] <- apply(cyclictrackline, 2, sd) - cyclictrackline.totals <- apply(cyclictrackline, 1, FUN = sum, na.rm = T) + cyclictrackline.totals <- apply(cyclictrackline, 1, FUN = sum, na.rm = TRUE) cyclictrackline.summary[1,(strata.count+1)] <- min(cyclictrackline.totals) cyclictrackline.summary[2,(strata.count+1)] <- mean(cyclictrackline.totals) cyclictrackline.summary[3,(strata.count+1)] <- median(cyclictrackline.totals) diff --git a/R/write.transects.R b/R/write.transects.R index 909c967..613ce20 100644 --- a/R/write.transects.R +++ b/R/write.transects.R @@ -81,7 +81,7 @@ write.transects <- function(object, dsn, layer = NULL, dataset.options = character(0), overwrite = FALSE, proj4string = character(0)){ if(length(proj4string) > 0){ if(is.na(sf::st_crs(object@samplers))){ - warning("No coordinate system found for survey transects. A coordinate system is only specified for transects if one was specified for the survey region. Cannot project survey transects.", immediate. = TRUE, call. = FALSE) + warning("No coordinate system found for survey transects. A coordinate system is only specified for transects if one was specified for the survey region. Cannot project survey transects.", call. = FALSE) }else{ object@samplers <- sf::st_transform(object@samplers, proj4string) } diff --git a/man/dssd-package.Rd b/man/dssd-package.Rd index 6aa618f..2fd220a 100644 --- a/man/dssd-package.Rd +++ b/man/dssd-package.Rd @@ -1,5 +1,6 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/dssd-package.R +\docType{package} \name{dssd-package} \alias{dssd-package} \alias{dssd} @@ -22,9 +23,15 @@ Further information on distance sampling methods and example code is available a Also see our website for vignettes / example code at \url{https://distancesampling.org/resources/vignettes.html}. For help with distance sampling and this package, there is a Google Group \url{https://groups.google.com/forum/#!forum/distance-sampling}. +} +\seealso{ +Useful links: +\itemize{ + \item Report bugs at \url{https://github.com/DistanceDevelopment/dssd/issues} +} + } \author{ Laura Marshall } -\keyword{"_PACKAGE"} \keyword{package} diff --git a/man/run.coverage.Rd b/man/run.coverage.Rd index 70b9102..3f6e2b4 100644 --- a/man/run.coverage.Rd +++ b/man/run.coverage.Rd @@ -4,7 +4,14 @@ \alias{run.coverage} \title{run.coverage} \usage{ -run.coverage(design, reps = 10, save.transects = "", quiet = FALSE) +run.coverage( + design, + reps = 10, + save.transects = "", + run.parallel = FALSE, + max.cores = NA, + quiet = FALSE +) } \arguments{ \item{design}{an object which inherits from the Survey.Design @@ -17,6 +24,11 @@ to be carried out.} transects can be saved. The shapefile names will be S1, S2, ... existing files in the directory will not be overwritten.} +\item{run.parallel}{logical option to use multiple processors.} + +\item{max.cores}{integer maximum number of cores to use, if not +specified then one less than the number available will be used.} + \item{quiet}{when TRUE no progress counter is displayed.} } \value{