Merge pull request #124 from jfisher-usgs/master

merge with upstream

Author: jfisher-usgs

.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()