Tunable parameters for Density-based (DBSCAN) and Model-based clustering (GMMs)

NAMESPACE

@@ -55,6 +55,7 @@ export(batch_size)
 export(buffer)
 export(cal_method_class)
 export(cal_method_reg)
+export(circular)
 export(class_weights)
 export(conditional_min_criterion)
 export(conditional_test_statistic)
@@ -105,6 +106,7 @@ export(max_times)
 export(max_tokens)
 export(min_dist)
 export(min_n)
+export(min_points)
 export(min_times)
 export(min_unique)
 export(mixture)
@@ -142,6 +144,7 @@ export(prior_terminal_node_expo)
 export(prod_degree)
 export(prune)
 export(prune_method)
+export(radius)
 export(range_get)
 export(range_set)
 export(range_validate)
@@ -165,6 +168,9 @@ export(sample_size)
 export(scale_factor)
 export(scale_pos_weight)
 export(select_features)
+export(shared_orientation)
+export(shared_shape)
+export(shared_size)
 export(shrinkage_correlation)
 export(shrinkage_frequencies)
 export(shrinkage_variance)
@@ -216,6 +222,7 @@ export(weight)
 export(weight_func)
 export(weight_scheme)
 export(window_size)
+export(zero_covariance)
 import(rlang)
 importFrom(DiceDesign,dmaxDesign)
 importFrom(DiceDesign,lhsDesign)

R/param_circular.R

@@ -0,0 +1,16 @@
+#' Parameter to control circular or ellipsoidal cluster shapes
+#'
+#' Used in `tidyclust::gm_clust()`.
+#'
+#' @param values A vector of possible values (TRUE or FALSE).
+#' @examples
+#' circular()
+#' @export
+circular <- function(values = c(TRUE, FALSE)) {
+  new_qual_param(
+    type = "logical",
+    values = values,
+    label = c(circular = "Circular cluster shapes?"),
+    finalize = NULL
+  )
+}

R/param_min_points.R

@@ -0,0 +1,18 @@
+#' Minimum number of nearby points to be considered a core-point
+#'
+#' Used in `tidyclust::db_clust` model.
+#'
+#' @inheritParams Laplace
+#' @examples
+#' min_points()
+#' @export
+min_points <- function(range = c(3L, 50L), trans = NULL) {
+  new_quant_param(
+    type = "integer",
+    range = range,
+    inclusive = c(TRUE, TRUE),
+    trans = trans,
+    label = c(min_points = "Min Points"),
+    finalize = NULL
+  )
+}

R/param_radius.R

@@ -0,0 +1,18 @@
+#' Radius used to determine core-points and cluster assignments
+#'
+#' Used in `tidyclust::db_clust`.
+#'
+#' @inheritParams Laplace
+#' @examples
+#' radius()
+#' @export
+radius <- function(range = c(-2, 2), trans = transform_log10()) {
+  new_quant_param(
+    type = "double",
+    range = range,
+    inclusive = c(TRUE, TRUE),
+    trans = trans,
+    label = c(radius = "Radius"),
+    finalize = NULL
+  )
+}

R/param_shared_orientation.R

@@ -0,0 +1,17 @@
+#' Parameter to control whether clusters share the same orientation in the predictor space
+#' (Only applicable if zero_covariance = FALSE)
+#'
+#' Used in `tidyclust::gm_clust()`.
+#'
+#' @param values A vector of possible values (TRUE or FALSE).
+#' @examples
+#' shared_orientation()
+#' @export
+shared_orientation <- function(values = c(TRUE, FALSE)) {
+  new_qual_param(
+    type = "logical",
+    values = values,
+    label = c(shared_orientation = "Shared orientation between clusters?"),
+    finalize = NULL
+  )
+}

R/param_shared_shape.R

@@ -0,0 +1,17 @@
+#' Parameter to control whether clusters share the same shape in the predictor space
+#' (Only applicable if circular = FALSE)
+#'
+#' Used in `tidyclust::gm_clust()`.
+#'
+#' @param values A vector of possible values (TRUE or FALSE).
+#' @examples
+#' shared_shape()
+#' @export
+shared_shape <- function(values = c(TRUE, FALSE)) {
+  new_qual_param(
+    type = "logical",
+    values = values,
+    label = c(shared_shape = "Shared shape between clusters?"),
+    finalize = NULL
+  )
+}

R/param_shared_size.R

@@ -0,0 +1,16 @@
+#' Parameter to control whether clusters share the same size in the predictor space
+#'
+#' Used in `tidyclust::gm_clust()`.
+#'
+#' @param values A vector of possible values (TRUE or FALSE).
+#' @examples
+#' shared_size()
+#' @export
+shared_size <- function(values = c(TRUE, FALSE)) {
+  new_qual_param(
+    type = "logical",
+    values = values,
+    label = c(shared_size = "Shared size between clusters?"),
+    finalize = NULL
+  )
+}

R/param_zero_covariance.R

@@ -0,0 +1,16 @@
+#' Parameter to control whether clusters have zero covariance between predictors
+#'
+#' Used in `tidyclust::gm_clust()`.
+#'
+#' @param values A vector of possible values (TRUE or FALSE).
+#' @examples
+#' zero_covariance()
+#' @export
+zero_covariance <- function(values = c(TRUE, FALSE)) {
+  new_qual_param(
+    type = "logical",
+    values = values,
+    label = c(zero_covariance = "Zero covariance between predictors?"),
+    finalize = NULL
+  )
+}

tests/testthat/test-params.R

@@ -137,11 +137,13 @@ test_that("param ranges", {
   expect_equal(target_weight(c(0.1, 0.4))$range, list(lower = 0.1, upper = 0.4))
   expect_equal(lower_limit(c(Inf, 0))$range, list(lower = Inf, upper = 0))
   expect_equal(upper_limit(c(0, Inf))$range, list(lower = 0, upper = Inf))
-  expect_equal(max_num_terms(c(31, 100))$range, list(lower = 31, upper = 100))
-  expect_equal(max_nodes(c(31, 100))$range, list(lower = 31, upper = 100))
-  expect_equal(num_tokens(c(31, 100))$range, list(lower = 31, upper = 100))
-  expect_equal(mtry_prop(c(.1, .2))$range, list(lower = .1, upper = .2))
-  expect_equal(dropout(c(.1, .2))$range, list(lower = .1, upper = .2))
+  expect_equal(max_num_terms(c(31,100))$range, list(lower = 31, upper = 100))
+  expect_equal(max_nodes(c(31,100))$range, list(lower = 31, upper = 100))
+  expect_equal(num_tokens(c(31,100))$range, list(lower = 31, upper = 100))
+  expect_equal(mtry_prop(c(.1,.2))$range, list(lower = .1, upper = .2))
+  expect_equal(dropout(c(.1,.2))$range, list(lower = .1, upper = .2))
+  expect_equal(radius(c(0.01, 100))$range, list(lower = 0.01, upper = 100))
+  expect_equal(min_points(c(3, 50))$range, list(lower = 3, upper = 50))
 })
 
 
@@ -178,4 +180,9 @@ test_that("param values", {
   expect_equal(all_neighbors(TRUE)$values, TRUE)
   expect_equal(cal_method_class()$values, values_cal_cls)
   expect_equal(cal_method_reg()$values, values_cal_reg)
+  expect_equal(circular(TRUE)$values, TRUE)
+  expect_equal(zero_covariance(TRUE)$values, TRUE)
+  expect_equal(shared_orientation(TRUE)$values, TRUE)
+  expect_equal(shared_shape(TRUE)$values, TRUE)
+  expect_equal(shared_size(TRUE)$values, TRUE)
 })