Skip to content

Commit d49a522

Browse files
suz-estellasuz-estella
committed
writeRasterWithValues efficiency improvement & added ability to only set some cells
1 parent 9c960c0 commit d49a522

7 files changed

Lines changed: 97 additions & 67 deletions

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ Description: Implementation of several components of the Carbon Budget Model of
55
Canadian Forest Service (v3).
66
URL:
77
https://github.com/PredictiveEcology/CBMutils
8-
Version: 2.5.3.9001
8+
Version: 2.5.3.9002
99
Authors@R: c(
1010
person("Céline", "Boisvenue", email = "celine.boisvenue@nrcan-rncan.gc.ca", role = c("aut", "cre")),
1111
person("Alex M", "Chubaty", email = "achubaty@for-cast.ca", role = c("aut"), comment = c(ORCID = "0000-0001-7146-8135")),

‎R/Misc-extractToRast.R‎

Lines changed: 0 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -189,25 +189,3 @@ extractToRast_vect <- function(input, templateRast, field = 1, crop = TRUE){
189189
alignVals
190190
}
191191

192-
193-
#' Write raster with values
194-
#'
195-
#' Replace the values in a `SpatRaster` before writing it to file.
196-
#'
197-
#' @param templateRast terra `SpatRaster` template defining raster geometry.
198-
#' @param values numeric or character. New raster values.
199-
#' @param filename character. Output filename.
200-
#' @param ... arguments to \code{\link[terra]{writeRaster}}
201-
#'
202-
#' @export
203-
writeRasterWithValues <- function(templateRast, values, filename, ...){
204-
205-
if (!is.numeric(values)) values <- factor(values)
206-
terra::values(templateRast) <- values
207-
208-
dir.create(dirname(filename), recursive = TRUE, showWarnings = FALSE)
209-
terra::writeRaster(templateRast, filename = filename, ...)
210-
211-
return(invisible())
212-
}
213-

‎R/Misc-writeRasterWithValues.R‎

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
2+
#' Write raster with values
3+
#'
4+
#' Replace the values in a `SpatRaster` before writing it to file.
5+
#'
6+
#' @param templateRast terra `SpatRaster` template defining raster geometry.
7+
#' @param filename character. Output filename.
8+
#' @param cells integer. Raster cell index.
9+
#' @param values numeric or character. New raster values.
10+
#' @param ... arguments to \code{\link[terra]{writeRaster}}
11+
#'
12+
#' @export
13+
writeRasterWithValues <- function(templateRast, filename, cells = NULL, values = NULL, ...){
14+
15+
templateRast <- terra::rast(templateRast)
16+
17+
if (!is.null(values)){
18+
19+
if (!is.numeric(values)){
20+
values <- factor(values)
21+
cats <- unique(data.frame(
22+
value = as.integer(values),
23+
category = as.character(values)
24+
))
25+
cats <- cats[cats$value,]
26+
}
27+
28+
if (is.null(cells)){
29+
templateRast <- terra::rast(templateRast, vals = values)
30+
}else{
31+
templateRast <- terra::rast(templateRast)
32+
terra::set.values(templateRast, cells = cells, values = values)
33+
}
34+
35+
if (!is.numeric(values)) terra::set.cats(templateRast, layer = 1, cats)
36+
}
37+
38+
dir.create(dirname(filename), recursive = TRUE, showWarnings = FALSE)
39+
terra::writeRaster(templateRast, filename = filename, ...)
40+
41+
return(invisible())
42+
}
43+

‎man/writeRasterWithValues.Rd‎

Lines changed: 6 additions & 4 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/devel-runTests.R‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,4 +29,5 @@ testthat::test_local(filter = "CBM-tools_calcRootC")
2929
testthat::test_local(filter = "Data-CBMsources")
3030
testthat::test_local(filter = "Misc_ageStepBackward")
3131
testthat::test_local(filter = "Misc_extractToRast")
32+
testthat::test_local(filter = "Misc_writeRasterWithValues")
3233
testthat::test_local(filter = "Python_ReticulateFindPython")

‎tests/testthat/test-Misc_extractToRast.R‎

Lines changed: 11 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -2,41 +2,12 @@
22
if (!testthat::is_testing()) source(testthat::test_path("setup.R"))
33

44
tempDir <- file.path(testDirs$temp$outputs, "extractToRast")
5+
56
viewResults <- !testthat::is_testing()
67
if (viewResults){
78
file.copy(file.path(testDirs$testdata, "extractToRast"), testDirs$temp$outputs, recursive = TRUE, overwrite = TRUE)
89
}else dir.create(tempDir, recursive = TRUE, showWarnings = FALSE)
910

10-
test_that("Function: writeRasterWithValues", {
11-
12-
templateRast <- terra::rast(
13-
crs = file.path(testDirs$testdata, "extractToRast", "EPSG-32613.prj"),
14-
res = 100, vals = 1,
15-
ext = c(xmin = 456000, xmax = 457000, ymin = 6105000, ymax = 6106000))
16-
17-
outPath <- file.path(tempDir, "writeRasterWithValues-numeric.tif")
18-
writeRasterWithValues(
19-
templateRast, values = c(rep(1, 50), rep(2, 50)),
20-
filename = outPath, overwrite = TRUE)
21-
22-
rVals <- terra::rast(outPath)
23-
expect_true(terra::compareGeom(rVals, templateRast, stopOnError = FALSE))
24-
expect_equal(terra::values(rVals)[, 1], c(rep(1, 50), rep(2, 50)))
25-
expect_true(is.null(terra::cats(rVals)[[1]]))
26-
27-
outPath <- file.path(tempDir, "writeRasterWithValues-text.tif")
28-
writeRasterWithValues(
29-
templateRast, values = c(rep("Hello 1", 50), rep("Goodbye 2", 50)),
30-
filename = outPath, overwrite = TRUE)
31-
32-
rVals <- terra::rast(outPath)
33-
expect_true(terra::compareGeom(rVals, templateRast, stopOnError = FALSE))
34-
expect_equal(terra::values(rVals)[, 1], c(rep(2, 50), rep(1, 50)))
35-
expect_equal(terra::cats(rVals)[[1]][[1]], 1:2)
36-
expect_equal(terra::cats(rVals)[[1]][[2]], c("Goodbye 2", "Hello 1"))
37-
38-
})
39-
4011
test_that("Function: extractToRast: raster upsampling", {
4112

4213
input <- terra::rast(file.path(testDirs$testdata, "extractToRast", "SaskDist_1987_crop.tif"))
@@ -48,7 +19,7 @@ test_that("Function: extractToRast: raster upsampling", {
4819

4920
alignVals <- extractToRast(input, templateRast)
5021

51-
if (viewResults) writeRasterWithValues(templateRast, alignVals, file.path(tempDir, "rast-upsample.tif"), overwrite = TRUE)
22+
if (viewResults) writeRasterWithValues(templateRast, file.path(tempDir, "rast-upsample.tif"), values = alignVals, values = alignVals, overwrite = TRUE)
5223

5324
expect_equal(length(alignVals), terra::ncell(templateRast))
5425
expect_equal(
@@ -79,7 +50,7 @@ test_that("Function: extractToRast: raster upsampling with categories", {
7950

8051
alignVals <- extractToRast(input, templateRast)
8152

82-
if (viewResults) writeRasterWithValues(templateRast, alignVals, file.path(tempDir, "rast-upsample-cats.tif"), overwrite = TRUE)
53+
if (viewResults) writeRasterWithValues(templateRast, file.path(tempDir, "rast-upsample-cats.tif"), values = alignVals, overwrite = TRUE)
8354

8455
expect_equal(length(alignVals), terra::ncell(templateRast))
8556
expect_equal(
@@ -101,7 +72,7 @@ test_that("Function: extractToRast: raster downsampling", {
10172

10273
alignVals <- extractToRast(input, templateRast)
10374

104-
if (viewResults) writeRasterWithValues(templateRast, alignVals, file.path(tempDir, "rast-downsample.tif"), overwrite = TRUE)
75+
if (viewResults) writeRasterWithValues(templateRast, file.path(tempDir, "rast-downsample.tif"), values = alignVals, overwrite = TRUE)
10576

10677
expect_equal(length(alignVals), terra::ncell(templateRast))
10778
expect_equal(
@@ -123,7 +94,7 @@ test_that("Function: extractToRast: raster disaggregation", {
12394

12495
alignVals <- extractToRast(input, templateRast)
12596

126-
if (viewResults) writeRasterWithValues(templateRast, alignVals, file.path(tempDir, "rast-disagg.tif"), overwrite = TRUE)
97+
if (viewResults) writeRasterWithValues(templateRast, file.path(tempDir, "rast-disagg.tif"), values = alignVals, overwrite = TRUE)
12798

12899
expect_equal(length(alignVals), terra::ncell(templateRast))
129100
expect_equal(
@@ -146,7 +117,7 @@ test_that("Function: extractToRast: raster reprojecting", {
146117

147118
alignVals <- extractToRast(input, templateRast)
148119

149-
if (viewResults) writeRasterWithValues(templateRast, alignVals, file.path(tempDir, "rast-reproject.tif"), overwrite = TRUE)
120+
if (viewResults) writeRasterWithValues(templateRast, file.path(tempDir, "rast-reproject.tif"), values = alignVals, overwrite = TRUE)
150121

151122
expect_equal(length(alignVals), terra::ncell(templateRast))
152123
expect_equal(
@@ -168,7 +139,7 @@ test_that("Function: extractToRast: TIF file", {
168139

169140
alignVals <- extractToRast(input, templateRast)
170141

171-
if (viewResults) writeRasterWithValues(templateRast, alignVals, file.path(tempDir, "rast-TIF.tif"), overwrite = TRUE)
142+
if (viewResults) writeRasterWithValues(templateRast, file.path(tempDir, "rast-TIF.tif"), values = alignVals, overwrite = TRUE)
172143

173144
expect_equal(length(alignVals), terra::ncell(templateRast))
174145
expect_equal(
@@ -190,7 +161,7 @@ test_that("Function: extractToRast: TIF tiles", {
190161

191162
alignVals <- extractToRast(input, templateRast)
192163

193-
if (viewResults) writeRasterWithValues(templateRast, alignVals, file.path(tempDir, "rast-TIF-tiles.tif"), overwrite = TRUE)
164+
if (viewResults) writeRasterWithValues(templateRast, file.path(tempDir, "rast-TIF-tiles.tif"), values = alignVals, overwrite = TRUE)
194165

195166
expect_equal(length(alignVals), terra::ncell(templateRast))
196167
expect_equal(
@@ -296,7 +267,7 @@ test_that("Function: extractToRast: sf polygons with numeric field", {
296267

297268
alignVals <- extractToRast(input, templateRast)
298269

299-
if (viewResults) writeRasterWithValues(templateRast, alignVals, file.path(tempDir, "sf-numeric.tif"), overwrite = TRUE)
270+
if (viewResults) writeRasterWithValues(templateRast, file.path(tempDir, "sf-numeric.tif"), values = alignVals, overwrite = TRUE)
300271

301272
expect_equal(length(alignVals), terra::ncell(templateRast))
302273
expect_is(alignVals, "numeric")
@@ -356,7 +327,7 @@ test_that("Function: extractToRast: sf polygons with numeric field: reproject",
356327

357328
alignVals <- extractToRast(input, templateRast)
358329

359-
if (viewResults) writeRasterWithValues(templateRast, alignVals, file.path(tempDir, "sf-numeric-reproject.tif"), overwrite = TRUE)
330+
if (viewResults) writeRasterWithValues(templateRast, file.path(tempDir, "sf-numeric-reproject.tif"), values = alignVals, overwrite = TRUE)
360331

361332
expect_equal(length(alignVals), terra::ncell(templateRast))
362333
expect_is(alignVals, "numeric")
@@ -382,7 +353,7 @@ test_that("Function: extractToRast: sf polygons with text field: reproject", {
382353

383354
alignVals <- extractToRast(input, templateRast)
384355

385-
if (viewResults) writeRasterWithValues(templateRast, alignVals, file.path(tempDir, "sf-text-reproject.tif"), overwrite = TRUE)
356+
if (viewResults) writeRasterWithValues(templateRast, file.path(tempDir, "sf-text-reproject.tif"), values = alignVals, overwrite = TRUE)
386357

387358
expect_equal(length(alignVals), terra::ncell(templateRast))
388359

‎tests/testthat/test-Misc_writeRasterWithValues.R‎

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
2+
if (!testthat::is_testing()) source(testthat::test_path("setup.R"))
3+
4+
test_that("Function: writeRasterWithValues", {
5+
6+
tempDir <- file.path(testDirs$temp$outputs, "writeRasterWithValues")
7+
dir.create(tempDir, recursive = TRUE, showWarnings = FALSE)
8+
9+
templateRast <- terra::rast(
10+
crs = file.path(testDirs$testdata, "writeRasterWithValues", "EPSG-32613.prj"),
11+
res = 100, vals = 1,
12+
ext = c(xmin = 456000, xmax = 457000, ymin = 6105000, ymax = 6106000))
13+
14+
outPath <- file.path(tempDir, "writeRasterWithValues-numeric.tif")
15+
writeRasterWithValues(
16+
templateRast, values = c(rep(1, 50), rep(2, 50)),
17+
filename = outPath, overwrite = TRUE)
18+
19+
rVals <- terra::rast(outPath)
20+
expect_true(terra::compareGeom(rVals, templateRast, stopOnError = FALSE))
21+
expect_equal(terra::values(rVals)[, 1], c(rep(1, 50), rep(2, 50)))
22+
expect_true(is.null(terra::cats(rVals)[[1]]))
23+
24+
outPath <- file.path(tempDir, "writeRasterWithValues-text.tif")
25+
writeRasterWithValues(
26+
templateRast, values = c(rep("Hello 1", 50), rep("Goodbye 2", 50)),
27+
filename = outPath, overwrite = TRUE)
28+
29+
rVals <- terra::rast(outPath)
30+
expect_true(terra::compareGeom(rVals, templateRast, stopOnError = FALSE))
31+
expect_equal(terra::values(rVals)[, 1], c(rep(2, 50), rep(1, 50)))
32+
expect_equal(terra::cats(rVals)[[1]][[1]], 1:2)
33+
expect_equal(terra::cats(rVals)[[1]][[2]], c("Goodbye 2", "Hello 1"))
34+
35+
})

0 commit comments

Comments
 (0)