diff --git a/source/scripts/cmon_sqlite_to_geotiff.R b/source/scripts/cmon_sqlite_to_geotiff.R index aea0640..8d32485 100644 --- a/source/scripts/cmon_sqlite_to_geotiff.R +++ b/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", diff --git a/source/scripts/explore_categories_of_change.R b/source/scripts/explore_categories_of_change.R index 02f3b42..bc7c7af 100644 --- a/source/scripts/explore_categories_of_change.R +++ b/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() diff --git a/source/scripts/flea_functions.R b/source/scripts/flea_functions.R index 08c31d7..3127d3f 100644 --- a/source/scripts/flea_functions.R +++ b/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)) diff --git a/source/scripts/nca_functions.R b/source/scripts/nca_functions.R index d934203..61c48c1 100644 --- a/source/scripts/nca_functions.R +++ b/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 diff --git a/source/scripts/test_grts_sampling_design.R b/source/scripts/test_grts_sampling_design.R index 5c16a37..7ce52be 100644 --- a/source/scripts/test_grts_sampling_design.R +++ b/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,16 +111,16 @@ 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" @@ -125,26 +128,26 @@ if (file.exists( } 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 |> diff --git a/source/scripts/test_sampling_design.R b/source/scripts/test_sampling_design.R index 2594469..00bb924 100644 --- a/source/scripts/test_sampling_design.R +++ b/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,7 +58,7 @@ 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( @@ -64,7 +66,8 @@ microbenchmark::microbenchmark( 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) diff --git a/source/scripts/test_validation_functions.R b/source/scripts/test_validation_functions.R index 49ca296..a3b5b02 100644 --- a/source/scripts/test_validation_functions.R +++ b/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(