From f4fbdce3d89da520b404c92da5d3dc6e3f820071 Mon Sep 17 00:00:00 2001 From: jn Date: Mon, 9 Feb 2026 14:00:08 +0100 Subject: [PATCH 1/8] cleans vigs --- _pkgdown.yml | 2 ++ vignettes/articles/v2-intro.Rmd | 1 - 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index d6f1657..b059e29 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -16,6 +16,8 @@ navbar: href: articles/v2-parameters.html - text: Evaluation and diagnostics href: articles/v2-evaluation.html + - text: Benchmarks + href: articles/v2-benchmarks.html # - text: Title A1 # href: articles/a1.html # - text: Title A2 diff --git a/vignettes/articles/v2-intro.Rmd b/vignettes/articles/v2-intro.Rmd index 8f2c09b..962c6ba 100644 --- a/vignettes/articles/v2-intro.Rmd +++ b/vignettes/articles/v2-intro.Rmd @@ -88,7 +88,6 @@ Here, we specified `step = 8` which would result in supercells of approximately The compactness is set to `1` -- the behavior of this parameter depends on many factors, including the range of values in the raster, their properties, and the selected distance measure. ```{r} -# Polygon supercells (sf) vol_sc <- sc_slic( vol, step = 8, From e4a8ba59fddc7ecfa4923057a43ad703eea74c43 Mon Sep 17 00:00:00 2001 From: jn Date: Mon, 9 Feb 2026 15:17:47 +0100 Subject: [PATCH 2/8] improves metrics global outputs --- R/sc_metrics_global.R | 18 +++++++++++------- man/sc_metrics_global.Rd | 6 ++++-- man/sc_slic_convergence.Rd | 9 ++------- man/sc_slic_points.Rd | 3 ++- tests/testthat/test-sc-metrics.R | 8 ++++---- 5 files changed, 23 insertions(+), 21 deletions(-) diff --git a/R/sc_metrics_global.R b/R/sc_metrics_global.R index 7ebaa8a..849106f 100644 --- a/R/sc_metrics_global.R +++ b/R/sc_metrics_global.R @@ -30,8 +30,10 @@ #' \describe{ #' \item{step}{Step size used to generate supercells. Returned in meters when #' the input used `step = use_meters(...)`, otherwise in cells.} -#' \item{compactness}{Compactness value used to generate supercells.} -#' \item{adaptive_method}{Adaptive compactness method; `NA` for fixed compactness.} +#' \item{compactness}{Compactness value used to generate supercells; `NA` for +#' adaptive compactness.} +#' \item{compactness_method}{Compactness method: `"constant"` for fixed +#' compactness, `"local_max"` for adaptive compactness.} #' \item{n_supercells}{Number of supercells with at least one non-missing pixel.} #' \item{mean_value_dist}{Mean per-supercell value distance from cells to their #' supercell centers, averaged across supercells. Returned as `mean_value_dist` @@ -95,13 +97,15 @@ sc_metrics_global = function(x, sc, ) names(out_metrics) = unname(name_map[metrics]) step_out = prep$step_meta - adaptive_method_out = prep$adaptive_method - if (is.null(adaptive_method_out)) { - adaptive_method_out = NA_character_ + compactness_out = prep$compactness + compactness_method_out = "constant" + if (isTRUE(prep$adaptive_compactness)) { + compactness_out = NA_real_ + compactness_method_out = prep$adaptive_method } results = cbind( - data.frame(step = step_out, compactness = prep$compactness, - adaptive_method = adaptive_method_out, + data.frame(step = step_out, compactness = compactness_out, + compactness_method = compactness_method_out, n_supercells = out[["n_supercells"]]), out_metrics ) diff --git a/man/sc_metrics_global.Rd b/man/sc_metrics_global.Rd index 07f2ac5..ac98aa7 100644 --- a/man/sc_metrics_global.Rd +++ b/man/sc_metrics_global.Rd @@ -49,8 +49,10 @@ values indicate spatial dominance; positive values indicate value dominance.} \describe{ \item{step}{Step size used to generate supercells. Returned in meters when the input used \code{step = use_meters(...)}, otherwise in cells.} -\item{compactness}{Compactness value used to generate supercells.} -\item{adaptive_method}{Adaptive compactness method; \code{NA} for fixed compactness.} +\item{compactness}{Compactness value used to generate supercells; \code{NA} for +adaptive compactness.} +\item{compactness_method}{Compactness method: \code{"constant"} for fixed +compactness, \code{"local_max"} for adaptive compactness.} \item{n_supercells}{Number of supercells with at least one non-missing pixel.} \item{mean_value_dist}{Mean per-supercell value distance from cells to their supercell centers, averaged across supercells. Returned as \code{mean_value_dist} diff --git a/man/sc_slic_convergence.Rd b/man/sc_slic_convergence.Rd index 68cc43d..16c5883 100644 --- a/man/sc_slic_convergence.Rd +++ b/man/sc_slic_convergence.Rd @@ -2,7 +2,6 @@ % Please edit documentation in R/sc_slic_convergence.R \name{sc_slic_convergence} \alias{sc_slic_convergence} -\alias{plot.sc_slic_convergence} \title{SLIC convergence diagnostics} \usage{ sc_slic_convergence( @@ -18,8 +17,6 @@ sc_slic_convergence( centers = NULL, verbose = 0 ) - -\method{plot}{sc_slic_convergence}(x, ...) } \arguments{ \item{x}{An object of class SpatRaster (terra) or class stars (stars).} @@ -50,8 +47,6 @@ function must accept a numeric vector and return a single numeric value.} \item{centers}{Optional sf object of custom centers. Requires \code{step}.} \item{verbose}{Verbosity level.} - -\item{...}{Additional arguments passed to \code{\link[graphics:plot.default]{graphics::plot()}}.} } \value{ A data frame with class \code{sc_slic_convergence} and columns: @@ -62,7 +57,7 @@ A data frame with class \code{sc_slic_convergence} and columns: } \description{ Runs SLIC and returns per-iteration mean combined distance. -The output can be plotted directly with \code{\link[=plot.sc_slic_convergence]{plot()}}. +The output can be plotted directly with \code{\link[=plot]{plot()}}. } \examples{ library(supercells) @@ -71,5 +66,5 @@ conv = sc_slic_convergence(vol, step = 8, compactness = 5, iter = 10) plot(conv) } \seealso{ -\code{\link[=sc_slic]{sc_slic()}}, \code{\link[=plot.sc_slic_convergence]{plot()}} +\code{\link[=sc_slic]{sc_slic()}}, \code{\link[=plot]{plot()}} } diff --git a/man/sc_slic_points.Rd b/man/sc_slic_points.Rd index c8e0db6..825c4e9 100644 --- a/man/sc_slic_points.Rd +++ b/man/sc_slic_points.Rd @@ -50,7 +50,8 @@ function must accept a numeric vector and return a single numeric value.} \item{outcomes}{Character vector controlling which fields are returned. Allowed values are "supercells", "coordinates", and "values". Default is -"values". Use \code{outcomes = c("supercells", "coordinates", "values")} for full output.} +full output (\code{c("supercells", "coordinates", "values")}). +Use \code{outcomes = "values"} for value summaries only.} \item{chunks}{Chunking option. Use \code{FALSE} for no chunking, \code{TRUE} for automatic chunking based on size, or a numeric value for a fixed chunk size diff --git a/tests/testthat/test-sc-metrics.R b/tests/testthat/test-sc-metrics.R index c05d37f..27c3b3f 100644 --- a/tests/testthat/test-sc-metrics.R +++ b/tests/testthat/test-sc-metrics.R @@ -21,7 +21,7 @@ test_that("metrics outputs have expected structure", { gl = sc_metrics_global(v1, sc_full) expect_s3_class(gl, "data.frame") expect_equal(nrow(gl), 1) - expect_true(all(c("step", "compactness", "adaptive_method", "n_supercells", + expect_true(all(c("step", "compactness", "compactness_method", "n_supercells", "mean_value_dist_scaled", "mean_spatial_dist_scaled", "mean_combined_dist", "balance") %in% names(gl))) }) @@ -36,11 +36,11 @@ test_that("metrics use stored attributes and dist_fun defaults", { gl = sc_metrics_global(v1, sc_full) expect_equal(gl$step, attr(sc_full, "step")) expect_equal(gl$compactness, attr(sc_full, "compactness")) - expect_true(is.na(gl$adaptive_method)) + expect_equal(gl$compactness_method, "constant") gl_auto = sc_metrics_global(v1, sc_auto) - expect_equal(gl_auto$compactness, 0) - expect_equal(gl_auto$adaptive_method, "local_max") + expect_true(is.na(gl_auto$compactness)) + expect_equal(gl_auto$compactness_method, "local_max") g_attr = sc_metrics_global(v1, sc_custom) g_explicit = sc_metrics_global(v1, sc_custom, dist_fun = manhattan) From 5d429fc90782e5c73cded691537d88549a01f268 Mon Sep 17 00:00:00 2001 From: jn Date: Mon, 9 Feb 2026 15:28:51 +0100 Subject: [PATCH 3/8] cleans attributes --- R/helpers-general.R | 4 ++-- R/helpers-metrics.R | 25 ++++++++++++++----------- R/helpers-sc_slic.R | 10 +++++++--- R/sc_metrics_global.R | 3 +-- R/sc_metrics_pixels.R | 2 +- R/sc_slic.R | 4 ++-- man/sc_metrics_global.Rd | 2 +- man/sc_metrics_pixels.Rd | 2 +- man/sc_metrics_supercells.Rd | 2 +- man/sc_slic.Rd | 4 ++-- tests/testthat/test-sc-create.R | 6 +++--- 11 files changed, 35 insertions(+), 29 deletions(-) diff --git a/R/helpers-general.R b/R/helpers-general.R index aa8200b..93d95bd 100644 --- a/R/helpers-general.R +++ b/R/helpers-general.R @@ -94,11 +94,11 @@ # normalize compactness input for slic/metrics workflows .sc_util_prep_compactness = function(compactness) { if (is.numeric(compactness) && length(compactness) == 1 && !is.na(compactness) && compactness > 0) { - return(list(value = compactness, adaptive = FALSE, adaptive_method = NULL)) + return(list(value = compactness, adaptive = FALSE, compactness_method = "constant")) } if (inherits(compactness, "sc_adaptive")) { - return(list(value = 0, adaptive = TRUE, adaptive_method = compactness$method)) + return(list(value = 0, adaptive = TRUE, compactness_method = compactness$method)) } stop("The 'compactness' argument must be a single positive number or use_adaptive()", call. = FALSE) } diff --git a/R/helpers-metrics.R b/R/helpers-metrics.R index 2da4606..01c306c 100644 --- a/R/helpers-metrics.R +++ b/R/helpers-metrics.R @@ -44,25 +44,28 @@ if (missing(compactness)) { compactness = attr(sc, "compactness") } - adaptive_method = attr(sc, "adaptive_method") - if (!is.null(adaptive_method) && is.null(compactness)) { - compactness = 0 - } + compactness_method = attr(sc, "compactness_method") if (missing(step)) { step = attr(sc, "step") } - if (is.null(compactness) || is.null(step)) { + if (is.null(step)) { stop("Both 'compactness' and 'step' are required", call. = FALSE) } - if (!is.null(adaptive_method)) { - if (!is.character(adaptive_method) || length(adaptive_method) != 1 || is.na(adaptive_method) || - adaptive_method != "local_max") { - stop("The 'adaptive_method' attribute must be 'local_max' or NULL", call. = FALSE) + if (!is.null(compactness_method)) { + if (!is.character(compactness_method) || length(compactness_method) != 1 || is.na(compactness_method) || + !(compactness_method %in% c("constant", "local_max"))) { + stop("The 'compactness_method' attribute must be 'constant' or 'local_max'", call. = FALSE) } - compactness_prep = list(value = 0, adaptive = TRUE, adaptive_method = adaptive_method) + } + + if (identical(compactness_method, "local_max")) { + compactness_prep = list(value = 0, adaptive = TRUE, compactness_method = "local_max") } else { compactness_prep = .sc_util_prep_compactness(compactness) + if (!is.null(compactness_method) && compactness_prep$compactness_method != compactness_method) { + stop("The provided compactness method conflicts with 'compactness_method' attribute", call. = FALSE) + } } step_prep = .sc_util_step_to_cells(raster, step) step = step_prep$step @@ -99,7 +102,7 @@ step_meta = step_prep$step_meta, compactness = compactness_prep$value, adaptive_compactness = compactness_prep$adaptive, - adaptive_method = compactness_prep$adaptive_method, + compactness_method = compactness_prep$compactness_method, spatial_scale = spatial_scale, step_scale = step_scale ) diff --git a/R/helpers-sc_slic.R b/R/helpers-sc_slic.R index 4c02b87..1fb9234 100644 --- a/R/helpers-sc_slic.R +++ b/R/helpers-sc_slic.R @@ -44,7 +44,7 @@ outcomes = outcomes, compactness = compactness_prep$value, adaptive_compactness = compactness_prep$adaptive, - adaptive_method = compactness_prep$adaptive_method, + compactness_method = compactness_prep$compactness_method, clean = clean, iter = iter, verbose = verbose, verbose_cpp = verbose_cpp)) } @@ -196,9 +196,13 @@ slic_sf = .sc_slic_select_outcomes(slic_sf, prep$outcomes) + compactness_attr = prep$compactness + if (isTRUE(prep$adaptive_compactness)) { + compactness_attr = NA_real_ + } attr(slic_sf, "step") = prep$step_meta - attr(slic_sf, "compactness") = prep$compactness - attr(slic_sf, "adaptive_method") = prep$adaptive_method + attr(slic_sf, "compactness") = compactness_attr + attr(slic_sf, "compactness_method") = prep$compactness_method attr(slic_sf, "dist_fun") = prep$dist_fun_input cls = class(slic_sf) cls = c(setdiff(cls, "data.frame"), "supercells", "data.frame") diff --git a/R/sc_metrics_global.R b/R/sc_metrics_global.R index 849106f..9b67677 100644 --- a/R/sc_metrics_global.R +++ b/R/sc_metrics_global.R @@ -98,10 +98,9 @@ sc_metrics_global = function(x, sc, names(out_metrics) = unname(name_map[metrics]) step_out = prep$step_meta compactness_out = prep$compactness - compactness_method_out = "constant" + compactness_method_out = prep$compactness_method if (isTRUE(prep$adaptive_compactness)) { compactness_out = NA_real_ - compactness_method_out = prep$adaptive_method } results = cbind( data.frame(step = step_out, compactness = compactness_out, diff --git a/R/sc_metrics_pixels.R b/R/sc_metrics_pixels.R index 6f65f17..cde02e0 100644 --- a/R/sc_metrics_pixels.R +++ b/R/sc_metrics_pixels.R @@ -13,7 +13,7 @@ #' If missing, uses `attr(sc, "step")` when available #' @param compactness A compactness value used for the supercells #' If missing, uses `attr(sc, "compactness")` when available. -#' Adaptive mode is read from `attr(sc, "adaptive_method")` when available. +#' Compactness mode is read from `attr(sc, "compactness_method")` when available. #' @param dist_fun A distance function name or function, as in [sc_slic()]. #' If missing or `NULL`, uses `attr(sc, "dist_fun")` when available. #' diff --git a/R/sc_slic.R b/R/sc_slic.R index 61d1536..b3e8d50 100644 --- a/R/sc_slic.R +++ b/R/sc_slic.R @@ -45,8 +45,8 @@ #' @param verbose Verbosity level. #' #' @return An sf object with the supercell polygons and summary statistics. -#' Information on `step`, `compactness`, and `adaptive_method` are attached to -#' the result as attributes (`adaptive_method` is `NULL` for fixed compactness). +#' Information on `step`, `compactness`, and `compactness_method` are attached to +#' the result as attributes (`compactness` is `NA` for adaptive compactness). #' #' @references Achanta, R., Shaji, A., Smith, K., Lucchi, A., Fua, P., & Süsstrunk, S. (2012). SLIC Superpixels Compared to State-of-the-Art Superpixel Methods. IEEE Transactions on Pattern Analysis and Machine Intelligence, 34(11), 2274–2282. https://doi.org/10.1109/tpami.2012.120 #' @references Nowosad, J., Stepinski, T. (2022). Extended SLIC superpixels algorithm for applications to non-imagery geospatial rasters. International Journal of Applied Earth Observation and Geoinformation, https://doi.org/10.1016/j.jag.2022.102935 diff --git a/man/sc_metrics_global.Rd b/man/sc_metrics_global.Rd index ac98aa7..00b9622 100644 --- a/man/sc_metrics_global.Rd +++ b/man/sc_metrics_global.Rd @@ -31,7 +31,7 @@ If missing, uses \code{attr(sc, "step")} when available} \item{compactness}{A compactness value used for the supercells If missing, uses \code{attr(sc, "compactness")} when available. -Adaptive mode is read from \code{attr(sc, "adaptive_method")} when available.} +Compactness mode is read from \code{attr(sc, "compactness_method")} when available.} \item{dist_fun}{A distance function name or function, as in \code{\link[=sc_slic]{sc_slic()}}. If missing or \code{NULL}, uses \code{attr(sc, "dist_fun")} when available.} diff --git a/man/sc_metrics_pixels.Rd b/man/sc_metrics_pixels.Rd index 36355bf..ade9537 100644 --- a/man/sc_metrics_pixels.Rd +++ b/man/sc_metrics_pixels.Rd @@ -31,7 +31,7 @@ If missing, uses \code{attr(sc, "step")} when available} \item{compactness}{A compactness value used for the supercells If missing, uses \code{attr(sc, "compactness")} when available. -Adaptive mode is read from \code{attr(sc, "adaptive_method")} when available.} +Compactness mode is read from \code{attr(sc, "compactness_method")} when available.} \item{dist_fun}{A distance function name or function, as in \code{\link[=sc_slic]{sc_slic()}}. If missing or \code{NULL}, uses \code{attr(sc, "dist_fun")} when available.} diff --git a/man/sc_metrics_supercells.Rd b/man/sc_metrics_supercells.Rd index b8bfb13..e4f2f22 100644 --- a/man/sc_metrics_supercells.Rd +++ b/man/sc_metrics_supercells.Rd @@ -31,7 +31,7 @@ If missing, uses \code{attr(sc, "step")} when available} \item{compactness}{A compactness value used for the supercells If missing, uses \code{attr(sc, "compactness")} when available. -Adaptive mode is read from \code{attr(sc, "adaptive_method")} when available.} +Compactness mode is read from \code{attr(sc, "compactness_method")} when available.} \item{dist_fun}{A distance function name or function, as in \code{\link[=sc_slic]{sc_slic()}}. If missing or \code{NULL}, uses \code{attr(sc, "dist_fun")} when available.} diff --git a/man/sc_slic.Rd b/man/sc_slic.Rd index f8a7946..f6da884 100644 --- a/man/sc_slic.Rd +++ b/man/sc_slic.Rd @@ -61,8 +61,8 @@ automatic chunking based on size, or a numeric value for a fixed chunk size } \value{ An sf object with the supercell polygons and summary statistics. -Information on \code{step}, \code{compactness}, and \code{adaptive_method} are attached to -the result as attributes (\code{adaptive_method} is \code{NULL} for fixed compactness). +Information on \code{step}, \code{compactness}, and \code{compactness_method} are attached to +the result as attributes (\code{compactness} is \code{NA} for adaptive compactness). } \description{ Creates supercells from single- or multi-band rasters using an extended SLIC algorithm. diff --git a/tests/testthat/test-sc-create.R b/tests/testthat/test-sc-create.R index 93cfe96..b0a4ae3 100644 --- a/tests/testthat/test-sc-create.R +++ b/tests/testthat/test-sc-create.R @@ -5,11 +5,11 @@ test_that("sc_slic returns core output and attributes", { expect_true(all(c("supercells", "x", "y") %in% names(sc))) expect_false(is.null(attr(sc, "step"))) expect_equal(attr(sc, "compactness"), 1) - expect_null(attr(sc, "adaptive_method")) + expect_equal(attr(sc, "compactness_method"), "constant") sc_auto = sc_slic(v1, step = 8, compactness = use_adaptive()) - expect_equal(attr(sc_auto, "compactness"), 0) - expect_equal(attr(sc_auto, "adaptive_method"), "local_max") + expect_true(is.na(attr(sc_auto, "compactness"))) + expect_equal(attr(sc_auto, "compactness_method"), "local_max") }) test_that("sc_slic supports custom centers", { From bcb598eeafdee5c5a14a3962d37bbfa8fcb9b0dc Mon Sep 17 00:00:00 2001 From: jn Date: Mon, 9 Feb 2026 15:50:59 +0100 Subject: [PATCH 4/8] adds slic params funs --- NAMESPACE | 2 + R/sc_slic_params.R | 56 ++++++++++++++++++++++++++++ man/sc_slic_params.Rd | 34 +++++++++++++++++ tests/testthat/test-sc-slic-params.R | 26 +++++++++++++ 4 files changed, 118 insertions(+) create mode 100644 R/sc_slic_params.R create mode 100644 man/sc_slic_params.Rd create mode 100644 tests/testthat/test-sc-slic-params.R diff --git a/NAMESPACE b/NAMESPACE index b7d2867..8595c3f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,8 +6,10 @@ export(sc_metrics_pixels) export(sc_metrics_supercells) export(sc_slic) export(sc_slic_convergence) +export(sc_slic_get_params) export(sc_slic_points) export(sc_slic_raster) +export(sc_slic_set_params) export(sc_tune_compactness) export(supercells) export(use_adaptive) diff --git a/R/sc_slic_params.R b/R/sc_slic_params.R new file mode 100644 index 0000000..81630ac --- /dev/null +++ b/R/sc_slic_params.R @@ -0,0 +1,56 @@ +#' Get stored `sc_slic()` parameters +#' +#' Returns key `sc_slic()` parameters stored as attributes on a supercells object. +#' +#' @param sc An sf object returned by [sc_slic()]. +#' +#' @return A one-row data.frame with columns: +#' `step`, `compactness`, `compactness_method`, and `dist_fun`. +#' The `dist_fun` column is character; custom distance functions are stored as +#' `NA`. +#' +#' @seealso [sc_slic()], [sc_slic_set_params()] +#' @export +sc_slic_get_params = function(sc) { + dist_fun = attr(sc, "dist_fun") + if (is.function(dist_fun)) { + dist_fun = NA_character_ + } + data.frame( + step = attr(sc, "step"), + compactness = attr(sc, "compactness"), + compactness_method = attr(sc, "compactness_method"), + dist_fun = dist_fun + ) +} + +#' Set stored `sc_slic()` parameters +#' +#' Writes key `sc_slic()` parameters to attributes on a supercells object. +#' +#' @param sc An sf object. +#' @param params A data.frame, typically from [sc_slic_get_params()]. Only the +#' first row is used. +#' +#' @return The input object with updated attributes. +#' +#' @seealso [sc_slic()], [sc_slic_get_params()] +#' @export +sc_slic_set_params = function(sc, params) { + expected_cols = c("step", "compactness", "compactness_method", "dist_fun") + if (!all(expected_cols %in% names(params))) { + stop("params must contain columns: step, compactness, compactness_method, dist_fun", call. = FALSE) + } + + attr(sc, "step") = params[["step"]][1] + attr(sc, "compactness") = params[["compactness"]][1] + attr(sc, "compactness_method") = params[["compactness_method"]][1] + dist_fun = params[["dist_fun"]][1] + if (is.na(dist_fun)) { + attr(sc, "dist_fun") = NULL + } else { + attr(sc, "dist_fun") = dist_fun + } + + sc +} diff --git a/man/sc_slic_params.Rd b/man/sc_slic_params.Rd new file mode 100644 index 0000000..1887586 --- /dev/null +++ b/man/sc_slic_params.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sc_slic_params.R +\name{sc_slic_get_params} +\alias{sc_slic_get_params} +\alias{sc_slic_set_params} +\title{Get stored `sc_slic()` parameters} +\usage{ +sc_slic_get_params(sc) + +sc_slic_set_params(sc, params) +} +\arguments{ +\item{sc}{An sf object returned by \code{\link[=sc_slic]{sc_slic()}}.} + +\item{params}{A data.frame, typically from \code{\link[=sc_slic_get_params]{sc_slic_get_params()}}. Only the +first row is used.} +} +\value{ +\code{sc_slic_get_params()}: A one-row data.frame with columns: +\code{step}, \code{compactness}, \code{compactness_method}, and \code{dist_fun}. +The \code{dist_fun} column is character; custom distance functions are stored as +\code{NA}. + +\code{sc_slic_set_params()}: The input object with updated attributes. +} +\description{ +\code{sc_slic_get_params()} returns key \code{sc_slic()} parameters stored as attributes on a supercells object. +} +\details{ +\code{sc_slic_set_params()} writes key \code{sc_slic()} parameters to attributes on a supercells object. +} +\seealso{ +\code{\link[=sc_slic]{sc_slic()}}, \code{\link[=sc_slic_set_params]{sc_slic_set_params()}} +} diff --git a/tests/testthat/test-sc-slic-params.R b/tests/testthat/test-sc-slic-params.R new file mode 100644 index 0000000..01a9ff5 --- /dev/null +++ b/tests/testthat/test-sc-slic-params.R @@ -0,0 +1,26 @@ +test_that("sc_slic_get_params/sc_slic_set_params work with minimal roundtrip", { + sc = sc_slic(v1, step = 8, compactness = 1) + params = sc_slic_get_params(sc) + + expect_s3_class(params, "data.frame") + expect_equal(nrow(params), 1) + expect_true(all(c("step", "compactness", "compactness_method", "dist_fun") %in% names(params))) + expect_true(is.character(params$dist_fun)) + + sc2 = sc + attr(sc2, "step") = NULL + attr(sc2, "compactness") = NULL + attr(sc2, "compactness_method") = NULL + attr(sc2, "dist_fun") = NULL + sc2 = sc_slic_set_params(sc2, params) + + expect_equal(attr(sc2, "step"), attr(sc, "step")) + expect_equal(attr(sc2, "compactness"), attr(sc, "compactness")) + expect_equal(attr(sc2, "compactness_method"), attr(sc, "compactness_method")) + expect_equal(attr(sc2, "dist_fun"), attr(sc, "dist_fun")) + + manhattan = function(a, b) sum(abs(a - b)) + sc_custom = sc_slic(v1, step = 8, compactness = 1, dist_fun = manhattan) + params_custom = sc_slic_get_params(sc_custom) + expect_true(is.na(params_custom$dist_fun)) +}) From 85e6baaacc72ed5cf24b1f4bf749d1e0b87b1be1 Mon Sep 17 00:00:00 2001 From: jn Date: Mon, 9 Feb 2026 18:32:52 +0100 Subject: [PATCH 5/8] updates docs --- man/sc_slic_get_params.Rd | 23 +++++++++++++++++++++++ man/sc_slic_params.Rd | 34 ---------------------------------- man/sc_slic_set_params.Rd | 23 +++++++++++++++++++++++ 3 files changed, 46 insertions(+), 34 deletions(-) create mode 100644 man/sc_slic_get_params.Rd delete mode 100644 man/sc_slic_params.Rd create mode 100644 man/sc_slic_set_params.Rd diff --git a/man/sc_slic_get_params.Rd b/man/sc_slic_get_params.Rd new file mode 100644 index 0000000..07ec768 --- /dev/null +++ b/man/sc_slic_get_params.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sc_slic_params.R +\name{sc_slic_get_params} +\alias{sc_slic_get_params} +\title{Get stored \code{sc_slic()} parameters} +\usage{ +sc_slic_get_params(sc) +} +\arguments{ +\item{sc}{An sf object returned by \code{\link[=sc_slic]{sc_slic()}}.} +} +\value{ +A one-row data.frame with columns: +\code{step}, \code{compactness}, \code{compactness_method}, and \code{dist_fun}. +The \code{dist_fun} column is character; custom distance functions are stored as +\code{NA}. +} +\description{ +Returns key \code{sc_slic()} parameters stored as attributes on a supercells object. +} +\seealso{ +\code{\link[=sc_slic]{sc_slic()}}, \code{\link[=sc_slic_set_params]{sc_slic_set_params()}} +} diff --git a/man/sc_slic_params.Rd b/man/sc_slic_params.Rd deleted file mode 100644 index 1887586..0000000 --- a/man/sc_slic_params.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/sc_slic_params.R -\name{sc_slic_get_params} -\alias{sc_slic_get_params} -\alias{sc_slic_set_params} -\title{Get stored `sc_slic()` parameters} -\usage{ -sc_slic_get_params(sc) - -sc_slic_set_params(sc, params) -} -\arguments{ -\item{sc}{An sf object returned by \code{\link[=sc_slic]{sc_slic()}}.} - -\item{params}{A data.frame, typically from \code{\link[=sc_slic_get_params]{sc_slic_get_params()}}. Only the -first row is used.} -} -\value{ -\code{sc_slic_get_params()}: A one-row data.frame with columns: -\code{step}, \code{compactness}, \code{compactness_method}, and \code{dist_fun}. -The \code{dist_fun} column is character; custom distance functions are stored as -\code{NA}. - -\code{sc_slic_set_params()}: The input object with updated attributes. -} -\description{ -\code{sc_slic_get_params()} returns key \code{sc_slic()} parameters stored as attributes on a supercells object. -} -\details{ -\code{sc_slic_set_params()} writes key \code{sc_slic()} parameters to attributes on a supercells object. -} -\seealso{ -\code{\link[=sc_slic]{sc_slic()}}, \code{\link[=sc_slic_set_params]{sc_slic_set_params()}} -} diff --git a/man/sc_slic_set_params.Rd b/man/sc_slic_set_params.Rd new file mode 100644 index 0000000..2290a2c --- /dev/null +++ b/man/sc_slic_set_params.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sc_slic_params.R +\name{sc_slic_set_params} +\alias{sc_slic_set_params} +\title{Set stored \code{sc_slic()} parameters} +\usage{ +sc_slic_set_params(sc, params) +} +\arguments{ +\item{sc}{An sf object.} + +\item{params}{A data.frame, typically from \code{\link[=sc_slic_get_params]{sc_slic_get_params()}}. Only the +first row is used.} +} +\value{ +The input object with updated attributes. +} +\description{ +Writes key \code{sc_slic()} parameters to attributes on a supercells object. +} +\seealso{ +\code{\link[=sc_slic]{sc_slic()}}, \code{\link[=sc_slic_get_params]{sc_slic_get_params()}} +} From 22e9d624ae77d509aba4952499c865390deb0f47 Mon Sep 17 00:00:00 2001 From: jn Date: Mon, 9 Feb 2026 19:08:43 +0100 Subject: [PATCH 6/8] cleans docs --- R/sc_metrics_global.R | 29 ++++++++++++----------------- R/sc_metrics_supercells.R | 2 +- R/sc_slic.R | 2 +- R/sc_slic_points.R | 7 ++++--- R/sc_slic_raster.R | 2 +- man/sc_metrics_global.Rd | 29 ++++++++++++----------------- man/sc_metrics_supercells.Rd | 2 +- man/sc_slic.Rd | 2 +- man/sc_slic_points.Rd | 7 ++++--- man/sc_slic_raster.Rd | 2 +- 10 files changed, 38 insertions(+), 46 deletions(-) diff --git a/R/sc_metrics_global.R b/R/sc_metrics_global.R index 9b67677..ac69861 100644 --- a/R/sc_metrics_global.R +++ b/R/sc_metrics_global.R @@ -18,15 +18,7 @@ #' @param metrics Character vector of metric ideas to return. Options: #' `"spatial"`, `"value"`, `"combined"`, `"balance"`. Default: #' `c("spatial", "value", "combined", "balance")`. -#' @return A data.frame with a single row of global metrics and columns: -#' Interpretation: -#' \describe{ -#' \item{mean_value_dist}{Lower values indicate more homogeneous supercells.} -#' \item{mean_spatial_dist}{Lower values indicate more compact supercells.} -#' \item{mean_combined_dist}{Overall distance; mainly useful for ranking.} -#' \item{balance}{0 indicates balance between value and spatial terms; negative -#' values indicate spatial dominance; positive values indicate value dominance.} -#' } +#' @return A data.frame with a single row and columns: #' \describe{ #' \item{step}{Step size used to generate supercells. Returned in meters when #' the input used `step = use_meters(...)`, otherwise in cells.} @@ -35,22 +27,25 @@ #' \item{compactness_method}{Compactness method: `"constant"` for fixed #' compactness, `"local_max"` for adaptive compactness.} #' \item{n_supercells}{Number of supercells with at least one non-missing pixel.} -#' \item{mean_value_dist}{Mean per-supercell value distance from cells to their +#' \item{mean_value_dist / mean_value_dist_scaled}{Mean per-supercell value distance from cells to their #' supercell centers, averaged across supercells. Returned as `mean_value_dist` -#' (or `mean_value_dist_scaled` when `scale = TRUE`).} -#' \item{mean_spatial_dist}{Mean per-supercell spatial distance from cells to +#' (or `mean_value_dist_scaled` when `scale = TRUE`). Lower values indicate +#' more homogeneous supercells.} +#' \item{mean_spatial_dist / mean_spatial_dist_scaled}{Mean per-supercell spatial distance from cells to #' their supercell centers, averaged across supercells; units are grid cells #' (row/column index distance). If the input supercells were created with #' `step = use_meters(...)`, distances are reported in meters. Returned as -#' `mean_spatial_dist` (or `mean_spatial_dist_scaled` when `scale = TRUE`).} +#' `mean_spatial_dist` (or `mean_spatial_dist_scaled` when `scale = TRUE`). +#' Lower values indicate more compact supercells.} #' \item{mean_combined_dist}{Mean per-supercell combined distance, computed from #' value and spatial distances using `compactness` and `step`, averaged across -#' supercells. Returned as `mean_combined_dist`.} +#' supercells. Returned as `mean_combined_dist`. Lower values indicate lower +#' overall distance and are mainly useful for ranking.} #' \item{balance}{Mean signed log ratio of scaled value distance to scaled -#' spatial distance (averaged across supercells); 0 indicates balance.} +#' spatial distance (averaged across supercells); 0 indicates balance between +#' value and spatial terms, negative values indicate spatial dominance, and +#' positive values indicate value dominance.} #' } -#' When `scale = TRUE`, `mean_spatial_dist` and `mean_value_dist` are returned as -#' `mean_spatial_dist_scaled` and `mean_value_dist_scaled`. #' @seealso [`sc_slic()`], [`sc_metrics_pixels()`], [`sc_metrics_supercells()`] #' @export #' @examples diff --git a/R/sc_metrics_supercells.R b/R/sc_metrics_supercells.R index 045f506..1ec2c77 100644 --- a/R/sc_metrics_supercells.R +++ b/R/sc_metrics_supercells.R @@ -10,7 +10,7 @@ #' `c("spatial", "value", "combined", "balance")`. #' @details #' If `sc` lacks `supercells`, `x`, or `y` columns, they are derived from geometry -#' and row order, which may differ from the original centers +#' and row order, which may differ from the original centers. #' When using SLIC0 (set `compactness = use_adaptive()` in [sc_slic()]), combined and balance metrics use per-supercell #' adaptive compactness (SLIC0), and scaled value distances are computed with the #' per-supercell max value distance. diff --git a/R/sc_slic.R b/R/sc_slic.R index b3e8d50..384995f 100644 --- a/R/sc_slic.R +++ b/R/sc_slic.R @@ -15,7 +15,7 @@ #' \item Cluster diagnostics: [sc_metrics_supercells()] for per-supercell summaries. #' \item Global diagnostics: [sc_metrics_global()] for a single-row summary. #' } -#' @seealso [use_meters()], [use_adaptive()], [`sc_slic_raster()`], [`sc_slic_points()`], [`sc_slic_convergence()`], +#' @seealso [`sc_tune_compactness()`], [use_meters()], [use_adaptive()], [`sc_slic_raster()`], [`sc_slic_points()`], [`sc_slic_convergence()`], #' [`sc_metrics_pixels()`], [`sc_metrics_supercells()`], [`sc_metrics_global()`] #' #' @param x An object of class SpatRaster (terra) or class stars (stars). diff --git a/R/sc_slic_points.R b/R/sc_slic_points.R index 8300ab2..b0519a2 100644 --- a/R/sc_slic_points.R +++ b/R/sc_slic_points.R @@ -3,8 +3,9 @@ #' Runs the SLIC workflow and returns supercell centers as points. #' Use \code{iter = 0} to return the initial centers before iterations. #' For polygon outputs, use [`sc_slic()`]; for raster output, use [`sc_slic_raster()`] -#' By default, only value summaries are returned; add -#' `outcomes = c("supercells", "coordinates", "values")` to include ids and x/y. +#' By default, returns the same fields as [`sc_slic()`]: +#' `outcomes = c("supercells", "coordinates", "values")`. +#' Use `outcomes = "values"` for value summaries only. #' #' @inheritParams sc_slic #' @seealso [`sc_slic()`], [`sc_slic_raster()`] @@ -28,7 +29,7 @@ sc_slic_points = function(x, step = NULL, compactness, dist_fun = "euclidean", avg_fun = "mean", clean = TRUE, minarea, iter = 10, k = NULL, centers = NULL, - outcomes = "values", chunks = FALSE, + outcomes = c("supercells", "coordinates", "values"), chunks = FALSE, verbose = 0) { if (iter == 0) { clean = FALSE diff --git a/R/sc_slic_raster.R b/R/sc_slic_raster.R index 21db502..ff6756c 100644 --- a/R/sc_slic_raster.R +++ b/R/sc_slic_raster.R @@ -7,7 +7,7 @@ #' @inheritParams sc_slic #' @param outcomes Character vector controlling which fields are returned. #' Only `"supercells"` is supported in `sc_slic_raster()`. -#' @seealso [`sc_slic()`] +#' @seealso [`sc_slic()`], [`sc_slic_points()`] #' #' @return A SpatRaster with supercell IDs. #' diff --git a/man/sc_metrics_global.Rd b/man/sc_metrics_global.Rd index 00b9622..d525ce9 100644 --- a/man/sc_metrics_global.Rd +++ b/man/sc_metrics_global.Rd @@ -37,15 +37,7 @@ Compactness mode is read from \code{attr(sc, "compactness_method")} when availab If missing or \code{NULL}, uses \code{attr(sc, "dist_fun")} when available.} } \value{ -A data.frame with a single row of global metrics and columns: -Interpretation: -\describe{ -\item{mean_value_dist}{Lower values indicate more homogeneous supercells.} -\item{mean_spatial_dist}{Lower values indicate more compact supercells.} -\item{mean_combined_dist}{Overall distance; mainly useful for ranking.} -\item{balance}{0 indicates balance between value and spatial terms; negative -values indicate spatial dominance; positive values indicate value dominance.} -} +A data.frame with a single row and columns: \describe{ \item{step}{Step size used to generate supercells. Returned in meters when the input used \code{step = use_meters(...)}, otherwise in cells.} @@ -54,22 +46,25 @@ adaptive compactness.} \item{compactness_method}{Compactness method: \code{"constant"} for fixed compactness, \code{"local_max"} for adaptive compactness.} \item{n_supercells}{Number of supercells with at least one non-missing pixel.} -\item{mean_value_dist}{Mean per-supercell value distance from cells to their +\item{mean_value_dist / mean_value_dist_scaled}{Mean per-supercell value distance from cells to their supercell centers, averaged across supercells. Returned as \code{mean_value_dist} -(or \code{mean_value_dist_scaled} when \code{scale = TRUE}).} -\item{mean_spatial_dist}{Mean per-supercell spatial distance from cells to +(or \code{mean_value_dist_scaled} when \code{scale = TRUE}). Lower values indicate +more homogeneous supercells.} +\item{mean_spatial_dist / mean_spatial_dist_scaled}{Mean per-supercell spatial distance from cells to their supercell centers, averaged across supercells; units are grid cells (row/column index distance). If the input supercells were created with \code{step = use_meters(...)}, distances are reported in meters. Returned as -\code{mean_spatial_dist} (or \code{mean_spatial_dist_scaled} when \code{scale = TRUE}).} +\code{mean_spatial_dist} (or \code{mean_spatial_dist_scaled} when \code{scale = TRUE}). +Lower values indicate more compact supercells.} \item{mean_combined_dist}{Mean per-supercell combined distance, computed from value and spatial distances using \code{compactness} and \code{step}, averaged across -supercells. Returned as \code{mean_combined_dist}.} +supercells. Returned as \code{mean_combined_dist}. Lower values indicate lower +overall distance and are mainly useful for ranking.} \item{balance}{Mean signed log ratio of scaled value distance to scaled -spatial distance (averaged across supercells); 0 indicates balance.} +spatial distance (averaged across supercells); 0 indicates balance between +value and spatial terms, negative values indicate spatial dominance, and +positive values indicate value dominance.} } -When \code{scale = TRUE}, \code{mean_spatial_dist} and \code{mean_value_dist} are returned as -\code{mean_spatial_dist_scaled} and \code{mean_value_dist_scaled}. } \description{ Computes global distance diagnostics for supercells diff --git a/man/sc_metrics_supercells.Rd b/man/sc_metrics_supercells.Rd index e4f2f22..2e71b92 100644 --- a/man/sc_metrics_supercells.Rd +++ b/man/sc_metrics_supercells.Rd @@ -67,7 +67,7 @@ Computes per-supercell distance diagnostics } \details{ If \code{sc} lacks \code{supercells}, \code{x}, or \code{y} columns, they are derived from geometry -and row order, which may differ from the original centers +and row order, which may differ from the original centers. When using SLIC0 (set \code{compactness = use_adaptive()} in \code{\link[=sc_slic]{sc_slic()}}), combined and balance metrics use per-supercell adaptive compactness (SLIC0), and scaled value distances are computed with the per-supercell max value distance. diff --git a/man/sc_slic.Rd b/man/sc_slic.Rd index f6da884..01ab531 100644 --- a/man/sc_slic.Rd +++ b/man/sc_slic.Rd @@ -96,6 +96,6 @@ Achanta, R., Shaji, A., Smith, K., Lucchi, A., Fua, P., & Süsstrunk, S. (2012). Nowosad, J., Stepinski, T. (2022). Extended SLIC superpixels algorithm for applications to non-imagery geospatial rasters. International Journal of Applied Earth Observation and Geoinformation, https://doi.org/10.1016/j.jag.2022.102935 } \seealso{ -\code{\link[=use_meters]{use_meters()}}, \code{\link[=use_adaptive]{use_adaptive()}}, \code{\link[=sc_slic_raster]{sc_slic_raster()}}, \code{\link[=sc_slic_points]{sc_slic_points()}}, \code{\link[=sc_slic_convergence]{sc_slic_convergence()}}, +\code{\link[=sc_tune_compactness]{sc_tune_compactness()}}, \code{\link[=use_meters]{use_meters()}}, \code{\link[=use_adaptive]{use_adaptive()}}, \code{\link[=sc_slic_raster]{sc_slic_raster()}}, \code{\link[=sc_slic_points]{sc_slic_points()}}, \code{\link[=sc_slic_convergence]{sc_slic_convergence()}}, \code{\link[=sc_metrics_pixels]{sc_metrics_pixels()}}, \code{\link[=sc_metrics_supercells]{sc_metrics_supercells()}}, \code{\link[=sc_metrics_global]{sc_metrics_global()}} } diff --git a/man/sc_slic_points.Rd b/man/sc_slic_points.Rd index 825c4e9..4fb0c36 100644 --- a/man/sc_slic_points.Rd +++ b/man/sc_slic_points.Rd @@ -15,7 +15,7 @@ sc_slic_points( iter = 10, k = NULL, centers = NULL, - outcomes = "values", + outcomes = c("supercells", "coordinates", "values"), chunks = FALSE, verbose = 0 ) @@ -66,8 +66,9 @@ An sf object with supercell center points and summary statistics Runs the SLIC workflow and returns supercell centers as points. Use \code{iter = 0} to return the initial centers before iterations. For polygon outputs, use \code{\link[=sc_slic]{sc_slic()}}; for raster output, use \code{\link[=sc_slic_raster]{sc_slic_raster()}} -By default, only value summaries are returned; add -\code{outcomes = c("supercells", "coordinates", "values")} to include ids and x/y. +By default, returns the same fields as \code{\link[=sc_slic]{sc_slic()}}: +\code{outcomes = c("supercells", "coordinates", "values")}. +Use \code{outcomes = "values"} for value summaries only. } \examples{ library(supercells) diff --git a/man/sc_slic_raster.Rd b/man/sc_slic_raster.Rd index f0ed25c..6ed6330 100644 --- a/man/sc_slic_raster.Rd +++ b/man/sc_slic_raster.Rd @@ -72,5 +72,5 @@ vol_ids = sc_slic_raster(vol, step = 8, compactness = 1) terra::plot(vol_ids) } \seealso{ -\code{\link[=sc_slic]{sc_slic()}} +\code{\link[=sc_slic]{sc_slic()}}, \code{\link[=sc_slic_points]{sc_slic_points()}} } From 0fb552d54ab3ada11f85366db1c3291ba634fec0 Mon Sep 17 00:00:00 2001 From: jn Date: Mon, 9 Feb 2026 19:45:36 +0100 Subject: [PATCH 7/8] moves sc_merge_supercells to separate superregions --- NEWS.md | 2 - R/cpp11.R | 4 - R/sc_merge_supercells.R | 414 -------------------------------------- src/cpp11.cpp | 8 - src/distances_wrapper.cpp | 22 -- 5 files changed, 450 deletions(-) delete mode 100644 R/sc_merge_supercells.R delete mode 100644 src/distances_wrapper.cpp diff --git a/NEWS.md b/NEWS.md index f628f9c..9b2161f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,8 +4,6 @@ * Iteration diagnostics API redesigned: `iter_diagnostics` and `sc_plot_iter_diagnostics()` replaced by `sc_slic_convergence()` with a `plot()` method * Added `use_meters()` for map-distance step values (replacing `in_meters()`) * Added `use_adaptive()` for adaptive compactness mode (replacing `compactness = "auto"`) -* Added experimental `sc_merge_supercells()` for adjacency-constrained greedy merging -* Added `sc_dist_vec_cpp()` (C++ distance wrapper) to support merge utilities * Documentation and vignettes updated (pkgdown refresh, new articles, and revised examples) # supercells 1.8 diff --git a/R/cpp11.R b/R/cpp11.R index 7aa9ba9..9db3823 100644 --- a/R/cpp11.R +++ b/R/cpp11.R @@ -1,9 +1,5 @@ # Generated by cpp11: do not edit by hand -sc_dist_vec_cpp <- function(a, b, dist_name, dist_fun) { - .Call(`_supercells_sc_dist_vec_cpp`, a, b, dist_name, dist_fun) -} - sc_metrics_global_cpp <- function(clusters, centers_xy, centers_vals, vals, step, compactness, adaptive_compactness, dist_name, dist_fun) { .Call(`_supercells_sc_metrics_global_cpp`, clusters, centers_xy, centers_vals, vals, step, compactness, adaptive_compactness, dist_name, dist_fun) } diff --git a/R/sc_merge_supercells.R b/R/sc_merge_supercells.R deleted file mode 100644 index 85bd02c..0000000 --- a/R/sc_merge_supercells.R +++ /dev/null @@ -1,414 +0,0 @@ -# Prototype: merge adjacent supercells based on value-space distance. -# This is a minimal, adjacency-constrained greedy merge using sf input. - -# prepare a distance function wrapper -# input: dist_fun (string name or function) -# output: function(a, b) -> numeric distance -.sc_merge_dist_fun = function(dist_fun) { - if (is.function(dist_fun)) { - return(function(a, b) sc_dist_vec_cpp(a, b, "", dist_fun)) - } - if (!is.character(dist_fun) || length(dist_fun) != 1 || is.na(dist_fun)) { - stop("dist_fun must be a function or a single string", call. = FALSE) - } - if (!(dist_fun %in% c("euclidean", "jsd", "dtw", "dtw2d", philentropy::getDistMethods()))) { - stop("Unsupported dist_fun; provide a function for this distance", call. = FALSE) - } - dummy_fun = function() "" - return(function(a, b) sc_dist_vec_cpp(a, b, dist_fun, dummy_fun)) -} - -# build adjacency pairs and distances -# input: geoms (sfc), vals (matrix), dist_one (function) -# output: list(pairs = int matrix [m x 2], dists = numeric [m]) -.sc_merge_pairs_adjacent = function(geoms, vals, dist_one) { - adj = sf::st_touches(geoms) - if (length(adj) == 0) { - return(list(pairs = matrix(integer(0), ncol = 2), dists = numeric(0))) - } - pairs_list = lapply(seq_along(adj), function(i) { - nb = adj[[i]] - nb = nb[nb > i] - if (length(nb) == 0) return(NULL) - cbind(rep.int(i, length(nb)), nb) - }) - pairs = do.call(rbind, pairs_list) - if (is.null(pairs)) { - return(list(pairs = matrix(integer(0), ncol = 2), dists = numeric(0))) - } - dists = vapply(seq_len(nrow(pairs)), function(k) { - dist_one(vals[pairs[k, 1], ], vals[pairs[k, 2], ]) - }, numeric(1)) - list(pairs = pairs, dists = dists) -} - -# aggregate values/weights by group label -# input: groups (int vector), vals (matrix), w (numeric) -# output: list(group = reindexed groups, vals, w) -.sc_merge_aggregate_components = function(groups, vals, w) { - keep_ids = sort(unique(groups)) - id_map = stats::setNames(seq_len(length(keep_ids)), keep_ids) - group_ids = unname(id_map[as.character(groups)]) - new_vals = matrix(0, nrow = length(keep_ids), ncol = ncol(vals)) - new_w = numeric(length(keep_ids)) - for (idx in seq_along(groups)) { - gid = group_ids[idx] - wi = w[idx] - new_vals[gid, ] = new_vals[gid, ] + wi * vals[idx, ] - new_w[gid] = new_w[gid] + wi - } - new_vals = new_vals / new_w - list(group = group_ids, vals = new_vals, w = new_w) -} - -# finalize sf output from group labels and aggregated stats -# input: x (sf), geoms (sfc), group (int), vals_out (matrix), w_out (numeric) -# value_cols (char), weight_is_col (bool), has_xy (bool), crs_x (crs), -# dissolve_geoms (function) -# output: sf with merged geometry and updated attributes -.sc_merge_finalize_groups = function(x, geoms, group, vals_out, w_out, - value_cols, weight_is_col, has_xy, weight, - crs_x, dissolve_geoms) { - group_levels = seq_len(max(group)) - geom_idx = split(seq_len(nrow(x)), factor(group, levels = group_levels)) - keep = vapply(geom_idx, `[`, integer(1), 1L) - out = x[keep, , drop = FALSE] - out_geom = sf::st_sfc(lapply(geom_idx, function(idx) sf::st_union(geoms[idx])[[1]]), crs = crs_x) - out$geometry = dissolve_geoms(out_geom) - out[value_cols] = vals_out - if (weight_is_col) { - out[[weight]] = w_out - } - if (has_xy) { - coords = sf::st_coordinates(sf::st_centroid(out$geometry)) - out$x = coords[, 1] - out$y = coords[, 2] - } - out -} - -# Felzenszwalb-Huttenlocher (FH) merge -# input: geoms (sfc), vals (matrix), w (numeric), dist_one (function), kappa (numeric) -# output: list(group, vals, w) -.sc_merge_fh = function(geoms, vals, w, dist_one, kappa) { - n = nrow(vals) - pair_data = .sc_merge_pairs_adjacent(geoms, vals, dist_one) - pairs = pair_data$pairs - dists = pair_data$dists - if (length(pairs) == 0) { - return(list(group = seq_len(n), vals = vals, w = w)) - } - - ord = order(dists) - pairs = pairs[ord, , drop = FALSE] - dists = dists[ord] - - parent = seq_len(n) - find_root = function(i) { - while (parent[i] != i) { - i = parent[i] - } - i - } - comp_size = rep(1L, n) - comp_int = rep(0.0, n) - - for (k in seq_len(nrow(pairs))) { - i = pairs[k, 1] - j = pairs[k, 2] - ri = find_root(i) - rj = find_root(j) - if (ri == rj) next - w_ij = dists[k] - thresh_i = comp_int[ri] + kappa / comp_size[ri] - thresh_j = comp_int[rj] + kappa / comp_size[rj] - if (w_ij <= min(thresh_i, thresh_j)) { - if (comp_size[ri] < comp_size[rj]) { - tmp = ri; ri = rj; rj = tmp - } - parent[rj] = ri - comp_size[ri] = comp_size[ri] + comp_size[rj] - comp_int[ri] = max(comp_int[ri], comp_int[rj], w_ij) - } - } - groups = vapply(seq_len(n), find_root, integer(1)) - .sc_merge_aggregate_components(groups, vals, w) -} - -# MST-based merge -# input: geoms (sfc), vals (matrix), w (numeric), dist_one (function), -# target_k (int or NULL), tau (numeric or NULL) -# output: list(group, vals, w) -.sc_merge_mst = function(geoms, vals, w, dist_one, target_k, tau) { - n = nrow(vals) - pair_data = .sc_merge_pairs_adjacent(geoms, vals, dist_one) - pairs = pair_data$pairs - dists = pair_data$dists - if (length(pairs) == 0) { - return(list(group = seq_len(n), vals = vals, w = w)) - } - - ord = order(dists) - pairs = pairs[ord, , drop = FALSE] - dists = dists[ord] - - parent = seq_len(n) - find_root = function(i) { - while (parent[i] != i) { - i = parent[i] - } - i - } - mst_edges = list() - mst_weights = numeric(0) - for (k in seq_len(nrow(pairs))) { - i = pairs[k, 1] - j = pairs[k, 2] - ri = find_root(i) - rj = find_root(j) - if (ri != rj) { - parent[rj] = ri - mst_edges[[length(mst_edges) + 1L]] = c(i, j) - mst_weights[length(mst_weights) + 1L] = dists[k] - if (length(mst_edges) == n - 1) break - } - } - if (length(mst_edges) == 0) { - return(list(group = seq_len(n), vals = vals, w = w)) - } - - keep_edges = rep(TRUE, length(mst_edges)) - if (!is.null(target_k)) { - cuts = target_k - 1 - if (cuts > 0) { - cut_idx = order(mst_weights, decreasing = TRUE)[seq_len(cuts)] - keep_edges[cut_idx] = FALSE - } - } else if (!is.null(tau)) { - keep_edges = mst_weights <= tau - } - - parent = seq_len(n) - find_root = function(i) { - while (parent[i] != i) { - i = parent[i] - } - i - } - for (k in seq_along(mst_edges)) { - if (!keep_edges[k]) next - i = mst_edges[[k]][1] - j = mst_edges[[k]][2] - ri = find_root(i) - rj = find_root(j) - if (ri != rj) { - parent[rj] = ri - } - } - groups = vapply(seq_len(n), find_root, integer(1)) - .sc_merge_aggregate_components(groups, vals, w) -} - -# greedy adjacency-constrained merge -# input: geoms (sfc), vals (matrix), w (numeric), target_k/tau, -# dist_one (function), verbose (bool) -# output: list(group, vals, w) -.sc_merge_greedy = function(geoms, vals, w, target_k, tau, dist_one, verbose) { - n0 = nrow(vals) - vals0 = vals - w0 = w - alive = rep(TRUE, n0) - n_alive = n0 - neighbors = sf::st_touches(geoms) - parent = seq_len(n0) - find_root = function(i) { - while (parent[i] != i) { - i = parent[i] - } - i - } - - repeat { - if (!is.null(target_k) && n_alive <= target_k) break - min_dist = Inf - i = NA_integer_ - j = NA_integer_ - for (idx in which(alive)) { - nb = neighbors[[idx]] - if (length(nb) == 0) next - for (k in nb) { - if (!alive[k] || k <= idx) next - d = dist_one(vals[idx, ], vals[k, ]) - if (!is.finite(d)) next - if (d < min_dist) { - min_dist = d - i = idx - j = k - } - } - } - if (!is.finite(min_dist)) break - if (!is.null(tau) && min_dist > tau) break - - if (verbose) { - message(sprintf("Merging %d and %d (dist=%.4f)", i, j, min_dist)) - } - - w_i = w[i] - w_j = w[j] - w_new = w_i + w_j - vals[i, ] = (w_i * vals[i, ] + w_j * vals[j, ]) / w_new - w[i] = w_new - - old_i = neighbors[[i]] - old_j = neighbors[[j]] - new_neighbors = union(old_i, old_j) - new_neighbors = setdiff(new_neighbors, c(i, j)) - new_neighbors = new_neighbors[alive[new_neighbors]] - - for (k in old_j) { - if (!alive[k] || k == i) next - nk = neighbors[[k]] - nk = nk[nk != j] - if (!(i %in% nk)) nk = c(nk, i) - neighbors[[k]] = nk - } - for (k in old_i) { - if (!alive[k] || k == j) next - nk = neighbors[[k]] - nk = nk[nk != j] - neighbors[[k]] = nk - } - neighbors[[i]] = new_neighbors - neighbors[[j]] = integer(0) - - alive[j] = FALSE - n_alive = n_alive - 1L - parent[j] = i - } - - groups = vapply(seq_len(n0), find_root, integer(1)) - .sc_merge_aggregate_components(groups, vals0, w0) -} - -sc_merge_supercells = function(x, dist_fun = "euclidean", - method = c("greedy", "fh", "mst"), - method_opts = list(), - weight = "area", verbose = FALSE) { - if (!inherits(x, "sf")) { - stop("x must be an sf object (output of sc_slic)", call. = FALSE) - } - if (isTRUE(sf::st_is_longlat(x))) { - stop("sc_merge_supercells requires projected coordinates; reproject x before merging", call. = FALSE) - } - old_s2 = sf::sf_use_s2() - on.exit(sf::sf_use_s2(old_s2), add = TRUE) - sf::sf_use_s2(FALSE) - method = match.arg(method) - - if (nrow(x) < 2) { - return(x) - } - - x_df = sf::st_drop_geometry(x) - - skip_cols = c("supercells", "x", "y") - if (is.character(weight) && weight %in% names(x_df)) { - skip_cols = c(skip_cols, weight) - } - value_cols = setdiff(names(x_df), skip_cols) - value_cols = value_cols[sapply(x_df[, value_cols, drop = FALSE], is.numeric)] - if (length(value_cols) == 0) { - stop("No numeric value columns found for merging", call. = FALSE) - } - value_mat = x_df[, value_cols, drop = FALSE] - na_cols = colSums(is.na(value_mat)) > 0 - if (any(na_cols)) { - value_cols = value_cols[!na_cols] - if (length(value_cols) == 0) { - stop("All numeric value columns contain NA; cannot compute distances", call. = FALSE) - } - if (verbose) { - message("Dropping value columns with NA: ", paste(names(value_mat)[na_cols], collapse = ", ")) - } - } - - weight_is_col = is.character(weight) && length(weight) == 1 && weight %in% names(x_df) - if (is.character(weight) && length(weight) == 1) { - if (weight == "area") { - w = as.numeric(sf::st_area(x)) - } else if (weight_is_col) { - w = as.numeric(x_df[[weight]]) - } else { - stop("weight must be 'area', a column name, or numeric vector", call. = FALSE) - } - } else if (is.numeric(weight) && length(weight) == nrow(x)) { - w = as.numeric(weight) - } else { - stop("weight must be 'area', a column name, or numeric vector", call. = FALSE) - } - - vals = as.matrix(x_df[, value_cols, drop = FALSE]) - has_xy = all(c("x", "y") %in% names(x_df)) - - get_opt = function(name) { - if (is.list(method_opts) && name %in% names(method_opts)) { - return(method_opts[[name]]) - } - NULL - } - target_k = get_opt("target_k") - tau = get_opt("tau") - if (is.null(target_k) && is.null(tau) && method != "fh") { - stop("Provide target_k or tau to control merging", call. = FALSE) - } - if (!is.null(target_k) && (!is.numeric(target_k) || length(target_k) != 1 || target_k < 1)) { - stop("target_k must be a single positive number", call. = FALSE) - } - if (!is.null(target_k) && target_k > nrow(x)) { - stop("target_k cannot exceed the number of supercells", call. = FALSE) - } - if (method == "fh") { - kappa = get_opt("kappa") - if (is.null(kappa) || !is.numeric(kappa) || length(kappa) != 1) { - stop("Provide a single numeric kappa for method = 'fh'", call. = FALSE) - } - } - - crs_x = sf::st_crs(x) - dissolve_geoms = function(geoms) { - out = vector("list", length(geoms)) - for (k in seq_along(geoms)) { - g = sf::st_sfc(geoms[[k]], crs = crs_x) - g_type = sf::st_geometry_type(g) - if (any(g_type %in% c("MULTIPOLYGON", "GEOMETRYCOLLECTION"))) { - g = suppressWarnings(sf::st_cast(g, "POLYGON")) - g = sf::st_union(g) - } - if (length(g) == 0) g = sf::st_sfc(geoms[[k]], crs = crs_x) - out[[k]] = g[[1]] - } - sf::st_sfc(out, crs = crs_x) - } - - dist_one = .sc_merge_dist_fun(dist_fun) - geoms = sf::st_geometry(x) - finalize_groups = function(res) { - .sc_merge_finalize_groups(x, geoms, res$group, res$vals, res$w, - value_cols, weight_is_col, has_xy, weight, - crs_x, dissolve_geoms) - } - - if (method == "greedy") { - res = .sc_merge_greedy(geoms, vals, w, target_k, tau, dist_one, verbose) - } else if (method == "fh") { - res = .sc_merge_fh(geoms, vals, w, dist_one, kappa) - } else { - res = .sc_merge_mst(geoms, vals, w, dist_one, target_k, tau) - } - finalize_groups(res) - -# -# --- Archived FH/MST implementations (commented) --- -# Removed from inline comments now that FH/MST are implemented as helpers above. -} diff --git a/src/cpp11.cpp b/src/cpp11.cpp index 48f67a4..91c2214 100644 --- a/src/cpp11.cpp +++ b/src/cpp11.cpp @@ -5,13 +5,6 @@ #include "cpp11/declarations.hpp" #include -// distances_wrapper.cpp -double sc_dist_vec_cpp(cpp11::doubles a, cpp11::doubles b, std::string dist_name, cpp11::function dist_fun); -extern "C" SEXP _supercells_sc_dist_vec_cpp(SEXP a, SEXP b, SEXP dist_name, SEXP dist_fun) { - BEGIN_CPP11 - return cpp11::as_sexp(sc_dist_vec_cpp(cpp11::as_cpp>(a), cpp11::as_cpp>(b), cpp11::as_cpp>(dist_name), cpp11::as_cpp>(dist_fun))); - END_CPP11 -} // metrics_global.cpp cpp11::list sc_metrics_global_cpp(cpp11::integers_matrix<> clusters, cpp11::doubles_matrix<> centers_xy, cpp11::doubles_matrix<> centers_vals, cpp11::doubles_matrix<> vals, int step, double compactness, bool adaptive_compactness, std::string dist_name, cpp11::function dist_fun); extern "C" SEXP _supercells_sc_metrics_global_cpp(SEXP clusters, SEXP centers_xy, SEXP centers_vals, SEXP vals, SEXP step, SEXP compactness, SEXP adaptive_compactness, SEXP dist_name, SEXP dist_fun) { @@ -51,7 +44,6 @@ extern "C" SEXP _supercells_run_slic(SEXP mat, SEXP vals, SEXP step, SEXP compac extern "C" { static const R_CallMethodDef CallEntries[] = { {"_supercells_run_slic", (DL_FUNC) &_supercells_run_slic, 16}, - {"_supercells_sc_dist_vec_cpp", (DL_FUNC) &_supercells_sc_dist_vec_cpp, 4}, {"_supercells_sc_metrics_global_cpp", (DL_FUNC) &_supercells_sc_metrics_global_cpp, 9}, {"_supercells_sc_metrics_local_mean_cpp", (DL_FUNC) &_supercells_sc_metrics_local_mean_cpp, 8}, {"_supercells_sc_metrics_pixels_cpp", (DL_FUNC) &_supercells_sc_metrics_pixels_cpp, 9}, diff --git a/src/distances_wrapper.cpp b/src/distances_wrapper.cpp deleted file mode 100644 index 535d51b..0000000 --- a/src/distances_wrapper.cpp +++ /dev/null @@ -1,22 +0,0 @@ -#include "distances.h" -#include "cpp11.hpp" -#include "cpp11/doubles.hpp" -#include - -// Expose distance calculation to R for reuse in merging utilities. -[[cpp11::register]] -double sc_dist_vec_cpp(cpp11::doubles a, - cpp11::doubles b, - std::string dist_name, - cpp11::function dist_fun) { - if (a.size() != b.size()) { - cpp11::stop("Input vectors must have the same length"); - } - std::vector va(a.size()); - std::vector vb(b.size()); - for (int i = 0; i < a.size(); i++) { - va[i] = a[i]; - vb[i] = b[i]; - } - return get_vals_dist(va, vb, dist_name, dist_fun); -} From 1c648929b4cf278e61d2d24125815d8ec6a27ce1 Mon Sep 17 00:00:00 2001 From: jn Date: Mon, 9 Feb 2026 21:03:14 +0100 Subject: [PATCH 8/8] updATES news --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 9b2161f..732925c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,8 +2,11 @@ * Added `outcomes` argument to `sc_slic()`, `sc_slic_points()`, and `sc_slic_raster()`; replaces `metadata` for controlling returned fields * Iteration diagnostics API redesigned: `iter_diagnostics` and `sc_plot_iter_diagnostics()` replaced by `sc_slic_convergence()` with a `plot()` method +* Added `sc_slic_get_params()` and `sc_slic_set_params()` for reading/writing stored `sc_slic()` parameters * Added `use_meters()` for map-distance step values (replacing `in_meters()`) * Added `use_adaptive()` for adaptive compactness mode (replacing `compactness = "auto"`) +* Updated metrics API (`sc_metrics_pixels()`, `sc_metrics_supercells()`, `sc_metrics_global()`) to better reuse `sc_slic()` metadata and improve scaling/compactness handling +* Updated `sc_tune_compactness()` to align with the revised compactness/step workflows * Documentation and vignettes updated (pkgdown refresh, new articles, and revised examples) # supercells 1.8