1
#' @include RcppExports.R raptr-internal.R
2
NULL
3

4
#' Test if Gurobi is installed
5
#'
6
#' This function determines if the Gurobi R package is installed on the
7
#' computer and that it can be used [base::options()].
8
#'
9
#' @param verbose `logical` should messages be printed?
10
#'
11
#' @return `logical` Is it installed and ready to use?
12
#'
13
#' @seealso [base::options()].
14
#'
15
#' @examples
16
#' \dontrun{
17
#' # check if Gurobi is installed
18
#' is.GurobiInstalled()
19
#'
20
#' # print cached status of installation
21
#' options()$GurobiInstalled
22
#' }
23
#'
24
#' @export
25
is.GurobiInstalled <- function(verbose = TRUE) {
26
  # define installation instructions
27 4
  gurobiInstallationInstructions <- paste(
28 4
    "Follow these instructions to download the Gurobi software suite:\n  ",
29 4
    c("Linux" = "http://bit.ly/1ksXUaQ", "Windows" = "http://bit.ly/1MrjXWc",
30 4
      "Darwin" = "http://bit.ly/1N0AlT0")[Sys.info()[["sysname"]]])
31

32 4
  rInstallationInstructions1 <- paste(
33 4
    "Follow these instructions to install the \"gurobi\" R package:\n  ",
34 4
    c("Linux" = "http://bit.ly/1HLCRoE", "Windows" = "http://bit.ly/1MMSZaH",
35 4
      "Darwin" = "http://bit.ly/1Pr2WRG")[Sys.info()[["sysname"]]])
36

37 4
  licenseInstructions <- paste0("The Gurobi R package requires a Gurobi ",
38 4
    "license to work:\n  visit this web-page for an overview: ",
39 4
    "http://bit.ly/1OHEQCm\n  academics can obtain a license at no cost ",
40 4
    "here: http://bit.ly/1iYg3LX")
41

42
  # check if gurobi installed
43 4
  result <- suppressWarnings(system2("gurobi_cl", "-v", stdout = FALSE,
44 4
                                     stderr = FALSE))
45 4
  if (result != 0) {
46 4
    if (verbose) {
47 4
      message("The gorubi software is not installed")
48 4
      message(gurobiInstallationInstructions, "\n\n", licenseInstructions,
49 4
              "\n\n", rInstallationInstructions1)
50
    }
51 4
    options(GurobiInstalled = list(gurobi = FALSE))
52 4
    return(FALSE)
53
  }
54

55
  # check if R packages installed
56 0
  pkgs.installed <- list(gurobi =
57 0
    requireNamespace("gurobi", quietly = TRUE) &&
58 0
    utils::packageVersion("gurobi") >= as.package_version("8.0.0"))
59 0
  if (!pkgs.installed[[1]]) {
60 0
    if (verbose) {
61 0
      message("The gorubi R package (version 8.0.0+) is not installed\n")
62 0
      message(rInstallationInstructions1, "\n")
63
    }
64
  }
65 0
  options(GurobiInstalled = pkgs.installed)
66 0
  if (!pkgs.installed[[1]])
67 0
    return(FALSE)
68 0
  return(TRUE)
69
}
70

71
#' Blank raster
72
#'
73
#' This functions creates a blank raster based on the spatial extent of a
74
#' Spatial object.
75
#'
76
#' @param x [sp::Spatial-class] object.
77
#'
78
#' @param res `numeric` `vector` specifying resolution of the output raster
79
#'   in the x and y dimensions. If `vector` is of length one, then the
80
#'   pixels are assumed to be square.
81
#'
82
#' @examples
83
#' # make SpatialPolygons
84
#' polys <- sim.pus(225L)
85
#'
86
#' # make RasterLayer from SpatialPolygons
87
#' blank.raster(polys, 1)
88
#'
89
#' @rdname blank.raster
90
#'
91
#' @export
92
blank.raster <- function(x, res) {
93 4
  assertthat::assert_that(inherits(x, "Spatial"), is.numeric(res),
94 4
                          all(is.finite(res)), length(res) %in% c(1, 2))
95
  # initialize resolution inputs
96 4
  if (length(res) == 1)
97 4
    res <- c(res, res)
98
  # extract coordinates
99 4
  if ((raster::xmax(x) - raster::xmin(x)) <= res[1]) {
100 0
    xpos <- c(raster::xmin(x), res[1])
101
  } else {
102 4
    xpos <- seq(raster::xmin(x),
103 4
                raster::xmax(x) + (res[1] * (((raster::xmax(x) -
104 4
                  raster::xmin(x)) %% res[1]) != 0)),
105 4
                res[1])
106
  }
107 4
  if ((raster::ymax(x) - raster::ymin(x)) <= res[2]) {
108 0
    ypos <- c(raster::ymin(x), res[2])
109
  } else {
110 4
    ypos <- seq(raster::ymin(x),
111 4
                raster::ymax(x) + (res[2] * (((raster::ymax(x) -
112 4
                  raster::ymin(x)) %% res[2]) != 0)),
113 4
                res[2])
114
  }
115
  # generate raster from sp
116 4
  rast <- raster::raster(xmn = min(xpos), xmx = max(xpos), ymn = min(ypos),
117 4
                         ymx = max(ypos), nrow = length(ypos) - 1,
118 4
                         ncol = length(xpos) - 1)
119 4
  return(raster::setValues(rast, 1))
120
}
121

122
#' PolySet
123
#'
124
#' Object contains PolySet data.
125
#'
126
#' @seealso [PBSmapping::PolySet()].
127
#'
128
#' @name PolySet-class
129
#'
130
#' @aliases PolySet
131
#'
132
#' @exportClass PolySet
133
methods::setClass("PolySet")
134

135
#' RapOpts class
136
#'
137
#' Object is either [RapReliableOpts()] or
138
#' [RapUnreliableOpts()].
139
#'
140
#' @name RapOpts-class
141
#'
142
#' @aliases RapOpts
143
#'
144
#' @exportClass RapOpts
145
methods::setClass("RapOpts",
146
  methods::representation(BLM = "numeric"),
147
  prototype = list(BLM = 0))
148

149
#' SolverOpts class
150
#'
151
#' Object stores parameters used to solve problems.
152
#'
153
#' @name SolverOpts-class
154
#'
155
#' @seealso [GurobiOpts()].
156
#'
157
#' @aliases SolverOpts
158
#'
159
#' @exportClass SolverOpts
160
methods::setClass("SolverOpts")
161

162
#' Sample random points from a RasterLayer
163
#'
164
#' This function generates random points in a [raster::raster()]
165
#' object.
166
#'
167
#' @param mask [raster::raster()] object
168
#'
169
#' @param n `integer` number of points to sample
170
#'
171
#' @param prob `logical` should the raster values be used as weights?
172
#'   Defaults to `FALSE`.
173
#'
174
#' @return [base::matrix()] with x-coordinates, y-coordinates, and
175
#'   cell values.
176
#'
177
#' @seealso This function is similar to `dismo::randomPoints`.
178
#'
179
#' @examples
180
#' # simulate data
181
#' sim_pus <- sim.pus(225L)
182
#' sim_spp <- sim.species(sim_pus, model = "normal", n = 1, res = 0.25)
183
#'
184
#' # generate points
185
#' pts1 <- randomPoints(sim_spp, n = 5)
186
#' pts2 <- randomPoints(sim_spp, n = 5, prob = TRUE)
187
#'
188
#' # plot points
189
#' plot(sim_spp)
190
#' points(pts1, col = "red")
191
#' points(pts2, col = "black")
192
#'
193
#' @export
194
randomPoints <- function(mask, n, prob = FALSE) {
195
  # check that data can be processed in memory
196 4
  stopifnot(raster::canProcessInMemory(mask, n = 3))
197
  # extract cells
198 4
  validPos <- which(is.finite(mask[]))
199 4
  if (length(validPos) < n)
200 0
    stop("argument to n is greater than the number of cells with finite values")
201 4
  if (prob) {
202 4
    randomCells <- sample(validPos, n, prob = mask[validPos], replace = FALSE)
203
  } else {
204 4
    randomCells <- sample(validPos, n, replace = FALSE)
205
  }
206
  # get coordinates of the cell centres
207 4
  return(raster::xyFromCell(mask, randomCells))
208
}

Read our documentation on viewing source code .

Loading