prioritizr / prioritizr
Showing 19 of 348 files from the diff.
Other files ignored by Codecov
Makefile has changed.
docs/index.html has changed.
docs/404.html has changed.
docs/authors.html has changed.
docs/pkgdown.yml has changed.
.Rbuildignore has changed.
README.md has changed.
NEWS.md has changed.
DESCRIPTION has changed.
cran-comments.md has changed.

@@ -3,33 +3,28 @@
Loading
3 3
4 4
#' Simulate data
5 5
#'
6 -
#' Simulate spatially auto-correlated data.
6 +
#' Simulate spatially auto-correlated data using Gaussian random fields.
7 7
#'
8 -
#' @details
9 -
#' Data are simulated based on a Gaussian random field.
10 -
#'
11 -
#' @param x [`RasterLayer-class`] object to use as
12 -
#'    a template.
8 +
#' @param x [raster::raster()] raster object to use as a template.
13 9
#'
14 10
#' @param n `integer` number of layers to simulate.
15 11
#'   Defaults to 1.
16 12
#'
13 +
#' @param scale `numeric` parameter to control level of spatial
14 +
#'   auto-correlation.
15 +
#'   Defaults to 0.5.
16 +
#'
17 17
#' @param intensity `numeric` average value of simulated data.
18 18
#'   Defaults to 0.
19 19
#'
20 20
#' @param sd `numeric` standard deviation of simulated data.
21 21
#'   Defaults to 1.
22 22
#'
23 -
#' @param scale `numeric` strength of spatial auto-correlation.
24 -
#'   Defaults to 0.5.
25 -
#'
26 -
#' @param transform `function` transformation function.
27 -
#'   Defaults to [identity()], such that values remain unchanged follow
28 -
#    transformation.
29 -
#'
30 -
#' @return [`RasterStack-class`] object.
23 +
#' @param transform `function` transform values output from the simulation.
24 +
#'   Defaults to the [identity()] function such that values remain the same
25 +
#'   following transformation.
31 26
#'
32 -
#' @seealso [simulate_cost()], [simulate_species()].
27 +
#' @return [raster::stack()] object.
33 28
#'
34 29
#' @examples
35 30
#' \dontrun{
@@ -38,48 +33,52 @@
Loading
38 33
#' values(r) <- 1
39 34
#'
40 35
#' # simulate data using a Gaussian field
41 -
#' d <- simulate_data(r, n = 1)
36 +
#' x <- simulate_data(r, n = 1, scale = 0.2)
42 37
#'
43 38
#' # plot simulated data
44 -
#' plot(d, main = "simulated data")
39 +
#' plot(x, main = "simulated data")
45 40
#' }
46 41
#' @export
47 -
simulate_data <- function(x, n = 1, intensity = 0, sd = 1, scale = 0.5,
42 +
simulate_data <- function(x, n = 1, scale = 0.5, intensity = 0, sd = 1,
48 43
                          transform = identity) {
49 44
  # assert valid arguments
50 45
  assertthat::assert_that(
51 -
    inherits(x, "RasterLayer"),
52 -
    is.finite(raster::cellStats(x, "max", na.rm = TRUE)),
46 +
    inherits(x, "Raster"),
53 47
    assertthat::is.number(n),
54 -
    assertthat::noNA(n),
55 -
    assertthat::is.number(intensity),
56 -
    assertthat::noNA(intensity),
48 +
    is.finite(raster::cellStats(x, "max")[[1]]),
57 49
    assertthat::is.number(scale),
58 50
    assertthat::noNA(scale),
59 -
    inherits(transform, "function")
60 -
  )
61 -
  # generate values for rasters
62 -
  coords <- methods::as(x, "SpatialPoints")@coords
63 -
  # main processing
64 -
  mu <- rep(intensity, nrow(coords))
65 -
  p <- nrow(coords)
66 -
  chol_d <- chol(exp(-scale * as.matrix(stats::dist(coords))))
67 -
  mtx <- t(
68 -
    matrix(stats::rnorm(n = n * p, sd = sd), ncol = p) %*%
69 -
    chol_d + rep(mu, rep(n, p))
51 +
    assertthat::is.number(intensity),
52 +
    assertthat::noNA(intensity),
53 +
    assertthat::is.number(sd),
54 +
    assertthat::noNA(sd),
55 +
    is.function(transform),
56 +
    requireNamespace("fields", quietly = TRUE))
57 +
58 +
  # create object for simulation
59 +
  obj <- fields::circulantEmbeddingSetup(
60 +
    grid = list(
61 +
      x = seq(0, 5, length.out = raster::nrow(x)),
62 +
      y = seq(0, 5, length.out = raster::ncol(x))
63 +
    ),
64 +
    Covariance = "Exponential",
65 +
    aRange = scale
70 66
  )
71 -
  # ensure matrix output
72 -
  if (!is.matrix(mtx)) {
73 -
    mtx <- matrix(mtx, ncol = 1)
74 -
  }
67 +
75 68
  # generate populate rasters with values
76 -
  stk <- raster::stack(lapply(seq_len(ncol(mtx)), function(i) {
77 -
    r <- x[[1]]
78 -
    r[raster::Which(!is.na(r))] <- transform(mtx[, i])
69 +
  r <- raster::stack(lapply(seq_len(n), function(i) {
70 +
    ## populate with simulated values
71 +
    v <- c(t(fields::circulantEmbedding(obj)))
72 +
    v <- transform(v + stats::rnorm(length(v), mean = intensity, sd = sd))
73 +
    r <- raster::setValues(x[[1]], v[seq_len(raster::ncell(x))])
74 +
    ## apply mask for consistency
75 +
    r <- raster::mask(r, x[[1]])
76 +
    ## return result
79 77
    r
80 78
  }))
81 -
  # return raster stack with simulated data
82 -
  stk
79 +
80 +
  # return result
81 +
  r
83 82
}
84 83
85 84
#' Simulate species habitat suitability data
@@ -122,7 +121,7 @@
Loading
122 121
#' Simulate cost data
123 122
#'
124 123
#' Generates simulated cost data using Gaussian random fields.
125 -
#' Specifically, t returns spatially auto-correlated data with integer values.
124 +
#' Specifically, it returns spatially auto-correlated data with integer values.
126 125
#'
127 126
#' @inheritParams simulate_data
128 127
#'
@@ -130,10 +129,10 @@
Loading
130 129
#'   Defaults to 100.
131 130
#'
132 131
#' @param sd `numeric` standard deviation of simulated data.
133 -
#'   Defaults to 60.
132 +
#'   Defaults to 20.
134 133
#'
135 134
#' @param scale `numeric` strength of spatial auto-correlation.
136 -
#'   Defaults to 60.
135 +
#'   Defaults to 2.5.
137 136
#'
138 137
#' @return [`RasterStack-class`] object.
139 138
#'
@@ -153,7 +152,7 @@
Loading
153 152
#' }
154 153
#'
155 154
#' @export
156 -
simulate_cost <- function(x, n = 1, intensity = 100, sd = 60, scale = 60) {
155 +
simulate_cost <- function(x, n = 1, intensity = 100, sd = 20, scale = 2.5) {
157 156
  simulate_data(
158 157
    x,
159 158
    n = n,

@@ -19,7 +19,7 @@
Loading
19 19
  const bool is_sum = fun == "sum";
20 20
21 21
  // verify that fun is valid
22 -
  if ((fun != "sum") & (fun != "mean"))
22 +
  if ((fun != "sum") && (fun != "mean"))
23 23
    Rcpp::stop("argument to fun must be mean or sum");
24 24
25 25
  // main processing

@@ -292,7 +292,7 @@
Loading
292 292
      assertthat::noNA(c(data)),
293 293
      number_of_total_units(x) == nrow(data),
294 294
      number_of_zones(x) == ncol(data))
295 -
    add_linear_constraints(x, threshold, sense, methods::as(data, "dgCMatrix"))
295 +
    add_linear_constraints(x, threshold, sense, as_Matrix(data, "dgCMatrix"))
296 296
})
297 297
298 298
#' @name add_linear_constraints
@@ -310,7 +310,7 @@
Loading
310 310
      assertthat::noNA(c(data)),
311 311
      number_of_total_units(x) == nrow(data),
312 312
      number_of_zones(x) == ncol(data))
313 -
    add_linear_constraints(x, threshold, sense, methods::as(data, "dgCMatrix"))
313 +
    add_linear_constraints(x, threshold, sense, as_Matrix(data, "dgCMatrix"))
314 314
})
315 315
316 316
#' @name add_linear_constraints
@@ -339,7 +339,7 @@
Loading
339 339
    }
340 340
    d[is.na(d)] <- 0
341 341
    # add constraints
342 -
    add_linear_constraints(x, threshold, sense, methods::as(d, "dgCMatrix"))
342 +
    add_linear_constraints(x, threshold, sense, as_Matrix(d, "dgCMatrix"))
343 343
})
344 344
345 345
#' @name add_linear_constraints

@@ -156,7 +156,7 @@
Loading
156 156
methods::setMethod("eval_connectivity_summary",
157 157
  methods::signature("ConservationProblem", "ANY", "ANY", "matrix"),
158 158
  function(x, solution, zones, data) {
159 -
     eval_connectivity_summary(x, solution, zones, methods::as(data, "dgCMatrix"))
159 +
     eval_connectivity_summary(x, solution, zones, as_Matrix(data, "dgCMatrix"))
160 160
})
161 161
162 162
#' @name eval_connectivity_summary
@@ -165,7 +165,7 @@
Loading
165 165
methods::setMethod("eval_connectivity_summary",
166 166
  methods::signature("ConservationProblem", "ANY", "ANY", "Matrix"),
167 167
  function(x, solution, zones, data) {
168 -
     eval_connectivity_summary(x, solution, zones, methods::as(data, "dgCMatrix"))
168 +
     eval_connectivity_summary(x, solution, zones, as_Matrix(data, "dgCMatrix"))
169 169
})
170 170
171 171
#' @name eval_connectivity_summary
@@ -245,7 +245,7 @@
Loading
245 245
      m[[z1]] <- list()
246 246
      for (z2 in seq_len(dim(data)[4])) {
247 247
        m[[z1]][[z2]] <-
248 -
          methods::as(data[indices, indices, z1, z2], "dgCMatrix")
248 +
          as_Matrix(data[indices, indices, z1, z2], "dgCMatrix")
249 249
      }
250 250
    }
251 251
    # calculate connectivity
@@ -274,7 +274,7 @@
Loading
274 274
    zv <- vapply(seq_len(ncol(solution)), FUN.VALUE = numeric(1), function(z) {
275 275
      ## prepare data the z'th zone
276 276
      if (is.null(data)) {
277 -
        zd <- methods::as(zone_scaled_data[[z]][[z]], "dgCMatrix")
277 +
        zd <- as_Matrix(zone_scaled_data[[z]][[z]], "dgCMatrix")
278 278
      } else {
279 279
        zd <- data
280 280
      }

@@ -14,16 +14,7 @@
Loading
14 14
#'   [`Raster-class`] object then it must have only one
15 15
#'   layer.
16 16
#'
17 -
#' @param str_tree `logical` should a GEOS STRtree structure be used to
18 -
#'   to pre-process data? If `TRUE`, then the experimental
19 -
#'   [rgeos::gUnarySTRtreeQuery()] function
20 -
#'   will be used to pre-compute which planning units are adjacent to
21 -
#'   each other and potentially reduce the processing time required to
22 -
#'   generate the boundary matrices. This argument is only used when
23 -
#'   the planning unit data are vector-based polygons (i.e.,
24 -
#'   [sp::SpatialPolygonsDataFrame()] objects). **Note that
25 -
#'   using `TRUE` may crash Mac OSX systems.** The default argument
26 -
#'   is `FALSE`.
17 +
#' @param ... not used.
27 18
#'
28 19
#' @details This function returns a [`dsCMatrix-class`]
29 20
#'   symmetric sparse matrix. Cells on the off-diagonal indicate the length of
@@ -32,13 +23,24 @@
Loading
32 23
#'   neighbors (e.g., for edges of planning units found along the
33 24
#'   coastline). **This function assumes the data are in a coordinate
34 25
#'   system where Euclidean distances accurately describe the proximity
35 -
#'   between two points on the earth**. Thus spatial data in a longitude/latitude
36 -
#'   coordinate system (i.e.,
26 +
#'   between two points on the earth**. Thus spatial data in a
27 +
#'   longitude/latitude coordinate system (i.e.,
37 28
#'   [WGS84](https://spatialreference.org/ref/epsg/wgs-84/))
38 29
#'   should be reprojected to another coordinate system before using this
39 30
#'   function. Note that for [`Raster-class`] objects
40 31
#'   boundaries are missing for cells that have `NA` values in all cells.
41 32
#'
33 +
#' @section Notes:
34 +
#' In earlier versions, this function had an extra `str_tree` parameter
35 +
#' that could be used to leverage STR query trees to speed up processing
36 +
#' for planning units in vector format.
37 +
#' Although this functionality improved performance, it was not
38 +
#' enabled by default because the underlying function
39 +
#' (i.e., `rgeos:gUnarySTRtreeQuery()`) was documented as experimental.
40 +
#' The `boundary_matrix()` function has since been updated so that it will
41 +
#' use STR query trees to speed up processing for planning units in vector
42 +
#' format (using [geos::geos_strtree()]).
43 +
#'
42 44
#' @return [`dsCMatrix-class`] symmetric sparse matrix object.
43 45
#'   Each row and column represents a planning unit.
44 46
#'   Cells values indicate the shared boundary length between different pairs
@@ -66,10 +68,6 @@
Loading
66 68
#' # create boundary matrix using polygon (sf) data
67 69
#' bm_ply2 <- boundary_matrix(ply2)
68 70
#'
69 -
#' # create boundary matrix with polygon (Spatial) data and GEOS STR query trees
70 -
#' # to speed up processing
71 -
#' bm_ply3 <- boundary_matrix(ply, TRUE)
72 -
#'
73 71
#' # plot raster and boundary matrix
74 72
#' \dontrun{
75 73
#' par(mfrow = c(1, 2))
@@ -86,20 +84,16 @@
Loading
86 84
#' plot(r, main = "polygons (sf)", axes = FALSE, box = FALSE)
87 85
#' plot(raster(as.matrix(bm_ply2)), main = "boundary matrix", axes = FALSE,
88 86
#'      box = FALSE)
89 -
#' plot(raster(as.matrix(bm_ply3)), main = "boundary matrix (Spatial, STR)",
90 -
#'             axes = FALSE, box = FALSE)
91 87
#' }
92 88
#' @export
93 -
boundary_matrix <- function(x, str_tree) UseMethod("boundary_matrix")
89 +
boundary_matrix <- function(x, ...) UseMethod("boundary_matrix")
94 90
95 91
#' @rdname boundary_matrix
96 92
#' @method boundary_matrix Raster
97 93
#' @export
98 -
boundary_matrix.Raster <- function(x, str_tree = FALSE) {
94 +
boundary_matrix.Raster <- function(x, ...) {
99 95
  # assert that arguments are valid
100 -
  assertthat::assert_that(inherits(x, "Raster"),
101 -
                          assertthat::is.flag(str_tree),
102 -
                          !str_tree)
96 +
  assertthat::assert_that(inherits(x, "Raster"))
103 97
  if (raster::nlayers(x) == 1) {
104 98
    # indices of cells with finite values
105 99
    include <- raster::Which(is.finite(x), cells = TRUE)
@@ -123,50 +117,33 @@
Loading
123 117
  names(b) <- c("id1", "id2", "boundary")
124 118
  b$id1 <- as.integer(b$id1)
125 119
  b$id2 <- as.integer(b$id2)
126 -
  b <- b[(b$id1 %in% include) & (b$id2 %in% include), ]
120 +
  b <- b[(b$id1 %in% include) & (b$id2 %in% include), , drop = FALSE]
127 121
  # coerce to sparse matrix object
128 -
  m <- Matrix::forceSymmetric(Matrix::sparseMatrix(i = b[[1]], j = b[[2]],
129 -
                                                   x = b[[3]],
130 -
                                                   dims = rep(raster::ncell(x),
131 -
                                                              2)))
122 +
  m <- Matrix::forceSymmetric(
123 +
    Matrix::sparseMatrix(i = b[[1]], j = b[[2]], x = b[[3]],
124 +
                         dims = rep(raster::ncell(x), 2)))
132 125
  # if cells don't have four neighbors then set the diagonal to be the total
133 126
  # perimeter of the cell minus the boundaries of its neighbors
134 -
  Matrix::diag(m)[include] <- (sum(raster::res(x)) * 2) -
135 -
                              Matrix::colSums(m)[include]
127 +
  Matrix::diag(m)[include] <-
128 +
    (sum(raster::res(x)) * 2) - Matrix::colSums(m)[include]
136 129
  # return matrix
137 -
  methods::as(m, "dsCMatrix")
130 +
  as_Matrix(m, "dsCMatrix")
138 131
}
139 132
140 133
#' @rdname boundary_matrix
141 134
#' @method boundary_matrix SpatialPolygons
142 135
#' @export
143 -
boundary_matrix.SpatialPolygons <- function(x, str_tree = FALSE) {
136 +
boundary_matrix.SpatialPolygons <- function(x, ...) {
144 137
  # assert that arguments are valid
145 -
  assertthat::assert_that(inherits(x, "SpatialPolygons"),
146 -
                          assertthat::is.flag(str_tree))
147 -
  # pre-process str tree if needed
148 -
  strm <- Matrix::sparseMatrix(i = 1, j = 1, x = 1)
149 -
  if (str_tree) {
150 -
    strm <- rcpp_str_tree_to_sparse_matrix(rgeos::gUnarySTRtreeQuery(x))
151 -
    strm <- do.call(Matrix::sparseMatrix, strm)
152 -
    strm <- Matrix::forceSymmetric(strm, uplo = "U")
153 -
  }
154 -
  # calculate boundary data
155 -
  y <- rcpp_boundary_data(rcpp_sp_to_polyset(x@polygons, "Polygons"),
156 -
                          strm, str_tree)$data
157 -
  # show warnings generated if any
158 -
  if (length(y$warnings) > 0) {
159 -
    vapply(y$warnings, warning, character(1)) # nocov
160 -
  }
161 -
  # return result
162 -
  Matrix::sparseMatrix(i = y[[1]], j = y[[2]], x = y[[3]],
163 -
                       symmetric = TRUE, dims = rep(length(x), 2))
138 +
  assertthat::assert_that(inherits(x, "SpatialPolygons"))
139 +
  # convert to sf format for processing
140 +
  boundary_matrix.sf(sf::st_as_sf(x))
164 141
}
165 142
166 143
#' @rdname boundary_matrix
167 144
#' @method boundary_matrix SpatialLines
168 145
#' @export
169 -
boundary_matrix.SpatialLines <- function(x, str_tree = FALSE) {
146 +
boundary_matrix.SpatialLines <- function(x, ...) {
170 147
  assertthat::assert_that(inherits(x, "SpatialLines"))
171 148
  stop("data represented by lines have no boundaries - ",
172 149
    "see ?constraints for alternative constraints")
@@ -175,7 +152,7 @@
Loading
175 152
#' @rdname boundary_matrix
176 153
#' @method boundary_matrix SpatialPoints
177 154
#' @export
178 -
boundary_matrix.SpatialPoints <- function(x, str_tree = FALSE) {
155 +
boundary_matrix.SpatialPoints <- function(x, ...) {
179 156
  assertthat::assert_that(inherits(x, "SpatialPoints"))
180 157
  stop("data represented by points have no boundaries - ",
181 158
    "see ?constraints alternative constraints")
@@ -184,7 +161,8 @@
Loading
184 161
#' @rdname boundary_matrix
185 162
#' @method boundary_matrix sf
186 163
#' @export
187 -
boundary_matrix.sf <- function(x, str_tree = FALSE) {
164 +
boundary_matrix.sf <- function(x, ...) {
165 +
  # assert valid arguments
188 166
  assertthat::assert_that(inherits(x, "sf"))
189 167
  geomc <- geometry_classes(x)
190 168
  if (any(grepl("POINT", geomc, fixed = TRUE)))
@@ -195,13 +173,37 @@
Loading
195 173
      "see ?constraints alternative constraints")
196 174
  if (any(grepl("GEOMETRYCOLLECTION", geomc, fixed = TRUE)))
197 175
    stop("geometry collection data are not supported")
198 -
  boundary_matrix(sf::as_Spatial(sf::st_set_crs(x, sf::st_crs(NA_character_))),
199 -
                  str_tree = str_tree)
176 +
  # generate STR query tree
177 +
  g <- geos::as_geos_geometry(x)
178 +
  tree <- geos::geos_basic_strtree(g)
179 +
  strm <- geos::geos_basic_strtree_query(tree, g)
180 +
  geos::geos_basic_strtree_finalized(tree)
181 +
  rm(g, tree)
182 +
  # convert to matrix
183 +
  strm <- Matrix::sparseMatrix(
184 +
    i = strm$tree, j = strm$x, x = 1, dims = rep(nrow(x), 2)
185 +
  )
186 +
  strm <- Matrix::forceSymmetric(strm, uplo = "U")
187 +
  # calculate boundary data
188 +
  y <- rcpp_boundary_data(
189 +
    rcpp_sp_to_polyset(sf::as_Spatial(x)@polygons, "Polygons"),
190 +
    strm = strm,
191 +
    str_tree = TRUE
192 +
  )
193 +
  # if any warnings generated, then throw them
194 +
  if (length(y$warnings) > 0) {
195 +
    vapply(y$warnings, warning, character(1)) # nocov
196 +
  }
197 +
  # return result
198 +
  Matrix::sparseMatrix(
199 +
    i = y$data[[1]], j = y$data[[2]], x = y$data[[3]],
200 +
    symmetric = TRUE, dims = rep(nrow(x), 2)
201 +
  )
200 202
}
201 203
202 204
#' @rdname boundary_matrix
203 205
#' @method boundary_matrix default
204 206
#' @export
205 -
boundary_matrix.default <- function(x, str_tree = FALSE) {
206 -
  stop("data are not stored in a spatial format")
207 +
boundary_matrix.default <- function(x, ...) {
208 +
  stop("data must be in a spatial format to generate a boundary matrix")
207 209
}

@@ -168,7 +168,7 @@
Loading
168 168
                                 dims = c(nrow(y), nrow(x)))
169 169
    # exclude units from being intersecting if they only touch
170 170
    int1[int2 > 0.5] <- 0
171 -
    int1 <- methods::as(Matrix::drop0(int1), "dgTMatrix")
171 +
    int1 <- as_Matrix(Matrix::drop0(int1), "dgTMatrix")
172 172
    int1@j + 1
173 173
  }
174 174
)
@@ -186,7 +186,7 @@
Loading
186 186
      isTRUE(raster::nlayers(x) == 1),
187 187
      sf::st_crs(x@crs) == sf::st_crs(y),
188 188
      intersecting_extents(x, y))
189 -
    intersecting_units(x = x,  y = fasterize::fasterize(y, x, field = NULL))
189 +
    intersecting_units(x = x, y = fasterize::fasterize(y, x, field = NULL))
190 190
  }
191 191
)
192 192

@@ -90,7 +90,7 @@
Loading
90 90
#' require(Matrix)
91 91
#'
92 92
#' # load data
93 -
#' data(sim_pu_polygons, sim_pu_zones_stack, sim_features, sim_features_zones)
93 +
#' data(sim_pu_sf, sim_pu_zones_stack, sim_features, sim_features_zones)
94 94
#'
95 95
#' # define function to rescale values between zero and one so that we
96 96
#' # can compare solutions from different connectivity matrices
@@ -99,7 +99,7 @@
Loading
99 99
#' }
100 100
#'
101 101
#' # create basic problem
102 -
#' p1 <- problem(sim_pu_polygons, sim_features, "cost") %>%
102 +
#' p1 <- problem(sim_pu_sf, sim_features, "cost") %>%
103 103
#'       add_min_set_objective() %>%
104 104
#'       add_relative_targets(0.2) %>%
105 105
#'       add_default_solver(verbose = FALSE)
@@ -108,21 +108,21 @@
Loading
108 108
#' # adjacent planning units and, due to rivers flowing southwards
109 109
#' # through the study area, connectivity from northern planning units to
110 110
#' # southern planning units is ten times stronger than the reverse.
111 -
#' acm1 <- matrix(0, length(sim_pu_polygons), length(sim_pu_polygons))
111 +
#' acm1 <- matrix(0, nrow(sim_pu_sf), nrow(sim_pu_sf))
112 112
#' acm1 <- as(acm1, "Matrix")
113 -
#' centroids <- rgeos::gCentroid(sim_pu_polygons, byid = TRUE)
114 -
#' adjacent_units <- rgeos::gIntersects(sim_pu_polygons, byid = TRUE)
115 -
#' for (i in seq_len(length(sim_pu_polygons))) {
116 -
#'   for (j in seq_len(length(sim_pu_polygons))) {
113 +
#' centroids <- sf::st_coordinates(suppressWarnings(sf::st_centroid(sim_pu_sf)))
114 +
#' adjacent_units <- sf::st_intersects(sim_pu_sf, sparse = FALSE)
115 +
#' for (i in seq_len(nrow(sim_pu_sf))) {
116 +
#'   for (j in seq_len(nrow(sim_pu_sf))) {
117 117
#'     # find if planning units are adjacent
118 118
#'     if (adjacent_units[i, j]) {
119 119
#'       # find if planning units lay north and south of each other
120 120
#'       # i.e., they have the same x-coordinate
121 -
#'       if (centroids@coords[i, 1] == centroids@coords[j, 1]) {
122 -
#'         if (centroids@coords[i, 2] > centroids@coords[j, 2]) {
121 +
#'       if (centroids[i, 1] == centroids[j, 1]) {
122 +
#'         if (centroids[i, 2] > centroids[j, 2]) {
123 123
#'           # if i is north of j add 10 units of connectivity
124 124
#'           acm1[i, j] <- acm1[i, j] + 10
125 -
#'         } else if (centroids@coords[i, 2] < centroids@coords[j, 2]) {
125 +
#'         } else if (centroids[i, 2] < centroids[j, 2]) {
126 126
#'           # if i is south of j add 1 unit of connectivity
127 127
#'           acm1[i, j] <- acm1[i, j] + 1
128 128
#'         }
@@ -131,7 +131,7 @@
Loading
131 131
#'   }
132 132
#' }
133 133
#'
134 -
#' # standardize matrix values to lay between zero and one
134 +
#' # linearly re-scale matrix values to range between zero and one
135 135
#' acm1[] <- rescale(acm1[])
136 136
#'
137 137
#' # visualize asymmetric connectivity matrix
@@ -214,7 +214,7 @@
Loading
214 214
  methods::signature("ConservationProblem", "ANY", "ANY", "matrix"),
215 215
  function(x, penalty, zones, data) {
216 216
     add_asym_connectivity_penalties(x, penalty, zones,
217 -
       methods::as(data, "dgCMatrix"))
217 +
      as_Matrix(data, "dgCMatrix"))
218 218
})
219 219
220 220
#' @name add_asym_connectivity_penalties
@@ -224,7 +224,7 @@
Loading
224 224
  methods::signature("ConservationProblem", "ANY", "ANY", "Matrix"),
225 225
  function(x, penalty, zones, data) {
226 226
     add_asym_connectivity_penalties(x, penalty, zones,
227 -
       methods::as(data, "dgCMatrix"))
227 +
      as_Matrix(data, "dgCMatrix"))
228 228
})
229 229
230 230
#' @name add_asym_connectivity_penalties
@@ -308,8 +308,7 @@
Loading
308 308
    for (z1 in seq_len(dim(data)[3])) {
309 309
      m[[z1]] <- list()
310 310
      for (z2 in seq_len(dim(data)[4])) {
311 -
        m[[z1]][[z2]] <-
312 -
          methods::as(data[indices, indices, z1, z2], "dgCMatrix")
311 +
        m[[z1]][[z2]] <- as_Matrix(data[indices, indices, z1, z2], "dgCMatrix")
313 312
      }
314 313
    }
315 314
    # add penalties

@@ -282,7 +282,7 @@
Loading
282 282
      assertthat::noNA(c(data)),
283 283
      number_of_total_units(x) == nrow(data),
284 284
      number_of_zones(x) == ncol(data))
285 -
    add_linear_penalties(x, penalty, methods::as(data, "dgCMatrix"))
285 +
    add_linear_penalties(x, penalty, as_Matrix(data, "dgCMatrix"))
286 286
})
287 287
288 288
#' @name add_linear_penalties
@@ -297,7 +297,7 @@
Loading
297 297
      assertthat::noNA(c(data)),
298 298
      number_of_total_units(x) == nrow(data),
299 299
      number_of_zones(x) == ncol(data))
300 -
    add_linear_penalties(x, penalty, methods::as(data, "dgCMatrix"))
300 +
    add_linear_penalties(x, penalty, as_Matrix(data, "dgCMatrix"))
301 301
})
302 302
303 303
#' @name add_linear_penalties
@@ -323,7 +323,7 @@
Loading
323 323
    }
324 324
    d[is.na(d)] <- 0
325 325
    # add penalties
326 -
    add_linear_penalties(x, penalty, methods::as(d, "dgCMatrix"))
326 +
    add_linear_penalties(x, penalty, as_Matrix(d, "dgCMatrix"))
327 327
})
328 328
329 329
#' @name add_linear_penalties

@@ -151,8 +151,8 @@
Loading
151 151
methods::setMethod("eval_asym_connectivity_summary",
152 152
  methods::signature("ConservationProblem", "ANY", "ANY", "matrix"),
153 153
  function(x, solution, zones, data) {
154 -
     eval_asym_connectivity_summary(
155 -
       x, solution, zones, methods::as(data, "dgCMatrix"))
154 +
    eval_asym_connectivity_summary(
155 +
      x, solution, zones, as_Matrix(data, "dgCMatrix"))
156 156
})
157 157
158 158
#' @name eval_asym_connectivity_summary
@@ -161,8 +161,8 @@
Loading
161 161
methods::setMethod("eval_asym_connectivity_summary",
162 162
  methods::signature("ConservationProblem", "ANY", "ANY", "Matrix"),
163 163
  function(x, solution, zones, data) {
164 -
     eval_asym_connectivity_summary(x, solution, zones,
165 -
       methods::as(data, "dgCMatrix"))
164 +
    eval_asym_connectivity_summary(x, solution, zones,
165 +
      as_Matrix(data, "dgCMatrix"))
166 166
})
167 167
168 168
#' @name eval_asym_connectivity_summary
@@ -240,8 +240,7 @@
Loading
240 240
    for (z1 in seq_len(dim(data)[3])) {
241 241
      m[[z1]] <- list()
242 242
      for (z2 in seq_len(dim(data)[4])) {
243 -
        m[[z1]][[z2]] <-
244 -
          methods::as(data[indices, indices, z1, z2], "dgCMatrix")
243 +
        m[[z1]][[z2]] <- as_Matrix(data[indices, indices, z1, z2], "dgCMatrix")
245 244
      }
246 245
    }
247 246
    # calculate connectivity
@@ -270,7 +269,7 @@
Loading
270 269
    zv <- vapply(seq_len(ncol(solution)), FUN.VALUE = numeric(1), function(z) {
271 270
      ## prepare data the z'th zone
272 271
      if (is.null(data)) {
273 -
        zd <- methods::as(zone_scaled_data[[z]][[z]], "dgCMatrix")
272 +
        zd <- as_Matrix(zone_scaled_data[[z]][[z]], "dgCMatrix")
274 273
      } else {
275 274
        zd <- data
276 275
      }

@@ -42,7 +42,7 @@
Loading
42 42
    std::size_t j = 0;
43 43
    if (!str_tree) {
44 44
      while (i != PID.size()) {
45 -
        if ((PID[i] == PID[currPidStart]) & (SID[i] == SID[currPidStart])) {
45 +
        if ((PID[i] == PID[currPidStart]) && (SID[i] == SID[currPidStart])) {
46 46
          j = 0;
47 47
          while (j != PID.size()) {
48 48
            if (PID[currPidStart] != PID[j]) {
@@ -129,7 +129,7 @@
Loading
129 129
  std::iota(pos.begin(), pos.end(), 1);
130 130
  currPidStart = 0;
131 131
  for (std::size_t i = 1; i != PID.size(); ++i) {
132 -
    if ((PID[i] == PID[currPidStart]) & (SID[i] == SID[currPidStart])) {
132 +
    if ((PID[i] == PID[currPidStart]) && (SID[i] == SID[currPidStart])) {
133 133
      currLine = LINE(PID[i], pos[i], pos[i - 1], X[i], Y[i], X[i - 1],
134 134
                      Y[i - 1], tol);
135 135
      line_UMMAP.insert(std::pair<LINEID, LINE>(currLine._id,

@@ -27,9 +27,9 @@
Loading
27 27
#' @noRd
28 28
matrix_to_triplet_dataframe <- function(x) {
29 29
  if (inherits(x, c("dsCMatrix")))
30 -
    x <- methods::as(x, "dsTMatrix")
30 +
    x <- as_Matrix(x, "dsTMatrix")
31 31
  if (inherits(x, c("dgCMatrix", "matrix")))
32 -
    x <- methods::as(x, "dgTMatrix")
32 +
    x <- as_Matrix(x, "dgTMatrix")
33 33
  data.frame(i = x@i + 1, j = x@j + 1, x = x@x)
34 34
}
35 35
@@ -63,11 +63,13 @@
Loading
63 63
    m2 <- matrix(c(m@j + 1, m@i + 1, m@x), ncol = 3)
64 64
    m2 <- m2[m2[, 1] != m2[, 2], ]
65 65
    m[m2[, 1:2]] <- m2[, 3]
66 -
    return(Matrix::forceSymmetric(m))
66 +
    m <- Matrix::forceSymmetric(m)
67 +
    m <- as_Matrix(m, "dsCMatrix")
67 68
  } else {
68 -
    # return matrix in compressed format
69 -
    return(methods::as(m, "dgCMatrix"))
69 +
    m <- as_Matrix(m, "dgCMatrix")
70 70
  }
71 +
  # return result
72 +
  m
71 73
}
72 74
73 75
#' Sparse matrix (triplet)
@@ -288,3 +290,63 @@
Loading
288 290
  assertthat::assert_that(inherits(x, "sf"))
289 291
  vapply(sf::st_geometry(x), class, character(3))[2, ]
290 292
}
293 +
294 +
#' Convert to Matrix
295 +
#'
296 +
#' Convert an object to a matrix class provided by the \pkg{Matrix} package.
297 +
#'
298 +
#' @param object object.
299 +
#'
300 +
#' @param class `character` name of new classes.
301 +
#'
302 +
#' @details
303 +
#' This function is a wrapper that is designed to provide
304 +
#' compatibility with older and newer versions of the \pkg{Matrix} package.
305 +
#'
306 +
#' @return `Matrix` object.
307 +
#'
308 +
#' @noRd
309 +
as_Matrix <- function(object, class) {
310 +
  # assert valid argument
311 +
  assertthat::assert_that(
312 +
    assertthat::is.string(class),
313 +
    assertthat::noNA(class)
314 +
  )
315 +
  # if we just want to convert to generic Matrix class then do that...
316 +
  if (identical(class, "Matrix")) {
317 +
    return(methods::as(object, class))
318 +
  }
319 +
  # convert matrix
320 +
  # nocov start
321 +
  if (utils::packageVersion("Matrix") >= as.package_version("1.4-2")) {
322 +
    if (identical(class, "dgCMatrix")) {
323 +
      c1 <- "dMatrix"
324 +
      c2 <- "generalMatrix"
325 +
      c3 <- "CsparseMatrix"
326 +
    } else if (identical(class, "dgTMatrix")) {
327 +
      c1 <- "dMatrix"
328 +
      c2 <- "generalMatrix"
329 +
      c3 <- "TsparseMatrix"
330 +
    } else if (identical(class, "dsCMatrix")) {
331 +
      c1 <- "dMatrix"
332 +
      c2 <- "symmetricMatrix"
333 +
      c3 <- "CsparseMatrix"
334 +
    } else if (identical(class, "dsTMatrix")) {
335 +
      c1 <- "dMatrix"
336 +
      c2 <- "symmetricMatrix"
337 +
      c3 <- "TsparseMatrix"
338 +
    } else if (identical(class, "lgCMatrix")) {
339 +
      c1 <- "lMatrix"
340 +
      c2 <- "generalMatrix"
341 +
      c3 <- "CsparseMatrix"
342 +
    } else {
343 +
      stop("argument to \"class\" not recognized")
344 +
    }
345 +
    out <- methods::as(methods::as(methods::as(object, c1), c2), c3)
346 +
  } else {
347 +
    out <- methods::as(object, class)
348 +
  }
349 +
  # nocov end
350 +
  # return result
351 +
  out
352 +
}

@@ -306,8 +306,9 @@
Loading
306 306
    if (inherits(data, c("matrix", "Matrix"))) {
307 307
      # if it is matrix coerce to sparse matrix
308 308
      bm <- data
309 -
      if (!inherits(data, c("dsCMatrix", "dgCMatrix")))
310 -
        bm <- methods::as(data, "dgCMatrix")
309 +
      if (!inherits(data, c("dsCMatrix", "dgCMatrix"))) {
310 +
        bm <- as_Matrix(data, "dgCMatrix")
311 +
      }
311 312
      # check that matrix properties are correct
312 313
      assertthat::assert_that(
313 314
        ncol(bm) == nrow(bm),

@@ -201,10 +201,10 @@
Loading
201 201
     inherits(data, c("NULL", "Matrix")))
202 202
    if (!is.null(data)) {
203 203
      # check argument to data if not NULL
204 -
      assertthat::assert_that(all(methods::as(data, "dgCMatrix")@x %in%
204 +
      assertthat::assert_that(all(as_Matrix(data, "dgCMatrix")@x %in%
205 205
                                  c(0, 1, NA)),
206 206
        ncol(data) == nrow(data), number_of_total_units(x) == ncol(data),
207 -
        sum(!is.finite(methods::as(data, "dgCMatrix")@x)) == 0)
207 +
        sum(!is.finite(as_Matrix(data, "dgCMatrix")@x)) == 0)
208 208
      d <- list(matrix = data)
209 209
    } else {
210 210
      # check that planning unit data is spatially referenced
@@ -245,7 +245,7 @@
Loading
245 245
          # create matrix
246 246
          data <- adjacency_matrix(x$data$cost)
247 247
          # coerce matrix to full matrix
248 -
          data <- methods::as(data, "dgCMatrix")
248 +
          data <- as_Matrix(data, "dgCMatrix")
249 249
          # store data
250 250
          self$set_data("matrix", data)
251 251
        }
@@ -266,7 +266,7 @@
Loading
266 266
          for (z1 in seq_len(ncol(z))) {
267 267
            m[[z1]] <- list()
268 268
            for (z2 in seq_len(nrow(z))) {
269 -
              m[[z1]][[z2]] <- methods::as(d * z[z1, z2], "dgCMatrix")
269 +
              m[[z1]][[z2]] <- as_Matrix(d * z[z1, z2], "dgCMatrix")
270 270
            }
271 271
          }
272 272
          # apply constraints
@@ -294,7 +294,7 @@
Loading
294 294
  methods::signature("ConservationProblem", "ANY", "ANY", "matrix"),
295 295
  function(x, k, zones, data) {
296 296
    # add constraints
297 -
    add_neighbor_constraints(x, k, zones, methods::as(data, "dgCMatrix"))
297 +
    add_neighbor_constraints(x, k, zones, as_Matrix(data, "dgCMatrix"))
298 298
})
299 299
300 300
#' @name add_neighbor_constraints
@@ -330,8 +330,7 @@
Loading
330 330
    for (z1 in seq_len(dim(data)[3])) {
331 331
      m[[z1]] <- list()
332 332
      for (z2 in seq_len(dim(data)[4])) {
333 -
        m[[z1]][[z2]] <- methods::as(data[indices, indices, z1, z2],
334 -
                                     "dgCMatrix")
333 +
        m[[z1]][[z2]] <- as_Matrix(data[indices, indices, z1, z2], "dgCMatrix")
335 334
      }
336 335
    }
337 336
    # add the constraint

@@ -224,7 +224,7 @@
Loading
224 224
     inherits(data, c("NULL", "Matrix")))
225 225
    if (!is.null(data)) {
226 226
      # check argument to data if not NULL
227 -
      data <- methods::as(data, "dgCMatrix")
227 +
      data <- as_Matrix(data, "dgCMatrix")
228 228
      assertthat::assert_that(all(data@x %in% c(0, 1)),
229 229
        ncol(data) == nrow(data), number_of_total_units(x) == ncol(data),
230 230
        all(is.finite(data@x)), Matrix::isSymmetric(data))
@@ -261,7 +261,7 @@
Loading
261 261
          # create matrix
262 262
          data <- adjacency_matrix(x$data$cost)
263 263
          # coerce matrix to full matrix
264 -
          data <- methods::as(data, "dgCMatrix")
264 +
          data <- as_Matrix(data, "dgCMatrix")
265 265
          # store data
266 266
          self$set_data("matrix", data)
267 267
        }
@@ -314,5 +314,5 @@
Loading
314 314
  methods::signature("ConservationProblem", "ANY", "matrix"),
315 315
  function(x, zones, data) {
316 316
    # add constraints
317 -
    add_contiguity_constraints(x, zones, methods::as(data, "dgCMatrix"))
317 +
    add_contiguity_constraints(x, zones, as_Matrix(data, "dgCMatrix"))
318 318
})

@@ -158,10 +158,8 @@
Loading
158 158
#' cm4 <- lapply(seq_len(nlayers(sim_features)), function(i) {
159 159
#'   # create connectivity matrix using the i'th feature's habitat data
160 160
#'   m <- connectivity_matrix(sim_pu_raster, sim_features[[i]])
161 -
#'   # convert matrix to TRUE/FALSE values in top 20th percentile
162 -
#'   m <- m > quantile(as.vector(m), 1 - 0.015, names = FALSE)
163 -
#'   # convert matrix from TRUE/FALSE to sparse matrix with 0/1s
164 -
#'   m <- as(m, "dgCMatrix")
161 +
#'   # convert matrix to 0/1 values denoting values in top 20th percentile
162 +
#'   m <- round(m > quantile(as.vector(m), 1 - 0.015, names = FALSE))
165 163
#'   # remove 0s from the sparse matrix
166 164
#'   m <- Matrix::drop0(m)
167 165
#'   # return matrix
@@ -267,7 +265,7 @@
Loading
267 265
  methods::signature("ConservationProblem", "ANY", "matrix"),
268 266
  function(x, zones, data) {
269 267
    # add constraints
270 -
    add_feature_contiguity_constraints(x, zones, methods::as(data, "dgCMatrix"))
268 +
    add_feature_contiguity_constraints(x, zones, as_Matrix(data, "dgCMatrix"))
271 269
})
272 270
273 271
#' @name add_feature_contiguity_constraints
@@ -298,7 +296,7 @@
Loading
298 296
            "or data.frame"))
299 297
        # coerce to correct format
300 298
        if (is.matrix(data[[i]]))
301 -
          data[[i]] <- methods::as(data, "dgCMatrix")
299 +
          data[[i]] <- as_Matrix(data, "dgCMatrix")
302 300
        if (is.data.frame(data[[i]]))
303 301
          data[[i]] <- marxan_boundary_data_to_matrix(x, data[[i]])
304 302
        # run checks
@@ -348,7 +346,7 @@
Loading
348 346
        # create matrix
349 347
        data <- adjacency_matrix(x$data$cost)
350 348
        # coerce matrix to full matrix
351 -
        data <- methods::as(data, "dgCMatrix")
349 +
        data <- as_Matrix(data, "dgCMatrix")
352 350
        # create list for each feature
353 351
        data <- list(data)[rep(1, number_of_features(x))]
354 352
        # store data
@@ -377,7 +375,8 @@
Loading
377 375
        })
378 376
        # convert d to lower triangle sparse matrix
379 377
        d <- lapply(d, Matrix::forceSymmetric, uplo = "L")
380 -
        d <- lapply(d, `class<-`, "dgCMatrix")
378 +
        d <- lapply(d, Matrix::tril)
379 +
        d <- lapply(d, as_Matrix, "dgCMatrix")
381 380
        # apply the constraints
382 381
        if (max(vapply(z_cl, max, numeric(1))) > 0)
383 382
          rcpp_apply_feature_contiguity_constraints(x$ptr, d, z_cl)

@@ -80,8 +80,8 @@
Loading
80 80
                          assertthat::is.scalar(gap),
81 81
                          isTRUE(gap >= 0), isTRUE(all(is.finite(time_limit))),
82 82
                          assertthat::is.scalar(time_limit),
83 -
                          assertthat::is.count(time_limit) || isTRUE(time_limit
84 -
                            == -1),
83 +
                          assertthat::is.count(time_limit) ||
84 +
                            isTRUE(time_limit == -1),
85 85
                          assertthat::is.flag(verbose),
86 86
                          assertthat::is.flag(first_feasible),
87 87
                          assertthat::noNA(first_feasible),
@@ -109,7 +109,7 @@
Loading
109 109
      # create model
110 110
      model <- list(
111 111
        obj = x$obj(),
112 -
        mat = methods::as(x$A(), "dgTMatrix"),
112 +
        mat = as_Matrix(x$A(), "dgTMatrix"),
113 113
        dir = x$sense(),
114 114
        rhs = x$rhs(),
115 115
        types = x$vtype(),

@@ -308,7 +308,7 @@
Loading
308 308
  }
309 309
310 310
  ## check constraint matrix
311 -
  y <- methods::as(x$A(), "dgTMatrix")
311 +
  y <- as_Matrix(x$A(), "dgTMatrix")
312 312
  rownames(y) <- x$row_ids()
313 313
  colnames(y) <- x$col_ids()
314 314
  ### check upper threshold

@@ -167,7 +167,7 @@
Loading
167 167
#' require(Matrix)
168 168
#'
169 169
#' # load data
170 -
#' data(sim_pu_polygons, sim_pu_zones_stack, sim_features, sim_features_zones)
170 +
#' data(sim_pu_sf, sim_pu_zones_stack, sim_features, sim_features_zones)
171 171
#'
172 172
#' # define function to rescale values between zero and one so that we
173 173
#' # can compare solutions from different connectivity matrices
@@ -176,14 +176,14 @@
Loading
176 176
#' }
177 177
#'
178 178
#' # create basic problem
179 -
#' p1 <- problem(sim_pu_polygons, sim_features, "cost") %>%
179 +
#' p1 <- problem(sim_pu_sf, sim_features, "cost") %>%
180 180
#'       add_min_set_objective() %>%
181 181
#'       add_relative_targets(0.2) %>%
182 182
#'       add_default_solver(verbose = FALSE)
183 183
#'
184 184
#' # create a symmetric connectivity matrix where the connectivity between
185 185
#' # two planning units corresponds to their shared boundary length
186 -
#' b_matrix <- boundary_matrix(sim_pu_polygons)
186 +
#' b_matrix <- boundary_matrix(sim_pu_sf)
187 187
#'
188 188
#' # standardize matrix values to lay between zero and one
189 189
#' b_matrix[] <- rescale(b_matrix[])
@@ -195,8 +195,8 @@
Loading
195 195
#' # create a symmetric connectivity matrix where the connectivity between
196 196
#' # two planning units corresponds to their spatial proximity
197 197
#' # i.e., planning units that are further apart share less connectivity
198 -
#' centroids <- rgeos::gCentroid(sim_pu_polygons, byid = TRUE)
199 -
#' d_matrix <- (1 / (as(dist(centroids@coords), "Matrix") + 1))
198 +
#' centroids <- sf::st_coordinates(suppressWarnings(sf::st_centroid(sim_pu_sf)))
199 +
#' d_matrix <- (1 / (Matrix::Matrix(as.matrix(dist(centroids))) + 1))
200 200
#'
201 201
#' # standardize matrix values to lay between zero and one
202 202
#' d_matrix[] <- rescale(d_matrix[])
@@ -216,7 +216,7 @@
Loading
216 216
#' # each planning unit and we could use connectivity penalties to identify
217 217
#' # solutions that cluster planning units together that both contain large
218 218
#' # amounts of native vegetation
219 -
#' c_matrix <- connectivity_matrix(sim_pu_polygons, "cost")
219 +
#' c_matrix <- connectivity_matrix(sim_pu_sf, "cost")
220 220
#'
221 221
#' # standardize matrix values to lay between zero and one
222 222
#' c_matrix[] <- rescale(c_matrix[])
@@ -402,8 +402,9 @@
Loading
402 402
methods::setMethod("add_connectivity_penalties",
403 403
  methods::signature("ConservationProblem", "ANY", "ANY", "matrix"),
404 404
  function(x, penalty, zones, data) {
405 -
     add_connectivity_penalties(x, penalty, zones,
406 -
       methods::as(data, "dgCMatrix"))
405 +
    add_connectivity_penalties(
406 +
      x, penalty, zones, as_Matrix(data, "dgCMatrix")
407 +
   )
407 408
})
408 409
409 410
#' @name add_connectivity_penalties
@@ -413,7 +414,7 @@
Loading
413 414
  methods::signature("ConservationProblem", "ANY", "ANY", "Matrix"),
414 415
  function(x, penalty, zones, data) {
415 416
     add_connectivity_penalties(x, penalty, zones,
416 -
       methods::as(data, "dgCMatrix"))
417 +
       as_Matrix(data, "dgCMatrix"))
417 418
})
418 419
419 420
#' @name add_connectivity_penalties
@@ -497,7 +498,7 @@
Loading
497 498
      m[[z1]] <- list()
498 499
      for (z2 in seq_len(dim(data)[4])) {
499 500
        m[[z1]][[z2]] <-
500 -
          methods::as(data[indices, indices, z1, z2], "dgCMatrix")
501 +
          as_Matrix(data[indices, indices, z1, z2], "dgCMatrix")
501 502
      }
502 503
    }
503 504
    # add penalties
@@ -523,7 +524,7 @@
Loading
523 524
        # coerce to symmetric connectivity data
524 525
        cm <- self$get_data("data")
525 526
        cm <- lapply(cm, function(x) {
526 -
          lapply(x, function(y) methods::as(Matrix::tril(y), "dgCMatrix"))
527 +
          lapply(x, function(y) as_Matrix(Matrix::tril(y), "dgCMatrix"))
527 528
        })
528 529
        # apply penalties
529 530
        rcpp_apply_connectivity_penalties(

@@ -40,8 +40,8 @@
Loading
40 40
#' such as the
41 41
#' [Rtools software](https://cran.r-project.org/bin/windows/Rtools/)
42 42
#' or system libraries -- prior to installing the \pkg{rcbc} package.
43 -
#' For further details on installing this package, please consult
44 -
#' [official installation instructions for the package](https://dirkschumacher.github.io/rcbc/).
43 +
#' For further details on installing this package, please consult the
44 +
#' [online package documentation](https://dirkschumacher.github.io/rcbc/).
45 45
#'
46 46
#' @inheritSection add_gurobi_solver Start solution format
47 47
#'
@@ -176,11 +176,23 @@
Loading
176 176
        max = identical(x$modelsense(), "max"),
177 177
        obj = x$obj(),
178 178
        is_integer = x$vtype() == "B",
179 -
        mat = x$A(),
179 +
        mat = as_Matrix(x$A(), "dgTMatrix"),
180 180
        col_lb = x$lb(),
181 181
        col_ub = x$ub(),
182 182
        row_lb = row_lb,
183 183
        row_ub = row_ub)
184 +
      # if needed, insert dummy row to ensure non-zero value in last rij cell
185 +
      if (abs(model$mat[nrow(model$mat), ncol(model$mat)]) < 1e-300) {
186 +
        model$mat <- as_Matrix(
187 +
          rbind(
188 +
            model$mat,
189 +
            Matrix::sparseMatrix(i = 1, j = ncol(model$mat), x = 1, repr = "T")
190 +
          ),
191 +
          "dgTMatrix"
192 +
        )
193 +
        model$row_lb <- c(model$row_lb, -Inf)
194 +
        model$row_ub <- c(model$row_ub, Inf)
195 +
      }
184 196
      # add starting solution if specified
185 197
      start <- self$get_data("start")
186 198
      if (!is.null(start) && !is.Waiver(start)) {
Files Coverage
R 98.39%
src 97.00%
Project Totals (129 files) 97.97%

No yaml found.

Create your codecov.yml to customize your Codecov experience

Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading