Merge pull request #124 from jfisher-usgs/master

merge with upstream

.Rbuildignore

@@ -5,3 +5,4 @@
 ^Makefile$
 ^\.travis\.yml$
 ^appveyor\.yml$
+^vignettes/cache$

.gitignore

@@ -2,3 +2,4 @@
 /.Rhistory
 /*.tar.gz
 /*.zip
+/vignettes/cache/*

DESCRIPTION

@@ -44,6 +44,7 @@ Suggests:
     remotes,
     roxygen2,
     testthat
+SystemRequirements: pandoc - https://pandoc.org/
 License: CC0
 Copyright: This software is in the public domain because it contains materials
     that originally came from the USGS, an agency of the

NEWS.md

@@ -1,5 +1,9 @@
 # inlmisc 0.4.7.9000
 
+- In `FindOptimalSubset` function, add `numIslands` argument, used to specify the number of islands,
+  was previously dependent on the `parallel` argument;
+  change default value of `elitism` argument from 0 to 5-percent of the island population.
+
 - Add *misc/latex-packages.txt* file: contains a list of required LaTeX packages
   that are not included in the default installation of [TinyTeX](https://yihui.name/tinytex/);
   use the `inlmisc:::InstallLatexPackages()` command to install these packages into TinyTeX.

R/AddPoints.R

@@ -130,7 +130,7 @@
 #'           quantile.breaks = TRUE, add = FALSE)
 #'
 #' z <- as.factor(rep(c("dog", "cat", "ant", "pig", "bat"),
-#'                length.out = n))
+#'                    length.out = n))
 #' bg <- GetColors(nlevels(z), scheme = "bright", alpha = 0.8)
 #' AddPoints(x, z = z, bg = bg, add = FALSE)
 #'

R/BuildVignettes.R

@@ -33,12 +33,15 @@ BuildVignettes <- function(dir=getwd(), doc=file.path(dir, "inst/doc"),
                            gs_quality=c("ebook", "printer", "screen", "none"),
                            clean=TRUE, quiet=TRUE) {
 
-  checkmate::assertFileExists(file.path(dir, "DESCRIPTION"))
+  checkmate::assertString(dir)
   checkmate::assertPathForOutput(doc, overwrite=TRUE)
   gs_quality <- match.arg(gs_quality)
   checkmate::assertFlag(clean)
   checkmate::assertFlag(quiet)
 
+  dir <- normalizePath(path.expand(dir), winslash="/", mustWork=FALSE)
+  checkmate::assertFileExists(file.path(dir, "DESCRIPTION"))
+
   tools::buildVignettes(dir=dir, quiet=quiet, clean=clean, tangle=TRUE)
 
   v <- tools::pkgVignettes(dir=dir, output=TRUE, source=TRUE)
@@ -48,7 +51,7 @@ BuildVignettes <- function(dir=getwd(), doc=file.path(dir, "inst/doc"),
   if (v$dir != doc) {
     dir.create(doc, showWarnings=!quiet, recursive=TRUE)
     file.copy(c(v$docs, out), doc, overwrite=TRUE)
-    file.remove(out)
+    if (clean) file.remove(out)
   }
 
   if (gs_quality != "none") {

R/FindOptimalSubset.R

@@ -20,6 +20,8 @@
 #'   Additional arguments to be passed to the fitness function.
 #' @param popSize 'integer' count.
 #'   Population size
+#' @param numIslands 'integer' count.
+#'   Number of islands
 #' @param migrationRate 'numeric' number.
 #'   Proportion of individuals that should migrate between islands.
 #' @param migrationInterval 'integer' count.
@@ -31,6 +33,7 @@
 #'   Probability of mutation in a parent chromosome.
 #' @param elitism 'integer' count.
 #'   Number of chromosomes to survive into the next generation.
+#'   Defaults to 5-percent of the island population.
 #' @param maxiter 'integer' count.
 #'   Maximum number of iterations to run before the GA search is halted.
 #' @param run 'integer' count.
@@ -41,8 +44,7 @@
 #'   See returned \code{solution} component for a suggested value for this arugment.
 #' @param parallel 'logical' flag or 'integer' count.
 #'   Whether to use parallel computing.
-#'   This argument can also be used to specify the number of cores
-#'   (and number of islands) to employ; by default,
+#'   This argument can also be used to specify the number of cores to employ; by default,
 #'   this is the number of physical CPUs/cores.
 #'   The \pkg{parallel} and \pkg{doParallel} packages must be
 #'   installed for parallel computing to work.
@@ -98,8 +100,9 @@
 #' @export
 #'
 #' @examples
-#' # Problem: Choose the 4 smallest numbers from a list of 100 values
-#' # genearated from a standard uniform distribution.
+#' # Problem: Choose the 4 smallest numbers from a list
+#' #          of 100 values genearated from a standard
+#' #          uniform distribution.
 #' k <- 4
 #' n <- 100
 #' seed <- 123
@@ -109,19 +112,19 @@
 #'   -1 * sum(numbers[idxs])
 #' }
 #' \dontrun{
-#' out <- FindOptimalSubset(n, k, Fitness, numbers, elitism = 1,
-#'                          run = 10, monitor = GA::gaislMonitor,
-#'                          seed = seed)
+#' out <- FindOptimalSubset(n, k, Fitness, numbers, run = 10,
+#'                          monitor = GA::gaislMonitor, seed = seed)
 #' plot(out[["ga_output"]])
 #' summary(out[["ga_output"]])
 #' print(out[["solution"]])
 #' print(out[["ga_output"]]@fitnessValue)
 #' }
 #'
 
-FindOptimalSubset <- function(n, k, Fitness, ..., popSize=100,
+FindOptimalSubset <- function(n, k, Fitness, ..., popSize=100, numIslands=4,
                               migrationRate=0.1, migrationInterval=10,
-                              pcrossover=0.8, pmutation=0.1, elitism=0,
+                              pcrossover=0.8, pmutation=0.1,
+                              elitism=max(1, round(popSize/numIslands*0.05)),
                               maxiter=1000, run=maxiter, suggestions=NULL,
                               parallel=TRUE, monitor=NULL, seed=NULL) {
 
@@ -130,11 +133,12 @@ FindOptimalSubset <- function(n, k, Fitness, ..., popSize=100,
   checkmate::assertInt(k, lower=1, upper=n - 1)
   checkmate::assertFunction(Fitness)
   checkmate::assertInt(popSize, lower=1)
+  checkmate::assertInt(numIslands, lower=1)
   checkmate::assertNumber(migrationRate, lower=0, upper=1, finite=TRUE)
   checkmate::assertInt(migrationInterval, lower=1)
   checkmate::assertNumber(pcrossover, lower=0, upper=1, finite=TRUE)
   checkmate::assertNumber(pmutation, lower=0, upper=1, finite=TRUE)
-  checkmate::assertInt(elitism, lower=0, upper=popSize)
+  checkmate::assertInt(elitism, lower=1)
   checkmate::assertInt(maxiter, lower=1)
   checkmate::assertInt(run, lower=1, upper=maxiter)
   checkmate::assertMatrix(suggestions, min.rows=1, min.cols=1, null.ok=TRUE)
@@ -143,12 +147,6 @@ FindOptimalSubset <- function(n, k, Fitness, ..., popSize=100,
   if (is.null(monitor)) monitor <- FALSE
   checkmate::assertInt(seed, null.ok=TRUE)
 
-  # set number of islands
-  if (is.logical(parallel))
-    numIslands <- if (parallel) parallel::detectCores(logical=FALSE) else 4L
-  else
-    numIslands <- parallel
-
   # calculate number of bits in the binary string representing the chromosome
   nBits <- .CountBits(n) * k
 

R/GetRegionOfInterest.R

@@ -54,8 +54,10 @@
 #' r <- sqrt(stats::runif(n, 0.25^2, 0.50^2))
 #' x <- sp::SpatialPoints(cbind(0.5 + r * cos(theta), 0.5 + r * sin(theta)),
 #'                        proj4string = sp::CRS("+init=epsg:32610"))
-#' sp::plot(GetRegionOfInterest(x, alpha = 0.1, width = 0.05), col = "green")
-#' sp::plot(GetRegionOfInterest(x, alpha = 0.1), col = "yellow", add = TRUE)
+#' sp::plot(GetRegionOfInterest(x, alpha = 0.1, width = 0.05),
+#'          col = "green")
+#' sp::plot(GetRegionOfInterest(x, alpha = 0.1),
+#'          col = "yellow", add = TRUE)
 #' sp::plot(x, add = TRUE)
 #' }
 #'

R/Grid2Polygons.R

@@ -123,8 +123,8 @@
 #' m <- m[nrow(m):1, ncol(m):1]
 #' x <- seq(from = 2667405, length.out = ncol(m), by = 10)
 #' y <- seq(from = 6478705, length.out = nrow(m), by = 10)
-#' r <- raster::raster(m, xmn = min(x), xmx = max(x), ymn = min(y), ymx = max(y),
-#'                     crs = "+init=epsg:27200")
+#' r <- raster::raster(m, xmn = min(x), xmx = max(x), ymn = min(y),
+#'                     ymx = max(y), crs = "+init=epsg:27200")
 #' plys <- Grid2Polygons(r, level = TRUE)
 #' cols <- GetColors(length(plys), scheme = "DEM screen")
 #' sp::plot(plys, col = cols, border = "#515151")

R/PlotCrossSection.R

@@ -80,16 +80,20 @@
 #' m <- m[nrow(m):1, ncol(m):1]
 #' x <- seq(from = 2667405, length.out = ncol(m), by = 10)
 #' y <- seq(from = 6478705, length.out = nrow(m), by = 10)
-#' r1 <- raster::raster(m, xmn = min(x), xmx = max(x), ymn = min(y), ymx = max(y),
-#'                      crs = "+init=epsg:27200")
+#' r1 <- raster::raster(m, xmn = min(x), xmx = max(x), ymn = min(y),
+#'                      ymx = max(y), crs = "+init=epsg:27200")
 #' r2 <- min(r1[]) - r1 / 10
 #' r3 <- r1 - r2
 #' rs <- raster::stack(r1, r2, r3)
 #' names(rs) <- c("r1", "r2", "r3")
-#' xy <- rbind(c(2667508, 6479501), c(2667803, 6479214), c(2667508, 6478749))
-#' transect <- sp::SpatialLines(list(sp::Lines(list(sp::Line(xy)), ID = "Transect")),
+#' xy <- rbind(c(2667508, 6479501),
+#'             c(2667803, 6479214),
+#'             c(2667508, 6478749))
+#' transect <- sp::Lines(list(sp::Line(xy)), ID = "Transect")
+#' transect <- sp::SpatialLines(list(transect),
 #'                              proj4string = raster::crs(rs))
-#' xy <- rbind(c(2667705, 6478897), c(2667430, 6479178))
+#' xy <- rbind(c(2667705, 6478897),
+#'             c(2667430, 6479178))
 #' p <- sp::SpatialPoints(xy, proj4string = raster::crs(rs))
 #' d <-  data.frame("label" = c("Peak", "Random"))
 #' features <- sp::SpatialPointsDataFrame(p, d, match.ID = TRUE)
@@ -98,10 +102,13 @@
 #' PlotMap(r1, bg.image = bg.image,
 #'         pal = GetColors(scheme = "DEM screen", alpha = 0.8),
 #'         scale.loc = "top", arrow.loc = "topright",
-#'         contour.lines = list("col" = "#1F1F1FA6"), "useRaster" = TRUE)
+#'         contour.lines = list("col" = "#1F1F1FA6"),
+#'         useRaster = TRUE)
 #' lines(transect)
-#' raster::text(as(transect, "SpatialPoints"), labels = c("A", "BEND", "A'"),
-#'              halo = TRUE, cex = 0.7, pos = c(3, 4, 1), offset = 0.1, font = 4)
+#' raster::text(as(transect, "SpatialPoints"),
+#'              labels = c("A", "BEND", "A'"),
+#'              halo = TRUE, cex = 0.7, pos = c(3, 4, 1),
+#'              offset = 0.1, font = 4)
 #' points(features, pch = 19)
 #' raster::text(features, labels = features@data$label, halo = TRUE,
 #'              cex = 0.7, pos = 4, offset = 0.5, font = 4)
@@ -110,16 +117,18 @@
 #' asp <- 5
 #' unit <- "METERS"
 #' explanation <- "Vertical thickness between layers, in meters."
-#' PlotCrossSection(transect, rs, geo.lays = c("r1", "r2"), val.lays = "r3",
-#'                  ylab = "Elevation", asp = asp, unit = unit,
-#'                  explanation = explanation, features = features,
-#'                  max.feature.dist = 100, bg.col = "#E1E1E1",
-#'                  bend.label = "BEND IN\nSECTION", scale.loc = NULL)
+#' PlotCrossSection(transect, rs, geo.lays = c("r1", "r2"),
+#'                  val.lays = "r3", ylab = "Elevation", asp = asp,
+#'                  unit = unit, explanation = explanation,
+#'                  features = features, max.feature.dist = 100,
+#'                  bg.col = "#E1E1E1", bend.label = "BEND IN\nSECTION",
+#'                  scale.loc = NULL)
 #' AddScaleBar(unit = unit, vert.exag = asp, inset = 0.05)
 #'
-#' val <- PlotCrossSection(transect, rs, geo.lays = c("r1", "r2"), val.lays = "r3",
-#'                         ylab = "Elevation", asp = 5, unit = "METERS",
-#'                         explanation = explanation, file = "Rplots.png")
+#' val <- PlotCrossSection(transect, rs, geo.lays = c("r1", "r2"),
+#'                         val.lays = "r3", ylab = "Elevation", asp = 5,
+#'                         unit = "METERS", explanation = explanation,
+#'                         file = "Rplots.png")
 #' print(val)
 #'
 #' graphics.off()

R/PlotGraph.R

@@ -101,20 +101,22 @@
 #' x <- as.Date("2008-07-12") + 1:n
 #' y <- sample.int(n, replace = TRUE)
 #' PlotGraph(x, y, ylab = paste("Random number in", c("meters", "feet")),
-#'           main = "Main Title", type = "p", pch = 16, scientific = FALSE,
-#'           conversion.factor = 3.28)
+#'           main = "Main Title", type = "p", pch = 16,
+#'           scientific = FALSE, conversion.factor = 3.28)
 #'
 #' y <- data.frame(lapply(1:3, function(i) sample(n, replace = TRUE)))
-#' PlotGraph(x, y, ylab = "Random number", pch = 1, seq.date.by = "days",
-#'           scientific = TRUE)
+#' PlotGraph(x, y, ylab = "Random number", pch = 1,
+#'           seq.date.by = "days", scientific = TRUE)
 #'
-#' y <- sapply(1:3, function(i) sample((1:100) + i * 100, n, replace = TRUE))
+#' y <- sapply(1:3, function(i) {
+#'   sample((1:100) + i * 100, n, replace = TRUE)
+#' })
 #' m <- cbind(as.numeric(x), y)
 #' col <- GetColors(3, scheme = "bright")
-#' PlotGraph(m, xlab = "Number", ylab = "Random number", type = "b", pch = 15:17,
-#'           col = col, pt.cex = 0.9)
-#' legend("topright", LETTERS[1:3], inset = 0.02, col = col, lty = 1, pch = 15:17,
-#'        pt.cex = 0.9, cex = 0.7, bg = "white")
+#' PlotGraph(m, xlab = "Number", ylab = "Random number", type = "b",
+#'           pch = 15:17, col = col, pt.cex = 0.9)
+#' legend("topright", LETTERS[1:3], inset = 0.02, col = col, lty = 1,
+#'        pch = 15:17, pt.cex = 0.9, cex = 0.7, bg = "white")
 #'
 #' d <- data.frame(x = as.Date("2008-07-12") + 1:8 * 1000,
 #'                 y0 = c(NA, NA, 1, 3, 1, 4, 2, pi),

R/PlotMap.R

@@ -151,7 +151,8 @@
 #' r[51:100] <- 2L
 #' r[3:6, 1:5] <- 8L
 #' r <- raster::ratify(r)
-#' rat <- cbind(raster::levels(r)[[1]], land.cover = c("Pine", "Oak", "Meadow"))
+#' rat <- cbind(raster::levels(r)[[1]],
+#'              land.cover = c("Pine", "Oak", "Meadow"))
 #' levels(r) <- rat
 #' PlotMap(r)
 #'
@@ -160,23 +161,26 @@
 #' sp::proj4string(meuse.grid) <- sp::CRS("+init=epsg:28992")
 #' sp::gridded(meuse.grid) <- TRUE
 #' meuse.grid <- raster::raster(meuse.grid, layer = "soil")
-#' model <- gstat::gstat(id = "zinc", formula = zinc~1, locations = ~x+y, data = meuse)
+#' model <- gstat::gstat(id = "zinc", formula = zinc~1,
+#'                       locations = ~x+y, data = meuse)
 #' r <- raster::interpolate(meuse.grid, model)
 #' r <- raster::mask(r, meuse.grid)
 #' Pal <- function(n) GetColors(n, stops=c(0.3, 0.9))
 #' breaks <- seq(0, 2000, by = 200)
 #' credit <- paste("Data collected in a flood plain of the river Meuse,",
 #'                 "near the village of Stein (Netherlands),",
-#'                 "\nand iterpolated on a grid with 40-meter by 40-meter spacing",
+#'                 "\nand iterpolated on a grid with 40m by 40m spacing",
 #'                 "using inverse distance weighting.")
-#' PlotMap(r, breaks = breaks, pal = Pal, dms.tick = TRUE, bg.lines = TRUE,
-#'         contour.lines = list("col" = "#1F1F1F"), credit = credit,
-#'         draw.key = FALSE, simplify = 0)
-#' AddScaleBar(unit = c("KILOMETER", "MILES"), conv.fact = c(0.001, 0.000621371),
+#' PlotMap(r, breaks = breaks, pal = Pal, dms.tick = TRUE,
+#'         bg.lines = TRUE, contour.lines = list("col" = "#1F1F1F"),
+#'         credit = credit, draw.key = FALSE, simplify = 0)
+#' AddScaleBar(unit = c("KILOMETER", "MILES"),
+#'             conv.fact = c(0.001, 0.000621371),
 #'             loc = "bottomright", inset = c(0.1, 0.05))
 #' AddGradientLegend(breaks, Pal, at = breaks,
-#'                   title = "Topsoil zinc\nconcentration\n(ppm)", loc = "topleft",
-#'                   inset = c(0.05, 0.1), strip.dim = c(2, 20))
+#'                   title = "Topsoil zinc\nconcentration\n(ppm)",
+#'                   loc = "topleft", inset = c(0.05, 0.1),
+#'                   strip.dim = c(2, 20))
 #'
 #' m <- datasets::volcano
 #' m <- m[nrow(m):1, ncol(m):1]

R/PrintFigure.R

@@ -71,11 +71,11 @@
 #'     "PrintFigure(fig, 3, 2, 'id', title='Caption', headings=headings)",
 #'     "@",
 #'     "\\end{document}",
-#'     file = "figure-example.Rnw", sep = "\n")
-#' knitr::knit2pdf("figure-example.Rnw", clean = TRUE)  # requires LaTeX
-#' system("open figure-example.pdf")
+#'     file = "test-figure.Rnw", sep = "\n")
+#' knitr::knit2pdf("test-figure.Rnw", clean = TRUE)  # requires LaTeX
+#' system("open test-figure.pdf")
 #'
-#' unlink(c("figure-example.*", "figure"), recursive = TRUE)
+#' unlink(c("test-figure.*", "figure"), recursive = TRUE)
 #' }
 #'
 

R/PrintPackageHelp.R

@@ -41,15 +41,14 @@
 #'     "    toc: true",
 #'     "    toc_float: true",
 #'     "---",
-#'     sep = "\n", file = "help-example.Rmd")
-#' PrintPackageHelp("inlmisc", file = "help-example.Rmd",
-#'                  toc = TRUE, title_to_name = TRUE,
-#'                  notrun = FALSE)
-#' rmarkdown::render("help-example.Rmd")
-#' url <- file.path("file:/", getwd(), "help-example.html")
+#'     sep = "\n", file = "test-help.Rmd")
+#' PrintPackageHelp("inlmisc", file = "test-help.Rmd", toc = TRUE,
+#'                  title_to_name = TRUE, notrun = FALSE)
+#' rmarkdown::render("test-help.Rmd")
+#' url <- file.path("file:/", getwd(), "test-help.html")
 #' utils::browseURL(url)
 #'
-#' file.remove("help-example.Rmd", "help-example.html")
+#' file.remove("test-help.Rmd", "test-help.html")
 #' }
 #'