fix lintrs

source/scripts/cmon_sqlite_to_geotiff.R

@@ -9,10 +9,6 @@ flea_data <- gsub(
   pattern = "flea-extent", replacement = "flea-data", x = git_root
 )
 
-# lg2013 <- rast(file.path(flea_data, "data", "2013", "LG2013_finaal_update.tif"))
-# ext(lg2013)
-# plot(lg2013)
-# polys(ext(lg2013))
 flea_bbox <- rbind(x = c(20000, 259000), y = c(153000, 250000))
 flea_ext <- ext(as.numeric(flea_bbox), xy = TRUE)
 
@@ -53,7 +49,10 @@ dbDisconnect(con)
 class(allcells)
 head(allcells)
 # S4 method for class 'data.frame'
-# If the value is "xyz", the matrix or data.frame x must have at least two columns, the first with x (or longitude) and the second with y (or latitude) coordinates that represent the centers of raster cells. The additional columns are the values associated with the raster cells
+# If the value is "xyz", the matrix or data.frame x must have at least two
+# columns, the first with x (or longitude) and the second with y (or latitude)
+# coordinates that represent the centers of raster cells.
+# The additional columns are the values associated with the raster cells
 rast(
   x = allcells,
   type = "xyz",

source/scripts/explore_categories_of_change.R

@@ -9,7 +9,9 @@ flea_data <- gsub(
 )
 
 
-temporal_stratification <- rast(file.path(flea_data, "data/2013_2016_2019", "temporal_stratification.tif"))
+temporal_stratification <- rast(
+  file.path(flea_data, "data/2013_2016_2019", "temporal_stratification.tif")
+)
 
 changes_df <- cats(temporal_stratification)[[1]] |> as_tibble()
 

source/scripts/flea_functions.R

@@ -61,8 +61,8 @@ point_to_gridcell <- function(
 extract_sample_helper <- function(
     rast,
     n) {
-  require(terra)
-  require(sf)
+  require("terra")
+  require("sf")
 
   # Extract values, exclude NA
   extracted <- terra::extract(
@@ -116,9 +116,9 @@ extract_sample <- function(
     ntot,
     nmin,
     min_stratum_size) {
-  require(terra)
-  require(dplyr)
-  require(tibble)
+  require("terra")
+  require("dplyr")
+  require("tibble")
 
   # assertions
   assertthat::assert_that(!missing(stratum_raster))
@@ -184,7 +184,7 @@ extract_sample <- function(
   # remaining allocate proportional to stratum size
   allocation <- popsize |>
     mutate(
-      n_h = nmin + round((ntot - nmin * n()) * (notNA / sum(notNA)))
+      n_h = nmin + round((ntot - nmin * n()) * (notNA / sum(notNA))) # nolint
     )
 
   sample_ts2 <- vector(mode = "list", length = nlyr(fleagrts_ts2))

source/scripts/nca_functions.R

@@ -1,5 +1,5 @@
 # copy of NCA_functions.R in project NCA_validatingextent
-
+# nolint start
 library(assertthat)
 library(caret) # Confusion matrix maken
 
@@ -486,7 +486,8 @@ validation_data <- function(data_root) {
         "nochange", "change"
       ), oordeelval
     )) %>%
-    # Aanpassen beoordeling "verandering" -> als de validatieklasse 2 x hetzelfde
+    # Aanpassen beoordeling "verandering" ->
+    # als de validatieklasse 2 x hetzelfde
     # is per evaluator, dan "nochange"
     rowwise() %>%
     mutate(
@@ -636,3 +637,4 @@ validation_data <- function(data_root) {
     droplevels() %>%
     mutate(area = count / sum(count))
 }
+# nolint end

source/scripts/test_grts_sampling_design.R

@@ -35,7 +35,9 @@ slyr <- xml2::read_xml(
   file.path(flea_data, "data", "2013", "LG2013_finaal_update.qml")
 )
 
-catstable <- xml2::xml_find_all(x = slyr, ".//pipe//rasterrenderer//colorPalette") |>
+catstable <- xml2::xml_find_all(
+  x = slyr, ".//pipe//rasterrenderer//colorPalette"
+  ) |>
   xml2::xml_contents() |>
   purrr::map(xml2::xml_attrs) |>
   purrr::map_df(~ as.list(.)) |>
@@ -51,7 +53,7 @@ apply_cats <- function(x, cats = catstable, name, coltab = TRUE) {
   levels(xc) <- cats
   if (coltab) {
     coltab(xc) <- cats |>
-      dplyr::select(value, color) |>
+      dplyr::select(value, color) |> # nolint
       as.data.frame()
   }
   names(xc) <- name
@@ -62,7 +64,8 @@ lg2013 <- apply_cats(lg2013, name = "lg2013")
 lg2016 <- apply_cats(lg2016, name = "lg2016")
 lg2019 <- apply_cats(lg2019, name = "lg2019")
 
-lg2013 <- resample(lg2013, fleagrts) # needed because of slightly different origin
+# resampling needed because of slightly different origin
+lg2013 <- resample(lg2013, fleagrts)
 lg2016 <- resample(lg2016, fleagrts)
 lg2019 <- resample(lg2019, fleagrts)
 
@@ -108,43 +111,43 @@ if (file.exists(
     bind_cols(data, binary)
   }
 
-  categorize_land_use_change <- function(B, simple = TRUE) {
+  categorize_land_use_change <- function(b, simple = TRUE) {
     if (simple) {
       case_when(
         # Stable conditions
-        grepl("^0+$", B) ~ "Stable absence",
-        grepl("^1+$", B) ~ "Stable presence",
+        grepl("^0+$", b) ~ "Stable absence",
+        grepl("^1+$", b) ~ "Stable presence",
 
         # Simple changes
-        grepl("^0+1+$", B) ~ "Gain",
-        grepl("^1+0+$", B) ~ "Loss",
+        grepl("^0+1+$", b) ~ "Gain",
+        grepl("^1+0+$", b) ~ "Loss",
 
         # Default case
         TRUE ~ "Other complex pattern"
       )
     } else {
       case_when(
         # Stable conditions
-        grepl("^0+$", B) ~ "Stable absence",
-        grepl("^1+$", B) ~ "Stable presence",
+        grepl("^0+$", b) ~ "Stable absence",
+        grepl("^1+$", b) ~ "Stable presence",
 
         # Simple changes
-        grepl("^0+1+$", B) ~ "Gain",
-        grepl("^1+0+$", B) ~ "Loss",
+        grepl("^0+1+$", b) ~ "Gain",
+        grepl("^1+0+$", b) ~ "Loss",
 
         # Complex changes
-        grepl("^0+1+0+$", B) ~ "Temporary gain",
-        grepl("^1+0+1+$", B) ~ "Temporary loss",
-        grepl("^0+1+0+1+$", B) ~ "Intermittent presence (starting absent)",
-        grepl("^1+0+1+0+$", B) ~ "Intermittent presence (starting present)",
+        grepl("^0+1+0+$", b) ~ "Temporary gain",
+        grepl("^1+0+1+$", b) ~ "Temporary loss",
+        grepl("^0+1+0+1+$", b) ~ "Intermittent presence (starting absent)",
+        grepl("^1+0+1+0+$", b) ~ "Intermittent presence (starting present)",
 
         # Oscillating changes
-        grepl("^(01)+0?$", B) ~ "Oscillating (starting absent)",
-        grepl("^(10)+1?$", B) ~ "Oscillating (starting present)",
+        grepl("^(01)+0?$", b) ~ "Oscillating (starting absent)",
+        grepl("^(10)+1?$", b) ~ "Oscillating (starting present)",
 
         # Other complex patterns
-        grepl("01.*1$", B) & !grepl("^0+1+$", B) ~ "Complex gain",
-        grepl("10.*0$", B) & !grepl("^1+0+$", B) ~ "Complex loss",
+        grepl("01.*1$", b) & !grepl("^0+1+$", b) ~ "Complex gain",
+        grepl("10.*0$", b) & !grepl("^1+0+$", b) ~ "Complex loss",
 
         # Default case
         TRUE ~ "Other complex pattern"
@@ -216,7 +219,9 @@ if (file.exists(
   writeRaster(
     x = temporal_stratification,
     filename =
-      file.path(flea_data, "data/2013_2016_2019", "temporal_stratification.tif"),
+      file.path(
+        flea_data, "data/2013_2016_2019", "temporal_stratification.tif"
+      ),
     overwrite = FALSE
   )
 }
@@ -227,7 +232,8 @@ plot(`activeCat<-`(temporal_stratification, "Urbaan"))
 plot(`activeCat<-`(temporal_stratification, "Urbaan_changecat"))
 
 
-# calculate for each pixel the dominant temporal stratum inside a 9x9 block centered
+# calculate for each pixel the dominant temporal stratum inside a 9x9 block
+# centered
 # on the focal pixel
 temporal_stratification_modal9 <- focal(
   temporal_stratification,
@@ -239,11 +245,11 @@ temporal_stratification_modal9 <- focal(
 library(Rcpp)
 sourceCpp(here::here("source/scripts/unique-landuse-count.cpp"))
 # Then use it with focalCpp
-temporal_stratification_countunique9 <- terra::focalCpp(
+ts_countunique9 <- terra::focalCpp(
   x = temporal_stratification, w = 9, count_unique_landuse
 )
-hist(temporal_stratification_countunique9, maxcell = 1e7)
-plot(temporal_stratification_countunique9)
+hist(ts_countunique9, maxcell = 1e7)
+plot(ts_countunique9)
 
 jointable <- cats(temporal_stratification)[[1]] |>
   as_tibble() |>
@@ -414,7 +420,7 @@ all.equal(t1, t2)
 all_samples_collapsed <- all_samples_collapsed |>
   bind_cols(t2)
 
-all_samples_collapsed_sample_sizes <- all_samples_collapsed |>
+all_samples_collapsed_n <- all_samples_collapsed |>
   st_drop_geometry() |>
   inner_join(
     catstable_ts |>

source/scripts/test_sampling_design.R

@@ -29,7 +29,9 @@ slyr <- xml2::read_xml(
   file.path(flea_data, "data", "2013", "LG2013_finaal_update.qml")
 )
 
-catstable <- xml2::xml_find_all(x = slyr, ".//pipe//rasterrenderer//colorPalette") |>
+catstable <- xml2::xml_find_all(
+  x = slyr, ".//pipe//rasterrenderer//colorPalette"
+  ) |>
   xml2::xml_contents() |>
   purrr::map(xml2::xml_attrs) |>
   purrr::map_df(~ as.list(.)) |>
@@ -45,7 +47,7 @@ apply_cats <- function(x, cats = catstable, name, coltab = TRUE) {
   levels(xc) <- cats
   if (coltab) {
     coltab(xc) <- cats |>
-      dplyr::select(value, color) |>
+      dplyr::select(value, color) |> # nolint
       as.data.frame()
   }
   names(xc) <- name
@@ -56,15 +58,16 @@ lg2013 <- apply_cats(lg2013, name = "lg2013")
 lg2016 <- apply_cats(lg2016, name = "lg2016")
 lg2019 <- apply_cats(lg2019, name = "lg2019")
 
-# qgisprocess::qgis_show_help("grass:r.neighbors")
+# see qgisprocess qgis_show_help for "grass:r.neighbors"
 microbenchmark::microbenchmark(
   {
     qgisprocess::qgis_run_algorithm(
       "grass:r.neighbors",
       input = lg2013,
       method = "mode",
       size = 9,
-      output = file.path(flea_data, "data", "2013", "LG2013_mode_filter_9x9.tif"),
+      output =
+        file.path(flea_data, "data", "2013", "LG2013_mode_filter_9x9.tif"),
       .quiet = FALSE
     )
   },
@@ -516,7 +519,7 @@ for (i in unique(lg2013_strat_points_df$lg2013)) {
   )
   lg2013_sample_strat[[i]] <- df %>%
     slice(rowindex) %>%
-    mutate(order = 1:n())
+    mutate(order = seq_len(n()))
 }
 
 lg2013_sample_strat <- bind_rows(lg2013_sample_strat)

source/scripts/test_validation_functions.R

@@ -15,7 +15,7 @@ conflicted::conflicts_prefer(dplyr::filter)
 
 # load validation.Rdata
 # this file was produced by
-# validation_data(data_root = flea_data)
+# validation_data function with data_root = flea_data
 # but it is currently not working, probably due to different package versions
 # anyway, not really needed for this script
 load(
@@ -162,9 +162,9 @@ reschange2 <- calculate_accuracy(
   observed_changes$mapchange, observed_changes$refchange
 )
 
-A <- reschange1$byClass[, c(1, 2, 5, 6)]
-rownames(A) <- str_remove(rownames(A), "Class: ")
-A |>
+a <- reschange1$byClass[, c(1, 2, 5, 6)]
+rownames(a) <- str_remove(rownames(a), "Class: ")
+a |>
   round(digits = 2) |>
   knitr::kable(
     caption = str_c(