From 9543b88b7c633dda9023e62c3071663f507ff9a8 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Fri, 17 Jul 2026 17:30:24 -0400 Subject: [PATCH 01/45] introduce tuning dial for parallel penalty factor argument of ordinalNet --- DESCRIPTION | 1 + NAMESPACE | 1 + R/ordinal_reg-data.R | 11 ++++++++ R/param-engine-ordinalNet.R | 48 ++++++++++++++++++++++++++++++++++ _pkgdown.yml | 1 + ignore/tinker-workflow.R | 29 +++++++++++++-------- man/ordinalNet_parameters.Rd | 50 ++++++++++++++++++++++++++++++++++++ tests/testthat/test-dials.R | 5 ++++ 8 files changed, 135 insertions(+), 11 deletions(-) create mode 100644 R/param-engine-ordinalNet.R create mode 100644 man/ordinalNet_parameters.Rd diff --git a/DESCRIPTION b/DESCRIPTION index ac345e9..7cd3856 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,6 +29,7 @@ Imports: dials (>= 1.4.3), purrr, rlang (>= 1.1.4), + scales (>= 1.3.0), tibble, tidyr Suggests: diff --git a/NAMESPACE b/NAMESPACE index a1363fa..5bbd97a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -22,6 +22,7 @@ export(ord_metric) export(ordinalForest_wrapper) export(ordinalNet_wrapper) export(orf_wrapper) +export(parallel_penalty_factor) export(predict_glmnetcr_wrapper) export(predict_lrm_wrapper) export(predict_ordinalNet_wrapper) diff --git a/R/ordinal_reg-data.R b/R/ordinal_reg-data.R index b223b8a..54f6518 100644 --- a/R/ordinal_reg-data.R +++ b/R/ordinal_reg-data.R @@ -219,6 +219,7 @@ make_ordinal_reg_ordinalNet <- function() { mode = "classification" ) + # dials provided in {dials} parsnip::set_model_arg( model = "ordinal_reg", eng = "ordinalNet", @@ -254,6 +255,16 @@ make_ordinal_reg_ordinalNet <- function() { has_submodel = FALSE ) + # engine-specific arguments + parsnip::set_model_arg( + model = "ordinal_reg", + eng = "ordinalNet", + parsnip = "parallelPenaltyFactor", + original = "parallelPenaltyFactor", + func = list(pkg = "ordered", fun = "parallel_penalty_factor"), + has_submodel = FALSE + ) + parsnip::set_fit( model = "ordinal_reg", eng = "ordinalNet", diff --git a/R/param-engine-ordinalNet.R b/R/param-engine-ordinalNet.R new file mode 100644 index 0000000..9006714 --- /dev/null +++ b/R/param-engine-ordinalNet.R @@ -0,0 +1,48 @@ +#' Dials for `ordinalNet` engine parameters +#' +#' These parameters are auxiliary to ordinal regression models that use the +#' "ordinalNet" engine. They correspond to tuning parameters that would be +#' specified using `set_engine("ordinalNet", ...)`. +#' +#' @name ordinalNet_parameters +#' @param range A two-element vector holding the _defaults_ for the smallest and +#' largest possible values, respectively. If a transformation is specified, +#' these values should be in the _transformed units_. +#' @param trans A `trans` object from the `scales` package, such as +#' `scales::transform_log10()` or `scales::transform_reciprocal()`. If not +#' provided, the default is used which matches the units used in `range`. If +#' no transformation, `NULL`. +#' +#' @details These functions generate parameters for [parsnip::ordinal_reg()] +#' models using the `"ordinalNet"` engine. See `?ordinalNet::ordinalNet()` for +#' more details on the original parameters. These parameters are +#' engine-specific, not general to ordinal regression models, so are provided +#' here rather than in `dials`. +#' +#' * `parallel_penalty_factor()`: A nonnegative numeric factor that scales the +#' penalty on all parallel terms; tunes `parallelPenaltyFactor`. Only used +#' when `parallelTerms = TRUE`. +#' +#' @returns An object of S3 parent class `param` and primary class +#' `quant_param`; see [dials::new_quant_param()]. +#' @seealso [dials::penalty()] +#' @examples +#' parallel_penalty_factor() +#' +#' @export +#' @rdname ordinalNet_parameters +parallel_penalty_factor <- function( + range = c(-Inf, Inf), + trans = scales::transform_log10() +) { + dials::new_quant_param( + type = "double", + range = range, + inclusive = c(FALSE, FALSE), + trans = trans, + label = c( + parallel_penalty_factor = "Parallel Penalty Factor" + ), + finalize = NULL + ) +} diff --git a/_pkgdown.yml b/_pkgdown.yml index 628b5e4..9a78b2a 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -25,6 +25,7 @@ reference: Tunable Engine Parameters contents: - '`clm_parameters`' + - '`ordinalNet_parameters`' - '`rpartScore_parameters`' - '`ordinalForest_parameters`' - '`orf_parameters`' diff --git a/ignore/tinker-workflow.R b/ignore/tinker-workflow.R index 83d949a..775c5f0 100644 --- a/ignore/tinker-workflow.R +++ b/ignore/tinker-workflow.R @@ -29,12 +29,6 @@ vglm_spec <- set_engine("vglm") |> set_args(ordinal_link = tune(), odds_link = tune()) -# ordinalNet: penalty (submodel via multi_predict) + mixture -ordinalNet_spec <- - ordinal_reg() |> - set_engine("ordinalNet") |> - set_args(penalty = tune(), mixture = tune()) - # lrm: penalty lrm_spec <- ordinal_reg() |> @@ -47,6 +41,16 @@ orm_spec <- set_engine("orm") |> set_args(ordinal_link = tune(), penalty = tune()) +# ordinalNet: penalty (submodel via multi_predict) + mixture + +# parallel_penalty_factor +ordinalNet_spec <- + ordinal_reg() |> + set_engine("ordinalNet") |> + set_args( + penalty = tune(), mixture = tune(), + parallelPenaltyFactor = tune() + ) + # glmnetcr: penalty (submodel via multi_predict) + mixture glmnetcr_spec <- ordinal_reg() |> @@ -109,15 +113,18 @@ polr_tune <- extract_parameter_set_dials(polr_spec) vglm_tune <- extract_parameter_set_dials(vglm_spec) ( vglm_grid <- grid_regular(vglm_tune, levels = 2) ) -ordinalNet_tune <- extract_parameter_set_dials(ordinalNet_spec) -( ordinalNet_grid <- grid_regular(ordinalNet_tune, levels = 2) ) - lrm_tune <- extract_parameter_set_dials(lrm_spec) ( lrm_grid <- grid_regular(lrm_tune, levels = 2) ) orm_tune <- extract_parameter_set_dials(orm_spec) ( orm_grid <- grid_regular(orm_tune, levels = c(Inf, 2)) ) +ordinalNet_tune <- extract_parameter_set_dials(ordinalNet_spec) +# constrain the default c(-Inf, Inf) range for gridding +idx <- which(ordinalNet_tune$name == "parallelPenaltyFactor") +ordinalNet_tune$object[[idx]] <- parallel_penalty_factor(range = c(-1, 1)) +( ordinalNet_grid <- grid_regular(ordinalNet_tune, levels = 2) ) + glmnetcr_tune <- extract_parameter_set_dials(glmnetcr_spec) ( glmnetcr_grid <- grid_regular(glmnetcr_tune, levels = 2) ) @@ -145,9 +152,9 @@ workflow_set( models = list( polr = polr_spec, vglm = vglm_spec, - ordinalNet = ordinalNet_spec, lrm = lrm_spec, orm = orm_spec, + ordinalNet = ordinalNet_spec, glmnetcr = glmnetcr_spec, vgam = vgam_spec, rpart = rpart_spec, @@ -159,9 +166,9 @@ workflow_set( ) |> option_add(grid = polr_grid, id = "formula_polr") |> option_add(grid = vglm_grid, id = "formula_vglm") |> - option_add(grid = ordinalNet_grid, id = "formula_ordinalNet") |> option_add(grid = lrm_grid, id = "formula_lrm") |> option_add(grid = orm_grid, id = "formula_orm") |> + option_add(grid = ordinalNet_grid, id = "formula_ordinalNet") |> option_add(grid = glmnetcr_grid, id = "formula_glmnetcr") |> option_add(grid = vgam_grid, id = "formula_vgam") |> option_add(grid = rpart_grid, id = "formula_rpart") |> diff --git a/man/ordinalNet_parameters.Rd b/man/ordinalNet_parameters.Rd new file mode 100644 index 0000000..3b075f8 --- /dev/null +++ b/man/ordinalNet_parameters.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/param-engine-ordinalNet.R +\name{ordinalNet_parameters} +\alias{ordinalNet_parameters} +\alias{parallel_penalty_factor} +\title{Dials for \code{ordinalNet} engine parameters} +\usage{ +parallel_penalty_factor( + range = c(-Inf, Inf), + trans = scales::transform_log10() +) +} +\arguments{ +\item{range}{A two-element vector holding the \emph{defaults} for the smallest and +largest possible values, respectively. If a transformation is specified, +these values should be in the \emph{transformed units}.} + +\item{trans}{A \code{trans} object from the \code{scales} package, such as +\code{scales::transform_log10()} or \code{scales::transform_reciprocal()}. If not +provided, the default is used which matches the units used in \code{range}. If +no transformation, \code{NULL}.} +} +\value{ +An object of S3 parent class \code{param} and primary class +\code{quant_param}; see \code{\link[dials:new_quant_param]{dials::new_quant_param()}}. +} +\description{ +These parameters are auxiliary to ordinal regression models that use the +"ordinalNet" engine. They correspond to tuning parameters that would be +specified using \code{set_engine("ordinalNet", ...)}. +} +\details{ +These functions generate parameters for \code{\link[parsnip:ordinal_reg]{parsnip::ordinal_reg()}} +models using the \code{"ordinalNet"} engine. See \code{?ordinalNet::ordinalNet()} for +more details on the original parameters. These parameters are +engine-specific, not general to ordinal regression models, so are provided +here rather than in \code{dials}. +\itemize{ +\item \code{parallel_penalty_factor()}: A nonnegative numeric factor that scales the +penalty on all parallel terms; tunes \code{parallelPenaltyFactor}. Only used +when \code{parallelTerms = TRUE}. +} +} +\examples{ +parallel_penalty_factor() + +} +\seealso{ +\code{\link[dials:penalty]{dials::penalty()}} +} diff --git a/tests/testthat/test-dials.R b/tests/testthat/test-dials.R index 7a6d34b..a6e03cd 100644 --- a/tests/testthat/test-dials.R +++ b/tests/testthat/test-dials.R @@ -1,3 +1,8 @@ +test_that("ordinalNet::ordinalNet dial customization", { + expect_equal(parallel_penalty_factor(range = c(-2, 2))$range, + list(lower = -2, upper = 2)) +}) + test_that("rpartScore::rpartScore dial customization", { expect_equal(split_func(letters[1:3])$values, letters[1:3]) expect_equal(prune_func(letters[1:3])$values, letters[1:3]) From 3ad20ad11afbdcc5a891d970f73ed72368a037f8 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Sat, 18 Jul 2026 12:09:45 -0400 Subject: [PATCH 02/45] add threshold_structure model argument for ordinal_reg --- NAMESPACE | 2 +- R/ordinal_reg-VGAM.R | 77 +++++++++++++++++-- R/ordinal_reg-data.R | 12 ++- R/param-engine-clm.R | 30 ++------ ignore/tinker-workflow.R | 36 ++++++--- man/VGAM_vglm_wrapper.Rd | 21 ++++- man/clm_parameters.Rd | 27 ++----- .../testthat/_snaps/gen_additive_mod-VGAM.md | 4 +- tests/testthat/_snaps/ordinal_reg-VGAM.md | 4 +- tests/testthat/test-dials.R | 8 ++ tests/testthat/test-ordinal_reg-VGAM.R | 9 ++- tests/testthat/test-ordinal_reg-clm.R | 9 ++- 12 files changed, 161 insertions(+), 78 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 5bbd97a..d02b11c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -30,10 +30,10 @@ export(prune_func) export(rpartScore_wrapper) export(sample_fraction) export(split_func) -export(threshold_structure) export(values_ord_metric) export(values_ordinal_link_VGAM) export(values_ordinal_link_clm) +export(values_threshold_structure_VGAM) import(parsnip) import(rlang) importFrom(parsnip,eval_args) diff --git a/R/ordinal_reg-VGAM.R b/R/ordinal_reg-VGAM.R index 3f88a75..32e9bd5 100644 --- a/R/ordinal_reg-VGAM.R +++ b/R/ordinal_reg-VGAM.R @@ -7,8 +7,15 @@ #' The vector `values_ordinal_link_VGAM` extends the default `ordinal_link` #' options encoded in [`dials::values_ordinal_link`] to those accepted by #' [`VGAM::vglm()`] and [`VGAM::vgam()`]. +#' +#' The vector `values_threshold_structure_VGAM` extends the default +#' `threshold_structure` options encoded in +#' [`dials::values_threshold_structure`] to those accepted by [`VGAM::vglm()`] +#' and [`VGAM::vgam()`]. #' @param formula The formula to pass. #' @param data The data frame to pass. +#' @param Thresh The threshold structure for the cutpoints. See +#' [dials::threshold_structure()] for details. #' @param ... Additional arguments to pass. #' @details Note that `VGAM::vglm()` and `VGAM::vgam()` treat the rows of `data` #' as the units of observation: Compressed `data` with one row per predictor @@ -24,6 +31,8 @@ #' @examples #' values_ordinal_link_VGAM #' dials::ordinal_link(values = values_ordinal_link_VGAM) +#' values_threshold_structure_VGAM +#' dials::threshold_structure(values = values_threshold_structure_VGAM) #' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("VGAM") #' house_data <- @@ -31,12 +40,14 @@ #' # fit wrapper for linear model #' ( fit_orig <- VGAM::vglm( #' Sat ~ Type + Infl + Cont, -#' family = VGAM::sratio(link = "probitlink", parallel = TRUE), +#' family = VGAM::sratio( +#' link = "probitlink", parallel = TRUE, Thresh = "symm0" +#' ), #' data = house_data #' ) ) #' ( fit_wrap <- VGAM_vglm_wrapper( #' Sat ~ Type + Infl + Cont, -#' family = "stopping_ratio", link = "probit", +#' family = "stopping_ratio", link = "probit", Thresh = "symmetric_zero", #' data = house_data #' ) ) #' # fit wrapper for additive model @@ -55,6 +66,7 @@ VGAM_vglm_wrapper <- function( formula, data, family = "cumulative_link", link = "logistic", parallel = TRUE, + Thresh = NULL, ... ) { rlang::check_installed("VGAM") @@ -65,14 +77,27 @@ VGAM_vglm_wrapper <- function( # TODO: Ensure that `formula = cbind(...) ~ ...` is disallowed, for this and # for other `ordinal_reg()` engines. - # match and convert odds link options + # match and convert model arguments family <- match_VGAM_family(family) link <- match_VGAM_link(link) + Thresh <- match_VGAM_Thresh(Thresh) + + # `acat()` does not support certain link functions + if (family == "acat" && + link %in% c("logitlink", "probitlink", "clogloglink")) { + cli::cli_abort( + c( + "The {.val adjacent_categories} family is not compatible with + the {.val {link}} link function.", + "i" = "Use {.val cauchitlink} or {.val identitylink} instead." + ) + ) + } # execute nested call on modified inputs family_call <- rlang::call2( .fn = family, .ns = "VGAM", - link = link, parallel = parallel + link = link, parallel = parallel, Thresh = Thresh ) cl <- rlang::call2( .fn = "vglm", .ns = "VGAM", @@ -80,7 +105,7 @@ VGAM_vglm_wrapper <- function( family = family_call, ... ) - rlang::eval_tidy(cl) + suppressWarnings(rlang::eval_tidy(cl)) } #' @rdname VGAM_vglm_wrapper @@ -89,6 +114,7 @@ VGAM_vgam_wrapper <- function( formula, data, family = "cumulative_link", link = "logistic", parallel = TRUE, + Thresh = NULL, ... ) { rlang::check_installed("VGAM") @@ -96,14 +122,27 @@ VGAM_vgam_wrapper <- function( # for now, require `parallel` to be logical check_logical(parallel) - # match and convert odds link options + # match and convert model arguments family <- match_VGAM_family(family) link <- match_VGAM_link(link) + Thresh <- match_VGAM_Thresh(Thresh) + + # `acat()` does not support certain link functions + if (family == "acat" && + link %in% c("logitlink", "probitlink", "clogloglink")) { + cli::cli_abort( + c( + "The {.val adjacent_categories} family is not compatible with + the {.val {link}} link function.", + "i" = "Use {.val cauchitlink} or {.val identitylink} instead." + ) + ) + } # execute nested call on modified inputs family_call <- rlang::call2( .fn = family, .ns = "VGAM", - link = link, parallel = parallel + link = link, parallel = parallel, Thresh = Thresh ) cl <- rlang::call2( .fn = "vgam", .ns = "VGAM", @@ -111,7 +150,7 @@ VGAM_vgam_wrapper <- function( family = family_call, ... ) - rlang::eval_tidy(cl) + suppressWarnings(rlang::eval_tidy(cl)) } #' @rdname VGAM_vglm_wrapper @@ -122,6 +161,13 @@ values_ordinal_link_VGAM <- c( c("foldsqrt", "logc", "gord", "pord", "nbord") ) +#' @rdname VGAM_vglm_wrapper +#' @export +values_threshold_structure_VGAM <- c( + dials::values_threshold_structure, + "qnorm" +) + match_VGAM_family <- function(family) { family <- match.arg(family, dials::values_odds_link) switch( @@ -148,6 +194,21 @@ match_VGAM_link <- function(link) { paste0(link, "link") } +match_VGAM_Thresh <- function(Thresh) { + if (is.null(Thresh)) { + return(NULL) + } + Thresh <- match.arg(Thresh, values_threshold_structure_VGAM) + switch( + Thresh, + flexible = "free", + symmetric_median = "symm1", + symmetric_zero = "symm0", + equidistant = "equid", + qnorm = "qnorm" + ) +} + predict_VGAM_class_post <- function(x, object) { x <- apply(x, 1L, which.max) x <- ordered(object$lvl[x], object$lvl) diff --git a/R/ordinal_reg-data.R b/R/ordinal_reg-data.R index 54f6518..324edcb 100644 --- a/R/ordinal_reg-data.R +++ b/R/ordinal_reg-data.R @@ -135,6 +135,14 @@ make_ordinal_reg_vglm <- function() { func = list(pkg = "dials", fun = "odds_link"), has_submodel = FALSE ) + parsnip::set_model_arg( + model = "ordinal_reg", + eng = "vglm", + parsnip = "threshold_structure", + original = "Thresh", + func = list(pkg = "dials", fun = "threshold_structure"), + has_submodel = FALSE + ) parsnip::set_fit( model = "ordinal_reg", @@ -735,9 +743,9 @@ make_ordinal_reg_clm <- function() { parsnip::set_model_arg( model = "ordinal_reg", eng = "clm", - parsnip = "threshold", + parsnip = "threshold_structure", original = "threshold", - func = list(pkg = "ordered", fun = "threshold_structure"), + func = list(pkg = "dials", fun = "threshold_structure"), has_submodel = FALSE ) diff --git a/R/param-engine-clm.R b/R/param-engine-clm.R index a4010cf..e22b1bc 100644 --- a/R/param-engine-clm.R +++ b/R/param-engine-clm.R @@ -1,39 +1,21 @@ #' Dials for `ordinal` engine parameters #' -#' The `threshold_structure` dial is auxiliary to ordinal regression models that -#' use the "clm" engine. It corresponds to the `threshold` tuning parameter that -#' would be specified using `set_engine("clm", ...)`. -#' #' The vector `values_ordinal_link_clm` extends the default `ordinal_link` #' options encoded in [`dials::values_ordinal_link`] to those accepted by #' [`ordinal::clm()`]. #' +#' The `threshold_structure` dial is defined in the \pkg{dials} package. +#' See `?dials::threshold_structure` for details. +#' #' @name clm_parameters -#' @param values A character string of possible values. -#' @details `threshold_structure()` is a dial for the threshold structure in -#' cumulative link models. See `?ordinal::clm` for more details. Use -#' `set_args(threshold = ...)` to set this parameter on a model spec. These -#' parameters are engine-specific, not general to ordinal regression models, -#' so are provided here rather than in `dials`. #' @returns An object of S3 parent class `param` and primary class `qual_param`; #' see [dials::new_qual_param()]. #' @examples #' values_ordinal_link_clm #' dials::ordinal_link(values = values_ordinal_link_clm) -#' threshold_structure() -#' -#' @export -#' @rdname clm_parameters -threshold_structure <- function( - values = c("flexible", "symmetric", "symmetric2", "equidistant") -) { - dials::new_qual_param( - type = "character", - values = values, - label = c(threshold_structure = "Threshold Structure"), - finalize = NULL - ) -} +#' dials::threshold_structure(values = dials::values_threshold_structure) +#' @keywords internal +NULL #' @rdname clm_parameters #' @export diff --git a/ignore/tinker-workflow.R b/ignore/tinker-workflow.R index 775c5f0..07b9c21 100644 --- a/ignore/tinker-workflow.R +++ b/ignore/tinker-workflow.R @@ -1,4 +1,6 @@ -library(devtools); library(tidymodels); library(bonsai); load_all() +library(devtools); library(tidymodels) +load_all("../parsnip/"); load_all("../dials/") +library(bonsai); load_all() # reference example: # https://workflowsets.tidymodels.org/articles/tuning-and-comparing-models.html @@ -23,11 +25,11 @@ polr_spec <- set_engine("polr") |> set_args(ordinal_link = tune()) -# vglm: ordinal_link + odds_link -vglm_spec <- +# clm: ordinal_link + threshold_structure +clm_spec <- ordinal_reg() |> - set_engine("vglm") |> - set_args(ordinal_link = tune(), odds_link = tune()) + set_engine("clm") |> + set_args(ordinal_link = tune(), threshold_structure = tune()) # lrm: penalty lrm_spec <- @@ -41,6 +43,15 @@ orm_spec <- set_engine("orm") |> set_args(ordinal_link = tune(), penalty = tune()) +# vglm: ordinal_link + odds_link + threshold_structure +vglm_spec <- + ordinal_reg() |> + set_engine("vglm") |> + set_args( + ordinal_link = tune(), odds_link = tune(), + threshold_structure = tune() + ) + # ordinalNet: penalty (submodel via multi_predict) + mixture + # parallel_penalty_factor ordinalNet_spec <- @@ -110,15 +121,18 @@ cforest_spec <- polr_tune <- extract_parameter_set_dials(polr_spec) ( polr_grid <- grid_regular(polr_tune, levels = Inf) ) -vglm_tune <- extract_parameter_set_dials(vglm_spec) -( vglm_grid <- grid_regular(vglm_tune, levels = 2) ) +clm_tune <- extract_parameter_set_dials(clm_spec) +( clm_grid <- grid_regular(clm_tune, levels = 3) ) lrm_tune <- extract_parameter_set_dials(lrm_spec) -( lrm_grid <- grid_regular(lrm_tune, levels = 2) ) +( lrm_grid <- grid_regular(lrm_tune, levels = 3) ) orm_tune <- extract_parameter_set_dials(orm_spec) ( orm_grid <- grid_regular(orm_tune, levels = c(Inf, 2)) ) +vglm_tune <- extract_parameter_set_dials(vglm_spec) +( vglm_grid <- grid_regular(vglm_tune, levels = 2) ) + ordinalNet_tune <- extract_parameter_set_dials(ordinalNet_spec) # constrain the default c(-Inf, Inf) range for gridding idx <- which(ordinalNet_tune$name == "parallelPenaltyFactor") @@ -151,9 +165,10 @@ workflow_set( preproc = list(formula = Sat ~ Infl + Type + Cont), models = list( polr = polr_spec, - vglm = vglm_spec, + clm = clm_spec, lrm = lrm_spec, orm = orm_spec, + vglm = vglm_spec, ordinalNet = ordinalNet_spec, glmnetcr = glmnetcr_spec, vgam = vgam_spec, @@ -165,9 +180,10 @@ workflow_set( ) ) |> option_add(grid = polr_grid, id = "formula_polr") |> - option_add(grid = vglm_grid, id = "formula_vglm") |> + option_add(grid = clm_grid, id = "formula_clm") |> option_add(grid = lrm_grid, id = "formula_lrm") |> option_add(grid = orm_grid, id = "formula_orm") |> + option_add(grid = vglm_grid, id = "formula_vglm") |> option_add(grid = ordinalNet_grid, id = "formula_ordinalNet") |> option_add(grid = glmnetcr_grid, id = "formula_glmnetcr") |> option_add(grid = vgam_grid, id = "formula_vgam") |> diff --git a/man/VGAM_vglm_wrapper.Rd b/man/VGAM_vglm_wrapper.Rd index cf21692..645d65b 100644 --- a/man/VGAM_vglm_wrapper.Rd +++ b/man/VGAM_vglm_wrapper.Rd @@ -4,6 +4,7 @@ \alias{VGAM_vglm_wrapper} \alias{VGAM_vgam_wrapper} \alias{values_ordinal_link_VGAM} +\alias{values_threshold_structure_VGAM} \title{Wrappers for \code{VGAM}} \usage{ VGAM_vglm_wrapper( @@ -12,6 +13,7 @@ VGAM_vglm_wrapper( family = "cumulative_link", link = "logistic", parallel = TRUE, + Thresh = NULL, ... ) @@ -21,16 +23,22 @@ VGAM_vgam_wrapper( family = "cumulative_link", link = "logistic", parallel = TRUE, + Thresh = NULL, ... ) values_ordinal_link_VGAM + +values_threshold_structure_VGAM } \arguments{ \item{formula}{The formula to pass.} \item{data}{The data frame to pass.} +\item{Thresh}{The threshold structure for the cutpoints. See +\code{\link[dials:threshold_structure]{dials::threshold_structure()}} for details.} + \item{...}{Additional arguments to pass.} } \value{ @@ -47,6 +55,11 @@ The vector \code{values_ordinal_link_VGAM} extends the default \code{ordinal_lin options encoded in \code{\link[dials:values_ordinal_link]{dials::values_ordinal_link}} to those accepted by \code{\link[VGAM:vglm]{VGAM::vglm()}} and \code{\link[VGAM:vgam]{VGAM::vgam()}}. +The vector \code{values_threshold_structure_VGAM} extends the default +\code{threshold_structure} options encoded in +\code{\link[dials:values_threshold_structure]{dials::values_threshold_structure}} to those accepted by \code{\link[VGAM:vglm]{VGAM::vglm()}} +and \code{\link[VGAM:vgam]{VGAM::vgam()}}. + Note that \code{VGAM::vglm()} and \code{VGAM::vgam()} treat the rows of \code{data} as the units of observation: Compressed \code{data} with one row per predictor set will be understood as having a multinomial-valued outcome; only @@ -59,18 +72,22 @@ single ordinal outcome column and therefore do not accept the convenient \examples{ values_ordinal_link_VGAM dials::ordinal_link(values = values_ordinal_link_VGAM) +values_threshold_structure_VGAM +dials::threshold_structure(values = values_threshold_structure_VGAM) \dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("VGAM")) withAutoprint(\{ # examplesIf} house_data <- MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] # fit wrapper for linear model ( fit_orig <- VGAM::vglm( Sat ~ Type + Infl + Cont, - family = VGAM::sratio(link = "probitlink", parallel = TRUE), + family = VGAM::sratio( + link = "probitlink", parallel = TRUE, Thresh = "symm0" + ), data = house_data ) ) ( fit_wrap <- VGAM_vglm_wrapper( Sat ~ Type + Infl + Cont, - family = "stopping_ratio", link = "probit", + family = "stopping_ratio", link = "probit", Thresh = "symmetric_zero", data = house_data ) ) # fit wrapper for additive model diff --git a/man/clm_parameters.Rd b/man/clm_parameters.Rd index eebc410..e1aec46 100644 --- a/man/clm_parameters.Rd +++ b/man/clm_parameters.Rd @@ -2,42 +2,27 @@ % Please edit documentation in R/param-engine-clm.R \name{clm_parameters} \alias{clm_parameters} -\alias{threshold_structure} \alias{values_ordinal_link_clm} \title{Dials for \code{ordinal} engine parameters} \usage{ -threshold_structure( - values = c("flexible", "symmetric", "symmetric2", "equidistant") -) - values_ordinal_link_clm } -\arguments{ -\item{values}{A character string of possible values.} -} \value{ An object of S3 parent class \code{param} and primary class \code{qual_param}; see \code{\link[dials:new_qual_param]{dials::new_qual_param()}}. } \description{ -The \code{threshold_structure} dial is auxiliary to ordinal regression models that -use the "clm" engine. It corresponds to the \code{threshold} tuning parameter that -would be specified using \code{set_engine("clm", ...)}. -} -\details{ The vector \code{values_ordinal_link_clm} extends the default \code{ordinal_link} options encoded in \code{\link[dials:values_ordinal_link]{dials::values_ordinal_link}} to those accepted by \code{\link[ordinal:clm]{ordinal::clm()}}. - -\code{threshold_structure()} is a dial for the threshold structure in -cumulative link models. See \code{?ordinal::clm} for more details. Use -\code{set_args(threshold = ...)} to set this parameter on a model spec. These -parameters are engine-specific, not general to ordinal regression models, -so are provided here rather than in \code{dials}. +} +\details{ +The \code{threshold_structure} dial is defined in the \pkg{dials} package. +See \code{?dials::threshold_structure} for details. } \examples{ values_ordinal_link_clm dials::ordinal_link(values = values_ordinal_link_clm) -threshold_structure() - +dials::threshold_structure(values = dials::values_threshold_structure) } +\keyword{internal} diff --git a/tests/testthat/_snaps/gen_additive_mod-VGAM.md b/tests/testthat/_snaps/gen_additive_mod-VGAM.md index 5028be7..194024e 100644 --- a/tests/testthat/_snaps/gen_additive_mod-VGAM.md +++ b/tests/testthat/_snaps/gen_additive_mod-VGAM.md @@ -21,7 +21,7 @@ Call: VGAM::vgam(formula = formula, family = VGAM::cumulative(link = "logitlink", - parallel = TRUE), data = data) + parallel = TRUE, Thresh = NULL), data = data) Degrees of Freedom: 108 Total; 103 Residual @@ -38,7 +38,7 @@ Call: VGAM::vgam(formula = formula, family = VGAM::cumulative(link = "logitlink", - parallel = TRUE), data = data) + parallel = TRUE, Thresh = NULL), data = data) Degrees of Freedom: 108 Total; 103 Residual diff --git a/tests/testthat/_snaps/ordinal_reg-VGAM.md b/tests/testthat/_snaps/ordinal_reg-VGAM.md index afe7180..f597380 100644 --- a/tests/testthat/_snaps/ordinal_reg-VGAM.md +++ b/tests/testthat/_snaps/ordinal_reg-VGAM.md @@ -21,7 +21,7 @@ Call: VGAM::vglm(formula = formula, family = VGAM::cumulative(link = "logitlink", - parallel = TRUE), data = data) + parallel = TRUE, Thresh = NULL), data = data) Coefficients: @@ -42,7 +42,7 @@ Call: VGAM::vglm(formula = formula, family = VGAM::cumulative(link = "logitlink", - parallel = TRUE), data = data) + parallel = TRUE, Thresh = NULL), data = data) Coefficients: diff --git a/tests/testthat/test-dials.R b/tests/testthat/test-dials.R index a6e03cd..93347ce 100644 --- a/tests/testthat/test-dials.R +++ b/tests/testthat/test-dials.R @@ -8,6 +8,14 @@ test_that("rpartScore::rpartScore dial customization", { expect_equal(prune_func(letters[1:3])$values, letters[1:3]) }) +test_that("threshold_structure dial values and customization", { + expect_equal( + dials::threshold_structure()$values, + dials::values_threshold_structure + ) + expect_equal(dials::threshold_structure(letters[1:3])$values, letters[1:3]) +}) + test_that("ordinalForest::ordfor dial customization", { expect_equal(naive_scores(TRUE)$values, TRUE) expect_equal(num_scores(3:4)$range, list(lower = 3L, upper = 4L)) diff --git a/tests/testthat/test-ordinal_reg-VGAM.R b/tests/testthat/test-ordinal_reg-VGAM.R index e53804b..a8b2fd3 100644 --- a/tests/testthat/test-ordinal_reg-VGAM.R +++ b/tests/testthat/test-ordinal_reg-VGAM.R @@ -35,14 +35,19 @@ test_that("model object", { orig_fit <- VGAM::vglm( Sat ~ Type + Infl + Cont, # NB: Unused model parameters are ignored without comment. - family = VGAM::cratio(link = "probitlink", parallel = TRUE), + family = VGAM::cratio( + link = "probitlink", parallel = TRUE, Thresh = "symm1" + ), data = house_sub ) tidy_spec <- ordinal_reg() |> set_engine("vglm") |> set_mode("classification") |> - set_args(ordinal_link = "probit", odds_link = "continuation_ratio") + set_args( + ordinal_link = "probit", odds_link = "continuation_ratio", + threshold_structure = "symmetric_median" + ) set.seed(seed) tidy_fit <- fit(tidy_spec, Sat ~ Type + Infl + Cont, data = house_sub) diff --git a/tests/testthat/test-ordinal_reg-clm.R b/tests/testthat/test-ordinal_reg-clm.R index 54f875b..d02cecb 100644 --- a/tests/testthat/test-ordinal_reg-clm.R +++ b/tests/testthat/test-ordinal_reg-clm.R @@ -29,13 +29,14 @@ test_that("model object", { Sat ~ Type + Infl + Cont, data = house_sub, link = "probit", - threshold = "equidistant" + threshold = "symmetric" ) - tidy_spec <- ordinal_reg() |> + tidy_spec <- ordinal_reg( + ordinal_link = "probit", threshold_structure = "symmetric_median" + ) |> set_engine("clm") |> - set_mode("classification") |> - set_args(ordinal_link = "probit", threshold = "equidistant") + set_mode("classification") set.seed(seed) tidy_fit <- fit(tidy_spec, Sat ~ Type + Infl + Cont, data = house_sub) From 3486c41c4ed681f9b0e63972cfa412caed25e0c7 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Sat, 18 Jul 2026 12:23:57 -0400 Subject: [PATCH 03/45] attempt use of Remotes field with specified branch --- DESCRIPTION | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7cd3856..bc3e406 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,7 +26,7 @@ Depends: parsnip (> 1.6.0) Imports: cli, - dials (>= 1.4.3), + dials (> 1.4.4), purrr, rlang (>= 1.1.4), scales (>= 1.3.0), @@ -46,6 +46,9 @@ Suggests: QSARdata, spelling, testthat (>= 3.0.0) +Remotes: + corybrunson/parsnip@parallel-reg + corybrunson/dials@parallel-reg Config/testthat/edition: 3 Encoding: UTF-8 Language: en-US From 035569eecd87715f421a69a08a52bf24eafa7f21 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Sat, 18 Jul 2026 12:51:24 -0400 Subject: [PATCH 04/45] missing comma --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 714fbf8..e11d30a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -47,7 +47,7 @@ Suggests: spelling, testthat (>= 3.0.0) Remotes: - corybrunson/parsnip@parallel-reg + corybrunson/parsnip@parallel-reg, corybrunson/dials@parallel-reg Config/testthat/edition: 3 Encoding: UTF-8 From 6eff4c8b769854212193fe1ab7c77fc673b4b792 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Sat, 18 Jul 2026 18:06:25 -0400 Subject: [PATCH 05/45] handle parallel_reg model argument for ordinal_reg --- NAMESPACE | 3 + NEWS.md | 27 ++- R/ordinal_reg-VGAM.R | 128 ++++++++++++- R/ordinal_reg-clm.R | 181 ++++++++++++++++++ R/ordinal_reg-data.R | 29 ++- R/ordinal_reg-ordinalNet.R | 43 ++++- man/VGAM_vglm_wrapper.Rd | 6 +- man/clm_wrapper.Rd | 45 +++++ man/ordinalNet_wrapper.Rd | 1 + man/parallel_reg_to_clm_nominal.Rd | 21 ++ man/parallel_reg_to_ordinalNet.Rd | 19 ++ man/parallel_reg_to_vglm_parallel.Rd | 22 +++ tests/testthat/_snaps/ordinal_reg-VGAM.md | 9 + tests/testthat/_snaps/ordinal_reg-clm.md | 16 +- .../testthat/_snaps/ordinal_reg-ordinalNet.md | 10 + tests/testthat/_snaps/ordinal_reg.md | 118 ++++++++++++ tests/testthat/test-dials.R | 24 ++- tests/testthat/test-ordinal_reg-VGAM.R | 136 +++++++++++++ tests/testthat/test-ordinal_reg-clm.R | 96 ++++++++++ tests/testthat/test-ordinal_reg-ordinalNet.R | 99 ++++++++++ tests/testthat/test-ordinal_reg.R | 48 +++++ 21 files changed, 1050 insertions(+), 31 deletions(-) create mode 100644 R/ordinal_reg-clm.R create mode 100644 man/clm_wrapper.Rd create mode 100644 man/parallel_reg_to_clm_nominal.Rd create mode 100644 man/parallel_reg_to_ordinalNet.Rd create mode 100644 man/parallel_reg_to_vglm_parallel.Rd diff --git a/NAMESPACE b/NAMESPACE index d02b11c..285eb65 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,7 @@ S3method(predict_classprob,"_ordinalNet") S3method(predict_raw,"_ordinalNet") export(VGAM_vgam_wrapper) export(VGAM_vglm_wrapper) +export(clm_wrapper) export(honesty) export(honesty_fraction) export(naive_scores) @@ -40,4 +41,6 @@ importFrom(parsnip,eval_args) importFrom(parsnip,multi_predict) importFrom(parsnip,predict_raw) importFrom(stats,approx) +importFrom(stats,as.formula) +importFrom(stats,coef) importFrom(stats,predict) diff --git a/NEWS.md b/NEWS.md index be5f2db..d838149 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,12 @@ # next version -## additional engines +## bug fix + +A bug in the prediction of `vglm` models, and associated tests, were patched. +Previously, `predict()` was used, which triggers S3 dispatch when **VGAM** is not attached but S4 dispatched when it is. +Now `predictvglm()` is used instead. + +## additional ordinal regression and random forest engines This version introduces source code and unit tests for new engines: * `clm` from the **ordinal** package @@ -19,18 +25,25 @@ This version introduces source code and unit tests for new engines: - fit wrapper - dials for `sample.fraction`, `honesty`, and `honesty.fraction` arguments -Engine additions were coordinated with [parsnip PR #1384](https://github.com/tidymodels/parsnip/pull/1384). +Coordinated with [parsnip PR #1384](https://github.com/tidymodels/parsnip/pull/1384). -## linear predictions +## linear prediction type Linear predictions are enabled for the `clm`, `lrm`, `orm`, `vglm`, and `ordinalNet` ordinal regression engines and for the `vgam` generalized additive model engine. They consistently return a single column of linear predictors (without threshold contributions). -## bug fix +Coordinated with [parsnip PR #1391](https://github.com/tidymodels/parsnip/pull/1391). -A bug in the prediction of `vglm` models, and associated tests, were patched. -Previously, `predict()` was used, which triggers S3 dispatch when **VGAM** is not attached but S4 dispatched when it is. -Now `predictvglm()` is used instead. +## threshold structure and parallel regression model arguments + +The `threshold_structure` model argument for `ordinal_reg()` controls what constraints, if any, are imposed on the ordered thresholds. It can be used by the `clm` and `vglm` engines. + +The `parallel_reg` model argument for `ordinal_reg()` provides a unified interface for controlling the parallel regression assumption. It accepts a logical value (applied to all terms), a formula with a logical LHS naming parallel or non-parallel terms, or a list combining both; the engines `clm`, `vglm`, and `ordinalNet` are compatible with different subsets of specifications: +* `clm_wrapper()` (new) translates the `parallel_reg` specification to a formula accepted by `ordinal::clm(nominal)` +* `VGAM_vglm_wrapper()` and `VGAM_vgam_wrapper()` accept a `parallel_reg` argument and translate it for the VGAM `parallel` argument +* `ordinalNet_wrapper()` accepts a `parallel_reg` argument and translates it for the `parallelTerms` and `nonparallelTerms` arguments + +Coordinated with forthcoming PRs to parsnip and to dials. # ordered 0.1.0 diff --git a/R/ordinal_reg-VGAM.R b/R/ordinal_reg-VGAM.R index 32e9bd5..af966f6 100644 --- a/R/ordinal_reg-VGAM.R +++ b/R/ordinal_reg-VGAM.R @@ -14,8 +14,8 @@ #' and [`VGAM::vgam()`]. #' @param formula The formula to pass. #' @param data The data frame to pass. -#' @param Thresh The threshold structure for the cutpoints. See -#' [dials::threshold_structure()] for details. +#' @param Thresh The threshold constraints. See [dials::threshold_structure()] +#' for details. #' @param ... Additional arguments to pass. #' @details Note that `VGAM::vglm()` and `VGAM::vgam()` treat the rows of `data` #' as the units of observation: Compressed `data` with one row per predictor @@ -66,13 +66,20 @@ VGAM_vglm_wrapper <- function( formula, data, family = "cumulative_link", link = "logistic", parallel = TRUE, + parallel_reg = NULL, Thresh = NULL, ... ) { rlang::check_installed("VGAM") - # for now, require `parallel` to be logical - check_logical(parallel) + if (! is.null(parallel_reg)) { + parallel <- parallel_reg_to_vglm_parallel(parallel_reg, formula) + } + + # `parallel` can be logical or formula (VGAM supports both) + if (! is.logical(parallel) && ! inherits(parallel, "formula")) { + stop_input_type(parallel, "a logical vector or formula") + } # TODO: Ensure that `formula = cbind(...) ~ ...` is disallowed, for this and # for other `ordinal_reg()` engines. @@ -114,13 +121,19 @@ VGAM_vgam_wrapper <- function( formula, data, family = "cumulative_link", link = "logistic", parallel = TRUE, + parallel_reg = NULL, Thresh = NULL, ... ) { rlang::check_installed("VGAM") - # for now, require `parallel` to be logical - check_logical(parallel) + if (! is.null(parallel_reg)) { + parallel <- parallel_reg_to_vglm_parallel(parallel_reg, formula) + } + # `parallel` can be logical or formula (VGAM supports both) + if (! is.logical(parallel) && ! inherits(parallel, "formula")) { + stop_input_type(parallel, "a logical vector or formula") + } # match and convert model arguments family <- match_VGAM_family(family) @@ -219,3 +232,106 @@ predict_VGAM_prob_post <- function(x, object) { colnames(x) <- object$lvl tibble::as_tibble(x) } + +# ------------------------------------------------------------------------------ + +#' Translate `parallel_reg` to VGAM `parallel` argument +#' +#' @param parallel_reg A parallel regression specification. +#' @param formula The model formula (used to extract predictor names for list +#' forms). +#' @keywords internal +#' @returns A logical or formula suitable for the `parallel` argument of VGAM +#' family functions. +parallel_reg_to_vglm_parallel <- function(parallel_reg, formula) { + # single logical + if (is.logical(parallel_reg) && length(parallel_reg) == 1L) { + return(parallel_reg) + } + + # single formula + # TRUE ~ vars → TRUE ~ -1 + vars + # FALSE ~ vars → FALSE ~ 1 + vars + if (inherits(parallel_reg, "formula")) { + return(formula_to_vglm_parallel(parallel_reg)) + } + + # list + if (is.list(parallel_reg)) { + return(list_to_vglm_parallel(parallel_reg, formula)) + } + + cli::cli_abort("Invalid {.arg parallel_reg} specification.") +} + +#' @keywords internal +formula_to_vglm_parallel <- function(pr_formula) { + lhs <- pr_formula[[2L]] + rhs_vars <- all.vars(pr_formula[[3L]]) + + if (isTRUE(lhs)) { + # RHS names parallel terms; VGAM: TRUE ~ -1 + vars + rhs <- paste("-1 +", paste(rhs_vars, collapse = " + ")) + } else { + # RHS names non-parallel terms; VGAM: FALSE ~ -1 + vars + rhs <- paste("-1 +", paste(rhs_vars, collapse = " + ")) + } + as.formula(paste(format(lhs), "~", rhs)) +} + +#' @keywords internal +list_to_vglm_parallel <- function(lst, formula) { + parallel_vars <- character(0L) + nonparallel_vars <- character(0L) + has_bare_logical <- FALSE + + for (el in lst) { + if (is.logical(el) && length(el) == 1L) { + has_bare_logical <- TRUE + if (isTRUE(el)) { + parallel_vars <- all.vars(formula[[3L]]) + } + # bare FALSE: no action needed (non-parallel is VGAM default) + } else if (inherits(el, "formula")) { + lhs <- el[[2L]] + rhs_vars <- all.vars(el[[3L]]) + if (isTRUE(lhs)) { + parallel_vars <- union(parallel_vars, rhs_vars) + } else { + nonparallel_vars <- union(nonparallel_vars, rhs_vars) + } + } + } + + # check overlap + overlap <- intersect(parallel_vars, nonparallel_vars) + if (length(overlap) > 0L) { + cli::cli_abort( + "Variable{?s} {.val {overlap}} appear{?s/} in both parallel and + non-parallel specifications." + ) + } + + # when no bare logical is present, every predictor must appear + # in at least one formula entry + if (!has_bare_logical) { + all_pred_vars <- all.vars(formula[[3L]]) + covered <- union(parallel_vars, nonparallel_vars) + missing <- setdiff(all_pred_vars, covered) + if (length(missing) > 0L) { + cli::cli_abort( + "Variable{?s} {.val {missing}} not specified in {.arg parallel_reg} + list. Either use a bare logical ({.val TRUE}/{.val FALSE}) to set + defaults, or include all predictors in the formula entries." + ) + } + } + + if (length(parallel_vars) > 0L) { + return(as.formula(paste( + "TRUE ~ -1 +", paste(parallel_vars, collapse = " + ") + ))) + } + + return(FALSE) +} diff --git a/R/ordinal_reg-clm.R b/R/ordinal_reg-clm.R new file mode 100644 index 0000000..a30804f --- /dev/null +++ b/R/ordinal_reg-clm.R @@ -0,0 +1,181 @@ +#' Wrapper for `clm` +#' +#' Translates the `parallel_reg` specification to the `nominal` formula accepted +#' by [ordinal::clm()] and validates that each predictor is assigned to exactly +#' one side of the parallel regression specification. +#' @param formula The model formula. +#' @param data The data frame. +#' @param parallel_reg A parallel regression specification. See +#' [parsnip::ordinal_reg()] for details. +#' @param ... Additional arguments passed to [ordinal::clm()]. +#' @keywords internal +#' @returns An object of class `clm` as returned by [ordinal::clm()]. + +#' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("ordinal") +#' house_data <- +#' MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] +#' clm_wrapper( +#' Sat ~ Infl + Cont, data = house_data, +#' parallel_reg = FALSE +#' ) +#' clm_wrapper( +#' Sat ~ Infl + Cont, data = house_data, +#' parallel_reg = FALSE ~ Infl + Cont +#' ) +#' ordinal::clm( +#' Sat ~ Infl + Cont, data = house_data, +#' nominal = ~ Infl + Cont +#' ) +#' @export +clm_wrapper <- function( + formula, data, + parallel_reg = NULL, + ... +) { + rlang::check_installed("ordinal") + + nominal <- NULL + if (!is.null(parallel_reg)) { + nominal <- parallel_reg_to_clm_nominal(parallel_reg, formula) + } + + cl <- rlang::call2( + "clm", .ns = "ordinal", + formula = rlang::expr(formula), + data = rlang::expr(data), + nominal = nominal, + ... + ) + rlang::eval_tidy(cl) +} + +#' Translate `parallel_reg` to clm `nominal` formula +#' +#' @param parallel_reg A parallel regression specification. +#' @param formula The model formula (used to extract predictor names). +#' @keywords internal +#' @returns A formula suitable for the `nominal` argument of [ordinal::clm()], +#' or `NULL` for proportional odds. +parallel_reg_to_clm_nominal <- function(parallel_reg, formula) { + # single logical + if (is.logical(parallel_reg) && length(parallel_reg) == 1L) { + if (isTRUE(parallel_reg)) { + return(NULL) + } + # FALSE: all non-parallel + pred_vars <- all.vars(formula[[3L]]) + return(as.formula(paste("~", paste(pred_vars, collapse = " + ")))) + } + + # single formula + if (inherits(parallel_reg, "formula")) { + return(formula_to_clm_nominal(parallel_reg, formula)) + } + + # list + if (is.list(parallel_reg)) { + return(list_to_clm_nominal(parallel_reg, formula)) + } + + cli::cli_abort("Invalid {.arg parallel_reg} specification.") +} + +#' @keywords internal +formula_to_clm_nominal <- function(pr_formula, model_formula) { + lhs <- pr_formula[[2L]] + rhs_vars <- all.vars(pr_formula[[3L]]) + + if (isFALSE(lhs)) { + # RHS names non-parallel terms + if (length(rhs_vars) == 0L) { + return(NULL) + } + return(as.formula(paste("~", paste(rhs_vars, collapse = " + ")))) + } + + # TRUE: RHS names parallel terms; non-parallel = complement + all_pred_vars <- all.vars(model_formula[[3L]]) + nonparallel <- setdiff(all_pred_vars, rhs_vars) + if (length(nonparallel) == 0L) { + return(NULL) + } + return(as.formula(paste("~", paste(nonparallel, collapse = " + ")))) +} + +#' @keywords internal +list_to_clm_nominal <- function(lst, model_formula) { + parallel_vars <- character(0L) + nonparallel_vars <- character(0L) + has_bare_logical <- FALSE + + for (el in lst) { + if (is.logical(el) && length(el) == 1L) { + has_bare_logical <- TRUE + if (isTRUE(el)) { + parallel_vars <- all.vars(model_formula[[3L]]) + } else { + nonparallel_vars <- all.vars(model_formula[[3L]]) + } + } else if (inherits(el, "formula")) { + lhs <- el[[2L]] + rhs_vars <- all.vars(el[[3L]]) + if (isTRUE(lhs)) { + parallel_vars <- union(parallel_vars, rhs_vars) + } else { + nonparallel_vars <- union(nonparallel_vars, rhs_vars) + } + } + } + + # check overlap between explicit formula entries + overlap <- intersect(parallel_vars, nonparallel_vars) + if (length(overlap) > 0L) { + cli::cli_abort( + "Variable{?s} {.val {overlap}} appear{?s/} in both parallel and + non-parallel specifications. The {.code clm} engine must treat each + predictor as either parallel regression or category-specific (not both)." + ) + } + + # when no bare logical is present, every predictor must appear + # in at least one formula entry + if (!has_bare_logical) { + all_pred_vars <- all.vars(model_formula[[3L]]) + covered <- union(parallel_vars, nonparallel_vars) + missing <- setdiff(all_pred_vars, covered) + if (length(missing) > 0L) { + cli::cli_abort( + "Variable{?s} {.val {missing}} not specified in {.arg parallel_reg} + list. Either use a bare logical ({.val TRUE}/{.val FALSE}) to set + defaults, or include all predictors in the formula entries." + ) + } + } + + # for clm: nonparallel vars go in nominal + all_pred_vars <- all.vars(model_formula[[3L]]) + + if (length(nonparallel_vars) > 0L) { + # if parallel vars were also specified (via "all" or formulas), + # the nonparallel vars are the ones to put in nominal + if (length(parallel_vars) > 0L && + !identical(sort(parallel_vars), sort(all_pred_vars))) { + # both sides specified explicitly: use nonparallel vars + return(as.formula(paste("~", paste(nonparallel_vars, collapse = " + ")))) + } + # only nonparallel specified (or parallel = "all"): use nonparallel vars + return(as.formula(paste("~", paste(nonparallel_vars, collapse = " + ")))) + } + + if (length(parallel_vars) > 0L) { + # only parallel specified: nonparallel = complement + nonparallel <- setdiff(all_pred_vars, parallel_vars) + if (length(nonparallel) == 0L) { + return(NULL) + } + return(as.formula(paste("~", paste(nonparallel, collapse = " + ")))) + } + + # neither specified: default PO + return(NULL) +} diff --git a/R/ordinal_reg-data.R b/R/ordinal_reg-data.R index 2c1e36b..df05b97 100644 --- a/R/ordinal_reg-data.R +++ b/R/ordinal_reg-data.R @@ -143,6 +143,14 @@ make_ordinal_reg_vglm <- function() { func = list(pkg = "dials", fun = "threshold_structure"), has_submodel = FALSE ) + parsnip::set_model_arg( + model = "ordinal_reg", + eng = "vglm", + parsnip = "parallel_reg", + original = "parallel_reg", + func = list(pkg = "dials", fun = "parallel_reg"), + has_submodel = FALSE + ) parsnip::set_fit( model = "ordinal_reg", @@ -294,6 +302,14 @@ make_ordinal_reg_ordinalNet <- function() { func = list(pkg = "ordered", fun = "parallel_penalty_factor"), has_submodel = FALSE ) + parsnip::set_model_arg( + model = "ordinal_reg", + eng = "ordinalNet", + parsnip = "parallel_reg", + original = "parallel_reg", + func = list(pkg = "dials", fun = "parallel_reg"), + has_submodel = FALSE + ) parsnip::set_fit( model = "ordinal_reg", @@ -432,7 +448,6 @@ make_ordinal_reg_lrm <- function() { func = list(pkg = "dials", fun = "penalty"), has_submodel = FALSE ) - parsnip::set_fit( model = "ordinal_reg", eng = "lrm", @@ -555,7 +570,6 @@ make_ordinal_reg_lrm <- function() { func = list(pkg = "dials", fun = "penalty"), has_submodel = FALSE ) - parsnip::set_fit( model = "ordinal_reg", eng = "orm", @@ -682,7 +696,6 @@ make_ordinal_reg_glmnetcr <- function() { func = list(pkg = "dials", fun = "mixture"), has_submodel = FALSE ) - parsnip::set_fit( model = "ordinal_reg", eng = "glmnetcr", @@ -788,6 +801,14 @@ make_ordinal_reg_clm <- function() { func = list(pkg = "dials", fun = "threshold_structure"), has_submodel = FALSE ) + parsnip::set_model_arg( + model = "ordinal_reg", + eng = "clm", + parsnip = "parallel_reg", + original = "parallel_reg", + func = list(pkg = "dials", fun = "parallel_reg"), + has_submodel = FALSE + ) parsnip::set_fit( model = "ordinal_reg", @@ -796,7 +817,7 @@ make_ordinal_reg_clm <- function() { value = list( interface = "formula", protect = c("formula", "data", "weights"), - func = c(pkg = "ordinal", fun = "clm"), + func = c(pkg = "ordered", fun = "clm_wrapper"), defaults = list() ) ) diff --git a/R/ordinal_reg-ordinalNet.R b/R/ordinal_reg-ordinalNet.R index 3873e2b..4d295ad 100644 --- a/R/ordinal_reg-ordinalNet.R +++ b/R/ordinal_reg-ordinalNet.R @@ -62,10 +62,20 @@ ordinalNet_wrapper <- function( x, y, weights = NULL, # TODO: Test whether defaults can be omitted. family = "cumulative_link", link = "logistic", + parallel_reg = NULL, ... ) { rlang::check_installed("ordinalNet") + # `ordinalNet` supports only all-or-nothing parallel regression (or both) + parallelTerms <- TRUE + nonparallelTerms <- FALSE + if (! is.null(parallel_reg)) { + pt_nt <- parallel_reg_to_ordinalNet(parallel_reg) + parallelTerms <- pt_nt$parallelTerms + nonparallelTerms <- pt_nt$nonparallelTerms + } + # match and convert odds link options family <- match.arg(family, dials::values_odds_link) family <- switch( @@ -103,6 +113,8 @@ ordinalNet_wrapper <- function( .fn = "ordinalNet", .ns = "ordinalNet", x = rlang::expr(x), y = rlang::expr(y), family = rlang::expr(family), link = rlang::expr(link), + parallelTerms = parallelTerms, + nonparallelTerms = nonparallelTerms, ... ) rlang::eval_tidy(cl) @@ -226,7 +238,7 @@ approx_prediction_row <- function(values, adjacent, penalty) { # multi_predict__ordinal_net() <-- vectorizes prediction over penalty # predict._ordinalNet(multi = FALSE) <-- (see above) -#' @importFrom stats approx predict +#' @importFrom stats approx as.formula coef predict #' @importFrom parsnip eval_args predict_raw multi_predict #' @param penalty A numeric vector of penalty values. @@ -398,3 +410,32 @@ multi_predict_class_ordinal_net <- function(object, new_data, penalty) { tidyr::nest(.by = .row, .key = ".pred") %>% dplyr::select(-.row) } + +# ------------------------------------------------------------------------------ + +#' Translate `parallel_reg` to ordinalNet `parallelTerms`/`nonparallelTerms` +#' +#' @param parallel_reg A parallel regression specification. Must be one or two +#' logical values; formulae are not supported. +#' @keywords internal +#' @returns A list with elements `parallelTerms` and `nonparallelTerms`. +parallel_reg_to_ordinalNet <- function(parallel_reg) { + if (is.logical(parallel_reg)) { + if (length(parallel_reg) == 1L) { + if (isTRUE(parallel_reg)) { + return(list(parallelTerms = TRUE, nonparallelTerms = FALSE)) + } else { + return(list(parallelTerms = FALSE, nonparallelTerms = TRUE)) + } + } else { + return(list(parallelTerms = TRUE, nonparallelTerms = TRUE)) + } + } + + cli::cli_abort( + c( + "The {.val ordinalNet} engine does not support partial parallelism.", + "i" = "Use engine {.val clm} or {.val vglm} for partial parallelism." + ) + ) +} diff --git a/man/VGAM_vglm_wrapper.Rd b/man/VGAM_vglm_wrapper.Rd index 645d65b..8fdb0e3 100644 --- a/man/VGAM_vglm_wrapper.Rd +++ b/man/VGAM_vglm_wrapper.Rd @@ -13,6 +13,7 @@ VGAM_vglm_wrapper( family = "cumulative_link", link = "logistic", parallel = TRUE, + parallel_reg = NULL, Thresh = NULL, ... ) @@ -23,6 +24,7 @@ VGAM_vgam_wrapper( family = "cumulative_link", link = "logistic", parallel = TRUE, + parallel_reg = NULL, Thresh = NULL, ... ) @@ -36,8 +38,8 @@ values_threshold_structure_VGAM \item{data}{The data frame to pass.} -\item{Thresh}{The threshold structure for the cutpoints. See -\code{\link[dials:threshold_structure]{dials::threshold_structure()}} for details.} +\item{Thresh}{The threshold constraints. See \code{\link[dials:threshold_structure]{dials::threshold_structure()}} +for details.} \item{...}{Additional arguments to pass.} } diff --git a/man/clm_wrapper.Rd b/man/clm_wrapper.Rd new file mode 100644 index 0000000..0aeef39 --- /dev/null +++ b/man/clm_wrapper.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ordinal_reg-clm.R +\name{clm_wrapper} +\alias{clm_wrapper} +\title{Wrapper for \code{clm}} +\usage{ +clm_wrapper(formula, data, parallel_reg = NULL, ...) +} +\arguments{ +\item{formula}{The model formula.} + +\item{data}{The data frame.} + +\item{parallel_reg}{A parallel regression specification. See +\code{\link[parsnip:ordinal_reg]{parsnip::ordinal_reg()}} for details.} + +\item{...}{Additional arguments passed to \code{\link[ordinal:clm]{ordinal::clm()}}.} +} +\value{ +An object of class \code{clm} as returned by \code{\link[ordinal:clm]{ordinal::clm()}}. +} +\description{ +Translates the \code{parallel_reg} specification to the \code{nominal} formula accepted +by \code{\link[ordinal:clm]{ordinal::clm()}} and validates that each predictor is assigned to exactly +one side of the parallel regression specification. +} +\examples{ +\dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("ordinal")) withAutoprint(\{ # examplesIf} +house_data <- + MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] +clm_wrapper( + Sat ~ Infl + Cont, data = house_data, + parallel_reg = FALSE +) +clm_wrapper( + Sat ~ Infl + Cont, data = house_data, + parallel_reg = FALSE ~ Infl + Cont +) +ordinal::clm( + Sat ~ Infl + Cont, data = house_data, + nominal = ~ Infl + Cont +) +\dontshow{\}) # examplesIf} +} +\keyword{internal} diff --git a/man/ordinalNet_wrapper.Rd b/man/ordinalNet_wrapper.Rd index 6baaca7..fdbb359 100644 --- a/man/ordinalNet_wrapper.Rd +++ b/man/ordinalNet_wrapper.Rd @@ -16,6 +16,7 @@ ordinalNet_wrapper( weights = NULL, family = "cumulative_link", link = "logistic", + parallel_reg = NULL, ... ) diff --git a/man/parallel_reg_to_clm_nominal.Rd b/man/parallel_reg_to_clm_nominal.Rd new file mode 100644 index 0000000..825ff49 --- /dev/null +++ b/man/parallel_reg_to_clm_nominal.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ordinal_reg-clm.R +\name{parallel_reg_to_clm_nominal} +\alias{parallel_reg_to_clm_nominal} +\title{Translate \code{parallel_reg} to clm \code{nominal} formula} +\usage{ +parallel_reg_to_clm_nominal(parallel_reg, formula) +} +\arguments{ +\item{parallel_reg}{A parallel regression specification.} + +\item{formula}{The model formula (used to extract predictor names).} +} +\value{ +A formula suitable for the \code{nominal} argument of \code{\link[ordinal:clm]{ordinal::clm()}}, +or \code{NULL} for proportional odds. +} +\description{ +Translate \code{parallel_reg} to clm \code{nominal} formula +} +\keyword{internal} diff --git a/man/parallel_reg_to_ordinalNet.Rd b/man/parallel_reg_to_ordinalNet.Rd new file mode 100644 index 0000000..e5832ef --- /dev/null +++ b/man/parallel_reg_to_ordinalNet.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ordinal_reg-ordinalNet.R +\name{parallel_reg_to_ordinalNet} +\alias{parallel_reg_to_ordinalNet} +\title{Translate \code{parallel_reg} to ordinalNet \code{parallelTerms}/\code{nonparallelTerms}} +\usage{ +parallel_reg_to_ordinalNet(parallel_reg) +} +\arguments{ +\item{parallel_reg}{A parallel regression specification. Must be one or two +logical values; formulae are not supported.} +} +\value{ +A list with elements \code{parallelTerms} and \code{nonparallelTerms}. +} +\description{ +Translate \code{parallel_reg} to ordinalNet \code{parallelTerms}/\code{nonparallelTerms} +} +\keyword{internal} diff --git a/man/parallel_reg_to_vglm_parallel.Rd b/man/parallel_reg_to_vglm_parallel.Rd new file mode 100644 index 0000000..74d4880 --- /dev/null +++ b/man/parallel_reg_to_vglm_parallel.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ordinal_reg-VGAM.R +\name{parallel_reg_to_vglm_parallel} +\alias{parallel_reg_to_vglm_parallel} +\title{Translate \code{parallel_reg} to VGAM \code{parallel} argument} +\usage{ +parallel_reg_to_vglm_parallel(parallel_reg, formula) +} +\arguments{ +\item{parallel_reg}{A parallel regression specification.} + +\item{formula}{The model formula (used to extract predictor names for list +forms).} +} +\value{ +A logical or formula suitable for the \code{parallel} argument of VGAM +family functions. +} +\description{ +Translate \code{parallel_reg} to VGAM \code{parallel} argument +} +\keyword{internal} diff --git a/tests/testthat/_snaps/ordinal_reg-VGAM.md b/tests/testthat/_snaps/ordinal_reg-VGAM.md index f597380..89f52e5 100644 --- a/tests/testthat/_snaps/ordinal_reg-VGAM.md +++ b/tests/testthat/_snaps/ordinal_reg-VGAM.md @@ -77,3 +77,12 @@ set.seed(13) onet_arg_fit <- fit(onet_arg_spec, class ~ ., data = caco_train) +# parallel regression argument handles lists + + Code + fit(ordinal_reg(parallel_reg = list(TRUE ~ Infl, FALSE ~ Infl + Cont), engine = "vglm"), + Sat ~ Infl + Cont, data = house_sub) + Condition + Error in `list_to_vglm_parallel()`: + ! Variable "Infl" appears in both parallel and non-parallel specifications. + diff --git a/tests/testthat/_snaps/ordinal_reg-clm.md b/tests/testthat/_snaps/ordinal_reg-clm.md index 88b7306..1c40a40 100644 --- a/tests/testthat/_snaps/ordinal_reg-clm.md +++ b/tests/testthat/_snaps/ordinal_reg-clm.md @@ -8,7 +8,8 @@ Computational engine: clm Model fit template: - ordinal::clm(formula = missing_arg(), data = missing_arg(), weights = missing_arg()) + ordered::clm_wrapper(formula = missing_arg(), data = missing_arg(), + weights = missing_arg()) --- @@ -65,6 +66,15 @@ Computational engine: clm Model fit template: - ordinal::clm(formula = missing_arg(), data = missing_arg(), weights = missing_arg(), - link = "probit") + ordered::clm_wrapper(formula = missing_arg(), data = missing_arg(), + weights = missing_arg(), link = "probit") + +# parallel_reg errors for overlapping variables + + Code + fit(ordinal_reg(parallel_reg = list(FALSE ~ Infl, TRUE ~ Infl + Cont), engine = "clm"), + Sat ~ Infl + Cont, data = house_sub) + Condition + Error in `list_to_clm_nominal()`: + ! Variable "Infl" appears in both parallel and non-parallel specifications. Each predictor must be assigned to exactly one side: parallel regression or category-specific. diff --git a/tests/testthat/_snaps/ordinal_reg-ordinalNet.md b/tests/testthat/_snaps/ordinal_reg-ordinalNet.md index 3f3f344..bb98fc9 100644 --- a/tests/testthat/_snaps/ordinal_reg-ordinalNet.md +++ b/tests/testthat/_snaps/ordinal_reg-ordinalNet.md @@ -41,3 +41,13 @@ set.seed(13) onet_arg_fit <- fit(onet_arg_spec, class ~ ., data = caco_train) +# parallel regression argument handles formulae + + Code + fit(ordinal_reg(parallel_reg = TRUE ~ Infl, penalty = 0.01, engine = "ordinalNet"), + Sat ~ Cont, data = house_sub) + Condition + Error in `parallel_reg_to_ordinalNet()`: + ! The "ordinalNet" engine does not support partial parallelism. + i Use engine "clm" or "vglm" for partial parallelism. + diff --git a/tests/testthat/_snaps/ordinal_reg.md b/tests/testthat/_snaps/ordinal_reg.md index d9e86dc..7014b06 100644 --- a/tests/testthat/_snaps/ordinal_reg.md +++ b/tests/testthat/_snaps/ordinal_reg.md @@ -40,3 +40,121 @@ x Engine "wat?" is not supported for `ordinal_reg()`. i See `show_engines("ordinal_reg")`. +# parallel_reg accepts logical input + + Code + ordinal_reg(parallel_reg = TRUE) + Output + Ordinal Regression Model Specification (classification) + + Main Arguments: + parallel_reg = TRUE + + Computational engine: polr + + +--- + + Code + ordinal_reg(parallel_reg = FALSE) + Output + Ordinal Regression Model Specification (classification) + + Main Arguments: + parallel_reg = FALSE + + Computational engine: polr + + +# parallel_reg accepts formula input + + Code + ordinal_reg(parallel_reg = TRUE ~ x) + Output + Ordinal Regression Model Specification (classification) + + Main Arguments: + parallel_reg = TRUE ~ x + + Computational engine: polr + + +--- + + Code + ordinal_reg(parallel_reg = FALSE ~ y + z) + Output + Ordinal Regression Model Specification (classification) + + Main Arguments: + parallel_reg = FALSE ~ y + z + + Computational engine: polr + + +# parallel_reg accepts list input + + Code + ordinal_reg(parallel_reg = list(TRUE ~ x)) + Output + Ordinal Regression Model Specification (classification) + + Main Arguments: + parallel_reg = list(TRUE ~ x) + + Computational engine: polr + + +--- + + Code + ordinal_reg(parallel_reg = list(FALSE ~ x, TRUE ~ y)) + Output + Ordinal Regression Model Specification (classification) + + Main Arguments: + parallel_reg = list(FALSE ~ x, TRUE ~ y) + + Computational engine: polr + + +--- + + Code + ordinal_reg(parallel_reg = list(FALSE, TRUE ~ y)) + Output + Ordinal Regression Model Specification (classification) + + Main Arguments: + parallel_reg = list(FALSE, TRUE ~ y) + + Computational engine: polr + + +# parallel_reg rejects invalid inputs + + Code + fit(set_engine(ordinal_reg(parallel_reg = "TRUE"), "clm"), Sat ~ Infl + Cont, + data = house_sub) + Condition + Error in `fit()`: + ! `parallel_reg` must be a single logical value, a formula with a logical LHS, or a list of at most two such elements. + +--- + + Code + fit(set_engine(ordinal_reg(parallel_reg = Sat ~ Infl), "clm"), Sat ~ Infl + + Cont, data = house_sub) + Condition + Error in `fit()`: + ! The LHS of `parallel_reg` formula must be TRUE or FALSE. + +--- + + Code + fit(set_engine(ordinal_reg(parallel_reg = list(TRUE ~ Infl, FALSE ~ Cont, TRUE)), + "clm"), Sat ~ Infl + Cont, data = house_sub) + Condition + Error in `fit()`: + ! `parallel_reg` list can have at most 2 elements. + diff --git a/tests/testthat/test-dials.R b/tests/testthat/test-dials.R index 93347ce..fe9ab84 100644 --- a/tests/testthat/test-dials.R +++ b/tests/testthat/test-dials.R @@ -1,3 +1,19 @@ +test_that("threshold_structure dial values and customization", { + expect_equal( + dials::threshold_structure()$values, + dials::values_threshold_structure + ) + expect_equal(dials::threshold_structure(letters[1:3])$values, letters[1:3]) +}) + +test_that("parallel_reg dial values and customization", { + expect_equal( + dials::parallel_reg()$values, + dials::values_parallel_reg + ) + expect_equal(dials::parallel_reg(TRUE)$values, TRUE) +}) + test_that("ordinalNet::ordinalNet dial customization", { expect_equal(parallel_penalty_factor(range = c(-2, 2))$range, list(lower = -2, upper = 2)) @@ -8,14 +24,6 @@ test_that("rpartScore::rpartScore dial customization", { expect_equal(prune_func(letters[1:3])$values, letters[1:3]) }) -test_that("threshold_structure dial values and customization", { - expect_equal( - dials::threshold_structure()$values, - dials::values_threshold_structure - ) - expect_equal(dials::threshold_structure(letters[1:3])$values, letters[1:3]) -}) - test_that("ordinalForest::ordfor dial customization", { expect_equal(naive_scores(TRUE)$values, TRUE) expect_equal(num_scores(3:4)$range, list(lower = 3L, upper = 4L)) diff --git a/tests/testthat/test-ordinal_reg-VGAM.R b/tests/testthat/test-ordinal_reg-VGAM.R index 606fbb8..3a741db 100644 --- a/tests/testthat/test-ordinal_reg-VGAM.R +++ b/tests/testthat/test-ordinal_reg-VGAM.R @@ -233,3 +233,139 @@ test_that("arguments agree", { expect_equal(onet_arg_fit$fit@family@infos()$parallel, TRUE) expect_equal(onet_arg_fit$fit@family@vfamily[1L], "sratio") }) + +# parallel regression ---------------------------------------------------------- + +test_that("parallel regression argument handles logicals", { + skip_if_not_installed("MASS") + skip_if_not_installed("VGAM") + house_sub <- get_house()$sub + + # all parallel regression + + set.seed(seed) + tidy_fit <- ordinal_reg(parallel_reg = TRUE, engine = "vglm") |> + fit(Sat ~ Infl + Cont, data = house_sub) + + set.seed(seed) + orig_fit <- VGAM::vglm( + Sat ~ Infl + Cont, + family = VGAM::cumulative(parallel = TRUE), + data = house_sub + ) + + skip_slots <- c("call", "misc") + for (s in setdiff(slotNames(tidy_fit$fit), skip_slots)) { + expect_equal( + slot(tidy_fit$fit, s), + slot(orig_fit, s), + ignore_attr = TRUE, ignore_formula_env = TRUE + ) + } + + # all category-specific + + set.seed(seed) + tidy_fit <- ordinal_reg(parallel_reg = FALSE, engine = "vglm") |> + fit(Sat ~ Infl + Cont, data = house_sub) + + set.seed(seed) + orig_fit <- VGAM::vglm( + Sat ~ Infl + Cont, + family = VGAM::cumulative(parallel = FALSE), + data = house_sub + ) + + skip_slots <- c("call", "misc") + for (s in setdiff(slotNames(tidy_fit$fit), skip_slots)) { + expect_equal( + slot(tidy_fit$fit, s), + slot(orig_fit, s), + ignore_attr = TRUE, ignore_formula_env = TRUE + ) + } +}) + +test_that("parallel regression argument handles formulae", { + skip_if_not_installed("MASS") + skip_if_not_installed("VGAM") + house_sub <- get_house()$sub + + set.seed(seed) + tidy_fit <- ordinal_reg(parallel_reg = TRUE ~ Cont, engine = "vglm") |> + fit(Sat ~ Infl + Cont, data = house_sub) + + set.seed(seed) + orig_fit <- VGAM::vglm( + Sat ~ Infl + Cont, + family = VGAM::cumulative(parallel = TRUE ~ -1 + Cont), + data = house_sub + ) + + skip_slots <- c("call", "misc") + for (s in setdiff(slotNames(tidy_fit$fit), skip_slots)) { + expect_equal( + slot(tidy_fit$fit, s), + slot(orig_fit, s), + ignore_attr = TRUE, ignore_formula_env = TRUE + ) + } + + set.seed(seed) + tidy_fit <- ordinal_reg(parallel_reg = FALSE ~ Cont, engine = "vglm") |> + fit(Sat ~ Infl + Cont, data = house_sub) + + set.seed(seed) + orig_fit <- suppressWarnings(VGAM::vglm( + Sat ~ Infl + Cont, + family = VGAM::cumulative(parallel = FALSE ~ -1 + Cont), + data = house_sub + )) + + skip_slots <- c("call", "misc") + for (s in setdiff(slotNames(tidy_fit$fit), skip_slots)) { + expect_equal( + slot(tidy_fit$fit, s), + slot(orig_fit, s), + ignore_attr = TRUE, ignore_formula_env = TRUE + ) + } +}) + +test_that("parallel regression argument handles lists", { + skip_if_not_installed("MASS") + skip_if_not_installed("VGAM") + house_sub <- get_house()$sub + + set.seed(seed) + tidy_fit <- ordinal_reg( + parallel_reg = list(TRUE ~ Infl, FALSE ~ Type + Cont), + engine = "vglm" + ) |> + fit(Sat ~ Type + Infl + Cont, data = house_sub) + + set.seed(seed) + orig_fit <- VGAM::vglm( + Sat ~ Type + Infl + Cont, + family = VGAM::cumulative(parallel = TRUE ~ -1 + Infl), + data = house_sub + ) + + skip_slots <- c("call", "misc") + for (s in setdiff(slotNames(tidy_fit$fit), skip_slots)) { + expect_equal( + slot(tidy_fit$fit, s), + slot(orig_fit, s), + ignore_attr = TRUE, ignore_formula_env = TRUE + ) + } + + expect_snapshot( + ordinal_reg( + parallel_reg = list(TRUE ~ Infl, FALSE ~ Infl + Cont), + engine = "vglm" + ) |> + fit(Sat ~ Infl + Cont, data = house_sub), + error = TRUE + ) +}) diff --git a/tests/testthat/test-ordinal_reg-clm.R b/tests/testthat/test-ordinal_reg-clm.R index 370a0c2..5238b84 100644 --- a/tests/testthat/test-ordinal_reg-clm.R +++ b/tests/testthat/test-ordinal_reg-clm.R @@ -188,3 +188,99 @@ test_that("arguments agree", { }) expect_equal(clm_arg_fit$fit$link, "probit") }) + +# parallel regression ---------------------------------------------------------- + +test_that("parallel regression argument handles logicals", { + skip_if_not_installed("MASS") + skip_if_not_installed("ordinal") + house_sub <- get_house()$sub + + # all parallel regression + + set.seed(seed) + tidy_fit <- ordinal_reg(parallel_reg = TRUE, engine = "clm") |> + fit(Sat ~ Infl + Cont, data = house_sub) + + set.seed(seed) + orig_fit <- ordinal::clm( + Sat ~ Infl + Cont, data = house_sub + ) + + tidy_fit$fit$call <- orig_fit$call <- NULL + tidy_fit$fit$formulas <- orig_fit$formulas <- NULL + expect_equal(tidy_fit$fit, orig_fit, ignore_formula_env = TRUE) + + # all category-specific + + set.seed(seed) + tidy_fit <- ordinal_reg(parallel_reg = FALSE, engine = "clm") |> + fit(Sat ~ Infl + Cont, data = house_sub) + + set.seed(seed) + orig_fit <- ordinal::clm( + Sat ~ Infl + Cont, data = house_sub, + nominal = ~ Infl + Cont + ) + + tidy_fit$fit$call <- orig_fit$call <- NULL + tidy_fit$fit$formulas <- orig_fit$formulas <- NULL + expect_equal(tidy_fit$fit, orig_fit, ignore_formula_env = TRUE) +}) + +test_that("parallel regression argument handles formulae", { + skip_if_not_installed("MASS") + skip_if_not_installed("ordinal") + house_sub <- get_house()$sub + + set.seed(seed) + tidy_fit1 <- ordinal_reg(parallel_reg = FALSE ~ Cont, engine = "clm") |> + fit(Sat ~ Infl + Cont, data = house_sub) + + set.seed(seed) + tidy_fit2 <- ordinal_reg(parallel_reg = TRUE ~ Infl, engine = "clm") |> + fit(Sat ~ Infl + Cont, data = house_sub) + + set.seed(seed) + orig_fit <- ordinal::clm( + Sat ~ Infl + Cont, data = house_sub, + nominal = ~ Cont + ) + + tidy_fit1$fit$call <- tidy_fit2$fit$call <- orig_fit$call <- NULL + tidy_fit1$fit$formulas <- tidy_fit2$fit$formulas <- orig_fit$formulas <- NULL + expect_equal(tidy_fit1$fit, orig_fit, ignore_formula_env = TRUE) + expect_equal(tidy_fit2$fit, orig_fit, ignore_formula_env = TRUE) +}) + +test_that("parallel regression argument handles lists", { + skip_if_not_installed("MASS") + skip_if_not_installed("ordinal") + house_sub <- get_house()$sub + + set.seed(seed) + tidy_fit <- ordinal_reg( + parallel_reg = list(TRUE ~ Infl, FALSE ~ Cont), + engine = "clm" + ) |> + fit(Sat ~ Infl + Cont, data = house_sub) + + set.seed(seed) + orig_fit <- ordinal::clm( + Sat ~ Infl + Cont, data = house_sub, + nominal = ~ Cont + ) + + tidy_fit$fit$call <- orig_fit$call <- NULL + tidy_fit$fit$formulas <- orig_fit$formulas <- NULL + expect_equal(tidy_fit$fit, orig_fit, ignore_formula_env = TRUE) + + expect_snapshot( + ordinal_reg( + parallel_reg = list(FALSE ~ Infl, TRUE ~ Infl + Cont), + engine = "clm" + ) |> + fit(Sat ~ Infl + Cont, data = house_sub), + error = TRUE + ) +}) diff --git a/tests/testthat/test-ordinal_reg-ordinalNet.R b/tests/testthat/test-ordinal_reg-ordinalNet.R index 6e07927..5e41396 100644 --- a/tests/testthat/test-ordinal_reg-ordinalNet.R +++ b/tests/testthat/test-ordinal_reg-ordinalNet.R @@ -452,3 +452,102 @@ test_that("arguments agree", { expect_equal(onet_arg_fit$fit$args$link, "cloglog") expect_equal(onet_arg_fit$fit$args$family, "sratio") }) + +# parallel regression ---------------------------------------------------------- + +house_sub <- get_house()$sub |> + dplyr::filter(Type == "Apartment") |> + dplyr::select(-Type) +house_vars <- model.matrix( + Sat ~ Infl + Cont + 0, data = house_sub, + contrasts.arg = lapply(house_sub[, 2:3], contrasts, contrasts = FALSE) +) + +test_that("parallel regression argument handles logicals", { + skip_if_not_installed("MASS") + skip_if_not_installed("ordinalNet") + + # all parallel regression + + set.seed(seed) + orig_fit <- ordinalNet::ordinalNet( + house_vars, + y = house_sub$Sat, + nLambda = 120, lambdaMinRatio = .001, includeLambda0 = TRUE + ) + + set.seed(seed) + tidy_default <- ordinal_reg(penalty = 0.01) |> + set_engine("ordinalNet", path_values = !!orig_fit$lambdaVals) |> + fit(Sat ~ Infl + Cont, data = house_sub) + + set.seed(seed) + tidy_fit <- ordinal_reg(parallel_reg = TRUE, penalty = 0.01) |> + set_engine("ordinalNet", path_values = !!orig_fit$lambdaVals) |> + fit(Sat ~ Infl + Cont, data = house_sub) + + expect_equal(tidy_fit$fit, tidy_default$fit) + expect_equal(orig_fit$coefs, tidy_fit$fit$coefs) + + # all category-specific + + set.seed(seed) + expect_warning( + orig_fit <- ordinalNet::ordinalNet( + house_vars, + y = house_sub$Sat, + nLambda = 120, lambdaMinRatio = .001, includeLambda0 = TRUE, + nonparallelTerms = TRUE, parallelTerms = FALSE + ), + "nonparallelTerms" + ) + + set.seed(seed) + expect_warning( + tidy_fit <- ordinal_reg(parallel_reg = FALSE, penalty = 0.01) |> + set_engine("ordinalNet", path_values = !!orig_fit$lambdaVals) |> + fit(Sat ~ Infl + Cont, data = house_sub), + "nonparallelTerms" + ) + + expect_equal(orig_fit$coefs, tidy_fit$fit$coefs) +}) + +test_that("parallel regression argument handles formulae", { + skip_if_not_installed("MASS") + skip_if_not_installed("ordinalNet") + + expect_snapshot( + ordinal_reg( + parallel_reg = TRUE ~ Infl, penalty = 0.01, engine = "ordinalNet" + ) |> + fit(Sat ~ Cont, data = house_sub), + error = TRUE + ) +}) + +test_that("parallel regression argument handles lists", { + skip_if_not_installed("MASS") + skip_if_not_installed("ordinalNet") + + set.seed(seed) + expect_warning( + orig_fit <- ordinalNet::ordinalNet( + house_vars, + y = house_sub$Sat, + nLambda = 120, lambdaMinRatio = .001, includeLambda0 = TRUE, + nonparallelTerms = TRUE, parallelTerms = TRUE + ), + "nonparallelTerms" + ) + + set.seed(seed) + expect_warning( + tidy_fit <- ordinal_reg(parallel_reg = c(FALSE, TRUE), penalty = 0.01) |> + set_engine("ordinalNet", path_values = !!orig_fit$lambdaVals) |> + fit(Sat ~ Infl + Cont, data = house_sub), + "nonparallelTerms" + ) + + expect_equal(orig_fit$coefs, tidy_fit$fit$coefs) +}) diff --git a/tests/testthat/test-ordinal_reg.R b/tests/testthat/test-ordinal_reg.R index 4c6b8c3..e79b3e1 100644 --- a/tests/testthat/test-ordinal_reg.R +++ b/tests/testthat/test-ordinal_reg.R @@ -29,3 +29,51 @@ test_that("check_args() works", { # Here for completeness, no checking is done expect_true(TRUE) }) + +# parallel_reg validation ------------------------------------------------------ + +test_that("parallel_reg accepts logical input", { + expect_snapshot(ordinal_reg(parallel_reg = TRUE)) + expect_snapshot(ordinal_reg(parallel_reg = FALSE)) +}) + +test_that("parallel_reg accepts formula input", { + expect_snapshot(ordinal_reg(parallel_reg = TRUE ~ x)) + expect_snapshot(ordinal_reg(parallel_reg = FALSE ~ y + z)) +}) + +test_that("parallel_reg accepts list input", { + expect_snapshot(ordinal_reg(parallel_reg = list(TRUE ~ x))) + expect_snapshot(ordinal_reg(parallel_reg = list(FALSE ~ x, TRUE ~ y))) + expect_snapshot(ordinal_reg(parallel_reg = list(FALSE, TRUE ~ y))) +}) + +test_that("parallel_reg rejects invalid inputs", { + skip_if_not_installed("MASS") + house_sub <- MASS::housing[rep(seq(nrow(MASS::housing)), + MASS::housing$Freq), -5] + + # not logical or formula + expect_snapshot( + ordinal_reg(parallel_reg = "TRUE") |> + set_engine("clm") |> + fit(Sat ~ Infl + Cont, data = house_sub), + error = TRUE + ) + # formula without logical LHS + expect_snapshot( + ordinal_reg(parallel_reg = Sat ~ Infl) |> + set_engine("clm") |> + fit(Sat ~ Infl + Cont, data = house_sub), + error = TRUE + ) + # list with > 2 elements + expect_snapshot( + ordinal_reg( + parallel_reg = list(TRUE ~ Infl, FALSE ~ Cont, TRUE) + ) |> + set_engine("clm") |> + fit(Sat ~ Infl + Cont, data = house_sub), + error = TRUE + ) +}) From 628ddede6fae9f6d2ec99b9c2ce2b10d0443d9ee Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 20 Jul 2026 11:01:37 -0400 Subject: [PATCH 06/45] update snapshot --- tests/testthat/_snaps/ordinal_reg-clm.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/_snaps/ordinal_reg-clm.md b/tests/testthat/_snaps/ordinal_reg-clm.md index 1c40a40..4131d2f 100644 --- a/tests/testthat/_snaps/ordinal_reg-clm.md +++ b/tests/testthat/_snaps/ordinal_reg-clm.md @@ -69,12 +69,12 @@ ordered::clm_wrapper(formula = missing_arg(), data = missing_arg(), weights = missing_arg(), link = "probit") -# parallel_reg errors for overlapping variables +# parallel regression argument handles lists Code fit(ordinal_reg(parallel_reg = list(FALSE ~ Infl, TRUE ~ Infl + Cont), engine = "clm"), Sat ~ Infl + Cont, data = house_sub) Condition Error in `list_to_clm_nominal()`: - ! Variable "Infl" appears in both parallel and non-parallel specifications. Each predictor must be assigned to exactly one side: parallel regression or category-specific. + ! Variable "Infl" appears in both parallel and non-parallel specifications. The `clm` engine must treat each predictor as either parallel regression or category-specific (not both). From 0be00b368809fced4cb21caf3135836122a20499 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Tue, 21 Jul 2026 10:32:05 -0400 Subject: [PATCH 07/45] clarify & tests model argument requirements --- R/ordinal_reg-clm.R | 4 ++-- tests/testthat/_snaps/ordinal_reg-clm.md | 2 +- tests/testthat/test-ordinal_reg-clm.R | 20 ++++++++++++++++++++ tests/testthat/test-ordinal_reg-polr.R | 13 ++++++++++--- 4 files changed, 33 insertions(+), 6 deletions(-) diff --git a/R/ordinal_reg-clm.R b/R/ordinal_reg-clm.R index a30804f..aa4f037 100644 --- a/R/ordinal_reg-clm.R +++ b/R/ordinal_reg-clm.R @@ -132,14 +132,14 @@ list_to_clm_nominal <- function(lst, model_formula) { if (length(overlap) > 0L) { cli::cli_abort( "Variable{?s} {.val {overlap}} appear{?s/} in both parallel and - non-parallel specifications. The {.code clm} engine must treat each + non-parallel specifications. The {.val clm} engine must treat each predictor as either parallel regression or category-specific (not both)." ) } # when no bare logical is present, every predictor must appear # in at least one formula entry - if (!has_bare_logical) { + if (! has_bare_logical) { all_pred_vars <- all.vars(model_formula[[3L]]) covered <- union(parallel_vars, nonparallel_vars) missing <- setdiff(all_pred_vars, covered) diff --git a/tests/testthat/_snaps/ordinal_reg-clm.md b/tests/testthat/_snaps/ordinal_reg-clm.md index 4131d2f..cc77e5e 100644 --- a/tests/testthat/_snaps/ordinal_reg-clm.md +++ b/tests/testthat/_snaps/ordinal_reg-clm.md @@ -76,5 +76,5 @@ Sat ~ Infl + Cont, data = house_sub) Condition Error in `list_to_clm_nominal()`: - ! Variable "Infl" appears in both parallel and non-parallel specifications. The `clm` engine must treat each predictor as either parallel regression or category-specific (not both). + ! Variable "Infl" appears in both parallel and non-parallel specifications. The "clm" engine must treat each predictor as either parallel regression or category-specific (not both). diff --git a/tests/testthat/test-ordinal_reg-clm.R b/tests/testthat/test-ordinal_reg-clm.R index 5238b84..5096974 100644 --- a/tests/testthat/test-ordinal_reg-clm.R +++ b/tests/testthat/test-ordinal_reg-clm.R @@ -1,5 +1,25 @@ seed <- 144688L +# specification: arguments ----------------------------------------------------- + +test_that("specification handles model parameters", { + skip_if_not_installed("MASS") + house_sub <- get_house()$sub + + # a legitimate ordinal link function not recognized by {dials} + ao_spec <- ordinal_reg(engine = "clm", ordinal_link = "Aranda-Ordaz") + expect_no_error(suppressWarnings(suppressMessages( + fit(ao_spec, Sat ~ Infl + Cont, data = house_sub) + ))) + + # an unavailable odds link function + acat_spec <- ordinal_reg(engine = "clm", odds_link = "adjacent_categories") + expect_warning( + fit(acat_spec, Sat ~ Type + Infl + Cont, data = house_sub), + "clm.*cumulative[ \\_]link" + ) +}) + # model: basic ----------------------------------------------------------------- test_that("model object", { diff --git a/tests/testthat/test-ordinal_reg-polr.R b/tests/testthat/test-ordinal_reg-polr.R index bc33f03..fe90782 100644 --- a/tests/testthat/test-ordinal_reg-polr.R +++ b/tests/testthat/test-ordinal_reg-polr.R @@ -1,13 +1,20 @@ # specification: arguments ----------------------------------------------------- -test_that("ordinal_link", { +test_that("specification handles model parameters", { skip_if_not_installed("MASS") house_sub <- get_house()$sub # a legitimate ordinal link function not recognized by {dials} - tidy_spec <- ordinal_reg(engine = "polr", ordinal_link = "Aranda-Ordaz") - expect_error(fit(tidy_spec, Sat ~ Type + Infl + Cont, data = house_sub)) + ao_spec <- ordinal_reg(engine = "polr", ordinal_link = "Aranda-Ordaz") + expect_error(fit(ao_spec, Sat ~ Type + Infl + Cont, data = house_sub)) + + # an unavailable odds link function + acat_spec <- ordinal_reg(engine = "polr", odds_link = "adjacent_categories") + expect_warning( + fit(acat_spec, Sat ~ Type + Infl + Cont, data = house_sub), + "polr.*cumulative[ \\_]link" + ) }) # model: basic ----------------------------------------------------------------- From e6493226e422e677a08be97242ef5f3642e49d86 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Thu, 23 Jul 2026 10:44:42 -0400 Subject: [PATCH 08/45] review & simplify parallel_reg logic --- R/ordinal_reg-VGAM.R | 15 ++++++------ R/ordinal_reg-clm.R | 47 ++++++++++++++------------------------ R/ordinal_reg-ordinalNet.R | 6 ++--- 3 files changed, 26 insertions(+), 42 deletions(-) diff --git a/R/ordinal_reg-VGAM.R b/R/ordinal_reg-VGAM.R index af966f6..9132e23 100644 --- a/R/ordinal_reg-VGAM.R +++ b/R/ordinal_reg-VGAM.R @@ -233,13 +233,10 @@ predict_VGAM_prob_post <- function(x, object) { tibble::as_tibble(x) } -# ------------------------------------------------------------------------------ - -#' Translate `parallel_reg` to VGAM `parallel` argument +#' Translate `parallel_reg` to `vg*m(parallel)` #' #' @param parallel_reg A parallel regression specification. -#' @param formula The model formula (used to extract predictor names for list -#' forms). +#' @param formula The model formula (used to extract predictor names. #' @keywords internal #' @returns A logical or formula suitable for the `parallel` argument of VGAM #' family functions. @@ -270,11 +267,11 @@ formula_to_vglm_parallel <- function(pr_formula) { rhs_vars <- all.vars(pr_formula[[3L]]) if (isTRUE(lhs)) { - # RHS names parallel terms; VGAM: TRUE ~ -1 + vars + # RHS names parallel terms rhs <- paste("-1 +", paste(rhs_vars, collapse = " + ")) } else { - # RHS names non-parallel terms; VGAM: FALSE ~ -1 + vars - rhs <- paste("-1 +", paste(rhs_vars, collapse = " + ")) + # RHS names non-parallel terms + rhs <- paste("1 +", paste(rhs_vars, collapse = " + ")) } as.formula(paste(format(lhs), "~", rhs)) } @@ -303,6 +300,7 @@ list_to_vglm_parallel <- function(lst, formula) { } } + # REVIEW: Move this check to parsnip? # check overlap overlap <- intersect(parallel_vars, nonparallel_vars) if (length(overlap) > 0L) { @@ -312,6 +310,7 @@ list_to_vglm_parallel <- function(lst, formula) { ) } + # REVIEW: Move this check to parsnip? # when no bare logical is present, every predictor must appear # in at least one formula entry if (!has_bare_logical) { diff --git a/R/ordinal_reg-clm.R b/R/ordinal_reg-clm.R index aa4f037..b43a932 100644 --- a/R/ordinal_reg-clm.R +++ b/R/ordinal_reg-clm.R @@ -49,7 +49,7 @@ clm_wrapper <- function( rlang::eval_tidy(cl) } -#' Translate `parallel_reg` to clm `nominal` formula +#' Translate `parallel_reg` to `clm(nominal)` #' #' @param parallel_reg A parallel regression specification. #' @param formula The model formula (used to extract predictor names). @@ -62,7 +62,6 @@ parallel_reg_to_clm_nominal <- function(parallel_reg, formula) { if (isTRUE(parallel_reg)) { return(NULL) } - # FALSE: all non-parallel pred_vars <- all.vars(formula[[3L]]) return(as.formula(paste("~", paste(pred_vars, collapse = " + ")))) } @@ -91,15 +90,15 @@ formula_to_clm_nominal <- function(pr_formula, model_formula) { return(NULL) } return(as.formula(paste("~", paste(rhs_vars, collapse = " + ")))) + } else { + # RHS names parallel terms + all_pred_vars <- all.vars(model_formula[[3L]]) + nonparallel <- setdiff(all_pred_vars, rhs_vars) + if (length(nonparallel) == 0L) { + return(NULL) + } + return(as.formula(paste("~", paste(nonparallel, collapse = " + ")))) } - - # TRUE: RHS names parallel terms; non-parallel = complement - all_pred_vars <- all.vars(model_formula[[3L]]) - nonparallel <- setdiff(all_pred_vars, rhs_vars) - if (length(nonparallel) == 0L) { - return(NULL) - } - return(as.formula(paste("~", paste(nonparallel, collapse = " + ")))) } #' @keywords internal @@ -127,6 +126,7 @@ list_to_clm_nominal <- function(lst, model_formula) { } } + # REVIEW: Move this check to parsnip? # check overlap between explicit formula entries overlap <- intersect(parallel_vars, nonparallel_vars) if (length(overlap) > 0L) { @@ -137,6 +137,7 @@ list_to_clm_nominal <- function(lst, model_formula) { ) } + # REVIEW: Move this check to parsnip? # when no bare logical is present, every predictor must appear # in at least one formula entry if (! has_bare_logical) { @@ -156,26 +157,12 @@ list_to_clm_nominal <- function(lst, model_formula) { all_pred_vars <- all.vars(model_formula[[3L]]) if (length(nonparallel_vars) > 0L) { - # if parallel vars were also specified (via "all" or formulas), - # the nonparallel vars are the ones to put in nominal - if (length(parallel_vars) > 0L && - !identical(sort(parallel_vars), sort(all_pred_vars))) { - # both sides specified explicitly: use nonparallel vars - return(as.formula(paste("~", paste(nonparallel_vars, collapse = " + ")))) - } - # only nonparallel specified (or parallel = "all"): use nonparallel vars return(as.formula(paste("~", paste(nonparallel_vars, collapse = " + ")))) + } else if (length(parallel_vars) > 0L) { + # in case only parallel vars were specified + nonparallel_vars <- setdiff(all_pred_vars, parallel_vars) + return(as.formula(paste("~", paste(nonparallel_vars, collapse = " + ")))) + } else { + return(NULL) } - - if (length(parallel_vars) > 0L) { - # only parallel specified: nonparallel = complement - nonparallel <- setdiff(all_pred_vars, parallel_vars) - if (length(nonparallel) == 0L) { - return(NULL) - } - return(as.formula(paste("~", paste(nonparallel, collapse = " + ")))) - } - - # neither specified: default PO - return(NULL) } diff --git a/R/ordinal_reg-ordinalNet.R b/R/ordinal_reg-ordinalNet.R index 4d295ad..8a7f74f 100644 --- a/R/ordinal_reg-ordinalNet.R +++ b/R/ordinal_reg-ordinalNet.R @@ -411,14 +411,12 @@ multi_predict_class_ordinal_net <- function(object, new_data, penalty) { dplyr::select(-.row) } -# ------------------------------------------------------------------------------ - -#' Translate `parallel_reg` to ordinalNet `parallelTerms`/`nonparallelTerms` +#' Translate `parallel_reg` to `ordinalNet(parallelTerms, nonparallelTerms)` #' #' @param parallel_reg A parallel regression specification. Must be one or two #' logical values; formulae are not supported. #' @keywords internal -#' @returns A list with elements `parallelTerms` and `nonparallelTerms`. +#' @returns A list with logical elements `parallelTerms` and `nonparallelTerms`. parallel_reg_to_ordinalNet <- function(parallel_reg) { if (is.logical(parallel_reg)) { if (length(parallel_reg) == 1L) { From 8138d87e22b10c6dcadce2089e67b4c87df03f0f Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Sat, 8 Aug 2026 15:16:44 -0400 Subject: [PATCH 09/45] change parallel_reg argument to logical + move argument handling to parsnip --- NAMESPACE | 1 - NEWS.md | 16 +- R/gen_additive_mod-data.R | 20 +- R/ordinal_reg-VGAM.R | 230 ++---------------- R/ordinal_reg-clm.R | 168 ------------- R/ordinal_reg-data.R | 8 +- R/ordinal_reg-ordinalNet.R | 89 ++----- ignore/tinker-workflow.R | 23 +- man/VGAM_vglm_wrapper.Rd | 41 ++-- man/clm_wrapper.Rd | 45 ---- man/ordinalNet_wrapper.Rd | 35 ++- man/parallel_reg_to_clm_nominal.Rd | 21 -- man/parallel_reg_to_ordinalNet.Rd | 19 -- man/parallel_reg_to_vglm_parallel.Rd | 22 -- .../testthat/_snaps/gen_additive_mod-VGAM.md | 8 +- tests/testthat/_snaps/ordinal_reg-VGAM.md | 15 +- tests/testthat/_snaps/ordinal_reg-clm.md | 16 +- .../testthat/_snaps/ordinal_reg-ordinalNet.md | 12 +- tests/testthat/_snaps/ordinal_reg.md | 6 +- tests/testthat/test-gen_additive_mod-VGAM.R | 19 +- tests/testthat/test-ordinal_reg-VGAM.R | 101 +------- tests/testthat/test-ordinal_reg-clm.R | 57 ----- tests/testthat/test-ordinal_reg-ordinalNet.R | 39 --- 23 files changed, 181 insertions(+), 830 deletions(-) delete mode 100644 R/ordinal_reg-clm.R delete mode 100644 man/clm_wrapper.Rd delete mode 100644 man/parallel_reg_to_clm_nominal.Rd delete mode 100644 man/parallel_reg_to_ordinalNet.Rd delete mode 100644 man/parallel_reg_to_vglm_parallel.Rd diff --git a/NAMESPACE b/NAMESPACE index 285eb65..8f9461b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,7 +11,6 @@ S3method(predict_classprob,"_ordinalNet") S3method(predict_raw,"_ordinalNet") export(VGAM_vgam_wrapper) export(VGAM_vglm_wrapper) -export(clm_wrapper) export(honesty) export(honesty_fraction) export(naive_scores) diff --git a/NEWS.md b/NEWS.md index d838149..0d0c330 100644 --- a/NEWS.md +++ b/NEWS.md @@ -12,7 +12,6 @@ This version introduces source code and unit tests for new engines: * `clm` from the **ordinal** package - cumulative link ordinal regression - additional `ordinal_link` dial values - - dial for `threshold` argument * `lrm` and `orm` from the **rms** package - regularized cumulative probability ordinal regression - shared prediction wrapper @@ -36,14 +35,17 @@ Coordinated with [parsnip PR #1391](https://github.com/tidymodels/parsnip/pull/1 ## threshold structure and parallel regression model arguments -The `threshold_structure` model argument for `ordinal_reg()` controls what constraints, if any, are imposed on the ordered thresholds. It can be used by the `clm` and `vglm` engines. +The `threshold_structure` model argument for `ordinal_reg()` controls what constraints, if any, are imposed on the ordered thresholds. +It can be used by the `clm` and `vglm` engines. -The `parallel_reg` model argument for `ordinal_reg()` provides a unified interface for controlling the parallel regression assumption. It accepts a logical value (applied to all terms), a formula with a logical LHS naming parallel or non-parallel terms, or a list combining both; the engines `clm`, `vglm`, and `ordinalNet` are compatible with different subsets of specifications: -* `clm_wrapper()` (new) translates the `parallel_reg` specification to a formula accepted by `ordinal::clm(nominal)` -* `VGAM_vglm_wrapper()` and `VGAM_vgam_wrapper()` accept a `parallel_reg` argument and translate it for the VGAM `parallel` argument -* `ordinalNet_wrapper()` accepts a `parallel_reg` argument and translates it for the `parallelTerms` and `nonparallelTerms` arguments +The `parallel_reg` model argument for `ordinal_reg()` controls the parallel regression assumption with a logical value applied to all predictors. +It can be used by the `clm`, `vglm`, and `ordinalNet` engines. +Note that the default is to defer to the engine, and the `vglm` engine defaults to non-parallel terms. -Coordinated with forthcoming PRs to parsnip and to dials. +The `gen_additive_mod()` `vgam` engine additionally registers the `Thresh` and `parallel` engine arguments. +These may be tuned using the `threshold_structure` and `parallel_reg` dials. + +Coordinated with [parsnip PR #1393](https://github.com/tidymodels/parsnip/pull/1393) and [dials PR #462](https://github.com/tidymodels/dials/pull/462). # ordered 0.1.0 diff --git a/R/gen_additive_mod-data.R b/R/gen_additive_mod-data.R index 927073d..7917897 100644 --- a/R/gen_additive_mod-data.R +++ b/R/gen_additive_mod-data.R @@ -44,6 +44,22 @@ make_gen_additive_mod_vgam <- function() { func = list(pkg = "dials", fun = "odds_link"), has_submodel = FALSE ) + parsnip::set_model_arg( + model = "gen_additive_mod", + eng = "vgam", + parsnip = "Thresh", + original = "Thresh", + func = list(pkg = "dials", fun = "threshold_structure"), + has_submodel = FALSE + ) + parsnip::set_model_arg( + model = "gen_additive_mod", + eng = "vgam", + parsnip = "parallel", + original = "parallel", + func = list(pkg = "dials", fun = "parallel_reg"), + has_submodel = FALSE + ) parsnip::set_fit( model = "gen_additive_mod", @@ -53,9 +69,7 @@ make_gen_additive_mod_vgam <- function() { interface = "formula", protect = c("formula", "data", "weights"), func = c(pkg = "ordered", fun = "VGAM_vgam_wrapper"), - defaults = list( - parallel = TRUE - ) + defaults = list() ) ) diff --git a/R/ordinal_reg-VGAM.R b/R/ordinal_reg-VGAM.R index 9132e23..62845e8 100644 --- a/R/ordinal_reg-VGAM.R +++ b/R/ordinal_reg-VGAM.R @@ -1,8 +1,10 @@ #' Wrappers for `VGAM` #' -#' These wrappers convert the standardized `odds_link` options encoded in -#' [`dials::values_odds_link`] to [`VGAM::vglmff-class`] objects passed to the -#' `family` argument of [VGAM::vglm()] and [VGAM::vgam()]. +#' These wrappers reorganize arguments into proper calls to [VGAM::vglm()] and +#' [VGAM::vgam()], which specialize to several families of ordinal regression +#' models. The standardized argument values used by `parsnip::ordinal_reg()` and +#' `parsnip::gen_additive_mod()` are matched and converted to the values native +#' to `VGAM` at translation time. #' #' The vector `values_ordinal_link_VGAM` extends the default `ordinal_link` #' options encoded in [`dials::values_ordinal_link`] to those accepted by @@ -14,8 +16,15 @@ #' and [`VGAM::vgam()`]. #' @param formula The formula to pass. #' @param data The data frame to pass. -#' @param Thresh The threshold constraints. See [dials::threshold_structure()] -#' for details. +#' @param family The `VGAM` family function, as a character string (e.g. +#' `"cumulative"`, `"acat"`, `"cratio"`, `"sratio"`). +#' @param link The `VGAM` link function (e.g. `"logitlink"`). +#' @param parallel A logical; whether predictor effects are shared across +#' thresholds. It corresponds to the standardized `parallel_reg` argument (see +#' [dials::parallel_reg()]). +#' @param Thresh A character; the threshold constraint pattern. It corresponds +#' to the standardized `threshold_structure` argument (see +#' [dials::threshold_structure()]). #' @param ... Additional arguments to pass. #' @details Note that `VGAM::vglm()` and `VGAM::vgam()` treat the rows of `data` #' as the units of observation: Compressed `data` with one row per predictor @@ -47,7 +56,8 @@ #' ) ) #' ( fit_wrap <- VGAM_vglm_wrapper( #' Sat ~ Type + Infl + Cont, -#' family = "stopping_ratio", link = "probit", Thresh = "symmetric_zero", +#' family = "sratio", +#' link = "probitlink", parallel = TRUE, Thresh = "symm0", #' data = house_data #' ) ) #' # fit wrapper for additive model @@ -58,49 +68,23 @@ #' ) ) #' ( fit_wrap <- VGAM_vgam_wrapper( #' Sat ~ Type + Infl + Cont, -#' family = "continuation_ratio", link = "cloglog", +#' family = "cratio", link = "clogloglink", parallel = TRUE, #' data = house_data #' ) ) #' @export VGAM_vglm_wrapper <- function( formula, data, - family = "cumulative_link", link = "logistic", - parallel = TRUE, - parallel_reg = NULL, + family = "cumulative", + link = "logitlink", + parallel = FALSE, Thresh = NULL, ... ) { rlang::check_installed("VGAM") - if (! is.null(parallel_reg)) { - parallel <- parallel_reg_to_vglm_parallel(parallel_reg, formula) - } - - # `parallel` can be logical or formula (VGAM supports both) - if (! is.logical(parallel) && ! inherits(parallel, "formula")) { - stop_input_type(parallel, "a logical vector or formula") - } - # TODO: Ensure that `formula = cbind(...) ~ ...` is disallowed, for this and # for other `ordinal_reg()` engines. - # match and convert model arguments - family <- match_VGAM_family(family) - link <- match_VGAM_link(link) - Thresh <- match_VGAM_Thresh(Thresh) - - # `acat()` does not support certain link functions - if (family == "acat" && - link %in% c("logitlink", "probitlink", "clogloglink")) { - cli::cli_abort( - c( - "The {.val adjacent_categories} family is not compatible with - the {.val {link}} link function.", - "i" = "Use {.val cauchitlink} or {.val identitylink} instead." - ) - ) - } - # execute nested call on modified inputs family_call <- rlang::call2( .fn = family, .ns = "VGAM", @@ -119,39 +103,14 @@ VGAM_vglm_wrapper <- function( #' @export VGAM_vgam_wrapper <- function( formula, data, - family = "cumulative_link", link = "logistic", - parallel = TRUE, - parallel_reg = NULL, + family = "cumulative", + link = "logitlink", + parallel = FALSE, Thresh = NULL, ... ) { rlang::check_installed("VGAM") - if (! is.null(parallel_reg)) { - parallel <- parallel_reg_to_vglm_parallel(parallel_reg, formula) - } - # `parallel` can be logical or formula (VGAM supports both) - if (! is.logical(parallel) && ! inherits(parallel, "formula")) { - stop_input_type(parallel, "a logical vector or formula") - } - - # match and convert model arguments - family <- match_VGAM_family(family) - link <- match_VGAM_link(link) - Thresh <- match_VGAM_Thresh(Thresh) - - # `acat()` does not support certain link functions - if (family == "acat" && - link %in% c("logitlink", "probitlink", "clogloglink")) { - cli::cli_abort( - c( - "The {.val adjacent_categories} family is not compatible with - the {.val {link}} link function.", - "i" = "Use {.val cauchitlink} or {.val identitylink} instead." - ) - ) - } - # execute nested call on modified inputs family_call <- rlang::call2( .fn = family, .ns = "VGAM", @@ -181,47 +140,6 @@ values_threshold_structure_VGAM <- c( "qnorm" ) -match_VGAM_family <- function(family) { - family <- match.arg(family, dials::values_odds_link) - switch( - family, - cumulative_link = "cumulative", - adjacent_categories = "acat", - continuation_ratio = "cratio", - stopping_ratio = "sratio" - ) -} - -match_VGAM_link <- function(link) { - link <- match.arg(link, values_ordinal_link_VGAM) - # REVIEW: Change `logistic` to `logit` in {dials}? - if (link == "logistic") link <- "logit" - if (link == "loglog") { - cli::cli_abort( - c( - "The `vglm` engine does not support the log-log ordinal link.", - "i" = "See `?VGAM::Links` for provided link functions." - ) - ) - } - paste0(link, "link") -} - -match_VGAM_Thresh <- function(Thresh) { - if (is.null(Thresh)) { - return(NULL) - } - Thresh <- match.arg(Thresh, values_threshold_structure_VGAM) - switch( - Thresh, - flexible = "free", - symmetric_median = "symm1", - symmetric_zero = "symm0", - equidistant = "equid", - qnorm = "qnorm" - ) -} - predict_VGAM_class_post <- function(x, object) { x <- apply(x, 1L, which.max) x <- ordered(object$lvl[x], object$lvl) @@ -232,105 +150,3 @@ predict_VGAM_prob_post <- function(x, object) { colnames(x) <- object$lvl tibble::as_tibble(x) } - -#' Translate `parallel_reg` to `vg*m(parallel)` -#' -#' @param parallel_reg A parallel regression specification. -#' @param formula The model formula (used to extract predictor names. -#' @keywords internal -#' @returns A logical or formula suitable for the `parallel` argument of VGAM -#' family functions. -parallel_reg_to_vglm_parallel <- function(parallel_reg, formula) { - # single logical - if (is.logical(parallel_reg) && length(parallel_reg) == 1L) { - return(parallel_reg) - } - - # single formula - # TRUE ~ vars → TRUE ~ -1 + vars - # FALSE ~ vars → FALSE ~ 1 + vars - if (inherits(parallel_reg, "formula")) { - return(formula_to_vglm_parallel(parallel_reg)) - } - - # list - if (is.list(parallel_reg)) { - return(list_to_vglm_parallel(parallel_reg, formula)) - } - - cli::cli_abort("Invalid {.arg parallel_reg} specification.") -} - -#' @keywords internal -formula_to_vglm_parallel <- function(pr_formula) { - lhs <- pr_formula[[2L]] - rhs_vars <- all.vars(pr_formula[[3L]]) - - if (isTRUE(lhs)) { - # RHS names parallel terms - rhs <- paste("-1 +", paste(rhs_vars, collapse = " + ")) - } else { - # RHS names non-parallel terms - rhs <- paste("1 +", paste(rhs_vars, collapse = " + ")) - } - as.formula(paste(format(lhs), "~", rhs)) -} - -#' @keywords internal -list_to_vglm_parallel <- function(lst, formula) { - parallel_vars <- character(0L) - nonparallel_vars <- character(0L) - has_bare_logical <- FALSE - - for (el in lst) { - if (is.logical(el) && length(el) == 1L) { - has_bare_logical <- TRUE - if (isTRUE(el)) { - parallel_vars <- all.vars(formula[[3L]]) - } - # bare FALSE: no action needed (non-parallel is VGAM default) - } else if (inherits(el, "formula")) { - lhs <- el[[2L]] - rhs_vars <- all.vars(el[[3L]]) - if (isTRUE(lhs)) { - parallel_vars <- union(parallel_vars, rhs_vars) - } else { - nonparallel_vars <- union(nonparallel_vars, rhs_vars) - } - } - } - - # REVIEW: Move this check to parsnip? - # check overlap - overlap <- intersect(parallel_vars, nonparallel_vars) - if (length(overlap) > 0L) { - cli::cli_abort( - "Variable{?s} {.val {overlap}} appear{?s/} in both parallel and - non-parallel specifications." - ) - } - - # REVIEW: Move this check to parsnip? - # when no bare logical is present, every predictor must appear - # in at least one formula entry - if (!has_bare_logical) { - all_pred_vars <- all.vars(formula[[3L]]) - covered <- union(parallel_vars, nonparallel_vars) - missing <- setdiff(all_pred_vars, covered) - if (length(missing) > 0L) { - cli::cli_abort( - "Variable{?s} {.val {missing}} not specified in {.arg parallel_reg} - list. Either use a bare logical ({.val TRUE}/{.val FALSE}) to set - defaults, or include all predictors in the formula entries." - ) - } - } - - if (length(parallel_vars) > 0L) { - return(as.formula(paste( - "TRUE ~ -1 +", paste(parallel_vars, collapse = " + ") - ))) - } - - return(FALSE) -} diff --git a/R/ordinal_reg-clm.R b/R/ordinal_reg-clm.R deleted file mode 100644 index b43a932..0000000 --- a/R/ordinal_reg-clm.R +++ /dev/null @@ -1,168 +0,0 @@ -#' Wrapper for `clm` -#' -#' Translates the `parallel_reg` specification to the `nominal` formula accepted -#' by [ordinal::clm()] and validates that each predictor is assigned to exactly -#' one side of the parallel regression specification. -#' @param formula The model formula. -#' @param data The data frame. -#' @param parallel_reg A parallel regression specification. See -#' [parsnip::ordinal_reg()] for details. -#' @param ... Additional arguments passed to [ordinal::clm()]. -#' @keywords internal -#' @returns An object of class `clm` as returned by [ordinal::clm()]. - -#' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("ordinal") -#' house_data <- -#' MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] -#' clm_wrapper( -#' Sat ~ Infl + Cont, data = house_data, -#' parallel_reg = FALSE -#' ) -#' clm_wrapper( -#' Sat ~ Infl + Cont, data = house_data, -#' parallel_reg = FALSE ~ Infl + Cont -#' ) -#' ordinal::clm( -#' Sat ~ Infl + Cont, data = house_data, -#' nominal = ~ Infl + Cont -#' ) -#' @export -clm_wrapper <- function( - formula, data, - parallel_reg = NULL, - ... -) { - rlang::check_installed("ordinal") - - nominal <- NULL - if (!is.null(parallel_reg)) { - nominal <- parallel_reg_to_clm_nominal(parallel_reg, formula) - } - - cl <- rlang::call2( - "clm", .ns = "ordinal", - formula = rlang::expr(formula), - data = rlang::expr(data), - nominal = nominal, - ... - ) - rlang::eval_tidy(cl) -} - -#' Translate `parallel_reg` to `clm(nominal)` -#' -#' @param parallel_reg A parallel regression specification. -#' @param formula The model formula (used to extract predictor names). -#' @keywords internal -#' @returns A formula suitable for the `nominal` argument of [ordinal::clm()], -#' or `NULL` for proportional odds. -parallel_reg_to_clm_nominal <- function(parallel_reg, formula) { - # single logical - if (is.logical(parallel_reg) && length(parallel_reg) == 1L) { - if (isTRUE(parallel_reg)) { - return(NULL) - } - pred_vars <- all.vars(formula[[3L]]) - return(as.formula(paste("~", paste(pred_vars, collapse = " + ")))) - } - - # single formula - if (inherits(parallel_reg, "formula")) { - return(formula_to_clm_nominal(parallel_reg, formula)) - } - - # list - if (is.list(parallel_reg)) { - return(list_to_clm_nominal(parallel_reg, formula)) - } - - cli::cli_abort("Invalid {.arg parallel_reg} specification.") -} - -#' @keywords internal -formula_to_clm_nominal <- function(pr_formula, model_formula) { - lhs <- pr_formula[[2L]] - rhs_vars <- all.vars(pr_formula[[3L]]) - - if (isFALSE(lhs)) { - # RHS names non-parallel terms - if (length(rhs_vars) == 0L) { - return(NULL) - } - return(as.formula(paste("~", paste(rhs_vars, collapse = " + ")))) - } else { - # RHS names parallel terms - all_pred_vars <- all.vars(model_formula[[3L]]) - nonparallel <- setdiff(all_pred_vars, rhs_vars) - if (length(nonparallel) == 0L) { - return(NULL) - } - return(as.formula(paste("~", paste(nonparallel, collapse = " + ")))) - } -} - -#' @keywords internal -list_to_clm_nominal <- function(lst, model_formula) { - parallel_vars <- character(0L) - nonparallel_vars <- character(0L) - has_bare_logical <- FALSE - - for (el in lst) { - if (is.logical(el) && length(el) == 1L) { - has_bare_logical <- TRUE - if (isTRUE(el)) { - parallel_vars <- all.vars(model_formula[[3L]]) - } else { - nonparallel_vars <- all.vars(model_formula[[3L]]) - } - } else if (inherits(el, "formula")) { - lhs <- el[[2L]] - rhs_vars <- all.vars(el[[3L]]) - if (isTRUE(lhs)) { - parallel_vars <- union(parallel_vars, rhs_vars) - } else { - nonparallel_vars <- union(nonparallel_vars, rhs_vars) - } - } - } - - # REVIEW: Move this check to parsnip? - # check overlap between explicit formula entries - overlap <- intersect(parallel_vars, nonparallel_vars) - if (length(overlap) > 0L) { - cli::cli_abort( - "Variable{?s} {.val {overlap}} appear{?s/} in both parallel and - non-parallel specifications. The {.val clm} engine must treat each - predictor as either parallel regression or category-specific (not both)." - ) - } - - # REVIEW: Move this check to parsnip? - # when no bare logical is present, every predictor must appear - # in at least one formula entry - if (! has_bare_logical) { - all_pred_vars <- all.vars(model_formula[[3L]]) - covered <- union(parallel_vars, nonparallel_vars) - missing <- setdiff(all_pred_vars, covered) - if (length(missing) > 0L) { - cli::cli_abort( - "Variable{?s} {.val {missing}} not specified in {.arg parallel_reg} - list. Either use a bare logical ({.val TRUE}/{.val FALSE}) to set - defaults, or include all predictors in the formula entries." - ) - } - } - - # for clm: nonparallel vars go in nominal - all_pred_vars <- all.vars(model_formula[[3L]]) - - if (length(nonparallel_vars) > 0L) { - return(as.formula(paste("~", paste(nonparallel_vars, collapse = " + ")))) - } else if (length(parallel_vars) > 0L) { - # in case only parallel vars were specified - nonparallel_vars <- setdiff(all_pred_vars, parallel_vars) - return(as.formula(paste("~", paste(nonparallel_vars, collapse = " + ")))) - } else { - return(NULL) - } -} diff --git a/R/ordinal_reg-data.R b/R/ordinal_reg-data.R index df05b97..de4aada 100644 --- a/R/ordinal_reg-data.R +++ b/R/ordinal_reg-data.R @@ -147,7 +147,7 @@ make_ordinal_reg_vglm <- function() { model = "ordinal_reg", eng = "vglm", parsnip = "parallel_reg", - original = "parallel_reg", + original = "parallel", func = list(pkg = "dials", fun = "parallel_reg"), has_submodel = FALSE ) @@ -160,9 +160,7 @@ make_ordinal_reg_vglm <- function() { interface = "formula", protect = c("formula", "data", "weights"), func = c(pkg = "ordered", fun = "VGAM_vglm_wrapper"), - defaults = list( - parallel = TRUE - ) + defaults = list() ) ) @@ -817,7 +815,7 @@ make_ordinal_reg_clm <- function() { value = list( interface = "formula", protect = c("formula", "data", "weights"), - func = c(pkg = "ordered", fun = "clm_wrapper"), + func = c(pkg = "ordinal", fun = "clm"), defaults = list() ) ) diff --git a/R/ordinal_reg-ordinalNet.R b/R/ordinal_reg-ordinalNet.R index 8a7f74f..92e5e7d 100644 --- a/R/ordinal_reg-ordinalNet.R +++ b/R/ordinal_reg-ordinalNet.R @@ -1,11 +1,22 @@ #' Wrappers for `ordinalNet` #' -#' The fit wrapper converts the standardized `odds_link` options encoded in -#' [`dials::values_odds_link`] to the `family` options of -#' [ordinalNet::ordinalNet()]. The prediction wrapper interpolates between -#' fitted penalties to enable submodel prediction at specified penalties. +#' The fit wrapper restructures case weights and reorganizes arguments into a +#' call to [ordinalNet::ordinalNet()]. The prediction wrapper interpolates +#' between fitted penalties to enable submodel prediction at specified +#' penalties. #' @param x The predictor data. #' @param y The outcome vector. +#' @param weights An optional numeric vector of case weights. When provided, +#' the outcome is restructured into a multinomial matrix of weighted +#' indicators. +#' @param family The `ordinalNet` family function, as a character string (e.g. +#' `"cumulative"`, `"sratio"`, `"cratio"`, `"acat"`). +#' @param link The `ordinalNet` link function, as a character string (e.g. +#' `"logit"`, `"probit"`, `"cloglog"`, `"cauchit"`). +#' @param parallelTerms Logical; whether to use parallel terms. +#' @param nonparallelTerms Logical; whether to use non-parallel terms. +#' @param parallelPenaltyFactor Numeric; scale factor applied to the penalty on +#' parallel terms. Errs when used without parallel terms. #' @param ... Additional arguments to pass. #' @keywords internal #' @returns An object of S3 class `ordinalNet` as returned by @@ -29,7 +40,7 @@ #' ) ) #' ( fit_wrap <- ordinalNet_wrapper( #' house_matrix, y = house_data$Sat, -#' family = "stopping_ratio", link = "logistic", +#' family = "sratio", link = "logit", #' lambdaVals = pen_vec #' ) ) #' fit_tidy <- @@ -60,44 +71,16 @@ #' @export ordinalNet_wrapper <- function( x, y, weights = NULL, - # TODO: Test whether defaults can be omitted. - family = "cumulative_link", link = "logistic", - parallel_reg = NULL, + family = "cumulative", + link = "logit", + parallelTerms = TRUE, nonparallelTerms = FALSE, parallelPenaltyFactor = 1, ... ) { rlang::check_installed("ordinalNet") - # `ordinalNet` supports only all-or-nothing parallel regression (or both) - parallelTerms <- TRUE - nonparallelTerms <- FALSE - if (! is.null(parallel_reg)) { - pt_nt <- parallel_reg_to_ordinalNet(parallel_reg) - parallelTerms <- pt_nt$parallelTerms - nonparallelTerms <- pt_nt$nonparallelTerms - } - - # match and convert odds link options - family <- match.arg(family, dials::values_odds_link) - family <- switch( - family, - cumulative_link = "cumulative", - adjacent_categories = "acat", - continuation_ratio = "cratio", - stopping_ratio = "sratio" - ) - # REVIEW: There may be a standard way to do this. In particular, can this be - # robust to upgrades in {ordinalNet}? How can errors and duplication be - # prevented in tuning routines? - link <- match.arg(link, dials::values_ordinal_link) - # REVIEW: Change `logistic` to `logit` in {dials}? - if (link == "logistic") link <- "logit" - if (link == "loglog") { - cli::cli_abort( - c( - "The `ordinalNet` engine does not support the log-log ordinal link.", - "i" = "See `?ordinalNet::ordinalNet` for provided link functions." - ) - ) + # throw error if penalty factor would go unused + if (! parallelTerms && parallelPenaltyFactor != 1) { + abort("{.arg parallelPenaltyFactor} cannot be used without parallel terms.") } # restructure based on weights (requires `y` to be a factor) @@ -115,6 +98,7 @@ ordinalNet_wrapper <- function( family = rlang::expr(family), link = rlang::expr(link), parallelTerms = parallelTerms, nonparallelTerms = nonparallelTerms, + parallelPenaltyFactor = parallelPenaltyFactor, ... ) rlang::eval_tidy(cl) @@ -410,30 +394,3 @@ multi_predict_class_ordinal_net <- function(object, new_data, penalty) { tidyr::nest(.by = .row, .key = ".pred") %>% dplyr::select(-.row) } - -#' Translate `parallel_reg` to `ordinalNet(parallelTerms, nonparallelTerms)` -#' -#' @param parallel_reg A parallel regression specification. Must be one or two -#' logical values; formulae are not supported. -#' @keywords internal -#' @returns A list with logical elements `parallelTerms` and `nonparallelTerms`. -parallel_reg_to_ordinalNet <- function(parallel_reg) { - if (is.logical(parallel_reg)) { - if (length(parallel_reg) == 1L) { - if (isTRUE(parallel_reg)) { - return(list(parallelTerms = TRUE, nonparallelTerms = FALSE)) - } else { - return(list(parallelTerms = FALSE, nonparallelTerms = TRUE)) - } - } else { - return(list(parallelTerms = TRUE, nonparallelTerms = TRUE)) - } - } - - cli::cli_abort( - c( - "The {.val ordinalNet} engine does not support partial parallelism.", - "i" = "Use engine {.val clm} or {.val vglm} for partial parallelism." - ) - ) -} diff --git a/ignore/tinker-workflow.R b/ignore/tinker-workflow.R index 07b9c21..17e9ba7 100644 --- a/ignore/tinker-workflow.R +++ b/ignore/tinker-workflow.R @@ -25,11 +25,14 @@ polr_spec <- set_engine("polr") |> set_args(ordinal_link = tune()) -# clm: ordinal_link + threshold_structure +# clm: ordinal_link + threshold_structure + parallel_reg clm_spec <- ordinal_reg() |> set_engine("clm") |> - set_args(ordinal_link = tune(), threshold_structure = tune()) + set_args( + ordinal_link = tune(), + threshold_structure = tune(), parallel_reg = tune() + ) # lrm: penalty lrm_spec <- @@ -43,23 +46,23 @@ orm_spec <- set_engine("orm") |> set_args(ordinal_link = tune(), penalty = tune()) -# vglm: ordinal_link + odds_link + threshold_structure +# vglm: ordinal_link + odds_link + threshold_structure + parallel_reg vglm_spec <- ordinal_reg() |> set_engine("vglm") |> set_args( ordinal_link = tune(), odds_link = tune(), - threshold_structure = tune() + threshold_structure = tune(), parallel_reg = tune() ) # ordinalNet: penalty (submodel via multi_predict) + mixture + -# parallel_penalty_factor +# parallel_penalty_factor + parallel_reg ordinalNet_spec <- ordinal_reg() |> set_engine("ordinalNet") |> set_args( penalty = tune(), mixture = tune(), - parallelPenaltyFactor = tune() + parallelPenaltyFactor = tune(), parallel_reg = tune() ) # glmnetcr: penalty (submodel via multi_predict) + mixture @@ -70,12 +73,16 @@ glmnetcr_spec <- # --- gen_additive_mod engines --- -# vgam: link + family (named differently from ordinal_reg parameter) +# vgam: link + family (named differently from ordinal_reg parameter) + +# Thresh + parallel (engine parameters) vgam_spec <- gen_additive_mod() |> set_engine("vgam") |> set_mode("classification") |> - set_args(link = tune(), family = tune()) + set_args( + link = tune(), family = tune(), + Thresh = tune(), parallel = tune() + ) # --- decision_tree engines --- diff --git a/man/VGAM_vglm_wrapper.Rd b/man/VGAM_vglm_wrapper.Rd index 8fdb0e3..e4a95e4 100644 --- a/man/VGAM_vglm_wrapper.Rd +++ b/man/VGAM_vglm_wrapper.Rd @@ -10,10 +10,9 @@ VGAM_vglm_wrapper( formula, data, - family = "cumulative_link", - link = "logistic", - parallel = TRUE, - parallel_reg = NULL, + family = "cumulative", + link = "logitlink", + parallel = FALSE, Thresh = NULL, ... ) @@ -21,10 +20,9 @@ VGAM_vglm_wrapper( VGAM_vgam_wrapper( formula, data, - family = "cumulative_link", - link = "logistic", - parallel = TRUE, - parallel_reg = NULL, + family = "cumulative", + link = "logitlink", + parallel = FALSE, Thresh = NULL, ... ) @@ -38,8 +36,18 @@ values_threshold_structure_VGAM \item{data}{The data frame to pass.} -\item{Thresh}{The threshold constraints. See \code{\link[dials:threshold_structure]{dials::threshold_structure()}} -for details.} +\item{family}{The \code{VGAM} family function, as a character string (e.g. +\code{"cumulative"}, \code{"acat"}, \code{"cratio"}, \code{"sratio"}).} + +\item{link}{The \code{VGAM} link function (e.g. \code{"logitlink"}).} + +\item{parallel}{A logical; whether predictor effects are shared across +thresholds. It corresponds to the standardized \code{parallel_reg} argument (see +\code{\link[dials:parallel_reg]{dials::parallel_reg()}}).} + +\item{Thresh}{A character; the threshold constraint pattern. It corresponds +to the standardized \code{threshold_structure} argument (see +\code{\link[dials:threshold_structure]{dials::threshold_structure()}}).} \item{...}{Additional arguments to pass.} } @@ -48,9 +56,11 @@ An object of S3 parent class \code{VGAM} and primary classes \code{vglm} or \code{vgam} as returned by \code{\link[VGAM:vglm]{VGAM::vglm()}} and \code{\link[VGAM:vgam]{VGAM::vgam()}}. } \description{ -These wrappers convert the standardized \code{odds_link} options encoded in -\code{\link[dials:values_odds_link]{dials::values_odds_link}} to \code{\link[VGAM:vglmff-class]{VGAM::vglmff}} objects passed to the -\code{family} argument of \code{\link[VGAM:vglm]{VGAM::vglm()}} and \code{\link[VGAM:vgam]{VGAM::vgam()}}. +These wrappers reorganize arguments into proper calls to \code{\link[VGAM:vglm]{VGAM::vglm()}} and +\code{\link[VGAM:vgam]{VGAM::vgam()}}, which specialize to several families of ordinal regression +models. The standardized argument values used by \code{parsnip::ordinal_reg()} and +\code{parsnip::gen_additive_mod()} are matched and converted to the values native +to \code{VGAM} at translation time. } \details{ The vector \code{values_ordinal_link_VGAM} extends the default \code{ordinal_link} @@ -89,7 +99,8 @@ house_data <- ) ) ( fit_wrap <- VGAM_vglm_wrapper( Sat ~ Type + Infl + Cont, - family = "stopping_ratio", link = "probit", Thresh = "symmetric_zero", + family = "sratio", + link = "probitlink", parallel = TRUE, Thresh = "symm0", data = house_data ) ) # fit wrapper for additive model @@ -100,7 +111,7 @@ house_data <- ) ) ( fit_wrap <- VGAM_vgam_wrapper( Sat ~ Type + Infl + Cont, - family = "continuation_ratio", link = "cloglog", + family = "cratio", link = "clogloglink", parallel = TRUE, data = house_data ) ) \dontshow{\}) # examplesIf} diff --git a/man/clm_wrapper.Rd b/man/clm_wrapper.Rd deleted file mode 100644 index 0aeef39..0000000 --- a/man/clm_wrapper.Rd +++ /dev/null @@ -1,45 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ordinal_reg-clm.R -\name{clm_wrapper} -\alias{clm_wrapper} -\title{Wrapper for \code{clm}} -\usage{ -clm_wrapper(formula, data, parallel_reg = NULL, ...) -} -\arguments{ -\item{formula}{The model formula.} - -\item{data}{The data frame.} - -\item{parallel_reg}{A parallel regression specification. See -\code{\link[parsnip:ordinal_reg]{parsnip::ordinal_reg()}} for details.} - -\item{...}{Additional arguments passed to \code{\link[ordinal:clm]{ordinal::clm()}}.} -} -\value{ -An object of class \code{clm} as returned by \code{\link[ordinal:clm]{ordinal::clm()}}. -} -\description{ -Translates the \code{parallel_reg} specification to the \code{nominal} formula accepted -by \code{\link[ordinal:clm]{ordinal::clm()}} and validates that each predictor is assigned to exactly -one side of the parallel regression specification. -} -\examples{ -\dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("ordinal")) withAutoprint(\{ # examplesIf} -house_data <- - MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] -clm_wrapper( - Sat ~ Infl + Cont, data = house_data, - parallel_reg = FALSE -) -clm_wrapper( - Sat ~ Infl + Cont, data = house_data, - parallel_reg = FALSE ~ Infl + Cont -) -ordinal::clm( - Sat ~ Infl + Cont, data = house_data, - nominal = ~ Infl + Cont -) -\dontshow{\}) # examplesIf} -} -\keyword{internal} diff --git a/man/ordinalNet_wrapper.Rd b/man/ordinalNet_wrapper.Rd index fdbb359..0e85368 100644 --- a/man/ordinalNet_wrapper.Rd +++ b/man/ordinalNet_wrapper.Rd @@ -14,9 +14,11 @@ ordinalNet_wrapper( x, y, weights = NULL, - family = "cumulative_link", - link = "logistic", - parallel_reg = NULL, + family = "cumulative", + link = "logit", + parallelTerms = TRUE, + nonparallelTerms = FALSE, + parallelPenaltyFactor = 1, ... ) @@ -58,6 +60,23 @@ predict_ordinalNet_wrapper( \item{y}{The outcome vector.} +\item{weights}{An optional numeric vector of case weights. When provided, +the outcome is restructured into a multinomial matrix of weighted +indicators.} + +\item{family}{The \code{ordinalNet} family function, as a character string (e.g. +\code{"cumulative"}, \code{"sratio"}, \code{"cratio"}, \code{"acat"}).} + +\item{link}{The \code{ordinalNet} link function, as a character string (e.g. +\code{"logit"}, \code{"probit"}, \code{"cloglog"}, \code{"cauchit"}).} + +\item{parallelTerms}{Logical; whether to use parallel terms.} + +\item{nonparallelTerms}{Logical; whether to use non-parallel terms.} + +\item{parallelPenaltyFactor}{Numeric; scale factor applied to the penalty on +parallel terms. Errs when used without parallel terms.} + \item{...}{Additional arguments to pass.} \item{penalty}{A numeric vector of penalty values.} @@ -68,10 +87,10 @@ An object of S3 class \code{ordinalNet} as returned by returned by \code{\link[ordinalNet:predict.ordinalNet]{ordinalNet::predict.ordinalNet}}\verb{()}. } \description{ -The fit wrapper converts the standardized \code{odds_link} options encoded in -\code{\link[dials:values_odds_link]{dials::values_odds_link}} to the \code{family} options of -\code{\link[ordinalNet:ordinalNet]{ordinalNet::ordinalNet()}}. The prediction wrapper interpolates between -fitted penalties to enable submodel prediction at specified penalties. +The fit wrapper restructures case weights and reorganizes arguments into a +call to \code{\link[ordinalNet:ordinalNet]{ordinalNet::ordinalNet()}}. The prediction wrapper interpolates +between fitted penalties to enable submodel prediction at specified +penalties. } \examples{ \dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("ordinalNet")) withAutoprint(\{ # examplesIf} @@ -91,7 +110,7 @@ pen_vec <- 10 ^ seq(-2.5, -.5, 1) ) ) ( fit_wrap <- ordinalNet_wrapper( house_matrix, y = house_data$Sat, - family = "stopping_ratio", link = "logistic", + family = "sratio", link = "logit", lambdaVals = pen_vec ) ) fit_tidy <- diff --git a/man/parallel_reg_to_clm_nominal.Rd b/man/parallel_reg_to_clm_nominal.Rd deleted file mode 100644 index 825ff49..0000000 --- a/man/parallel_reg_to_clm_nominal.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ordinal_reg-clm.R -\name{parallel_reg_to_clm_nominal} -\alias{parallel_reg_to_clm_nominal} -\title{Translate \code{parallel_reg} to clm \code{nominal} formula} -\usage{ -parallel_reg_to_clm_nominal(parallel_reg, formula) -} -\arguments{ -\item{parallel_reg}{A parallel regression specification.} - -\item{formula}{The model formula (used to extract predictor names).} -} -\value{ -A formula suitable for the \code{nominal} argument of \code{\link[ordinal:clm]{ordinal::clm()}}, -or \code{NULL} for proportional odds. -} -\description{ -Translate \code{parallel_reg} to clm \code{nominal} formula -} -\keyword{internal} diff --git a/man/parallel_reg_to_ordinalNet.Rd b/man/parallel_reg_to_ordinalNet.Rd deleted file mode 100644 index e5832ef..0000000 --- a/man/parallel_reg_to_ordinalNet.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ordinal_reg-ordinalNet.R -\name{parallel_reg_to_ordinalNet} -\alias{parallel_reg_to_ordinalNet} -\title{Translate \code{parallel_reg} to ordinalNet \code{parallelTerms}/\code{nonparallelTerms}} -\usage{ -parallel_reg_to_ordinalNet(parallel_reg) -} -\arguments{ -\item{parallel_reg}{A parallel regression specification. Must be one or two -logical values; formulae are not supported.} -} -\value{ -A list with elements \code{parallelTerms} and \code{nonparallelTerms}. -} -\description{ -Translate \code{parallel_reg} to ordinalNet \code{parallelTerms}/\code{nonparallelTerms} -} -\keyword{internal} diff --git a/man/parallel_reg_to_vglm_parallel.Rd b/man/parallel_reg_to_vglm_parallel.Rd deleted file mode 100644 index 74d4880..0000000 --- a/man/parallel_reg_to_vglm_parallel.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ordinal_reg-VGAM.R -\name{parallel_reg_to_vglm_parallel} -\alias{parallel_reg_to_vglm_parallel} -\title{Translate \code{parallel_reg} to VGAM \code{parallel} argument} -\usage{ -parallel_reg_to_vglm_parallel(parallel_reg, formula) -} -\arguments{ -\item{parallel_reg}{A parallel regression specification.} - -\item{formula}{The model formula (used to extract predictor names for list -forms).} -} -\value{ -A logical or formula suitable for the \code{parallel} argument of VGAM -family functions. -} -\description{ -Translate \code{parallel_reg} to VGAM \code{parallel} argument -} -\keyword{internal} diff --git a/tests/testthat/_snaps/gen_additive_mod-VGAM.md b/tests/testthat/_snaps/gen_additive_mod-VGAM.md index 194024e..b56035e 100644 --- a/tests/testthat/_snaps/gen_additive_mod-VGAM.md +++ b/tests/testthat/_snaps/gen_additive_mod-VGAM.md @@ -5,6 +5,9 @@ Output GAM Model Specification (classification) + Engine-Specific Arguments: + parallel = TRUE + Computational engine: vgam Model fit template: @@ -53,6 +56,7 @@ GAM Model Specification (classification) Engine-Specific Arguments: + parallel = TRUE link = cloglog family = stopping @@ -60,8 +64,8 @@ Model fit template: ordered::VGAM_vgam_wrapper(formula = missing_arg(), data = missing_arg(), - weights = missing_arg(), link = "cloglog", family = "stopping", - parallel = TRUE) + weights = missing_arg(), parallel = TRUE, link = "clogloglink", + family = "sratio") --- diff --git a/tests/testthat/_snaps/ordinal_reg-VGAM.md b/tests/testthat/_snaps/ordinal_reg-VGAM.md index 89f52e5..efb6eb8 100644 --- a/tests/testthat/_snaps/ordinal_reg-VGAM.md +++ b/tests/testthat/_snaps/ordinal_reg-VGAM.md @@ -5,6 +5,9 @@ Output Ordinal Regression Model Specification (classification) + Main Arguments: + parallel_reg = TRUE + Computational engine: vglm Model fit template: @@ -63,12 +66,13 @@ Main Arguments: ordinal_link = cloglog odds_link = stopping + parallel_reg = TRUE Computational engine: vglm Model fit template: ordered::VGAM_vglm_wrapper(formula = missing_arg(), data = missing_arg(), - weights = missing_arg(), link = "cloglog", family = "stopping", + weights = missing_arg(), link = "clogloglink", family = "sratio", parallel = TRUE) --- @@ -77,12 +81,3 @@ set.seed(13) onet_arg_fit <- fit(onet_arg_spec, class ~ ., data = caco_train) -# parallel regression argument handles lists - - Code - fit(ordinal_reg(parallel_reg = list(TRUE ~ Infl, FALSE ~ Infl + Cont), engine = "vglm"), - Sat ~ Infl + Cont, data = house_sub) - Condition - Error in `list_to_vglm_parallel()`: - ! Variable "Infl" appears in both parallel and non-parallel specifications. - diff --git a/tests/testthat/_snaps/ordinal_reg-clm.md b/tests/testthat/_snaps/ordinal_reg-clm.md index cc77e5e..88b7306 100644 --- a/tests/testthat/_snaps/ordinal_reg-clm.md +++ b/tests/testthat/_snaps/ordinal_reg-clm.md @@ -8,8 +8,7 @@ Computational engine: clm Model fit template: - ordered::clm_wrapper(formula = missing_arg(), data = missing_arg(), - weights = missing_arg()) + ordinal::clm(formula = missing_arg(), data = missing_arg(), weights = missing_arg()) --- @@ -66,15 +65,6 @@ Computational engine: clm Model fit template: - ordered::clm_wrapper(formula = missing_arg(), data = missing_arg(), - weights = missing_arg(), link = "probit") - -# parallel regression argument handles lists - - Code - fit(ordinal_reg(parallel_reg = list(FALSE ~ Infl, TRUE ~ Infl + Cont), engine = "clm"), - Sat ~ Infl + Cont, data = house_sub) - Condition - Error in `list_to_clm_nominal()`: - ! Variable "Infl" appears in both parallel and non-parallel specifications. The "clm" engine must treat each predictor as either parallel regression or category-specific (not both). + ordinal::clm(formula = missing_arg(), data = missing_arg(), weights = missing_arg(), + link = "probit") diff --git a/tests/testthat/_snaps/ordinal_reg-ordinalNet.md b/tests/testthat/_snaps/ordinal_reg-ordinalNet.md index bb98fc9..cfd9098 100644 --- a/tests/testthat/_snaps/ordinal_reg-ordinalNet.md +++ b/tests/testthat/_snaps/ordinal_reg-ordinalNet.md @@ -32,7 +32,7 @@ Model fit template: ordered::ordinalNet_wrapper(x = missing_arg(), y = missing_arg(), - weights = missing_arg(), link = "cloglog", family = "stopping", + weights = missing_arg(), link = "cloglog", family = "sratio", lambdaVals = 10^seq(-6, -1), alpha = 0.25) --- @@ -41,13 +41,3 @@ set.seed(13) onet_arg_fit <- fit(onet_arg_spec, class ~ ., data = caco_train) -# parallel regression argument handles formulae - - Code - fit(ordinal_reg(parallel_reg = TRUE ~ Infl, penalty = 0.01, engine = "ordinalNet"), - Sat ~ Cont, data = house_sub) - Condition - Error in `parallel_reg_to_ordinalNet()`: - ! The "ordinalNet" engine does not support partial parallelism. - i Use engine "clm" or "vglm" for partial parallelism. - diff --git a/tests/testthat/_snaps/ordinal_reg.md b/tests/testthat/_snaps/ordinal_reg.md index 7014b06..ba37384 100644 --- a/tests/testthat/_snaps/ordinal_reg.md +++ b/tests/testthat/_snaps/ordinal_reg.md @@ -138,7 +138,7 @@ data = house_sub) Condition Error in `fit()`: - ! `parallel_reg` must be a single logical value, a formula with a logical LHS, or a list of at most two such elements. + ! `parallel_reg` must be a single logical value. --- @@ -147,7 +147,7 @@ Cont, data = house_sub) Condition Error in `fit()`: - ! The LHS of `parallel_reg` formula must be TRUE or FALSE. + ! `parallel_reg` must be a single logical value. --- @@ -156,5 +156,5 @@ "clm"), Sat ~ Infl + Cont, data = house_sub) Condition Error in `fit()`: - ! `parallel_reg` list can have at most 2 elements. + ! `parallel_reg` must be a single logical value. diff --git a/tests/testthat/test-gen_additive_mod-VGAM.R b/tests/testthat/test-gen_additive_mod-VGAM.R index 48ad4f9..64884c7 100644 --- a/tests/testthat/test-gen_additive_mod-VGAM.R +++ b/tests/testthat/test-gen_additive_mod-VGAM.R @@ -11,11 +11,11 @@ test_that("model object", { # no extra arguments set.seed(seed) - orig_fit <- VGAM::vgam( + orig_fit <- suppressWarnings(VGAM::vgam( class ~ mol_weight + volume + ClogP, - family = VGAM::cumulative(parallel = TRUE), + family = VGAM::cumulative(), data = caco_train - ) + )) tidy_spec <- gen_additive_mod() |> set_engine("vgam") |> @@ -40,12 +40,11 @@ test_that("model object", { # extra arguments set.seed(seed) - orig_fit <- VGAM::vgam( + orig_fit <- suppressWarnings(VGAM::vgam( class ~ s(mol_weight) + volume + ClogP, - # NB: Unused model parameters are ignored without comment. - family = VGAM::cratio(link = "probitlink", parallel = TRUE), + family = VGAM::cratio(link = "probitlink"), data = caco_train - ) + )) tidy_spec <- gen_additive_mod() |> set_engine("vgam") |> @@ -95,7 +94,7 @@ test_that("case weights", { ) tidy_spec <- gen_additive_mod() |> - set_engine("vgam") |> + set_engine("vgam", parallel = TRUE) |> set_mode("classification") set.seed(seed) tidy_fit <- fit( @@ -194,7 +193,7 @@ test_that("interfaces agree", { onet_spec <- gen_additive_mod() |> set_mode("classification") |> - set_engine("vgam") + set_engine("vgam", parallel = TRUE) expect_snapshot(onet_spec |> translate()) expect_no_error({ @@ -226,7 +225,7 @@ test_that("arguments agree", { onet_arg_spec <- gen_additive_mod() |> set_mode("classification") |> - set_engine("vgam") |> + set_engine("vgam", parallel = TRUE) |> set_args(link = "cloglog", family = "stopping") expect_snapshot(onet_arg_spec |> translate()) diff --git a/tests/testthat/test-ordinal_reg-VGAM.R b/tests/testthat/test-ordinal_reg-VGAM.R index 3a741db..9450bcf 100644 --- a/tests/testthat/test-ordinal_reg-VGAM.R +++ b/tests/testthat/test-ordinal_reg-VGAM.R @@ -3,6 +3,7 @@ test_that("model object", { skip_if_not_installed("MASS") skip_if_not_installed("VGAM") + house_sub <- get_house()$sub # no extra arguments @@ -14,7 +15,7 @@ test_that("model object", { data = house_sub ) - tidy_spec <- ordinal_reg() |> + tidy_spec <- ordinal_reg(parallel_reg = TRUE) |> set_engine("vglm") |> set_mode("classification") set.seed(seed) @@ -34,14 +35,13 @@ test_that("model object", { set.seed(seed) orig_fit <- VGAM::vglm( Sat ~ Type + Infl + Cont, - # NB: Unused model parameters are ignored without comment. family = VGAM::cratio( link = "probitlink", parallel = TRUE, Thresh = "symm1" ), data = house_sub ) - tidy_spec <- ordinal_reg() |> + tidy_spec <- ordinal_reg(parallel_reg = TRUE) |> set_engine("vglm") |> set_mode("classification") |> set_args( @@ -70,6 +70,7 @@ test_that("model object", { test_that("case weights", { skip_if_not_installed("MASS") skip_if_not_installed("VGAM") + house_sub <- get_house()$sub set.seed(seed) @@ -83,7 +84,7 @@ test_that("case weights", { weights = house_wts ) - tidy_spec <- ordinal_reg() |> + tidy_spec <- ordinal_reg(parallel_reg = TRUE) |> set_engine("vglm") |> set_mode("classification") set.seed(seed) @@ -112,7 +113,7 @@ test_that("class prediction", { house_sub <- get_house()$sub - tidy_fit <- ordinal_reg(engine = "vglm") |> + tidy_fit <- ordinal_reg(engine = "vglm", parallel_reg = TRUE) |> fit(Sat ~ Type + Cont, data = house_sub) # as in `parsnip::set_pred()`, use `VGAM::predictvglm()` to avoid mis-dispatch @@ -139,7 +140,7 @@ test_that("probability prediction", { house_sub <- get_house()$sub - tidy_fit <- ordinal_reg(engine = "vglm") |> + tidy_fit <- ordinal_reg(engine = "vglm", parallel_reg = TRUE) |> fit(Sat ~ Type + Cont, data = house_sub) # as in `parsnip::set_pred()`, use `VGAM::predictvglm()` to avoid mis-dispatch @@ -165,7 +166,7 @@ test_that("linear_pred prediction", { house_sub <- get_house()$sub - tidy_fit <- ordinal_reg(engine = "vglm") |> + tidy_fit <- ordinal_reg(engine = "vglm", parallel_reg = TRUE) |> fit(Sat ~ Type + Cont, data = house_sub) orig_link <- VGAM::predictvglm( @@ -186,7 +187,7 @@ test_that("interfaces agree", { skip_if_not_installed("QSARdata") onet_spec <- - ordinal_reg() |> + ordinal_reg(parallel_reg = TRUE) |> set_mode("classification") |> set_engine("vglm") expect_snapshot(onet_spec |> translate()) @@ -219,6 +220,7 @@ test_that("arguments agree", { onet_arg_spec <- ordinal_reg( + parallel_reg = TRUE, ordinal_link = "cloglog", odds_link = "stopping" ) |> set_mode("classification") |> @@ -239,6 +241,7 @@ test_that("arguments agree", { test_that("parallel regression argument handles logicals", { skip_if_not_installed("MASS") skip_if_not_installed("VGAM") + house_sub <- get_house()$sub # all parallel regression @@ -286,86 +289,4 @@ test_that("parallel regression argument handles logicals", { } }) -test_that("parallel regression argument handles formulae", { - skip_if_not_installed("MASS") - skip_if_not_installed("VGAM") - house_sub <- get_house()$sub - - set.seed(seed) - tidy_fit <- ordinal_reg(parallel_reg = TRUE ~ Cont, engine = "vglm") |> - fit(Sat ~ Infl + Cont, data = house_sub) - - set.seed(seed) - orig_fit <- VGAM::vglm( - Sat ~ Infl + Cont, - family = VGAM::cumulative(parallel = TRUE ~ -1 + Cont), - data = house_sub - ) - - skip_slots <- c("call", "misc") - for (s in setdiff(slotNames(tidy_fit$fit), skip_slots)) { - expect_equal( - slot(tidy_fit$fit, s), - slot(orig_fit, s), - ignore_attr = TRUE, ignore_formula_env = TRUE - ) - } - - set.seed(seed) - tidy_fit <- ordinal_reg(parallel_reg = FALSE ~ Cont, engine = "vglm") |> - fit(Sat ~ Infl + Cont, data = house_sub) - - set.seed(seed) - orig_fit <- suppressWarnings(VGAM::vglm( - Sat ~ Infl + Cont, - family = VGAM::cumulative(parallel = FALSE ~ -1 + Cont), - data = house_sub - )) - - skip_slots <- c("call", "misc") - for (s in setdiff(slotNames(tidy_fit$fit), skip_slots)) { - expect_equal( - slot(tidy_fit$fit, s), - slot(orig_fit, s), - ignore_attr = TRUE, ignore_formula_env = TRUE - ) - } -}) - -test_that("parallel regression argument handles lists", { - skip_if_not_installed("MASS") - skip_if_not_installed("VGAM") - house_sub <- get_house()$sub - - set.seed(seed) - tidy_fit <- ordinal_reg( - parallel_reg = list(TRUE ~ Infl, FALSE ~ Type + Cont), - engine = "vglm" - ) |> - fit(Sat ~ Type + Infl + Cont, data = house_sub) - set.seed(seed) - orig_fit <- VGAM::vglm( - Sat ~ Type + Infl + Cont, - family = VGAM::cumulative(parallel = TRUE ~ -1 + Infl), - data = house_sub - ) - - skip_slots <- c("call", "misc") - for (s in setdiff(slotNames(tidy_fit$fit), skip_slots)) { - expect_equal( - slot(tidy_fit$fit, s), - slot(orig_fit, s), - ignore_attr = TRUE, ignore_formula_env = TRUE - ) - } - - expect_snapshot( - ordinal_reg( - parallel_reg = list(TRUE ~ Infl, FALSE ~ Infl + Cont), - engine = "vglm" - ) |> - fit(Sat ~ Infl + Cont, data = house_sub), - error = TRUE - ) -}) diff --git a/tests/testthat/test-ordinal_reg-clm.R b/tests/testthat/test-ordinal_reg-clm.R index 5096974..d527cfb 100644 --- a/tests/testthat/test-ordinal_reg-clm.R +++ b/tests/testthat/test-ordinal_reg-clm.R @@ -247,60 +247,3 @@ test_that("parallel regression argument handles logicals", { tidy_fit$fit$formulas <- orig_fit$formulas <- NULL expect_equal(tidy_fit$fit, orig_fit, ignore_formula_env = TRUE) }) - -test_that("parallel regression argument handles formulae", { - skip_if_not_installed("MASS") - skip_if_not_installed("ordinal") - house_sub <- get_house()$sub - - set.seed(seed) - tidy_fit1 <- ordinal_reg(parallel_reg = FALSE ~ Cont, engine = "clm") |> - fit(Sat ~ Infl + Cont, data = house_sub) - - set.seed(seed) - tidy_fit2 <- ordinal_reg(parallel_reg = TRUE ~ Infl, engine = "clm") |> - fit(Sat ~ Infl + Cont, data = house_sub) - - set.seed(seed) - orig_fit <- ordinal::clm( - Sat ~ Infl + Cont, data = house_sub, - nominal = ~ Cont - ) - - tidy_fit1$fit$call <- tidy_fit2$fit$call <- orig_fit$call <- NULL - tidy_fit1$fit$formulas <- tidy_fit2$fit$formulas <- orig_fit$formulas <- NULL - expect_equal(tidy_fit1$fit, orig_fit, ignore_formula_env = TRUE) - expect_equal(tidy_fit2$fit, orig_fit, ignore_formula_env = TRUE) -}) - -test_that("parallel regression argument handles lists", { - skip_if_not_installed("MASS") - skip_if_not_installed("ordinal") - house_sub <- get_house()$sub - - set.seed(seed) - tidy_fit <- ordinal_reg( - parallel_reg = list(TRUE ~ Infl, FALSE ~ Cont), - engine = "clm" - ) |> - fit(Sat ~ Infl + Cont, data = house_sub) - - set.seed(seed) - orig_fit <- ordinal::clm( - Sat ~ Infl + Cont, data = house_sub, - nominal = ~ Cont - ) - - tidy_fit$fit$call <- orig_fit$call <- NULL - tidy_fit$fit$formulas <- orig_fit$formulas <- NULL - expect_equal(tidy_fit$fit, orig_fit, ignore_formula_env = TRUE) - - expect_snapshot( - ordinal_reg( - parallel_reg = list(FALSE ~ Infl, TRUE ~ Infl + Cont), - engine = "clm" - ) |> - fit(Sat ~ Infl + Cont, data = house_sub), - error = TRUE - ) -}) diff --git a/tests/testthat/test-ordinal_reg-ordinalNet.R b/tests/testthat/test-ordinal_reg-ordinalNet.R index 5e41396..e9df96b 100644 --- a/tests/testthat/test-ordinal_reg-ordinalNet.R +++ b/tests/testthat/test-ordinal_reg-ordinalNet.R @@ -512,42 +512,3 @@ test_that("parallel regression argument handles logicals", { expect_equal(orig_fit$coefs, tidy_fit$fit$coefs) }) - -test_that("parallel regression argument handles formulae", { - skip_if_not_installed("MASS") - skip_if_not_installed("ordinalNet") - - expect_snapshot( - ordinal_reg( - parallel_reg = TRUE ~ Infl, penalty = 0.01, engine = "ordinalNet" - ) |> - fit(Sat ~ Cont, data = house_sub), - error = TRUE - ) -}) - -test_that("parallel regression argument handles lists", { - skip_if_not_installed("MASS") - skip_if_not_installed("ordinalNet") - - set.seed(seed) - expect_warning( - orig_fit <- ordinalNet::ordinalNet( - house_vars, - y = house_sub$Sat, - nLambda = 120, lambdaMinRatio = .001, includeLambda0 = TRUE, - nonparallelTerms = TRUE, parallelTerms = TRUE - ), - "nonparallelTerms" - ) - - set.seed(seed) - expect_warning( - tidy_fit <- ordinal_reg(parallel_reg = c(FALSE, TRUE), penalty = 0.01) |> - set_engine("ordinalNet", path_values = !!orig_fit$lambdaVals) |> - fit(Sat ~ Infl + Cont, data = house_sub), - "nonparallelTerms" - ) - - expect_equal(orig_fit$coefs, tidy_fit$fit$coefs) -}) From 742f16e7ad83a107d0d241815ca11eec8cc5d995 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Sun, 9 Aug 2026 13:21:48 -0400 Subject: [PATCH 10/45] track agent-generated explication of parallel regression assumption control --- ignore/parallel-regression-assumption.Rmd | 1467 +++++++++++++++++++++ 1 file changed, 1467 insertions(+) create mode 100644 ignore/parallel-regression-assumption.Rmd diff --git a/ignore/parallel-regression-assumption.Rmd b/ignore/parallel-regression-assumption.Rmd new file mode 100644 index 0000000..85cfccb --- /dev/null +++ b/ignore/parallel-regression-assumption.Rmd @@ -0,0 +1,1467 @@ +--- +title: "Controlling the Parallel Regression Assumption across Ordinal Engines" +output: html_document +--- + +The parallel regression assumption states that the effect of each +predictor is the same across all cumulative thresholds. Four engines +allow users to relax this assumption in different ways: + +1. **`ordinalNet::ordinalNet()`**: `parallelTerms`, `nonparallelTerms`, `parallelPenaltyFactor` arguments +2. **`ordinal::clm()`**: `nominal` formula +3. **`VGAM::vglm()`**: `parallel` argument in the family function +4. **`brms::brm()`**: `cs()` function in the model formula + +This document explores each engine's parameterization directly (without +using the ordered package), compares results where they should agree, +describes their idiosyncrasies, and proposes harmonizations. + +```{r setup, include=FALSE} +knitr::opts_chunk$set( + message = FALSE, + warning = FALSE, + comment = "#>" +) +``` + +# Setup + +```{r install-ordered} +devtools::install_local("..", force = TRUE, quiet = TRUE) +``` + +```{r load-packages} +library(MASS) +library(VGAM) +library(ordinalNet) +library(ordinal) +``` + +# Data + +A survey of housing conditions in Copenhagen, with an ordered factor +response `Sat` (satisfaction: Low < Medium < High) and three categorical +predictors: `Infl` (influence on management), `Type` (type of housing), +`Cont` (contact with neighbors). The `Freq` column gives cell counts. + +We use only `Infl` and `Cont` as predictors to keep models tractable. +`Type` (4 levels) is omitted to avoid saturation in fully non-parallel +models. + +```{r housing-data} +data("housing") + +housing <- housing[housing$Type == "Tower", ] +housing$Type <- NULL +housing_long <- housing[rep(seq_len(nrow(housing)), housing$Freq), ] +housing_long$Freq <- NULL +rownames(housing_long) <- NULL + +nrow(housing_long) +table(housing_long$Sat) + +f <- Sat ~ Infl + Cont +``` + +# Models across engines + +Each engine expresses parallelism through its own interface, but all four +can fit the same models. The table summarizes the syntax; the subsections +below fit each model in every engine and compare the results. + +| Engine | Interface | Fully parallel | Fully non-parallel | Partial | +|---|---|---|---|---| +| `vglm` | formula + family argument | parallel = TRUE | parallel = FALSE | parallel = TRUE ~ <parallel terms> | +| `clm` | formula + `nominal` | no `nominal` | nominal = ~ <all terms> | nominal = ~ <non-parallel terms> | +| `ordinalNet` | matrix + term flags | parallelTerms = TRUE, nonparallelTerms = FALSE | parallelTerms = FALSE, nonparallelTerms = TRUE | semi-parallel (both `TRUE`) | +| `brm` | formula + `cs()` | no `cs()` | all terms in `cs()` | `cs()` | + +The conventions differ in three ways: + +- **What the formula names**: `vglm`'s `parallel` formula names the + **parallel** terms; `clm`'s `nominal` and `brm`'s `cs()` name the + **non-parallel** terms; `ordinalNet` names both with separate flags. +- **Sign convention**: `clm` uses the opposite sign of `vglm` and `ordinalNet` + (latent-variable formulation); `brm` matches `vglm`. This matters only when + comparing coefficient estimates. +- **Estimator**: `ordinalNet` is penalized, so we use `lambdaVals = 0` (no + penalty) to compare with unpenalized `vglm` and `clm`; `brm` fits via MCMC, + so we compare posterior means (not MLEs) and log-likelihoods (which are + comparable). + +`vglm` formula details: the `parallel` argument lives inside the family +function (`cumulative()`, `cratio()`, `sratio()`, `acat()`), and the +intercept is always category-specific (never parallel), regardless of the +formula specification. `TRUE ~ -1 + x1` (x1 parallel) is equivalent to +`FALSE ~ 1 + (all other terms)`, verified in the "`vglm`: equivalent +formula formulations" subsection below. + +```{r ordinalNet-setup} +x_mat <- model.matrix(f, data = housing_long)[, -1] +y_fac <- housing_long$Sat +``` + +## Fully parallel model + +In the fully parallel model, each predictor has a single coefficient, +shared across all thresholds. With 2 predictors and 2 thresholds, the +model has 2 intercepts + 2 = 4 free parameters. For the logit link, this +is the proportional odds model. The engines specify it as: + +- `vglm`: `parallel = TRUE` +- `clm`: no `nominal` argument +- `ordinalNet`: `parallelTerms = TRUE, nonparallelTerms = FALSE` +- `brm`: no `cs()` + +
+`vglm`: coefficient matrix and log-likelihood + +```{r vglm-par} +vglm_par <- vglm( + f, data = housing_long, + family = VGAM::cumulative(link = "logitlink", parallel = TRUE) +) + +coef(vglm_par, matrix = TRUE) +logLik(vglm_par) +``` + +
+ + +
+`clm`: coefficients and log-likelihood + +```{r clm-par} +clm_par <- clm(f, data = housing_long, link = "logit") + +coef(clm_par) +logLik(clm_par) +``` + +
+ + +
+`ordinalNet`: coefficients and log-likelihood + +```{r ordinalNet-par} +set.seed(42) +on_par <- ordinalNet( + x = x_mat, y = y_fac, + family = "cumulative", link = "logit", + parallelTerms = TRUE, nonparallelTerms = FALSE, + lambdaVals = 0, nLambda = 1 +) + +coef(on_par) +on_par$loglik +``` + +
+ + +
+`brm`: posterior means + +```{r brm-par, cache=TRUE} +library(brms) + +set.seed(42) +brms_par <- brm( + Sat ~ Infl + Cont, data = housing_long, + family = brms::cumulative("logit"), + chains = 4, iter = 2000, warmup = 1000, + silent = 2, refresh = 0 +) + +# Posterior means for non-intercept coefficients +brms::fixef(brms_par) +``` + +
+ + +
+`brm`: log-likelihood + +```{r brm-par-ll} +# Pointwise log-likelihood, then sum across observations +ll_mat <- brms::log_lik(brms_par) +brms_par_LL <- sum(colMeans(ll_mat)) +brms_par_LL +``` + +
+ + +All four engines should agree: + +
+Cross-engine comparison of coefficients and log-likelihoods + +```{r cross-par} +params <- c("InflMedium", "InflHigh", "ContHigh") + +cf_vglm_mat <- coef(vglm_par, matrix = TRUE) +cf_clm_vec <- coef(clm_par) +cf_on_vec <- coef(on_par) +cf_brms_vec <- brms::fixef(brms_par)[params, "Estimate"] + +data.frame( + parameter = params, + vglm = as.numeric(cf_vglm_mat[params, 1]), + clm = as.numeric(cf_clm_vec[params]), + ordinalNet = as.numeric(cf_on_vec[params]), + brm = cf_brms_vec, + check.names = FALSE +) + +# Log-likelihoods +data.frame( + engine = c("vglm", "clm", "ordinalNet", "brm"), + LL = signif(c( + as.numeric(logLik(vglm_par)), + as.numeric(logLik(clm_par)), + on_par$loglik, + brms_par_LL + ), 7) +) +``` + +
+ + +`vglm` and `ordinalNet` share the same sign convention; `clm` uses the opposite +sign (latent-variable formulation). `brm` uses the same sign convention as +`vglm`. The three MLE log-likelihoods (`vglm`, `clm`, `ordinalNet`) should be +identical. `brm` reports the posterior-mean log-likelihood, which +approximates but does not exactly equal the MLE (the gap widens for +more-parameter models like the fully non-parallel model, where MCMC +mixing is harder). + +## Fully non-parallel model + +In the fully non-parallel model, every predictor has category-specific +coefficients. With 2 predictors and 2 thresholds, the model has +2 intercepts + 2×2 = 6 free parameters, versus 4 for the fully parallel +model. For the logit link, this model is known as the generalized ordered +logit. The engines specify it as: + +- `vglm`: `parallel = FALSE` +- `clm`: `nominal = ~ Infl + Cont` +- `ordinalNet`: `parallelTerms = FALSE, nonparallelTerms = TRUE` +- `brm`: `cs(Infl) + cs(Cont)` + +
+`vglm`: coefficient matrix and log-likelihood + +```{r vglm-npar} +vglm_npar <- vglm( + f, data = housing_long, + family = VGAM::cumulative(link = "logitlink", parallel = FALSE) +) + +coef(vglm_npar, matrix = TRUE) +logLik(vglm_npar) +``` + +
+ + +
+`clm`: coefficients and log-likelihood + +```{r clm-npar} +clm_npar <- clm(f, data = housing_long, link = "logit", + nominal = ~ Infl + Cont) + +coef(clm_npar) +logLik(clm_npar) +``` + +
+ + +
+`ordinalNet`: coefficients and log-likelihood + +```{r ordinalNet-npar} +set.seed(42) +on_npar <- ordinalNet( + x = x_mat, y = y_fac, + family = "cumulative", link = "logit", + parallelTerms = FALSE, nonparallelTerms = TRUE, + lambdaVals = 0, nLambda = 1 +) + +coef(on_npar) +on_npar$loglik +``` + +
+ + +
+`brm`: posterior means + +```{r brm-npar, cache=TRUE} +set.seed(42) +brms_npar <- brm( + Sat ~ cs(Infl) + cs(Cont), data = housing_long, + family = brms::cumulative("logit"), + chains = 4, iter = 2000, warmup = 1000, + silent = 2, refresh = 0 +) + +brms::fixef(brms_npar) +``` + +
+ + +
+`brm`: log-likelihood + +```{r brm-npar-ll} +brms_npar_LL <- sum(colMeans(brms::log_lik(brms_npar))) +brms_npar_LL +``` + +
+ + +
+Coefficient structures across engines + +```{r cross-npar} +# vglm fully non-parallel coefficient matrix (rows = predictors, cols = thresholds) +cf_vglm_npar_mat <- coef(vglm_npar, matrix = TRUE) +cf_vglm_npar_mat + +# ordinalNet non-parallel coefficients (vector with "predictor:threshold" names) +cf_on_npar_vec <- coef(on_npar) +cf_on_npar_vec + +# clm non-parallel coefficients (vector with "threshold.predictor" names, opposite sign) +cf_clm_npar_vec <- coef(clm_npar) +cf_clm_npar_vec +``` + +
+ + +
+Log-likelihoods across engines + +```{r cross-ll-npar} +data.frame( + engine = c("vglm", "clm", "ordinalNet", "brm"), + LL = signif(c( + as.numeric(logLik(vglm_npar)), + as.numeric(logLik(clm_npar)), + on_npar$loglik, + brms_npar_LL + ), 7) +) +``` + +
+ + +To compare `vglm` and `ordinalNet` directly (same sign convention), extract +the category-specific coefficients into a common structure: + +
+Aligned category-specific coefficients + +```{r cross-npar-aligned} +params <- c("InflMedium", "InflHigh", "ContHigh") +thr_names <- c("1", "2") + +# brm fully non-parallel posterior means (category-specific) +cf_brms_npar <- brms::fixef(brms_npar) + +npar_aligned <- expand.grid( + parameter = params, + threshold = thr_names, + stringsAsFactors = FALSE +) + +for (i in seq_len(nrow(npar_aligned))) { + p <- npar_aligned$parameter[i] + t <- npar_aligned$threshold[i] + npar_aligned$vglm[i] <- cf_vglm_npar_mat[p, as.integer(t)] + npar_aligned$ordinalNet[i] <- cf_on_npar_vec[paste0(p, ":", t)] + npar_aligned$brm[i] <- cf_brms_npar[paste0(p, "[", t, "]"), "Estimate"] +} +npar_aligned +``` + +
+ + +## Partial: Infl parallel, Cont non-parallel + +Here Infl is parallel and Cont is non-parallel. The engines specify it +as: + +- `vglm`: `parallel = TRUE ~ -1 + Infl` +- `clm`: `nominal = ~ Cont` +- `brm`: `Sat ~ Infl + cs(Cont)` +- `ordinalNet`: cannot express this directly (its flags are all-or-nothing; + see "`ordinalNet`: semi-parallel model" below) + +
+`vglm`: coefficient matrix and log-likelihood + +```{r vglm-partial-infl} +vglm_partial_infl <- vglm( + f, data = housing_long, + family = VGAM::cumulative(link = "logitlink", parallel = TRUE ~ -1 + Infl) +) + +coef(vglm_partial_infl, matrix = TRUE) +logLik(vglm_partial_infl) +``` + +
+ + +
+`clm`: coefficients and log-likelihood + +```{r clm-partial-cont} +clm_partial_cont <- clm(f, data = housing_long, link = "logit", + nominal = ~ Cont) + +coef(clm_partial_cont) +logLik(clm_partial_cont) +``` + +
+ + +
+`brm`: posterior means + +```{r brm-partial-infl, cache=TRUE} +set.seed(42) +brms_partial_infl <- brm( + Sat ~ Infl + cs(Cont), data = housing_long, + family = brms::cumulative("logit"), + chains = 4, iter = 2000, warmup = 1000, + silent = 2, refresh = 0 +) + +brms::fixef(brms_partial_infl) +``` + +
+ + +
+`brm`: log-likelihood + +```{r brm-partial-infl-ll} +brms_partial_infl_LL <- sum(colMeans(brms::log_lik(brms_partial_infl))) +brms_partial_infl_LL +``` + +
+ + +
+Cross-engine comparison of coefficients and log-likelihoods + +```{r cross-partial-infl} +# vglm: Infl parallel, Cont non-parallel +cf_vglm_part_infl <- coef(vglm_partial_infl, matrix = TRUE) + +# clm: Cont nominal (non-parallel), Infl parallel --- same model +cf_clm_part_cont <- coef(clm_partial_cont) + +# brm: Infl parallel, Cont non-parallel +cf_brms_part_infl <- brms::fixef(brms_partial_infl) + +# Align by parameter name +# vglm has ContHigh (non-parallel, category-specific) +# and InflMedium, InflHigh (parallel, shared across thresholds) +params_np <- c("ContHigh") +params_p <- c("InflMedium", "InflHigh") + +data.frame( + parameter = c(params_np, params_p), + vglm_thr1 = c( + as.numeric(cf_vglm_part_infl[params_np, 1]), + as.numeric(cf_vglm_part_infl[params_p, 1]) + ), + vglm_thr2 = c( + as.numeric(cf_vglm_part_infl[params_np, 2]), + as.numeric(cf_vglm_part_infl[params_p, 2]) + ), + clm = c( + as.numeric(cf_clm_part_cont[paste0("Low|Medium.", params_np)]), + as.numeric(cf_clm_part_cont[params_p]) + ), + brm_thr1 = c( + cf_brms_part_infl[paste0(params_np, "[1]"), "Estimate"], + cf_brms_part_infl[params_p, "Estimate"] + ), + brm_thr2 = c( + cf_brms_part_infl[paste0(params_np, "[2]"), "Estimate"], + cf_brms_part_infl[params_p, "Estimate"] + ), + check.names = FALSE +) + +data.frame( + engine = c("vglm", "clm", "brm"), + LL = signif(c( + as.numeric(logLik(vglm_partial_infl)), + as.numeric(logLik(clm_partial_cont)), + brms_partial_infl_LL + ), 7) +) +``` + +
+ + +These should be identical (same model, different parameterization). + +## Partial: Cont parallel, Infl non-parallel + +Here Cont is parallel and Infl is non-parallel. The engines specify it +as: + +- `vglm`: `parallel = TRUE ~ -1 + Cont` +- `clm`: `nominal = ~ Infl` +- `brm`: `Sat ~ cs(Infl) + Cont` +- `ordinalNet`: cannot express this directly (its flags are all-or-nothing; + see "`ordinalNet`: semi-parallel model" below) + +
+`vglm`: coefficient matrix and log-likelihood + +```{r vglm-partial-cont} +vglm_partial_cont <- vglm( + f, data = housing_long, + family = VGAM::cumulative(link = "logitlink", parallel = TRUE ~ -1 + Cont) +) + +coef(vglm_partial_cont, matrix = TRUE) +logLik(vglm_partial_cont) +``` + +
+ + +
+`clm`: coefficients and log-likelihood + +```{r clm-partial-infl} +clm_partial_infl <- clm(f, data = housing_long, link = "logit", + nominal = ~ Infl) + +coef(clm_partial_infl) +logLik(clm_partial_infl) +``` + +
+ + +
+`brm`: posterior means + +```{r brm-partial-cont, cache=TRUE} +set.seed(42) +brms_partial_cont <- brm( + Sat ~ cs(Infl) + Cont, data = housing_long, + family = brms::cumulative("logit"), + chains = 4, iter = 2000, warmup = 1000, + silent = 2, refresh = 0 +) + +brms::fixef(brms_partial_cont) +``` + +
+ + +
+`brm`: log-likelihood + +```{r brm-partial-cont-ll} +brms_partial_cont_LL <- sum(colMeans(brms::log_lik(brms_partial_cont))) +brms_partial_cont_LL +``` + +
+ + +
+Cross-engine comparison of coefficients and log-likelihoods + +```{r cross-partial-cont} +# vglm: Cont parallel, Infl non-parallel +cf_vglm_part_cont <- coef(vglm_partial_cont, matrix = TRUE) + +# clm: Infl nominal (non-parallel), Cont parallel --- same model +cf_clm_part_infl <- coef(clm_partial_infl) + +# brm: Cont parallel, Infl non-parallel +cf_brms_part_cont <- brms::fixef(brms_partial_cont) + +# Align by parameter name (non-intercept only) +# vglm has InflMedium, InflHigh (non-parallel, category-specific) +# and ContHigh (parallel, shared across thresholds) +params_np <- c("InflMedium", "InflHigh") +params_p <- c("ContHigh") + +data.frame( + parameter = c(params_np, params_p), + vglm_thr1 = c( + as.numeric(cf_vglm_part_cont[params_np, 1]), + as.numeric(cf_vglm_part_cont[params_p, 1]) + ), + vglm_thr2 = c( + as.numeric(cf_vglm_part_cont[params_np, 2]), + as.numeric(cf_vglm_part_cont[params_p, 2]) + ), + clm = c( + as.numeric(cf_clm_part_infl[paste0("Low|Medium.", params_np)]), + as.numeric(cf_clm_part_infl[params_p]) + ), + brm_thr1 = c( + cf_brms_part_cont[paste0(params_np, "[1]"), "Estimate"], + cf_brms_part_cont[params_p, "Estimate"] + ), + brm_thr2 = c( + cf_brms_part_cont[paste0(params_np, "[2]"), "Estimate"], + cf_brms_part_cont[params_p, "Estimate"] + ), + check.names = FALSE +) + +data.frame( + engine = c("vglm", "clm", "brm"), + LL = signif(c( + as.numeric(logLik(vglm_partial_cont)), + as.numeric(logLik(clm_partial_infl)), + brms_partial_cont_LL + ), 7) +) +``` + +
+ + +These should be identical (same model, different parameterization). + +# Engine-specific parameterizations + +## `vglm`: equivalent formula formulations + +`TRUE ~ -1 + Infl` (Infl parallel) should equal `FALSE ~ 1 + Cont` +(Cont non-parallel; everything else parallel). + +
+Equivalent formula formulations: coefficients and equality checks + +```{r vglm-equivalence} +vglm_partial_infl_check <- vglm( + f, data = housing_long, + family = VGAM::cumulative(link = "logitlink", parallel = FALSE ~ 1 + Cont) +) + +vglm_partial_cont_check <- vglm( + f, data = housing_long, + family = VGAM::cumulative(link = "logitlink", parallel = FALSE ~ 1 + Infl) +) + +# TRUE ~ -1 + Infl should equal FALSE ~ 1 + Cont +cf_a <- coef(vglm_partial_infl, matrix = TRUE) +cf_b <- coef(vglm_partial_infl_check, matrix = TRUE) + +data.frame( + parameter = rownames(cf_a), + `TRUE~-1+Infl` = as.numeric(cf_a[, 1]), + `FALSE~1+Cont` = as.numeric(cf_b[, 1]), + check.names = FALSE +) + +all.equal(cf_a, cf_b) + +# TRUE ~ -1 + Cont should equal FALSE ~ 1 + Infl +cf_c <- coef(vglm_partial_cont, matrix = TRUE) +cf_d <- coef(vglm_partial_cont_check, matrix = TRUE) + +data.frame( + parameter = rownames(cf_c), + `TRUE~-1+Cont` = as.numeric(cf_c[, 1]), + `FALSE~1+Infl` = as.numeric(cf_d[, 1]), + check.names = FALSE +) + +all.equal(cf_c, cf_d) +``` + +
+ + +## `brm`: same variable parallel and non-parallel + +`brm` also lets the same variable appear both with and without `cs()`: + +```r +Sat ~ Infl + cs(Infl) + Cont +``` + +The variable's effect decomposes into a shared (parallel) coefficient +`b` plus a category-specific deviation `bcs_j` --- a reparameterization +of the fully non-parallel model. The other engines cannot do this: `vglm`'s +`parallel` formula, `clm`'s `nominal` formula, and `ordinalNet`'s +`parallelTerms`/`nonparallelTerms` flags each assign a variable to +exactly one side of the partition. + +## `ordinalNet`: semi-parallel model + +`parallelTerms` and `nonparallelTerms` cannot both be `FALSE`. The +"semi-parallel" model has both `TRUE`: the elastic net penalty (scaled by +`parallelPenaltyFactor`) shrinks the nonparallel terms toward the +parallel model. At `lambda = 0`, the semi-parallel model spans the same +space as the fully non-parallel model; the parallel terms are redundant +(absorbed into nonparallel). + +
+`ordinalNet`: semi-parallel coefficients and log-likelihood + +```{r ordinalNet-semi} +set.seed(42) +on_semi <- ordinalNet( + x = x_mat, y = y_fac, + family = "cumulative", link = "logit", + parallelTerms = TRUE, nonparallelTerms = TRUE, + lambdaVals = 0, nLambda = 1 +) + +coef(on_semi) +on_semi$loglik +``` + +
+ + +With higher `parallelPenaltyFactor`, parallel terms are penalized more, +so nonparallel terms should be larger (less shrunk toward zero). This +effectively biases the model **away** from the fully parallel model. + +
+`ordinalNet`: effect of parallelPenaltyFactor on coefficients + +```{r ordinalNet-pf} +set.seed(42) +on_pf1 <- ordinalNet( + x = x_mat, y = y_fac, + family = "cumulative", link = "logit", + parallelTerms = TRUE, nonparallelTerms = TRUE, + parallelPenaltyFactor = 1, + lambdaVals = c(0.05), nLambda = 1 +) + +writeLines("pf=1, lambda=0.05:") +print(coef(on_pf1)) + +set.seed(42) +on_pf5 <- ordinalNet( + x = x_mat, y = y_fac, + family = "cumulative", link = "logit", + parallelTerms = TRUE, nonparallelTerms = TRUE, + parallelPenaltyFactor = 5, + lambdaVals = c(0.05), nLambda = 1 +) + +writeLines(c("", "pf=5, lambda=0.05:")) +print(coef(on_pf5)) +``` + +
+ + +## `parallelPenaltyFactor` mechanics + +### How it works + +The semi-parallel model has both `parallelTerms` and `nonparallelTerms` +`TRUE`. Its elastic net penalty is constructed (from the `ordinalNet` +source) as: + +``` +penaltyFactorsIntercept <- rep(0, nLev - 1) # unpenalized +penaltyFactorsParallel <- penaltyFactors * parallelPenaltyFactor +penaltyFactorsNonparallel <- rep(penaltyFactors, nLev - 1) +penaltyFactors <- c(penaltyFactorsIntercept, + penaltyFactorsParallel, + penaltyFactorsNonparallel) +``` + +For 3 levels, 3 predictors, the per-parameter penalty is: + +| Parameter | Penalty | +|---|---| +| `(Intercept):1` | 0 (always unpenalized) | +| `(Intercept):2` | 0 (always unpenalized) | +| `InflMedium` (parallel) | `penaltyFactors[1] * parallelPenaltyFactor` | +| `InflHigh` (parallel) | `penaltyFactors[2] * parallelPenaltyFactor` | +| `ContHigh` (parallel) | `penaltyFactors[3] * parallelPenaltyFactor` | +| `InflMedium:1` (nonpar) | `penaltyFactors[1]` | +| `InflHigh:1` (nonpar) | `penaltyFactors[2]` | +| `ContHigh:1` (nonpar) | `penaltyFactors[3]` | +| `InflMedium:2` (nonpar) | `penaltyFactors[1]` | +| `InflHigh:2` (nonpar) | `penaltyFactors[2]` | +| `ContHigh:2` (nonpar) | `penaltyFactors[3]` | + +`parallelPenaltyFactor` scales the parallel terms relative to the +nonparallel terms: higher values penalize parallel terms more (pushing +toward the fully non-parallel model), lower values penalize them less +(pushing toward the fully parallel model). + +The critical constraint is that `penaltyFactors[j]` is the **same** for +both the parallel and nonparallel terms of variable `j`, so there is no +way to independently control the penalty on Cont's parallel versus its +nonparallel terms. + +### Sweep: `parallelPenaltyFactor` from `0` to `Inf` + +
+Sweep results across parallelPenaltyFactor values + +```{r pf-sweep, cache=TRUE} +pf_sweep <- c(0, 0.01, 0.1, 0.5, 1, 2, 5, 10, 50, Inf) +results_pf <- data.frame() + +for (pf in pf_sweep) { + set.seed(42) + pf_use <- ifelse(is.infinite(pf), 1e10, pf) + fit <- tryCatch( + ordinalNet( + x = x_mat, y = y_fac, + family = "cumulative", link = "logit", + parallelTerms = TRUE, nonparallelTerms = TRUE, + parallelPenaltyFactor = pf_use, + lambdaVals = c(0.05), nLambda = 1, + warn = FALSE + ), + error = function(e) NULL + ) + if (!is.null(fit)) { + cf <- coef(fit) + results_pf <- rbind(results_pf, data.frame( + pf = pf, + LL = fit$loglik, + Infl_par = abs(cf["InflMedium"]) + abs(cf["InflHigh"]), + Infl_np = abs(cf["InflMedium:1"]) + abs(cf["InflHigh:1"]) + + abs(cf["InflMedium:2"]) + abs(cf["InflHigh:2"]), + Cont_par = abs(cf["ContHigh"]), + Cont_np = abs(cf["ContHigh:1"]) + abs(cf["ContHigh:2"]), + npar = sum(cf != 0), + stringsAsFactors = FALSE + )) + } +} + +results_pf$pf_label <- ifelse( + is.infinite(results_pf$pf), "Inf", + sprintf("%.2f", results_pf$pf) +) +print(results_pf[, c("pf_label", "LL", "Infl_par", "Infl_np", + "Cont_par", "Cont_np", "npar")]) +``` + +
+ + +- `pf = 0`: parallel terms unpenalized, nonparallel penalized => fully + parallel model +- `pf = 1`: equal penalty => intermediate model +- `pf = Inf`: parallel terms zeroed out => fully non-parallel model + +(Values in between interpolate: `pf = 0.01` is nearly fully parallel, +`pf >= 2` already approaches fully non-parallel.) + +### Partial parallelism is impossible + +Because `penaltyFactors[j]` is shared between the parallel and nonparallel +terms of each variable, `parallelPenaltyFactor` is a "global knob" for +the parallel regression assumption, not a per-variable switch: it cannot +make one variable non-parallel while another stays parallel. + +Target: Infl parallel, Cont non-parallel (`clm` reference: +`LL = -404.4711` via `nominal = ~ Cont`). Attempt: set `penaltyFactors` +to penalize Cont more than Infl: + +
+Attempted partial parallelism: coefficients and log-likelihood + +```{r partial-try} +pf_partial <- c(1, 1, 10) +set.seed(42) +fit_partial_try <- ordinalNet( + x = x_mat, y = y_fac, + family = "cumulative", link = "logit", + parallelTerms = TRUE, nonparallelTerms = TRUE, + parallelPenaltyFactor = 1, + penaltyFactors = pf_partial, + lambdaVals = c(0.05), nLambda = 1, + warn = FALSE +) + +print(coef(fit_partial_try)) +fit_partial_try$loglik +``` + +
+ + +**Problem**: this penalizes both Cont's parallel **and** nonparallel +terms more than Infl's --- the opposite of what we want, since Cont's +nonparallel terms are the very terms we want to keep. + +**Contrast with `clm`/`vglm`/`brm`**: these engines use maximum likelihood +with a design matrix that includes category-specific terms **only** for +non-parallel variables. This is a hard structural constraint in the model +itself, not a soft penalization, so per-variable partial parallelism is +native. + +**Implication for ordered**: `ordinalNet` cannot express the same model +as `clm`/`vglm` when some variables are parallel and others are not. The +harmonized interface must either: + +(a) Error when partial parallelism is requested for `ordinalNet`, +(b) Approximate it (poorly) via penalty tuning, or +(c) Advise users to switch to `clm` or `vglm` for partial parallelism. + +### What `parallelPenaltyFactor` _is_ good for + +Despite this, `parallelPenaltyFactor` serves valuable purposes: + +1. **Model selection and regularized estimation**: sweeping it (or using + cross-validation) data-adaptively estimates the overall degree of + parallel regression assumption violation, and the semi-parallel model + can predict better than either extreme by borrowing strength across + categories. +2. **Variable selection**: combined with the elastic net (`alpha < 1`), + it selects predictors while the parallelism structure determines how + their effects are modeled. + +**Practical recommendation**: for per-variable partial parallelism, use +`clm`, `vglm`, or `brm`. Use `ordinalNet` when the entire model should be +regularized, when variable selection matters, or when the degree of +parallel regression assumption violation is uncertain and should be +estimated. + +### Design matrix approach for partial parallelism + +A wrapper around `ordinalNet` *could* achieve per-variable partial +parallelism by constructing the design matrix by hand: shared dummy terms +for the parallel variables, and interactions with threshold indicators +for the nonparallel variables. + +
+Constructed design matrix dimensions + +```{r design-matrix-demo} +# Demonstrate the design-matrix construction (not fitted) +# Target: Infl parallel, Cont non-parallel + +# Step 1: Identify groups +parallel_vars <- c("InflMedium", "InflHigh") +nonparallel_vars <- c("ContHigh") + +# Step 2: Parallel design matrix (standard dummies, shared across thresholds) +X_par <- x_mat[, parallel_vars, drop = FALSE] + +# Step 3: Nonparallel design matrix (interactions with threshold indicators) +K <- nlevels(y_fac) +n_thr <- K - 1 +X_np_list <- list() +for (j in seq_along(nonparallel_vars)) { + for (t in seq_len(n_thr)) { + thr_indicator <- as.integer(as.integer(y_fac) > t) + X_np_list[[length(X_np_list) + 1]] <- x_mat[, nonparallel_vars[j]] * thr_indicator + } +} +X_np <- do.call(cbind, X_np_list) +colnames(X_np) <- paste0(rep(nonparallel_vars, each = n_thr), ":", seq_len(n_thr)) + +# Step 4: Combine +X_partial <- cbind(X_par, X_np) + +data.frame( + full_columns = ncol(x_mat), + partial_columns = ncol(X_partial), + parallel = paste(parallel_vars, collapse = ", "), + nonparallel = paste(colnames(X_np), collapse = ", ") +) +``` + +
+ + +In practice this is not native to `ordinalNet`: the wrapper would need to +bypass the internal design-matrix construction (setting both flags +`FALSE`) and pass the intercepts and the full penalty vector to the +internal optimizer or to `glmnet` directly, and the resulting fit would +forfeit elastic net regularization for the parallel terms. The approach +is mainly of theoretical interest --- it shows that `ordinalNet`'s *model +space* can express partial parallelism, but its *interface* does not +expose it. + +### Parallel-to-non-parallel spectrum + +
+`ordinalNet` spectrum: log-likelihood and information criteria + +```{r spectrum, cache=TRUE} +models_spectrum <- list( + list(name = "Parallel", pt = TRUE, nt = FALSE, pf = 1), + list(name = "Semi (pf=0.1)", pt = TRUE, nt = TRUE, pf = 0.1), + list(name = "Semi (pf=0.5)", pt = TRUE, nt = TRUE, pf = 0.5), + list(name = "Semi (pf=1)", pt = TRUE, nt = TRUE, pf = 1), + list(name = "Semi (pf=5)", pt = TRUE, nt = TRUE, pf = 5), + list(name = "Semi (pf=10)", pt = TRUE, nt = TRUE, pf = 10), + list(name = "Non-parallel", pt = FALSE, nt = TRUE, pf = 1) +) + +spectrum_df <- data.frame( + model = character(7), LL = NA_real_, AIC = NA_real_, + BIC = NA_real_, npar = NA_integer_, + stringsAsFactors = FALSE +) +for (i in seq_along(models_spectrum)) { + m <- models_spectrum[[i]] + set.seed(42) + fit <- ordinalNet( + x = x_mat, y = y_fac, + family = "cumulative", link = "logit", + parallelTerms = m$pt, nonparallelTerms = m$nt, + parallelPenaltyFactor = m$pf, + lambdaVals = c(0.05), nLambda = 1, + warn = FALSE + ) + npar <- sum(coef(fit) != 0) + spectrum_df$model[i] <- m$name + spectrum_df$LL[i] <- fit$loglik + spectrum_df$AIC[i] <- -2 * fit$loglik + 2 * npar + spectrum_df$BIC[i] <- -2 * fit$loglik + log(nrow(x_mat)) * npar + spectrum_df$npar[i] <- npar +} +print(spectrum_df) +``` + +
+ + +`clm` reference (unpenalized MLE): + +
+`clm` reference: log-likelihoods and information criteria + +```{r spectrum-clm-ref} +n <- nrow(x_mat) +data.frame( + model = c("Parallel (clm)", "Non-parallel (clm)", "Partial Cont (clm)", "Partial Infl (clm)"), + LL = c( + as.numeric(logLik(clm_par)), + as.numeric(logLik(clm_npar)), + as.numeric(logLik(clm_partial_cont)), + as.numeric(logLik(clm_partial_infl)) + ), + AIC = c( + -2 * as.numeric(logLik(clm_par)) + 2 * 5, + -2 * as.numeric(logLik(clm_npar)) + 2 * 8, + -2 * as.numeric(logLik(clm_partial_cont)) + 2 * 6, + -2 * as.numeric(logLik(clm_partial_infl)) + 2 * 7 + ), + BIC = c( + -2 * as.numeric(logLik(clm_par)) + log(n) * 5, + -2 * as.numeric(logLik(clm_npar)) + log(n) * 8, + -2 * as.numeric(logLik(clm_partial_cont)) + log(n) * 6, + -2 * as.numeric(logLik(clm_partial_infl)) + log(n) * 7 + ), + npar = c(5, 8, 6, 7) +) +``` + +
+ + +Note: `ordinalNet` fits use `lambda = 0.05` (regularized), so LLs are lower +than the unpenalized MLE. The semi-parallel model with `pf = 0` recovers +the fully parallel model; with `pf >= 2` it recovers the fully non-parallel +model (all parallel terms zeroed). The "sweet spot" depends on the data +and tuning. + +# Threshold constraints with parallel regression + +Threshold constraints and parallel regression constraints are orthogonal: +thresholds control the intercept structure, while parallelism controls +the regression coefficients. They can be combined freely. Which engines +support threshold constraints, and how? + +## Available constraints + +`flexible` (the default in all engines) estimates K-1 independent +thresholds. The constrained options reduce the number of free threshold +parameters: + +- **equidistant / equid**: equal spacing between thresholds (2 free + parameters: intercept + spacing, regardless of K). +- **symmetric / symm1**: thresholds symmetric around the central + threshold (floor(K/2) + 1 free parameters). +- **symmetric2 / symm0**: symmetric about zero; central threshold is + zero (even K) or two central thresholds are equal and opposite + (odd K). +- **qnorm** (`vglm` only): thresholds placed at normal-distribution + quantiles (1 free parameter: the scale). +- **sum_to_zero** (`brm` only): thresholds constrained to sum to zero + (K-1 free parameters, but centered). + +`vglm`'s threshold syntax changed at version 1.1-10: up to 1.1-9 the +argument was `thresholds` with values `"equidistant"`, `"symmetric1"`, +and `"symmetric0"`; from 1.1-10 it is `Thresh` with the abbreviated +values `"equid"`, `"symm1"`, `"symm0"`, `"free"`, and `"qnorm"`. + +| Engine | Threshold argument | Options | Exposed in ordered? | +|---|---|---|---| +| `clm` | `threshold` | `flexible`, `symmetric`, `symmetric2`, `equidistant` | Yes (`threshold_structure` dial) | +| `vglm` (≤ 1.1-9) | `thresholds` (in family) | `"equidistant"`, `"symmetric1"`, `"symmetric0"` | No (wrapper uses `...`) | +| `vglm` (≥ 1.1-10) | `Thresh` (in family) | `NULL`, `"equid"`, `"symm1"`, `"symm0"`, `"free"`, `"qnorm"` | No (wrapper uses `...`) | +| `brm` | `threshold` (in family) | `"flexible"`, `"equidistant"`, `"sum_to_zero"` | No (not registered) | +| `ordinalNet` | --- | None | --- | + +## Interaction with parallelism + +Because thresholds and parallelism constrain different parts of the +model, they compose without conflict: + +```r +# clm: equidistant thresholds + partial non-parallel effects +clm(Sat ~ Infl + Cont, data = data, + nominal = ~ Cont, threshold = "equidistant") + +# vglm: equidistant thresholds + non-parallel effects +vglm(Sat ~ Infl + Cont, data = data, + family = VGAM::cumulative(link = "logitlink", + parallel = FALSE, Thresh = "equid")) + +# brm: equidistant thresholds + category-specific effects +brm(Sat ~ Infl + cs(Cont), data = data, + family = brms::cumulative("logit", threshold = "equidistant")) +``` + +The parallel regression specification determines how many coefficient +vectors are estimated (one for a fully parallel model, K-1 for a fully +non-parallel model, variable for partial parallelism). +The threshold constraint determines how many intercepts are estimated. +Together, they set the total number of free parameters. + +## Comparison on housing data + +
+`clm`: threshold sweep log-likelihoods and degrees of freedom + +```{r threshold-comparison, cache=TRUE} +# clm: threshold sweep with fully parallel model +clm_thr_par <- data.frame( + threshold = c("flexible", "symmetric", "equidistant"), + LL = NA_real_, df = NA_integer_, + stringsAsFactors = FALSE +) +for (i in seq_along(clm_thr_par$threshold)) { + fit <- clm(f, data = housing_long, link = "logit", + threshold = clm_thr_par$threshold[i]) + clm_thr_par$LL[i] <- as.numeric(logLik(fit)) + clm_thr_par$df[i] <- attr(logLik(fit), "df") +} +print(clm_thr_par) + +# clm: threshold sweep with fully non-parallel model (all nominal) +clm_thr_npar <- clm_thr_par +for (i in seq_along(clm_thr_npar$threshold)) { + fit <- clm(f, data = housing_long, link = "logit", + nominal = ~ Infl + Cont, + threshold = clm_thr_npar$threshold[i]) + clm_thr_npar$LL[i] <- as.numeric(logLik(fit)) + clm_thr_npar$df[i] <- attr(logLik(fit), "df") +} +print(clm_thr_npar) +``` + +
+ + +With 3 satisfaction levels (2 thresholds) and 2 categorical predictors, +the equidistant constraint saves at most 1 degree of freedom (2 +thresholds down to 1 spacing parameter). The gain grows with the number +of ordinal levels. Threshold constraints are most useful when the +spacing between categories is plausibly uniform, and they interact +naturally with the parallel regression specification: a user can +simultaneously request equidistant thresholds and partial non-parallel +effects, getting a parsimonious model on both dimensions. + +# Harmonization proposals + +## Proposal 1: Unified parallelism specification + +A single engine argument called `parallelism` that accepts: + +- `parallelism = "parallel"` (or `TRUE`): all terms parallel. + Equivalent to `vglm: parallel = TRUE`, `clm: nominal = NULL`, + `brm: Sat ~ x1 + x2` (no `cs()` terms), + `ordinalNet: parallelTerms=TRUE, nonparallelTerms=FALSE`. + +- `parallelism = "nonparallel"` (or `FALSE`): no terms parallel. + Equivalent to `vglm: parallel = FALSE`, `clm: nominal = ~ .`, + `brm: Sat ~ cs(x1) + cs(x2)`, + `ordinalNet: parallelTerms=FALSE, nonparallelTerms=TRUE`. + +- `parallelism = ~ x1 + x2` (formula naming non-parallel terms): + partial specification. Equivalent to `vglm: parallel = TRUE ~ -1 + + (complement of formula)`, `clm: nominal = ~ x1 + x2`, + `brm: Sat ~ Infl + cs(Cont)`, + NOT SUPPORTED natively by `ordinalNet`. + +- `parallelism = "semi"` (`ordinalNet`-specific): semi-parallel model with + penalized nonparallel terms. + +## Proposal 2: `clm`-style formula + +Adopt `clm`'s convention (shared by `brm`): a formula naming the +**non-parallel** terms. + +``` +nominal = ~ x3 +=> x3 is non-parallel; everything else is parallel. +``` + +Advantages: + +- More intuitive for users who want to "break" the parallel regression + assumption for specific variables. +- Maps to `ordinalNet`'s all-or-nothing flags: if all variables are in + the formula, set `parallelTerms=FALSE, nonparallelTerms=TRUE`; if no + variables are in the formula, set `parallelTerms=TRUE, + nonparallelTerms=FALSE`. Partial parallelism is not supported natively + (see Challenges below). +- `clm`, `brm`, and `ordinalNet` use the same direction (non-parallel terms). + +### Implementation + +Given the constraints, the most practical harmonization for ordered +would be to: + +1. Register `nominal` (or a renamed `parallelism`) as a model argument + for each engine, accepting a right-hand-side formula. + +2. Document the translation: + - For `clm`: pass directly as `nominal = ~ ...`. + - For `vglm`: convert to `parallel = TRUE ~ -1 + (complement)`. + - For `brm`: wrap non-parallel terms in `cs()` in the formula. + - For `ordinalNet`: convert to `parallelTerms`/`nonparallelTerms` + booleans, with an error if partial parallelism is requested. + +3. Keep `parallelPenaltyFactor` as a separate engine-specific argument + (`ordinalNet` only). + +4. Document that `vglm`/`brm` and `clm` use opposite sign conventions for + coefficients (cumulative probability vs. latent variable). + +5. Note that `brm` is Bayesian; posterior means approximate MLEs with + large samples but require MCMC computation time. + +This approach respects each engine's native interface while giving users +clear guidance on how to express the same model across engines. + +## Proposal 3: `cs()`-style formula syntax + +The `gen_additive_mod()` model with the `vgam` engine demonstrates how +formula specials control model structure: the `s()` function marks +predictors for smooth treatment, and the formula is passed through to +`VGAM::vgam()` which interprets it natively. This precedent motivates a +similar approach for parallelism: a `cs()` ("category-specific") formula +special that marks predictors for non-parallel treatment. + +Adopt `brm`'s `cs()` convention directly in the model formula (as +demonstrated in the `brm` section above): variables wrapped in `cs()` are +category-specific (non-parallel); unwrapped variables are parallel. +Unlike Proposal 2, this needs no separate argument --- the formula +itself carries the parallelism information. + +``` +Sat ~ Infl + cs(Cont) # Infl parallel, Cont non-parallel +Sat ~ cs(Infl) + cs(Cont) # All non-parallel +Sat ~ Infl + Cont # All parallel +``` + +### Translation to `vglm` + +The wrapper parses the formula to identify `cs()` terms, strips the +wrappers, and constructs the `parallel` argument for the family function. +`vglm` names the **parallel** terms, so the wrapper computes the complement +of the `cs()` variables: + +```r +# User formula: Sat ~ Infl + cs(Cont) +# cs() vars: Cont => parallel vars: Infl +# Translation: +vglm( + Sat ~ Infl + Cont, data = data, + family = VGAM::cumulative(link = "logitlink", parallel = TRUE ~ -1 + Infl) +) +``` + +When all terms are non-parallel (`cs(Infl) + cs(Cont)`), the wrapper +sets `parallel = FALSE`. When no terms are `cs()`, it sets +`parallel = TRUE`. The intercept is always category-specific regardless +of the specification. + +### Translation to `clm` + +The wrapper extracts `cs()` terms and passes them as the `nominal` +formula. This maps directly: `cs()` terms become nominal terms. + +```r +# User formula: Sat ~ Infl + cs(Cont) +# cs() vars: Cont +# Translation: +clm(Sat ~ Infl + Cont, data = data, nominal = ~ Cont) +``` + +### Translation to `ordinalNet` + +`ordinalNet` cannot express partial parallelism natively (see the +structural limitation discussed above). The wrapper checks whether the +`cs()` specification is all-or-nothing: + +```r +# Sat ~ Infl + Cont (no cs()): fully parallel model +ordinalNet(x, y, ..., parallelTerms = TRUE, nonparallelTerms = FALSE) + +# Sat ~ cs(Infl) + cs(Cont) (all cs()): fully non-parallel model +ordinalNet(x, y, ..., parallelTerms = FALSE, nonparallelTerms = TRUE) + +# Sat ~ Infl + cs(Cont) (partial): ERROR +stop("ordinalNet does not support partial parallelism. ", + "Use engine 'clm' or 'vglm' for partial parallelism.") +``` + +### Interaction with `s()` terms + +`brm` allows `s()` and `cs()` in the same formula, but only on +**different** predictors: + +```r +bf(rating ~ period + cs(treat) + s(x), family = sratio()) +``` + +Here `period` and `x` have parallel effects and `treat` has a +non-parallel effect; `cs()` controls parallelism, `s()` controls +functional form. Nesting is not allowed --- `cs(s(x))` raises an error --- +and `cs()` works only with `sratio()`, `cratio()`, and `acat()` +families, not `cumulative()`. + +`vglm` is richer here: smooth terms and non-parallel effects coexist +naturally, and a smooth term can itself be non-parallel, a capability +`brm` lacks. The catch is that `vglm`'s `parallel` formula matches terms by +**exact string label**, so a raw variable name like `x1` does not match +the smooth term label `s(x1, df = 2)`: + +```r +vgam(y ~ s(x1, df = 2) + x2, + family = VGAM::cumulative(link = "logitlink", + parallel = FALSE ~ 1 + s(x1, df = 2))) +``` + +A `cs()` implementation in ordered's vgam wrapper would therefore need +to map `cs()` variable names to their exact smooth term labels when +constructing the `parallel` formula. + +### Implementation sketch + +The wrapper would parse the formula to identify `cs()` specials, +analogous to how `VGAM::vgam()` handles `s()` specials: + +```r +parse_cs_terms <- function(formula) { + terms_obj <- terms(formula, specials = "cs") + cs_idx <- attr(terms_obj, "specials")$cs + all_vars <- rownames(attr(terms_obj, "factors")) + if (is.null(cs_idx)) { + return(list(formula = formula, cs_vars = character(0))) + } + cs_vars <- all_vars[cs_idx] + clean_formula <- remove_cs_wrappers(formula) + list(formula = clean_formula, cs_vars = cs_vars) +} +``` + +This approach is formula-native, matches the user's mental model ("wrap +in cs() to make that variable non-parallel"), and parallels the existing +`gen_additive_mod` + `s()` precedent in the tidymodels ecosystem. + +## Challenges with harmonization + +1. **Formula semantics differ**: In `vglm`, the formula names PARALLEL + terms (`TRUE ~ -1 + x1` => x1 is parallel). In `clm` and `brm`, the + formula names NON-PARALLEL terms (`nominal = ~ x1` or `cs(x1)`). + These are logical inverses. A unified interface should pick ONE + convention and translate for each engine. + +2. **Family vs. model argument**: In `vglm`, the parallelism is specified + inside the family function (`cumulative(parallel=...)`), not as a model + argument. In `clm` and `ordinalNet`, it is a model argument. In `brm`, it + is part of the formula (`cs()`). For a unified interface, it should be + a model argument (consistent with `clm` and `ordinalNet`), and the wrapper + should inject it into the `vglm` family constructor and the `brm` + formula. + +3. **Intercept handling**: `vglm` explicitly excludes the intercept from + the parallelism constraint (intercepts are always category-specific). + `clm` does the same by design. `ordinalNet` has no explicit intercept in + the design matrix. A unified interface should document that intercepts + are always category-specific regardless of the parallelism setting. + +4. **Penalty interactions**: `ordinalNet`'s `parallelPenaltyFactor` has no + analog in `vglm` or `clm`. If we harmonize the parallelism specification, + we still need a separate mechanism for differential penalization. This + could be a separate `parallel_penalty_factor` engine argument. + +5. **`ordinalNet`'s all-or-nothing design**: `ordinalNet` cannot express + partial parallelism natively. A formula-based interface would require + `ordinalNet` to either accept the formula and zero out non-selected + nonparallel terms, or raise an error when partial parallelism is + requested. The first option is feasible but requires a wrapper that + constructs the design matrix with interaction terms only for + non-parallel variables. + +6. **Threshold structure**: `clm` supports threshold constraints + (equidistant, symmetric, etc.) that interact with nominal effects. + `vglm` supports similar constraints via the `Thresh` argument. `brm` + supports threshold constraints via the `threshold` argument in the + family. `ordinalNet` has no threshold structure. A unified interface + would need to decide whether threshold constraints are part of the + parallelism specification or separate. See the "Threshold constraints + with parallel regression" section above. + +7. **Scale model**: `clm` supports a scale formula for heteroscedastic + models. `vglm` supports this via `s()` in `vgam`. `brm` supports this + via distributional regression (`bf(..., sigma ~ ...)`). `ordinalNet` + does not. This is orthogonal to parallelism but adds complexity to the + unified interface. + +8. **Link function interactions**: `clm` supports Aranda-Ordaz and log-gamma + links that `vglm`, `ordinalNet`, and `brm` do not. The parallelism + specification is orthogonal to the link, but some links may have + convergence issues with non-parallel models. From 4fc86c421366f28bf0d058a0291d991b5a124d5c Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Sat, 15 Aug 2026 15:48:17 -0400 Subject: [PATCH 11/45] respond to parsnip updates in response to review of pr 1393 --- tests/testthat/_snaps/ordinal_reg-clm.md | 9 +++++++++ tests/testthat/test-ordinal_reg-clm.R | 23 +++++++++++++++++++---- 2 files changed, 28 insertions(+), 4 deletions(-) diff --git a/tests/testthat/_snaps/ordinal_reg-clm.md b/tests/testthat/_snaps/ordinal_reg-clm.md index 88b7306..4f6981c 100644 --- a/tests/testthat/_snaps/ordinal_reg-clm.md +++ b/tests/testthat/_snaps/ordinal_reg-clm.md @@ -1,3 +1,12 @@ +# specification handles model parameters + + Code + fit(acat_spec, Sat ~ Type + Infl + Cont, data = house_sub) + Condition + Error in `fit()`: + ! The "clm" engine supports only the cumulative odds link. + i Use the "vglm" or "ordinalNet" engine for alternative odds links. + # interfaces agree Code diff --git a/tests/testthat/test-ordinal_reg-clm.R b/tests/testthat/test-ordinal_reg-clm.R index d527cfb..123ec88 100644 --- a/tests/testthat/test-ordinal_reg-clm.R +++ b/tests/testthat/test-ordinal_reg-clm.R @@ -14,10 +14,9 @@ test_that("specification handles model parameters", { # an unavailable odds link function acat_spec <- ordinal_reg(engine = "clm", odds_link = "adjacent_categories") - expect_warning( - fit(acat_spec, Sat ~ Type + Infl + Cont, data = house_sub), - "clm.*cumulative[ \\_]link" - ) + expect_snapshot(error = TRUE, { + fit(acat_spec, Sat ~ Type + Infl + Cont, data = house_sub) + }) }) # model: basic ----------------------------------------------------------------- @@ -246,4 +245,20 @@ test_that("parallel regression argument handles logicals", { tidy_fit$fit$call <- orig_fit$call <- NULL tidy_fit$fit$formulas <- orig_fit$formulas <- NULL expect_equal(tidy_fit$fit, orig_fit, ignore_formula_env = TRUE) + + # all category-specific with interactions + + set.seed(seed) + tidy_fit <- ordinal_reg(parallel_reg = FALSE, engine = "clm") |> + fit(Sat ~ Infl * Cont, data = house_sub) + + set.seed(seed) + orig_fit <- ordinal::clm( + Sat ~ Infl * Cont, data = house_sub, + nominal = ~ Infl * Cont + ) + + tidy_fit$fit$call <- orig_fit$call <- NULL + tidy_fit$fit$formulas <- orig_fit$formulas <- NULL + expect_equal(tidy_fit$fit, orig_fit, ignore_formula_env = TRUE) }) From d5d70553260987ef1e766c14218eb9c23f0e5488 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 31 Aug 2026 14:55:51 -0400 Subject: [PATCH 12/45] revise tests to match parsnip@a57bf3087 --- tests/testthat/_snaps/gen_additive_mod-VGAM.md | 2 +- tests/testthat/_snaps/ordinal_reg-VGAM.md | 2 +- tests/testthat/_snaps/ordinal_reg-glmnetcr.md | 2 +- tests/testthat/_snaps/ordinal_reg-ordinalNet.md | 2 +- tests/testthat/_snaps/ordinal_reg.md | 8 ++++---- tests/testthat/test-gen_additive_mod-VGAM.R | 2 +- tests/testthat/test-ordinal_reg-VGAM.R | 2 +- tests/testthat/test-ordinal_reg-clm.R | 14 +++++++++----- tests/testthat/test-ordinal_reg-ordinalNet.R | 8 ++++---- tests/testthat/test-ordinal_reg-polr.R | 4 ++-- 10 files changed, 25 insertions(+), 21 deletions(-) diff --git a/tests/testthat/_snaps/gen_additive_mod-VGAM.md b/tests/testthat/_snaps/gen_additive_mod-VGAM.md index b56035e..e0ac90c 100644 --- a/tests/testthat/_snaps/gen_additive_mod-VGAM.md +++ b/tests/testthat/_snaps/gen_additive_mod-VGAM.md @@ -58,7 +58,7 @@ Engine-Specific Arguments: parallel = TRUE link = cloglog - family = stopping + family = stopping_ratio Computational engine: vgam diff --git a/tests/testthat/_snaps/ordinal_reg-VGAM.md b/tests/testthat/_snaps/ordinal_reg-VGAM.md index efb6eb8..a27b579 100644 --- a/tests/testthat/_snaps/ordinal_reg-VGAM.md +++ b/tests/testthat/_snaps/ordinal_reg-VGAM.md @@ -65,7 +65,7 @@ Main Arguments: ordinal_link = cloglog - odds_link = stopping + odds_link = stopping_ratio parallel_reg = TRUE Computational engine: vglm diff --git a/tests/testthat/_snaps/ordinal_reg-glmnetcr.md b/tests/testthat/_snaps/ordinal_reg-glmnetcr.md index 55dc415..566fd0f 100644 --- a/tests/testthat/_snaps/ordinal_reg-glmnetcr.md +++ b/tests/testthat/_snaps/ordinal_reg-glmnetcr.md @@ -4,7 +4,7 @@ translate(gcr_spec) Condition Warning: - x The glmnetcr engine ignores `penalty` in favor of a path that enables prediction at interpolated penalty values. + x The "glmnetcr" engine ignores `penalty` in favor of a path that enables prediction at interpolated penalty values. ! `penalty` was passed 0 values. i Use `path_values` to override the default path. Output diff --git a/tests/testthat/_snaps/ordinal_reg-ordinalNet.md b/tests/testthat/_snaps/ordinal_reg-ordinalNet.md index cfd9098..a9df4ee 100644 --- a/tests/testthat/_snaps/ordinal_reg-ordinalNet.md +++ b/tests/testthat/_snaps/ordinal_reg-ordinalNet.md @@ -24,7 +24,7 @@ Main Arguments: ordinal_link = cloglog - odds_link = stopping + odds_link = stopping_ratio penalty = 0.1 mixture = 0.25 diff --git a/tests/testthat/_snaps/ordinal_reg.md b/tests/testthat/_snaps/ordinal_reg.md index ba37384..33093e1 100644 --- a/tests/testthat/_snaps/ordinal_reg.md +++ b/tests/testthat/_snaps/ordinal_reg.md @@ -29,7 +29,7 @@ ordinal_reg(mode = "regression") Condition Error in `ordinal_reg()`: - ! `mode` should be 'classification' + ! `mode` should be "classification". --- @@ -138,7 +138,7 @@ data = house_sub) Condition Error in `fit()`: - ! `parallel_reg` must be a single logical value. + ! `parallel_reg` must be `TRUE`, `FALSE`, or `NULL`, not the string "TRUE". --- @@ -147,7 +147,7 @@ Cont, data = house_sub) Condition Error in `fit()`: - ! `parallel_reg` must be a single logical value. + ! `parallel_reg` must be `TRUE`, `FALSE`, or `NULL`, not a object. --- @@ -156,5 +156,5 @@ "clm"), Sat ~ Infl + Cont, data = house_sub) Condition Error in `fit()`: - ! `parallel_reg` must be a single logical value. + ! `parallel_reg` must be `TRUE`, `FALSE`, or `NULL`, not a list. diff --git a/tests/testthat/test-gen_additive_mod-VGAM.R b/tests/testthat/test-gen_additive_mod-VGAM.R index 64884c7..f677e78 100644 --- a/tests/testthat/test-gen_additive_mod-VGAM.R +++ b/tests/testthat/test-gen_additive_mod-VGAM.R @@ -226,7 +226,7 @@ test_that("arguments agree", { gen_additive_mod() |> set_mode("classification") |> set_engine("vgam", parallel = TRUE) |> - set_args(link = "cloglog", family = "stopping") + set_args(link = "cloglog", family = "stopping_ratio") expect_snapshot(onet_arg_spec |> translate()) expect_snapshot({ diff --git a/tests/testthat/test-ordinal_reg-VGAM.R b/tests/testthat/test-ordinal_reg-VGAM.R index 9450bcf..f658428 100644 --- a/tests/testthat/test-ordinal_reg-VGAM.R +++ b/tests/testthat/test-ordinal_reg-VGAM.R @@ -221,7 +221,7 @@ test_that("arguments agree", { onet_arg_spec <- ordinal_reg( parallel_reg = TRUE, - ordinal_link = "cloglog", odds_link = "stopping" + ordinal_link = "cloglog", odds_link = "stopping_ratio" ) |> set_mode("classification") |> set_engine("vglm") diff --git a/tests/testthat/test-ordinal_reg-clm.R b/tests/testthat/test-ordinal_reg-clm.R index 123ec88..03221eb 100644 --- a/tests/testthat/test-ordinal_reg-clm.R +++ b/tests/testthat/test-ordinal_reg-clm.R @@ -249,13 +249,17 @@ test_that("parallel regression argument handles logicals", { # all category-specific with interactions set.seed(seed) - tidy_fit <- ordinal_reg(parallel_reg = FALSE, engine = "clm") |> - fit(Sat ~ Infl * Cont, data = house_sub) + suppressWarnings( + tidy_fit <- ordinal_reg(parallel_reg = FALSE, engine = "clm") |> + fit(Sat ~ Infl * Cont, data = house_sub) + ) set.seed(seed) - orig_fit <- ordinal::clm( - Sat ~ Infl * Cont, data = house_sub, - nominal = ~ Infl * Cont + suppressWarnings( + orig_fit <- ordinal::clm( + Sat ~ Infl * Cont, data = house_sub, + nominal = ~ Infl * Cont + ) ) tidy_fit$fit$call <- orig_fit$call <- NULL diff --git a/tests/testthat/test-ordinal_reg-ordinalNet.R b/tests/testthat/test-ordinal_reg-ordinalNet.R index e9df96b..a886cfc 100644 --- a/tests/testthat/test-ordinal_reg-ordinalNet.R +++ b/tests/testthat/test-ordinal_reg-ordinalNet.R @@ -42,7 +42,7 @@ test_that("model object (penalty path from original to tidy)", { ) tidy_spec <- - ordinal_reg(penalty = 0.01, mixture = .5, odds_link = "stopping") |> + ordinal_reg(penalty = 0.01, mixture = .5, odds_link = "stopping_ratio") |> set_engine("ordinalNet", path_values = !!orig_fit$lambdaVals) set.seed(seed) tidy_fit <- fit(tidy_spec, Sat ~ Type + Infl + Cont, data = house_sub) @@ -90,7 +90,7 @@ test_that("model object (penalty path from tidy to original)", { # extra arguments tidy_spec <- - ordinal_reg(penalty = 0.001, mixture = .5, odds_link = "stopping") |> + ordinal_reg(penalty = 0.001, mixture = .5, odds_link = "stopping_ratio") |> set_engine("ordinalNet") set.seed(seed) tidy_fit <- fit(tidy_spec, Sat ~ Type + Infl + Cont, data = house_sub) @@ -180,7 +180,7 @@ test_that("case weights", { tidy_spec <- ordinal_reg(penalty = 0.01) |> set_engine("ordinalNet", path_values = !!orig_fit$lambdaVals) |> - set_args(mixture = .5, odds_link = "stopping") + set_args(mixture = .5, odds_link = "stopping_ratio") tidy_data <- transform(house_data, Freq = frequency_weights(Freq)) set.seed(seed) tidy_fit <- fit( @@ -437,7 +437,7 @@ test_that("arguments agree", { ordinal_reg( penalty = 0.1, mixture = .25, - ordinal_link = "cloglog", odds_link = "stopping" + ordinal_link = "cloglog", odds_link = "stopping_ratio" ) |> set_mode("classification") |> set_engine("ordinalNet", path_values = 10 ^ seq(-6, -1)) diff --git a/tests/testthat/test-ordinal_reg-polr.R b/tests/testthat/test-ordinal_reg-polr.R index fe90782..8568312 100644 --- a/tests/testthat/test-ordinal_reg-polr.R +++ b/tests/testthat/test-ordinal_reg-polr.R @@ -11,9 +11,9 @@ test_that("specification handles model parameters", { # an unavailable odds link function acat_spec <- ordinal_reg(engine = "polr", odds_link = "adjacent_categories") - expect_warning( + expect_error( fit(acat_spec, Sat ~ Type + Infl + Cont, data = house_sub), - "polr.*cumulative[ \\_]link" + "polr.*cumulative.*link" ) }) From 5b09476e7d1e39b81ae6e398271456c6fa12b119 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 31 Aug 2026 16:07:22 -0400 Subject: [PATCH 13/45] add intercept-only section --- ignore/parallel-regression-assumption.Rmd | 113 ++++++++++++++++++++++ 1 file changed, 113 insertions(+) diff --git a/ignore/parallel-regression-assumption.Rmd b/ignore/parallel-regression-assumption.Rmd index 85cfccb..ce5431d 100644 --- a/ignore/parallel-regression-assumption.Rmd +++ b/ignore/parallel-regression-assumption.Rmd @@ -659,6 +659,119 @@ data.frame( These should be identical (same model, different parameterization). +## Intercept-only model: relaxing parallelism with no variable predictors + +When the model contains only an intercept and no variable predictors, the +parallel regression assumption has nothing to differentiate: there are no +slope coefficients to make category-specific. Relaxing parallelism "for all +terms" therefore reduces to asking each engine what it does with its +intercepts when instructed to estimate non-parallel terms, which the engines +handle very differently. + +The four engines, fit to the intercept-only model `Sat ~ 1`: + +- `vglm`: `parallel = FALSE` +- `clm`: `nominal = ~ 1` +- `ordinalNet`: `parallelTerms = FALSE, nonparallelTerms = TRUE` +- `brm`: `Sat ~ cs(1)` (a degenerate request, since `cs()` has no term to wrap) + +
+`vglm`: `parallel = FALSE` on an intercept-only model + +```{r vglm-int-only} +vglm_int_par <- vglm( + Sat ~ 1, data = housing_long, + family = VGAM::cumulative(link = "logitlink", parallel = TRUE) +) +vglm_int_npar <- vglm( + Sat ~ 1, data = housing_long, + family = VGAM::cumulative(link = "logitlink", parallel = FALSE) +) + +coef(vglm_int_par, matrix = TRUE) +coef(vglm_int_npar, matrix = TRUE) +all.equal(coef(vglm_int_par, matrix = TRUE), coef(vglm_int_npar, matrix = TRUE)) +``` + +
+ +`vglm` treats the intercept as category-specific regardless of the +`parallel` setting, so `parallel = FALSE` changes nothing: the two fits have +identical thresholds and identical log-likelihoods. Relaxing parallelism is a +no-op when there are no variable predictors. + +
+`clm`: `nominal = ~ 1` on an intercept-only model + +```{r clm-int-only} +clm_int_par <- clm(Sat ~ 1, data = housing_long, link = "logit") +clm_int_npar <- clm(Sat ~ 1, data = housing_long, link = "logit", + nominal = ~ 1) + +coef(clm_int_par) +coef(clm_int_npar) +all.equal(unname(coef(clm_int_par)), unname(coef(clm_int_npar))) +``` + +
+ +`clm` accepts `nominal = ~ 1` and simply re-labels the threshold intercepts +as `Threshold.(Intercept)` terms, but their estimates are numerically +identical to the plain parallel fit. As with `vglm`, there are no variable +effects to relax, so relaxing parallelism does not change the model. The +`nominal = ~ .` form, which names "all" terms, is degenerate here: with no +full-rank predictor, the resulting fit is near-singular and fails to +converge. + +
+`ordinalNet`: intercept-only model (zero predictor columns) + +```{r ordinalNet-int-only, error=TRUE} +x_mat_int <- model.matrix(~ 1, data = housing_long)[, -1] +on_int <- ordinalNet( + x = x_mat_int, y = housing_long$Sat, + family = "cumulative", link = "logit", + parallelTerms = FALSE, nonparallelTerms = TRUE, + lambdaVals = 0, nLambda = 1 +) +``` + +
+ +`ordinalNet` fits from a predictor matrix rather than a formula, and it +requires at least one predictor column. With zero columns (the intercept-only +case), it throws `"subscript out of bounds"` before fitting, for both the +parallel and the non-parallel flag settings. So `ordinalNet` cannot express +even the simplest intercept-only model through its matrix interface, let +alone relax parallelism in one. + +
+`brm`: intercept-only model and `cs()` + +```{r brm-int-only, cache=TRUE} +brms_int <- brm( + Sat ~ 1, data = housing_long, + family = brms::cumulative("logit"), + chains = 4, iter = 2000, warmup = 1000, + silent = 2, refresh = 0 +) + +brms::fixef(brms_int) +``` + +
+ +`brm`'s `cs()` special attaches to individual predictor terms, so with an +intercept-only model there is no term to wrap and `cs()` has no effect. The +intercepts remain a single set of category-specific thresholds, and the +posterior means match the `vglm`/`clm` estimates. + +In summary, relaxing parallelism for "all terms" of an intercept-only model +is vacuous for `vglm`, `clm`, and `brm` --- each leaves the intercepts (which +are always category-specific) unchanged --- while `ordinalNet` cannot fit the +model at all because its matrix interface demands at least one predictor +column. + # Engine-specific parameterizations ## `vglm`: equivalent formula formulations From c58f4a3c7001b0945f2ed95e78352587050d5cce Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 31 Aug 2026 20:32:28 -0400 Subject: [PATCH 14/45] move clm wrapper from parsnip - pairs with parsnip@ea1eec4 --- DESCRIPTION | 2 +- NAMESPACE | 1 + NEWS.md | 1 + R/ordinal_reg-clm.R | 99 +++++++++++++ R/ordinal_reg-data.R | 2 +- _pkgdown.yml | 1 + man/clm_wrapper.Rd | 55 +++++++ .../_snaps/ordinal_reg-clm-wrapper.md | 8 + tests/testthat/_snaps/ordinal_reg-clm.md | 7 +- tests/testthat/test-ordinal_reg-clm-wrapper.R | 140 ++++++++++++++++++ tests/testthat/test-ordinal_reg-clm.R | 7 +- 11 files changed, 315 insertions(+), 8 deletions(-) create mode 100644 R/ordinal_reg-clm.R create mode 100644 man/clm_wrapper.Rd create mode 100644 tests/testthat/_snaps/ordinal_reg-clm-wrapper.md create mode 100644 tests/testthat/test-ordinal_reg-clm-wrapper.R diff --git a/DESCRIPTION b/DESCRIPTION index e11d30a..552e177 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ordered Title: 'parsnip' Engines and Wrappers for Ordinal Classification Models -Version: 0.1.0.9002 +Version: 0.1.0.9003 Authors@R: c( person("Max", "Kuhn", , "max@posit.co", role = "aut", diff --git a/NAMESPACE b/NAMESPACE index 8f9461b..285eb65 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,7 @@ S3method(predict_classprob,"_ordinalNet") S3method(predict_raw,"_ordinalNet") export(VGAM_vgam_wrapper) export(VGAM_vglm_wrapper) +export(clm_wrapper) export(honesty) export(honesty_fraction) export(naive_scores) diff --git a/NEWS.md b/NEWS.md index 0d0c330..8f7251f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,6 +11,7 @@ Now `predictvglm()` is used instead. This version introduces source code and unit tests for new engines: * `clm` from the **ordinal** package - cumulative link ordinal regression + - fit wrapper to translate formulae - additional `ordinal_link` dial values * `lrm` and `orm` from the **rms** package - regularized cumulative probability ordinal regression diff --git a/R/ordinal_reg-clm.R b/R/ordinal_reg-clm.R new file mode 100644 index 0000000..b480c4a --- /dev/null +++ b/R/ordinal_reg-clm.R @@ -0,0 +1,99 @@ +#' Fit wrapper for `ordinal::clm()` +#' +#' Fit `clm()`, translating `parallel_reg` into the `nominal` formula. This is +#' done here rather than in [parsnip::translate()] because the formula can only +#' be split once `data` is known, and because the standard translation +#' (`make_form_call()`) overwrites any location formula that `translate()` sets. +#' @param formula The formula to pass. +#' @param data The data frame to pass. +#' @param weights An optional vector of case weights to pass. +#' @param parallel_reg Logical; whether predictor effects are shared across +#' thresholds. When `FALSE`, every predictor is moved to a `nominal` formula. +#' @param ... Additional arguments to pass. +#' @param call The execution environment of a currently running function. +#' @keywords internal +#' @returns An object of class `clm` as returned by [ordinal::clm()]. +#' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("ordinal") +#' house_data <- +#' MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] +#' # parallel regression assumption +#' ( fit_orig <- ordinal::clm(Sat ~ Type + Cont, data = house_data) ) +#' ( fit_wrap <- clm_wrapper(Sat ~ Type + Cont, data = house_data) ) +#' # non-parallelism +#' ( fit_orig <- ordinal::clm( +#' Sat ~ 1, data = house_data, nominal = ~ Infl + Cont +#' ) ) +#' ( fit_wrap <- clm_wrapper( +#' Sat ~ Infl + Cont, data = house_data, parallel_reg = FALSE +#' ) ) +#' @export +clm_wrapper <- function( + formula, + data, + weights = NULL, + parallel_reg = NULL, + ..., + call = rlang::caller_env() +) { + rlang::check_installed("ordinal") + + # capture before forcing the promises, so that the rebuilt call below records + # engine arguments as the user wrote them rather than as their values + dot_exprs <- rlang::enexprs(...) + dots <- list(...) + + formulas <- if (isFALSE(parallel_reg)) { + clm_formulas(formula, data, call = call) + } else { + list(formula = formula) + } + + args <- c(formulas, list(data = data), dots) + if (! is.null(weights)) { + args$weights <- weights + } + + res <- do.call(ordinal::clm, args) + + # `do.call()` inlines the data into the recorded call. Rebuild it so that + # printing the fit shows the formulas and engine arguments that were used. + res$call <- rlang::call2( + "clm", + !!! formulas, + data = rlang::sym("data"), + !!! dot_exprs, + .ns = "ordinal" + ) + + res +} + +# Split a model formula into the location and `nominal` formulas that +# `ordinal::clm()` expects when the parallel regression assumption is relaxed. +# Every predictor moves to `nominal`, leaving an intercept-only location +# formula, so that `clm()` has no aliased coefficients to drop. An offset has no +# coefficient to vary across thresholds, so it stays in the location formula. +clm_formulas <- function(formula, data, call = rlang::caller_env()) { + term_info <- terms(formula, data = data) + term_labels <- attr(term_info, "term.labels") + offset <- attr(term_info, "offset") + + if (length(term_labels) == 0L) { + cli::cli_abort( + "{.code parallel_reg = FALSE} needs at least one predictor to make + non-parallel, but {.arg formula} has none.", + call = call + ) + } + + loc <- formula + loc[[3]] <- if (length(offset)) { + as.list(attr(term_info, "variables"))[[offset + 1L]] + } else { + 1 + } + + nominal <- stats::reformulate(term_labels, env = rlang::f_env(formula)) + + list(formula = loc, nominal = nominal) +} diff --git a/R/ordinal_reg-data.R b/R/ordinal_reg-data.R index de4aada..6e4acef 100644 --- a/R/ordinal_reg-data.R +++ b/R/ordinal_reg-data.R @@ -815,7 +815,7 @@ make_ordinal_reg_clm <- function() { value = list( interface = "formula", protect = c("formula", "data", "weights"), - func = c(pkg = "ordinal", fun = "clm"), + func = c(pkg = "ordered", fun = "clm_wrapper"), defaults = list() ) ) diff --git a/_pkgdown.yml b/_pkgdown.yml index 9a78b2a..24c6799 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -13,6 +13,7 @@ reference: desc: > Wrappers for Ordinal Classification Engines contents: + - '`clm_wrapper`' - '`ordinalNet_wrapper`' - '`predict_glmnetcr_wrapper`' - '`VGAM_vglm_wrapper`' diff --git a/man/clm_wrapper.Rd b/man/clm_wrapper.Rd new file mode 100644 index 0000000..fc9c66f --- /dev/null +++ b/man/clm_wrapper.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ordinal_reg-clm.R +\name{clm_wrapper} +\alias{clm_wrapper} +\title{Fit wrapper for \code{ordinal::clm()}} +\usage{ +clm_wrapper( + formula, + data, + weights = NULL, + parallel_reg = NULL, + ..., + call = rlang::caller_env() +) +} +\arguments{ +\item{formula}{The formula to pass.} + +\item{data}{The data frame to pass.} + +\item{weights}{An optional vector of case weights to pass.} + +\item{parallel_reg}{Logical; whether predictor effects are shared across +thresholds. When \code{FALSE}, every predictor is moved to a \code{nominal} formula.} + +\item{...}{Additional arguments to pass.} + +\item{call}{The execution environment of a currently running function.} +} +\value{ +An object of class \code{clm} as returned by \code{\link[ordinal:clm]{ordinal::clm()}}. +} +\description{ +Fit \code{clm()}, translating \code{parallel_reg} into the \code{nominal} formula. This is +done here rather than in \code{\link[parsnip:translate]{parsnip::translate()}} because the formula can only +be split once \code{data} is known, and because the standard translation +(\code{make_form_call()}) overwrites any location formula that \code{translate()} sets. +} +\examples{ +\dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("ordinal")) withAutoprint(\{ # examplesIf} +house_data <- + MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] +# parallel regression assumption +( fit_orig <- ordinal::clm(Sat ~ Type + Cont, data = house_data) ) +( fit_wrap <- clm_wrapper(Sat ~ Type + Cont, data = house_data) ) +# non-parallelism +( fit_orig <- ordinal::clm( + Sat ~ 1, data = house_data, nominal = ~ Infl + Cont +) ) +( fit_wrap <- clm_wrapper( + Sat ~ Infl + Cont, data = house_data, parallel_reg = FALSE +) ) +\dontshow{\}) # examplesIf} +} +\keyword{internal} diff --git a/tests/testthat/_snaps/ordinal_reg-clm-wrapper.md b/tests/testthat/_snaps/ordinal_reg-clm-wrapper.md new file mode 100644 index 0000000..42cfdc4 --- /dev/null +++ b/tests/testthat/_snaps/ordinal_reg-clm-wrapper.md @@ -0,0 +1,8 @@ +# clm_formulas() rejects a formula with no predictors + + Code + clm_formulas(rating ~ 1, d) + Condition + Error: + ! `parallel_reg = FALSE` needs at least one predictor to make non-parallel, but `formula` has none. + diff --git a/tests/testthat/_snaps/ordinal_reg-clm.md b/tests/testthat/_snaps/ordinal_reg-clm.md index 4f6981c..c141d12 100644 --- a/tests/testthat/_snaps/ordinal_reg-clm.md +++ b/tests/testthat/_snaps/ordinal_reg-clm.md @@ -17,7 +17,8 @@ Computational engine: clm Model fit template: - ordinal::clm(formula = missing_arg(), data = missing_arg(), weights = missing_arg()) + ordered::clm_wrapper(formula = missing_arg(), data = missing_arg(), + weights = missing_arg()) --- @@ -74,6 +75,6 @@ Computational engine: clm Model fit template: - ordinal::clm(formula = missing_arg(), data = missing_arg(), weights = missing_arg(), - link = "probit") + ordered::clm_wrapper(formula = missing_arg(), data = missing_arg(), + weights = missing_arg(), link = "probit") diff --git a/tests/testthat/test-ordinal_reg-clm-wrapper.R b/tests/testthat/test-ordinal_reg-clm-wrapper.R new file mode 100644 index 0000000..279e22e --- /dev/null +++ b/tests/testthat/test-ordinal_reg-clm-wrapper.R @@ -0,0 +1,140 @@ +test_that("clm_formulas() splits a formula into location and nominal parts", { + d <- data.frame( + rating = ordered(rep(1:3, 4)), + temp = rep(c("cold", "warm"), 6), + contact = rep(c("no", "yes"), each = 6) + ) + + res <- clm_formulas(rating ~ temp + contact, d) + + expect_equal(res$formula, rating ~ 1) + expect_equal(res$nominal, ~ temp + contact) +}) + +test_that("clm_formulas() expands a dot without capturing the outcome", { + d <- data.frame( + rating = ordered(rep(1:3, 4)), + temp = rep(c("cold", "warm"), 6), + contact = rep(c("no", "yes"), each = 6) + ) + + res <- clm_formulas(rating ~ ., d) + + expect_equal(res$formula, rating ~ 1) + expect_equal(res$nominal, ~ temp + contact) +}) + +test_that("clm_formulas() preserves the formula environment", { + d <- data.frame(rating = ordered(rep(1:3, 4)), temp = rep(c("a", "b"), 6)) + f <- rating ~ temp + + res <- clm_formulas(f, d) + + expect_identical(rlang::f_env(res$nominal), rlang::f_env(f)) +}) + +test_that("clm_formulas() keeps an offset in the location formula only", { + d <- data.frame( + rating = ordered(rep(1:3, 4)), + temp = rep(c("a", "b"), 6), + off = seq_len(12) / 12 + ) + + res <- clm_formulas(rating ~ temp + offset(off), d) + + expect_equal(res$formula, rating ~ offset(off)) + expect_equal(res$nominal, ~temp) +}) + +test_that("clm_formulas() carries transformations and odd names through", { + d <- data.frame(rating = ordered(rep(1:3, 4)), x = seq_len(12) / 12) + d[["not valid"]] <- rep(c("a", "b"), 6) + + res <- clm_formulas(rating ~ `not valid` + log(x) + poly(x, 2), d) + + expect_equal( + rlang::f_rhs(res$nominal), + rlang::expr(`not valid` + log(x) + poly(x, 2)) + ) +}) + +test_that("clm_formulas() rejects a formula with no predictors", { + d <- data.frame(rating = ordered(rep(1:3, 4))) + + expect_snapshot(error = TRUE, { + clm_formulas(rating ~ 1, d) + }) +}) + +test_that("clm_wrapper() moves every predictor to nominal when not parallel", { + skip_if_not_installed("ordinal") + soup <- ordinal::soup + + res <- clm_wrapper(SURENESS ~ PROD + DAY, data = soup, parallel_reg = FALSE) + exp <- ordinal::clm(SURENESS ~ 1, nominal = ~ PROD + DAY, data = soup) + + expect_equal(coef(res), coef(exp)) + expect_equal(logLik(res), logLik(exp)) +}) + +test_that("clm_wrapper() fits a plain model when parallel", { + skip_if_not_installed("ordinal") + soup <- ordinal::soup + exp <- ordinal::clm(SURENESS ~ PROD + DAY, data = soup) + + expect_equal(coef(clm_wrapper(SURENESS ~ PROD + DAY, data = soup)), coef(exp)) + expect_equal( + coef(clm_wrapper(SURENESS ~ PROD + DAY, data = soup, parallel_reg = TRUE)), + coef(exp) + ) +}) + +test_that("clm_wrapper() records the formulas it used in the call", { + skip_if_not_installed("ordinal") + soup <- ordinal::soup + + res <- clm_wrapper(SURENESS ~ PROD + DAY, data = soup, parallel_reg = FALSE) + expect_equal(res$call$formula, SURENESS ~ 1) + expect_equal(res$call$nominal, ~ PROD + DAY) + + res <- clm_wrapper(SURENESS ~ PROD + DAY, data = soup) + expect_equal(res$call$formula, SURENESS ~ PROD + DAY) + expect_null(res$call$nominal) +}) + +test_that("clm_wrapper() passes `nominal` through for partial parallelism", { + skip_if_not_installed("ordinal") + soup <- ordinal::soup + + res <- clm_wrapper(SURENESS ~ PROD, data = soup, nominal = ~DAY) + exp <- ordinal::clm(SURENESS ~ PROD, nominal = ~DAY, data = soup) + + expect_equal(coef(res), coef(exp)) +}) + +test_that("clm_wrapper() records arguments passed through `...` in the call", { + skip_if_not_installed("ordinal") + soup <- ordinal::soup + + res <- clm_wrapper( + SURENESS ~ PROD, + data = soup, + parallel_reg = FALSE, + link = "probit" + ) + expect_equal(res$call$link, "probit") + + res <- clm_wrapper(SURENESS ~ PROD, data = soup, nominal = ~DAY) + expect_equal(res$call$nominal, rlang::expr(~DAY)) + + # recorded as written, so that bulky arguments do not bloat the call + res <- clm_wrapper( + SURENESS ~ PROD, + data = soup, + control = ordinal::clm.control(maxIter = 200) + ) + expect_equal( + res$call$control, + rlang::expr(ordinal::clm.control(maxIter = 200)) + ) +}) diff --git a/tests/testthat/test-ordinal_reg-clm.R b/tests/testthat/test-ordinal_reg-clm.R index 03221eb..604574c 100644 --- a/tests/testthat/test-ordinal_reg-clm.R +++ b/tests/testthat/test-ordinal_reg-clm.R @@ -238,7 +238,7 @@ test_that("parallel regression argument handles logicals", { set.seed(seed) orig_fit <- ordinal::clm( - Sat ~ Infl + Cont, data = house_sub, + Sat ~ 1, data = house_sub, nominal = ~ Infl + Cont ) @@ -257,8 +257,9 @@ test_that("parallel regression argument handles logicals", { set.seed(seed) suppressWarnings( orig_fit <- ordinal::clm( - Sat ~ Infl * Cont, data = house_sub, - nominal = ~ Infl * Cont + Sat ~ 1, data = house_sub, + # wrapper expands full interaction expressions into summands + nominal = ~ Infl + Cont + Infl:Cont ) ) From 31ba30dbedbeebbdd387b884d9217e79ae6127db Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Tue, 1 Sep 2026 05:23:26 -0400 Subject: [PATCH 15/45] harmonize wrapper documentation & messages + call terms() via double-colon --- R/decision_tree-rpartScore.R | 2 +- R/ordinal_reg-VGAM.R | 7 +++---- R/ordinal_reg-clm.R | 2 +- R/ordinal_reg-glmnetcr.R | 19 +++++++++++-------- R/ordinal_reg-ordinalNet.R | 6 ++++-- R/ordinal_reg-rms.R | 6 +++--- R/rand_forest-ordinalForest.R | 6 +++--- R/rand_forest-orf.R | 33 +++++++++++---------------------- man/VGAM_vglm_wrapper.Rd | 6 +++--- man/ordinalForest_wrapper.Rd | 6 +++--- man/ordinalNet_wrapper.Rd | 2 +- man/orf_class_post.Rd | 21 --------------------- man/orf_prob_post.Rd | 21 --------------------- man/orf_wrapper.Rd | 10 +++++----- man/predict_glmnetcr_wrapper.Rd | 8 ++++---- man/predict_lrm_wrapper.Rd | 6 +++--- man/rpartScore_wrapper.Rd | 2 +- 17 files changed, 57 insertions(+), 106 deletions(-) delete mode 100644 man/orf_class_post.Rd delete mode 100644 man/orf_prob_post.Rd diff --git a/R/decision_tree-rpartScore.R b/R/decision_tree-rpartScore.R index 0fb145f..eed57b8 100644 --- a/R/decision_tree-rpartScore.R +++ b/R/decision_tree-rpartScore.R @@ -1,4 +1,4 @@ -#' A wrapper for `rpartScore` +#' Fit wrapper for `rpartScore` #' #' A wrapper is used because the model interface requires the response variable #' to be numeric rather than ordered or factor; the wrapper edits the input diff --git a/R/ordinal_reg-VGAM.R b/R/ordinal_reg-VGAM.R index 62845e8..ae9153f 100644 --- a/R/ordinal_reg-VGAM.R +++ b/R/ordinal_reg-VGAM.R @@ -1,4 +1,4 @@ -#' Wrappers for `VGAM` +#' Fit wrappers for `VGAM` #' #' These wrappers reorganize arguments into proper calls to [VGAM::vglm()] and #' [VGAM::vgam()], which specialize to several families of ordinal regression @@ -19,10 +19,10 @@ #' @param family The `VGAM` family function, as a character string (e.g. #' `"cumulative"`, `"acat"`, `"cratio"`, `"sratio"`). #' @param link The `VGAM` link function (e.g. `"logitlink"`). -#' @param parallel A logical; whether predictor effects are shared across +#' @param parallel Logical; whether predictor effects are shared across #' thresholds. It corresponds to the standardized `parallel_reg` argument (see #' [dials::parallel_reg()]). -#' @param Thresh A character; the threshold constraint pattern. It corresponds +#' @param Thresh Character; the threshold constraint pattern. It corresponds #' to the standardized `threshold_structure` argument (see #' [dials::threshold_structure()]). #' @param ... Additional arguments to pass. @@ -42,7 +42,6 @@ #' dials::ordinal_link(values = values_ordinal_link_VGAM) #' values_threshold_structure_VGAM #' dials::threshold_structure(values = values_threshold_structure_VGAM) - #' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("VGAM") #' house_data <- #' MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] diff --git a/R/ordinal_reg-clm.R b/R/ordinal_reg-clm.R index b480c4a..8e453bd 100644 --- a/R/ordinal_reg-clm.R +++ b/R/ordinal_reg-clm.R @@ -74,7 +74,7 @@ clm_wrapper <- function( # formula, so that `clm()` has no aliased coefficients to drop. An offset has no # coefficient to vary across thresholds, so it stays in the location formula. clm_formulas <- function(formula, data, call = rlang::caller_env()) { - term_info <- terms(formula, data = data) + term_info <- stats::terms(formula, data = data) term_labels <- attr(term_info, "term.labels") offset <- attr(term_info, "offset") diff --git a/R/ordinal_reg-glmnetcr.R b/R/ordinal_reg-glmnetcr.R index 9f0f751..48059a7 100644 --- a/R/ordinal_reg-glmnetcr.R +++ b/R/ordinal_reg-glmnetcr.R @@ -1,14 +1,14 @@ -#' Prediction wrapper for `glmnetcr` +#' Predict wrapper for `glmnetcr` #' #' Selects predictions at a specific penalty value from the regularization path. -#' When the requested penalty lies between two path values, linearly interpolates -#' between the probability matrices at the neighboring steps. +#' When the requested penalty lies between two path values, linearly +#' interpolates between the probability matrices at the neighboring steps. #' @param object A `glmnetcr` object. #' @param newx A predictor matrix. #' @param type Either `"class"` or `"prob"`. #' @param lambda A penalty value at which to predict. If `NULL`, the step #' minimizing `criteria` is used. -#' @param criteria Criterion by which to select `lambda` within the path +#' @param criteria The criterion by which to select `lambda` within the path #' sequence. Defaults to `"bic"` for consistency with #' [glmnetcr::predict.glmnetcr()]. (NB: This contrasts with #' [predict_ordinalNet_wrapper()].) @@ -103,7 +103,7 @@ predict_glmnetcr_wrapper <- function( ) } - return(res) + res } # S3 methods for parsnip's model_fit dispatch ---------------------------------- @@ -117,7 +117,7 @@ predict._glmnetcr <- function( object, new_data, type = NULL, opts = list(), penalty = NULL, ... ) { - if (is.null(penalty) && !is.null(object$spec$args$penalty)) { + if (is.null(penalty) && ! is.null(object$spec$args$penalty)) { penalty <- object$spec$args$penalty } object$spec$args$penalty <- penalty @@ -159,7 +159,7 @@ multi_predict._glmnetcr <- function( object$spec <- eval_args(object$spec) if (is.null(penalty)) { - if (!is.null(object$spec$args$penalty)) { + if (! is.null(object$spec$args$penalty)) { penalty <- object$spec$args$penalty } else { penalty <- object$fit$lambda @@ -179,7 +179,10 @@ multi_predict._glmnetcr <- function( object, new_data = new_data, penalty = penalty ), "raw" = rlang::abort( - "`type = 'raw'` is not yet supported for `multi_predict` with the `glmnetcr` engine." + paste0( + "`type = 'raw'` is not yet supported for `multi_predict` with the ", + "`glmnetcr` engine." + ) ) ) diff --git a/R/ordinal_reg-ordinalNet.R b/R/ordinal_reg-ordinalNet.R index 92e5e7d..a4910b8 100644 --- a/R/ordinal_reg-ordinalNet.R +++ b/R/ordinal_reg-ordinalNet.R @@ -1,4 +1,4 @@ -#' Wrappers for `ordinalNet` +#' Fit and predict wrappers for `ordinalNet` #' #' The fit wrapper restructures case weights and reorganizes arguments into a #' call to [ordinalNet::ordinalNet()]. The prediction wrapper interpolates @@ -80,7 +80,9 @@ ordinalNet_wrapper <- function( # throw error if penalty factor would go unused if (! parallelTerms && parallelPenaltyFactor != 1) { - abort("{.arg parallelPenaltyFactor} cannot be used without parallel terms.") + cli::cli_abort( + "{.arg parallelPenaltyFactor} cannot be used without parallel terms." + ) } # restructure based on weights (requires `y` to be a factor) diff --git a/R/ordinal_reg-rms.R b/R/ordinal_reg-rms.R index 6d5b26f..611ee24 100644 --- a/R/ordinal_reg-rms.R +++ b/R/ordinal_reg-rms.R @@ -1,4 +1,4 @@ -#' Wrapper for `rms` predictions +#' Predict wrapper for `rms` #' #' `rms::lrm()` and `rms::orm()` use [rms::predictrms()] internally, which #' does not accept tibble inputs. This wrapper ensures that `newdata` is @@ -6,10 +6,10 @@ #' @param object A fitted model object of class `"lrm"` or `"orm"`. #' @param newdata A data frame or tibble of predictors. #' @param type The prediction type, passed to the underlying method. -#' @param ... Additional arguments passed to the underlying method. +#' @param ... Additional arguments to pass. #' @keywords internal #' @returns The result of [stats::predict()] dispatched on `object`. -#' @examplesIf rlang::is_installed("rms") && rlang::is_installed("MASS") +#' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("rms") #' house_data <- #' MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] #' ( fit <- rms::lrm(Sat ~ Infl + Type + Cont, data = house_data) ) diff --git a/R/rand_forest-ordinalForest.R b/R/rand_forest-ordinalForest.R index a91ce1c..bd4487f 100644 --- a/R/rand_forest-ordinalForest.R +++ b/R/rand_forest-ordinalForest.R @@ -1,10 +1,10 @@ -#' A wrapper for `ordinalForest` +#' Fit wrapper for `ordinalForest` #' #' A wrapper is needed since they have a non-standard model interface that -#' required the data set and the column name (character string) for the outcome. +#' requires the data set and the column name (character string) for the outcome. #' @param x The predictor data. #' @param y The outcome factor. -#' @param ... Arguments to pass to the underlying model function. +#' @param ... Additional arguments to pass. #' @keywords internal #' @returns An object of S3 class `ordfor` as returned by #' [ordinalForest::ordfor()]. diff --git a/R/rand_forest-orf.R b/R/rand_forest-orf.R index ce6856d..3fc71a1 100644 --- a/R/rand_forest-orf.R +++ b/R/rand_forest-orf.R @@ -1,32 +1,33 @@ -#' A wrapper for `orf` +#' Fit wrapper for `orf` #' #' The `orf` package uses a non-standard interface that requires the predictor #' matrix `X` and the outcome vector `Y` as separate arguments, with `Y` as a #' numeric vector. This wrapper converts the parsnip-standard data.frame (`X`) #' and factor (`Y`) to the required formats before calling [orf::orf()]. -#' #' @param X The predictor data (data.frame). #' @param Y The outcome factor. -#' @param ... Arguments to pass to [orf::orf()]. +#' @param ... Additional arguments to pass. #' @keywords internal #' @returns An object of S3 class `orf` as returned by [orf::orf()]. -#' @examplesIf rlang::is_installed("orf") && rlang::is_installed("MASS") +#' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("orf") #' house_data <- #' MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] #' house_data <- house_data[sample(nrow(house_data), 50), ] #' # encode factors as dummy variables before passing to wrapper #' X_mat <- model.matrix(~ Infl + Type + Cont - 1, data = house_data) #' # fit wrapper -#' (fit_wrap <- orf_wrapper( +#' ( fit_wrap <- orf_wrapper( #' X = X_mat, #' Y = house_data$Sat, #' num.trees = 10 -#' )) +#' ) ) #' @export orf_wrapper <- function(X, Y, ...) { rlang::check_installed("orf") X <- as.matrix(X) Y <- as.numeric(Y) + + # execute call on modified inputs cl <- rlang::call2( .fn = "orf", .ns = "orf", X = X, Y = Y, ... @@ -34,27 +35,15 @@ orf_wrapper <- function(X, Y, ...) { rlang::eval_tidy(cl) } -#' Post-processing for `orf` class predictions -#' -#' Converts the `orf.prediction` object from [predict.orf()] to a factor -#' vector of predicted classes. -#' @param x An `orf.prediction` object from [predict.orf()]. -#' @param object A parsnip `model_fit` object. -#' @keywords internal -#' @returns A factor of predicted classes. +# post-process `orf` class predictions: convert `orf.prediction` object +# to a factor vector orf_class_post <- function(x, object) { pred_class <- x$predictions[, 1] factor(pred_class, levels = seq_along(object$lvl), labels = object$lvl) } -#' Post-processing for `orf` probability predictions -#' -#' Converts the `orf.prediction` object from [predict.orf()] to a tibble of -#' class probabilities with columns named `.pred_{level}`. -#' @param x An `orf.prediction` object from [predict.orf()]. -#' @param object A parsnip `model_fit` object. -#' @keywords internal -#' @returns A tibble of class probabilities. +# post-process `orf` probability predictions: convert `orf.prediction` +# object to a tibble of class probabilities orf_prob_post <- function(x, object) { x <- x$predictions colnames(x) <- paste0(".pred_", object$lvl) diff --git a/man/VGAM_vglm_wrapper.Rd b/man/VGAM_vglm_wrapper.Rd index e4a95e4..44ce50c 100644 --- a/man/VGAM_vglm_wrapper.Rd +++ b/man/VGAM_vglm_wrapper.Rd @@ -5,7 +5,7 @@ \alias{VGAM_vgam_wrapper} \alias{values_ordinal_link_VGAM} \alias{values_threshold_structure_VGAM} -\title{Wrappers for \code{VGAM}} +\title{Fit wrappers for \code{VGAM}} \usage{ VGAM_vglm_wrapper( formula, @@ -41,11 +41,11 @@ values_threshold_structure_VGAM \item{link}{The \code{VGAM} link function (e.g. \code{"logitlink"}).} -\item{parallel}{A logical; whether predictor effects are shared across +\item{parallel}{Logical; whether predictor effects are shared across thresholds. It corresponds to the standardized \code{parallel_reg} argument (see \code{\link[dials:parallel_reg]{dials::parallel_reg()}}).} -\item{Thresh}{A character; the threshold constraint pattern. It corresponds +\item{Thresh}{Character; the threshold constraint pattern. It corresponds to the standardized \code{threshold_structure} argument (see \code{\link[dials:threshold_structure]{dials::threshold_structure()}}).} diff --git a/man/ordinalForest_wrapper.Rd b/man/ordinalForest_wrapper.Rd index caa84ef..377b0db 100644 --- a/man/ordinalForest_wrapper.Rd +++ b/man/ordinalForest_wrapper.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/rand_forest-ordinalForest.R \name{ordinalForest_wrapper} \alias{ordinalForest_wrapper} -\title{A wrapper for \code{ordinalForest}} +\title{Fit wrapper for \code{ordinalForest}} \usage{ ordinalForest_wrapper(x, y, ...) } @@ -11,7 +11,7 @@ ordinalForest_wrapper(x, y, ...) \item{y}{The outcome factor.} -\item{...}{Arguments to pass to the underlying model function.} +\item{...}{Additional arguments to pass.} } \value{ An object of S3 class \code{ordfor} as returned by @@ -19,7 +19,7 @@ An object of S3 class \code{ordfor} as returned by } \description{ A wrapper is needed since they have a non-standard model interface that -required the data set and the column name (character string) for the outcome. +requires the data set and the column name (character string) for the outcome. } \examples{ \dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("ordinalForest")) withAutoprint(\{ # examplesIf} diff --git a/man/ordinalNet_wrapper.Rd b/man/ordinalNet_wrapper.Rd index 0e85368..4f2af0f 100644 --- a/man/ordinalNet_wrapper.Rd +++ b/man/ordinalNet_wrapper.Rd @@ -8,7 +8,7 @@ \alias{predict_raw._ordinalNet} \alias{predict_classprob._ordinalNet} \alias{predict_class._ordinalNet} -\title{Wrappers for \code{ordinalNet}} +\title{Fit and predict wrappers for \code{ordinalNet}} \usage{ ordinalNet_wrapper( x, diff --git a/man/orf_class_post.Rd b/man/orf_class_post.Rd deleted file mode 100644 index de8263e..0000000 --- a/man/orf_class_post.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/rand_forest-orf.R -\name{orf_class_post} -\alias{orf_class_post} -\title{Post-processing for \code{orf} class predictions} -\usage{ -orf_class_post(x, object) -} -\arguments{ -\item{x}{An \code{orf.prediction} object from \code{\link[orf:predict.orf]{predict.orf()}}.} - -\item{object}{A parsnip \code{model_fit} object.} -} -\value{ -A factor of predicted classes. -} -\description{ -Converts the \code{orf.prediction} object from \code{\link[orf:predict.orf]{predict.orf()}} to a factor -vector of predicted classes. -} -\keyword{internal} diff --git a/man/orf_prob_post.Rd b/man/orf_prob_post.Rd deleted file mode 100644 index a7ba6b5..0000000 --- a/man/orf_prob_post.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/rand_forest-orf.R -\name{orf_prob_post} -\alias{orf_prob_post} -\title{Post-processing for \code{orf} probability predictions} -\usage{ -orf_prob_post(x, object) -} -\arguments{ -\item{x}{An \code{orf.prediction} object from \code{\link[orf:predict.orf]{predict.orf()}}.} - -\item{object}{A parsnip \code{model_fit} object.} -} -\value{ -A tibble of class probabilities. -} -\description{ -Converts the \code{orf.prediction} object from \code{\link[orf:predict.orf]{predict.orf()}} to a tibble of -class probabilities with columns named \verb{.pred_\{level\}}. -} -\keyword{internal} diff --git a/man/orf_wrapper.Rd b/man/orf_wrapper.Rd index 431a07a..e6c313b 100644 --- a/man/orf_wrapper.Rd +++ b/man/orf_wrapper.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/rand_forest-orf.R \name{orf_wrapper} \alias{orf_wrapper} -\title{A wrapper for \code{orf}} +\title{Fit wrapper for \code{orf}} \usage{ orf_wrapper(X, Y, ...) } @@ -11,7 +11,7 @@ orf_wrapper(X, Y, ...) \item{Y}{The outcome factor.} -\item{...}{Arguments to pass to \code{\link[orf:orf]{orf::orf()}}.} +\item{...}{Additional arguments to pass.} } \value{ An object of S3 class \code{orf} as returned by \code{\link[orf:orf]{orf::orf()}}. @@ -23,18 +23,18 @@ numeric vector. This wrapper converts the parsnip-standard data.frame (\code{X}) and factor (\code{Y}) to the required formats before calling \code{\link[orf:orf]{orf::orf()}}. } \examples{ -\dontshow{if (rlang::is_installed("orf") && rlang::is_installed("MASS")) withAutoprint(\{ # examplesIf} +\dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("orf")) withAutoprint(\{ # examplesIf} house_data <- MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] house_data <- house_data[sample(nrow(house_data), 50), ] # encode factors as dummy variables before passing to wrapper X_mat <- model.matrix(~ Infl + Type + Cont - 1, data = house_data) # fit wrapper -(fit_wrap <- orf_wrapper( +( fit_wrap <- orf_wrapper( X = X_mat, Y = house_data$Sat, num.trees = 10 -)) +) ) \dontshow{\}) # examplesIf} } \keyword{internal} diff --git a/man/predict_glmnetcr_wrapper.Rd b/man/predict_glmnetcr_wrapper.Rd index 59f23a5..e79df7e 100644 --- a/man/predict_glmnetcr_wrapper.Rd +++ b/man/predict_glmnetcr_wrapper.Rd @@ -6,7 +6,7 @@ \alias{predict_class._glmnetcr} \alias{predict_classprob._glmnetcr} \alias{multi_predict._glmnetcr} -\title{Prediction wrapper for \code{glmnetcr}} +\title{Predict wrapper for \code{glmnetcr}} \usage{ predict_glmnetcr_wrapper( object, @@ -41,7 +41,7 @@ predict_glmnetcr_wrapper( \item{lambda}{A penalty value at which to predict. If \code{NULL}, the step minimizing \code{criteria} is used.} -\item{criteria}{Criterion by which to select \code{lambda} within the path +\item{criteria}{The criterion by which to select \code{lambda} within the path sequence. Defaults to \code{"bic"} for consistency with \code{\link[glmnetcr:predict.glmnetcr]{glmnetcr::predict.glmnetcr()}}. (NB: This contrasts with \code{\link[=predict_ordinalNet_wrapper]{predict_ordinalNet_wrapper()}}.)} @@ -56,8 +56,8 @@ probabilities. } \description{ Selects predictions at a specific penalty value from the regularization path. -When the requested penalty lies between two path values, linearly interpolates -between the probability matrices at the neighboring steps. +When the requested penalty lies between two path values, linearly +interpolates between the probability matrices at the neighboring steps. } \examples{ \dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("glmnetcr")) withAutoprint(\{ # examplesIf} diff --git a/man/predict_lrm_wrapper.Rd b/man/predict_lrm_wrapper.Rd index ee8f0af..946f726 100644 --- a/man/predict_lrm_wrapper.Rd +++ b/man/predict_lrm_wrapper.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/ordinal_reg-rms.R \name{predict_lrm_wrapper} \alias{predict_lrm_wrapper} -\title{Wrapper for \code{rms} predictions} +\title{Predict wrapper for \code{rms}} \usage{ predict_lrm_wrapper(object, newdata, type, ...) } @@ -13,7 +13,7 @@ predict_lrm_wrapper(object, newdata, type, ...) \item{type}{The prediction type, passed to the underlying method.} -\item{...}{Additional arguments passed to the underlying method.} +\item{...}{Additional arguments to pass.} } \value{ The result of \code{\link[stats:predict]{stats::predict()}} dispatched on \code{object}. @@ -24,7 +24,7 @@ does not accept tibble inputs. This wrapper ensures that \code{newdata} is converted to a plain data frame before the S3 method is dispatched. } \examples{ -\dontshow{if (rlang::is_installed("rms") && rlang::is_installed("MASS")) withAutoprint(\{ # examplesIf} +\dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("rms")) withAutoprint(\{ # examplesIf} house_data <- MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] ( fit <- rms::lrm(Sat ~ Infl + Type + Cont, data = house_data) ) diff --git a/man/rpartScore_wrapper.Rd b/man/rpartScore_wrapper.Rd index 47e7d03..dd558c3 100644 --- a/man/rpartScore_wrapper.Rd +++ b/man/rpartScore_wrapper.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/decision_tree-rpartScore.R \name{rpartScore_wrapper} \alias{rpartScore_wrapper} -\title{A wrapper for \code{rpartScore}} +\title{Fit wrapper for \code{rpartScore}} \usage{ rpartScore_wrapper(formula, data, ...) } From c27e17bcda985ae2ddbd2a47cd5631e70aa80bd0 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Tue, 1 Sep 2026 08:24:03 -0400 Subject: [PATCH 16/45] relevel news headers --- NEWS.md | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index 8f7251f..2d504fd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,12 +1,16 @@ # next version -## bug fix +## maintenance + +### bug fix A bug in the prediction of `vglm` models, and associated tests, were patched. Previously, `predict()` was used, which triggers S3 dispatch when **VGAM** is not attached but S4 dispatched when it is. Now `predictvglm()` is used instead. -## additional ordinal regression and random forest engines +## new features + +### additional ordinal regression and random forest engines This version introduces source code and unit tests for new engines: * `clm` from the **ordinal** package @@ -27,14 +31,14 @@ This version introduces source code and unit tests for new engines: Coordinated with [parsnip PR #1384](https://github.com/tidymodels/parsnip/pull/1384). -## linear prediction type +### linear prediction type Linear predictions are enabled for the `clm`, `lrm`, `orm`, `vglm`, and `ordinalNet` ordinal regression engines and for the `vgam` generalized additive model engine. They consistently return a single column of linear predictors (without threshold contributions). Coordinated with [parsnip PR #1391](https://github.com/tidymodels/parsnip/pull/1391). -## threshold structure and parallel regression model arguments +### threshold structure and parallel regression model arguments The `threshold_structure` model argument for `ordinal_reg()` controls what constraints, if any, are imposed on the ordered thresholds. It can be used by the `clm` and `vglm` engines. From 3e0fc6ef48a1bd3e543426978b51ff6895a7fdc3 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Tue, 1 Sep 2026 08:41:28 -0400 Subject: [PATCH 17/45] switch from rlang to cli for messages --- R/ordinal_reg-glmnetcr.R | 12 ++++++------ R/ordinal_reg-ordinalNet.R | 4 +++- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/R/ordinal_reg-glmnetcr.R b/R/ordinal_reg-glmnetcr.R index 48059a7..5a34328 100644 --- a/R/ordinal_reg-glmnetcr.R +++ b/R/ordinal_reg-glmnetcr.R @@ -167,7 +167,9 @@ multi_predict._glmnetcr <- function( } if (type != "raw" && length(opts) > 0L) { - rlang::warn("`opts` is only used with `type = 'raw'` and was ignored.") + cli::cli_warn( + "{.arg opts} is only used with {.arg type} = {.val raw} and was ignored." + ) } pred <- switch( @@ -178,11 +180,9 @@ multi_predict._glmnetcr <- function( "class" = multi_predict_class_glmnetcr( object, new_data = new_data, penalty = penalty ), - "raw" = rlang::abort( - paste0( - "`type = 'raw'` is not yet supported for `multi_predict` with the ", - "`glmnetcr` engine." - ) + "raw" = cli::cli_abort( + "{.arg type} = {.val raw} is not yet supported for `multi_predict` + with the {.val glmnetcr} engine." ) ) diff --git a/R/ordinal_reg-ordinalNet.R b/R/ordinal_reg-ordinalNet.R index a4910b8..1aab1b7 100644 --- a/R/ordinal_reg-ordinalNet.R +++ b/R/ordinal_reg-ordinalNet.R @@ -285,7 +285,9 @@ multi_predict._ordinalNet <- function( # adapted from `censored::multi_predict._coxnet` if (type != "raw" && length(opts) > 0L) { - rlang::warn("`opts` is only used with `type = 'raw'` and was ignored.") + cli::cli_warn( + "{.arg opts} is only used with {.arg type} = {.val raw} and was ignored." + ) } pred <- switch( From 297c64c4248adadd4f7c4c257134a5ee43e20f66 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Tue, 1 Sep 2026 09:01:38 -0400 Subject: [PATCH 18/45] correct call stack diagram --- R/ordinal_reg-ordinalNet.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ordinal_reg-ordinalNet.R b/R/ordinal_reg-ordinalNet.R index 1aab1b7..0dea5ae 100644 --- a/R/ordinal_reg-ordinalNet.R +++ b/R/ordinal_reg-ordinalNet.R @@ -210,7 +210,7 @@ approx_prediction_row <- function(values, adjacent, penalty) { # predict._ordinalNet(penalty = NULL) <-- checks and sets penalty # predict.model_fit() <-- checks for extra vars in ... # predict_() <-- dispatches by type -# predict_._ordinalNet() <-- post-processes interpolation +# predict_._ordinalNet() <-- evaluates spec arguments # predict_.model_fit() <-- prepares tidy call # eval_tidy() <-- evaluates tidy call # predict_ordinalNet_wrapper() <-- interpolates penalty From 3ba236bef478bd63844d95137e43e63db59d83f7 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Tue, 1 Sep 2026 09:10:25 -0400 Subject: [PATCH 19/45] adapt call stack diagram to glmnetcr engine --- R/ordinal_reg-glmnetcr.R | 21 +++++++++++++++++++++ R/ordinal_reg-ordinalNet.R | 6 +++--- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/R/ordinal_reg-glmnetcr.R b/R/ordinal_reg-glmnetcr.R index 5a34328..82334f0 100644 --- a/R/ordinal_reg-glmnetcr.R +++ b/R/ordinal_reg-glmnetcr.R @@ -106,6 +106,27 @@ predict_glmnetcr_wrapper <- function( res } +# `glmnetcr` call stack using `predict()` when object has +# classes "_glmnetcr" and "model_fit": +# +# predict() +# predict._glmnetcr(penalty = NULL) <-- checks and sets penalty +# predict.model_fit() <-- checks for extra vars in ... +# predict_() <-- dispatches by type +# predict_._glmnetcr() <-- evaluates spec arguments +# predict_.model_fit() <-- prepares tidy call +# eval_tidy() <-- evaluates tidy call +# predict_glmnetcr_wrapper() <-- interpolates penalty +# predict.glmnetcr() <-- generates predictions + +# `glmnetcr` call stack using `multi_predict()` when object has +# classes "_glmnetcr" and "model_fit": +# +# multi_predict() +# multi_predict._glmnetcr() <-- checks and sets penalty +# multi_predict__glmnetcr() <-- vectorizes over penalties +# predict._glmnetcr(multi = FALSE) <-- (see above) + # S3 methods for parsnip's model_fit dispatch ---------------------------------- #' @rdname predict_glmnetcr_wrapper diff --git a/R/ordinal_reg-ordinalNet.R b/R/ordinal_reg-ordinalNet.R index 0dea5ae..e534f16 100644 --- a/R/ordinal_reg-ordinalNet.R +++ b/R/ordinal_reg-ordinalNet.R @@ -203,7 +203,7 @@ approx_prediction_row <- function(values, adjacent, penalty) { approx(adjacent, values, xout = penalty)$y } -# ordinalNet call stack using `predict()` when object has +# `ordinalNet` call stack using `predict()` when object has # classes "_ordinalNet" and "model_fit": # # predict() @@ -216,12 +216,12 @@ approx_prediction_row <- function(values, adjacent, penalty) { # predict_ordinalNet_wrapper() <-- interpolates penalty # predict.ordinalNet() <-- generates predictions -# ordinalNet call stack using `multi_predict()` when object has +# `ordinalNet` call stack using `multi_predict()` when object has # classes "_ordinalNet" and "model_fit": # # multi_predict() # multi_predict._ordinalNet() <-- checks and sets penalty -# multi_predict__ordinal_net() <-- vectorizes prediction over penalty +# multi_predict__ordinal_net() <-- vectorizes over penalties # predict._ordinalNet(multi = FALSE) <-- (see above) #' @importFrom stats approx as.formula coef predict From 5a9730e60579b8602c7b6f3985ee4b9094aff184 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Tue, 1 Sep 2026 17:31:55 -0400 Subject: [PATCH 20/45] move clm argument revaluing from parsnip translate to ordered wrapper --- R/ordinal_reg-clm.R | 42 +++++++++++++++---- man/clm_wrapper.Rd | 22 +++++++--- tests/testthat/test-ordinal_reg-clm-wrapper.R | 18 ++++++++ 3 files changed, 69 insertions(+), 13 deletions(-) diff --git a/R/ordinal_reg-clm.R b/R/ordinal_reg-clm.R index 8e453bd..4c9bb98 100644 --- a/R/ordinal_reg-clm.R +++ b/R/ordinal_reg-clm.R @@ -16,15 +16,23 @@ #' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("ordinal") #' house_data <- #' MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] -#' # parallel regression assumption -#' ( fit_orig <- ordinal::clm(Sat ~ Type + Cont, data = house_data) ) -#' ( fit_wrap <- clm_wrapper(Sat ~ Type + Cont, data = house_data) ) -#' # non-parallelism +#' # arguments are translated #' ( fit_orig <- ordinal::clm( -#' Sat ~ 1, data = house_data, nominal = ~ Infl + Cont +#' Sat ~ Type + Cont, data = house_data, +#' link = "logit", threshold = "symmetric2" #' ) ) #' ( fit_wrap <- clm_wrapper( -#' Sat ~ Infl + Cont, data = house_data, parallel_reg = FALSE +#' Sat ~ Type + Cont, data = house_data, +#' link = "logistic", threshold = "symmetric_zero" +#' ) ) +#' # relax the parallel regression assumption +#' ( fit_orig <- ordinal::clm( +#' Sat ~ 1, data = house_data, +#' nominal = ~ Infl + Cont +#' ) ) +#' ( fit_wrap <- clm_wrapper( +#' Sat ~ Infl + Cont, data = house_data, +#' parallel_reg = FALSE #' ) ) #' @export clm_wrapper <- function( @@ -32,6 +40,8 @@ clm_wrapper <- function( data, weights = NULL, parallel_reg = NULL, + link = NULL, + threshold = NULL, ..., call = rlang::caller_env() ) { @@ -39,6 +49,7 @@ clm_wrapper <- function( # capture before forcing the promises, so that the rebuilt call below records # engine arguments as the user wrote them rather than as their values + arg_exprs <- rlang::enexprs(link = link, threshold = threshold) dot_exprs <- rlang::enexprs(...) dots <- list(...) @@ -48,10 +59,26 @@ clm_wrapper <- function( list(formula = formula) } - args <- c(formulas, list(data = data), dots) + args <- c(formulas, list(data = data)) if (! is.null(weights)) { args$weights <- weights } + if (! is.null(link)) { + if (link == "logistic") link <- "logit" + args$link <- link + } + if (! is.null(threshold)) { + threshold <- switch( + threshold, + flexible = "flexible", + symmetric_median = "symmetric", + symmetric_zero = "symmetric2", + equidistant = "equidistant", + threshold + ) + args$threshold <- threshold + } + args <- c(args, dots) res <- do.call(ordinal::clm, args) @@ -61,6 +88,7 @@ clm_wrapper <- function( "clm", !!! formulas, data = rlang::sym("data"), + !!! arg_exprs, !!! dot_exprs, .ns = "ordinal" ) diff --git a/man/clm_wrapper.Rd b/man/clm_wrapper.Rd index fc9c66f..5702072 100644 --- a/man/clm_wrapper.Rd +++ b/man/clm_wrapper.Rd @@ -9,6 +9,8 @@ clm_wrapper( data, weights = NULL, parallel_reg = NULL, + link = NULL, + threshold = NULL, ..., call = rlang::caller_env() ) @@ -40,15 +42,23 @@ be split once \code{data} is known, and because the standard translation \dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("ordinal")) withAutoprint(\{ # examplesIf} house_data <- MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] -# parallel regression assumption -( fit_orig <- ordinal::clm(Sat ~ Type + Cont, data = house_data) ) -( fit_wrap <- clm_wrapper(Sat ~ Type + Cont, data = house_data) ) -# non-parallelism +# arguments are translated ( fit_orig <- ordinal::clm( - Sat ~ 1, data = house_data, nominal = ~ Infl + Cont + Sat ~ Type + Cont, data = house_data, + link = "logit", threshold = "symmetric2" ) ) ( fit_wrap <- clm_wrapper( - Sat ~ Infl + Cont, data = house_data, parallel_reg = FALSE + Sat ~ Type + Cont, data = house_data, + link = "logistic", threshold = "symmetric_zero" +) ) +# relax the parallel regression assumption +( fit_orig <- ordinal::clm( + Sat ~ 1, data = house_data, + nominal = ~ Infl + Cont +) ) +( fit_wrap <- clm_wrapper( + Sat ~ Infl + Cont, data = house_data, + parallel_reg = FALSE ) ) \dontshow{\}) # examplesIf} } diff --git a/tests/testthat/test-ordinal_reg-clm-wrapper.R b/tests/testthat/test-ordinal_reg-clm-wrapper.R index 279e22e..351c984 100644 --- a/tests/testthat/test-ordinal_reg-clm-wrapper.R +++ b/tests/testthat/test-ordinal_reg-clm-wrapper.R @@ -112,6 +112,23 @@ test_that("clm_wrapper() passes `nominal` through for partial parallelism", { expect_equal(coef(res), coef(exp)) }) +test_that("clm_wrapper() records relays revalued arguments in the call", { + skip_if_not_installed("ordinal") + soup <- ordinal::soup + + res <- clm_wrapper( + SURENESS ~ PROD, + data = soup, + link = "logistic", threshold = "symmetric_zero" + ) + # unmodified call + expect_equal(res$call$link, "logistic") + expect_equal(res$call$threshold, "symmetric_zero") + # native values + expect_equal(res$info$link, "logit") + expect_equal(res$info$threshold, "symmetric2") +}) + test_that("clm_wrapper() records arguments passed through `...` in the call", { skip_if_not_installed("ordinal") soup <- ordinal::soup @@ -124,6 +141,7 @@ test_that("clm_wrapper() records arguments passed through `...` in the call", { ) expect_equal(res$call$link, "probit") + # absent `parallel_reg`, `nominal` is accepted res <- clm_wrapper(SURENESS ~ PROD, data = soup, nominal = ~DAY) expect_equal(res$call$nominal, rlang::expr(~DAY)) From c664f673ec0875e0e38c7b102737fe7ad64eddce Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Tue, 1 Sep 2026 21:48:21 -0400 Subject: [PATCH 21/45] revise & update clm tinker script per changes to wrapper + parallel_reg arg --- ignore/tinker-clm.R | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/ignore/tinker-clm.R b/ignore/tinker-clm.R index 6cda1a3..ec63b95 100644 --- a/ignore/tinker-clm.R +++ b/ignore/tinker-clm.R @@ -23,7 +23,11 @@ predict(house_mod, newdata = house_test, type = "class")$fit |> house_rec <- recipe(Sat ~ Infl + Type + Cont, data = house_train) house_spec <- ordinal_reg() |> set_engine("clm") |> - set_args(ordinal_link = tune(), threshold = tune()) + set_args( + ordinal_link = tune(), + threshold_structure = tune(), + parallel_reg = tune() + ) house_tune <- extract_parameter_set_dials(house_spec) ( house_grid <- grid_regular(house_tune, levels = Inf) ) @@ -31,7 +35,11 @@ house_tune <- extract_parameter_set_dials(house_spec) house_prep <- prep(house_rec) # fitted model house_spec |> - set_args(ordinal_link = "logistic", threshold = "flexible") |> + set_args( + ordinal_link = "logistic", + threshold_structure = "flexible", + parallel_reg = TRUE + ) |> fit(formula(house_prep), data = house_train) # weighted kappa metric From 60e5911e33775cc54c339396409ef22aceff5ea0 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Wed, 2 Sep 2026 22:05:07 -0400 Subject: [PATCH 22/45] wrap clm link translation in helper function for consistency --- R/ordinal_reg-clm.R | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/R/ordinal_reg-clm.R b/R/ordinal_reg-clm.R index 4c9bb98..ec877d9 100644 --- a/R/ordinal_reg-clm.R +++ b/R/ordinal_reg-clm.R @@ -64,8 +64,7 @@ clm_wrapper <- function( args$weights <- weights } if (! is.null(link)) { - if (link == "logistic") link <- "logit" - args$link <- link + args$link <- match_ordinal_link_clm(link, call = call) } if (! is.null(threshold)) { threshold <- switch( @@ -96,6 +95,24 @@ clm_wrapper <- function( res } +match_ordinal_link_clm <- function(link, call = rlang::caller_env()) { + if (! is.character(link)) { + return(link) + } + check_string(link, arg = "ordinal_link", call = call) + + link <- rlang::arg_match0( + link, + values_ordinal_link_clm, + arg_nm = "ordinal_link", + error_call = call + ) + if (link == "logistic") { + link <- "logit" + } + link +} + # Split a model formula into the location and `nominal` formulas that # `ordinal::clm()` expects when the parallel regression assumption is relaxed. # Every predictor moves to `nominal`, leaving an intercept-only location From 235e8188f8decfa5bf7d654e02a6f1cc5f0be386 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Wed, 2 Sep 2026 22:18:33 -0400 Subject: [PATCH 23/45] modularize clm prediction pre-processing function --- R/ordinal_reg-clm.R | 8 ++++++++ R/ordinal_reg-data.R | 16 ++-------------- 2 files changed, 10 insertions(+), 14 deletions(-) diff --git a/R/ordinal_reg-clm.R b/R/ordinal_reg-clm.R index ec877d9..3b758df 100644 --- a/R/ordinal_reg-clm.R +++ b/R/ordinal_reg-clm.R @@ -142,3 +142,11 @@ clm_formulas <- function(formula, data, call = rlang::caller_env()) { list(formula = loc, nominal = nominal) } + +predict_clm_pre <- function(new_data, object) { + resp <- all.vars(object$fit$terms[[2L]]) + if (resp %in% names(new_data)) { + new_data <- new_data[, !names(new_data) %in% resp, drop = FALSE] + } + new_data +} diff --git a/R/ordinal_reg-data.R b/R/ordinal_reg-data.R index 6e4acef..9c6baad 100644 --- a/R/ordinal_reg-data.R +++ b/R/ordinal_reg-data.R @@ -858,13 +858,7 @@ make_ordinal_reg_clm <- function() { mode = "classification", type = "prob", value = list( - pre = function(new_data, object) { - resp <- all.vars(object$fit$terms[[2L]]) - if (resp %in% names(new_data)) { - new_data <- new_data[, !names(new_data) %in% resp, drop = FALSE] - } - new_data - }, + pre = predict_clm_pre, post = function(x, object) { x <- tibble::as_tibble(x$fit) x <- set_names(x, paste0(".pred_", colnames(x))) @@ -886,13 +880,7 @@ make_ordinal_reg_clm <- function() { mode = "classification", type = "linear_pred", value = list( - pre = function(new_data, object) { - resp <- all.vars(object$fit$terms[[2L]]) - if (resp %in% names(new_data)) { - new_data <- new_data[, !names(new_data) %in% resp, drop = FALSE] - } - new_data - }, + pre = predict_clm_pre, post = function(x, object) { # x$eta1 = alpha_j - X*beta for each j; engine uses P(Y >= j) beta_x <- object$fit$alpha[1] - x$eta1[, 1] From 5bda5331dddbc7abc531a039f2b3fd623803d877 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Thu, 3 Sep 2026 16:36:21 -0400 Subject: [PATCH 24/45] move argument value translation to wrappers - pairs with parsnip@d2c04af2 --- NEWS.md | 4 + R/ordinal_reg-VGAM.R | 168 ++++++++++++++++-- R/ordinal_reg-ordinalNet.R | 69 +++++-- man/VGAM_vglm_wrapper.Rd | 18 +- man/ordinalNet_wrapper.Rd | 18 +- .../testthat/_snaps/gen_additive_mod-VGAM.md | 4 +- tests/testthat/_snaps/ordinal_reg-VGAM.md | 46 ++++- .../testthat/_snaps/ordinal_reg-ordinalNet.md | 29 ++- tests/testthat/test-dials.R | 22 ++- tests/testthat/test-ordinal_reg-VGAM.R | 61 +++++++ tests/testthat/test-ordinal_reg-ordinalNet.R | 50 ++++++ 11 files changed, 446 insertions(+), 43 deletions(-) diff --git a/NEWS.md b/NEWS.md index 2d504fd..e2eeac0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,6 +8,10 @@ A bug in the prediction of `vglm` models, and associated tests, were patched. Previously, `predict()` was used, which triggers S3 dispatch when **VGAM** is not attached but S4 dispatched when it is. Now `predictvglm()` is used instead. +### refactor + +`ordinal_reg()` argument value translation has been moved from the `translate()` method in parsnip to engine wrappers in ordered, with the exception of penalty path assembly for `ordinalNet` and `glmnetcr`, in coordination with [parsnip PR #1393](https://github.com/tidymodels/parsnip/pull/1393). + ## new features ### additional ordinal regression and random forest engines diff --git a/R/ordinal_reg-VGAM.R b/R/ordinal_reg-VGAM.R index ae9153f..cabcaa0 100644 --- a/R/ordinal_reg-VGAM.R +++ b/R/ordinal_reg-VGAM.R @@ -4,7 +4,7 @@ #' [VGAM::vgam()], which specialize to several families of ordinal regression #' models. The standardized argument values used by `parsnip::ordinal_reg()` and #' `parsnip::gen_additive_mod()` are matched and converted to the values native -#' to `VGAM` at translation time. +#' to `VGAM` within the wrappers. #' #' The vector `values_ordinal_link_VGAM` extends the default `ordinal_link` #' options encoded in [`dials::values_ordinal_link`] to those accepted by @@ -16,14 +16,18 @@ #' and [`VGAM::vgam()`]. #' @param formula The formula to pass. #' @param data The data frame to pass. -#' @param family The `VGAM` family function, as a character string (e.g. -#' `"cumulative"`, `"acat"`, `"cratio"`, `"sratio"`). -#' @param link The `VGAM` link function (e.g. `"logitlink"`). +#' @param family The odds link function; either a standardized dial value +#' (`"cumulative_link"`, `"adjacent_categories"`, `"continuation_ratio"`, +#' `"stopping_ratio"`) or a `VGAM` native value (`"cumulative"`, `"acat"`, +#' `"cratio"`, `"sratio"`). +#' @param link The ordinal link function; either a standardized dial value (e.g. +#' `"logistic"`, `"cloglog"`) or a `VGAM` native value (e.g. `"logitlink"`, +#' `"clogloglink"`). #' @param parallel Logical; whether predictor effects are shared across #' thresholds. It corresponds to the standardized `parallel_reg` argument (see #' [dials::parallel_reg()]). -#' @param Thresh Character; the threshold constraint pattern. It corresponds -#' to the standardized `threshold_structure` argument (see +#' @param Thresh Character; the threshold constraint pattern. It corresponds to +#' the standardized `threshold_structure` argument (see #' [dials::threshold_structure()]). #' @param ... Additional arguments to pass. #' @details Note that `VGAM::vglm()` and `VGAM::vgam()` treat the rows of `data` @@ -42,6 +46,7 @@ #' dials::ordinal_link(values = values_ordinal_link_VGAM) #' values_threshold_structure_VGAM #' dials::threshold_structure(values = values_threshold_structure_VGAM) + #' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("VGAM") #' house_data <- #' MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] @@ -56,18 +61,21 @@ #' ( fit_wrap <- VGAM_vglm_wrapper( #' Sat ~ Type + Infl + Cont, #' family = "sratio", -#' link = "probitlink", parallel = TRUE, Thresh = "symm0", +#' link = "probitlink", parallel = TRUE, Thresh = "symmetric_zero", #' data = house_data #' ) ) #' # fit wrapper for additive model #' ( fit_orig <- VGAM::vgam( #' Sat ~ Type + Infl + Cont, -#' family = VGAM::cratio(link = "clogloglink", parallel = TRUE), +#' family = VGAM::cratio( +#' link = "clogloglink", parallel = TRUE, Thresh = "symm0", +#' ), #' data = house_data #' ) ) #' ( fit_wrap <- VGAM_vgam_wrapper( #' Sat ~ Type + Infl + Cont, -#' family = "cratio", link = "clogloglink", parallel = TRUE, +#' family = "cratio", +#' link = "cloglog", parallel = TRUE, Thresh = "symm0", #' data = house_data #' ) ) #' @export @@ -77,13 +85,20 @@ VGAM_vglm_wrapper <- function( link = "logitlink", parallel = FALSE, Thresh = NULL, - ... + ..., + call = rlang::caller_env() ) { rlang::check_installed("VGAM") # TODO: Ensure that `formula = cbind(...) ~ ...` is disallowed, for this and # for other `ordinal_reg()` engines. + # match standardized argument values to their `VGAM` natives + link <- match_ordinal_link_VGAM(link, call = call) + family <- match_ordinal_family(family, call = call) + Thresh <- match_threshold_structure_VGAM(Thresh, call = call) + check_ordinal_link_family_VGAM(family = family, link = link, call = call) + # execute nested call on modified inputs family_call <- rlang::call2( .fn = family, .ns = "VGAM", @@ -106,10 +121,17 @@ VGAM_vgam_wrapper <- function( link = "logitlink", parallel = FALSE, Thresh = NULL, - ... + ..., + call = rlang::caller_env() ) { rlang::check_installed("VGAM") + # match standardized argument values to their `VGAM` natives + link <- match_ordinal_link_VGAM(link, call = call) + family <- match_ordinal_family(family, call = call) + Thresh <- match_threshold_structure_VGAM(Thresh, call = call) + check_ordinal_link_family_VGAM(family = family, link = link, call = call) + # execute nested call on modified inputs family_call <- rlang::call2( .fn = family, .ns = "VGAM", @@ -124,11 +146,14 @@ VGAM_vgam_wrapper <- function( suppressWarnings(rlang::eval_tidy(cl)) } +# The extended dial values are built directly from `dials::values_*` so +# synchronize automatically. + #' @rdname VGAM_vglm_wrapper #' @export values_ordinal_link_VGAM <- c( dials::values_ordinal_link, - # TODO: Expand to include link functions to other domains than [0,1]. + # TODO: Expand to include link functions to other domains than [0,1]? c("foldsqrt", "logc", "gord", "pord", "nbord") ) @@ -139,6 +164,125 @@ values_threshold_structure_VGAM <- c( "qnorm" ) +# match standardized `odds_link` value to a `VGAM`/`ordinalNet` family name; +# used by wrappers +match_ordinal_family <- function(family, call = rlang::caller_env()) { + if (!is.character(family)) { + return(family) + } + check_string(family, arg = "odds_link", call = call) + if (family %in% c("cumulative", "acat", "cratio", "sratio")) { + return(family) + } + family <- rlang::arg_match0( + family, + dials::values_odds_link, + arg_nm = "odds_link", + error_call = call + ) + switch( + family, + cumulative_link = "cumulative", + adjacent_categories = "acat", + continuation_ratio = "cratio", + stopping_ratio = "sratio" + ) +} + +match_ordinal_link_VGAM <- function(link, call = rlang::caller_env()) { + if (! is.character(link)) { + return(link) + } + check_string(link, arg = "ordinal_link", call = call) + + if ( + # keep native values + ! link %in% c( + "logitlink", "probitlink", "logloglink", "clogloglink", "cauchitlink", + "foldsqrtlink", "logclink", "gordlink", "pordlink", "nbordlink" + ) + ) { + # modify standardized values + link <- rlang::arg_match0( + link, + values_ordinal_link_VGAM, + arg_nm = "ordinal_link", + error_call = call + ) + if (link == "logistic") { + link <- "logit" + } + link <- paste0(link, "link") + } + + if (link == "logloglink") { + cli::cli_abort( + c( + "The {.pkg VGAM} engines do not support the log-log ordinal link.", + "i" = "See `?VGAM::Links` for provided link functions." + ), + call = call + ) + } + link +} + +match_threshold_structure_VGAM <- function( + Thresh, + call = rlang::caller_env() +) { + if (! is.character(Thresh)) { + return(Thresh) + } + check_string(Thresh, arg = "threshold_structure", call = call) + + if ( + # keep native values + ! Thresh %in% c("free", "symm1", "symm0", "equid", "qnorm") + ) { + # modify standardized values + Thresh <- rlang::arg_match0( + Thresh, + values_threshold_structure_VGAM, + arg_nm = "threshold_structure", + error_call = call + ) + Thresh <- switch( + Thresh, + flexible = "free", + symmetric_median = "symm1", + symmetric_zero = "symm0", + equidistant = "equid", + qnorm = "qnorm" + ) + } + + Thresh +} + +check_ordinal_link_family_VGAM <- function( + family, + link, + call = rlang::caller_env() +) { + if ( + is.character(family) && + is.character(link) && + family == "acat" && + link %in% c("logitlink", "probitlink", "clogloglink") + ) { + cli::cli_abort( + c( + "The {.val adjacent_categories} family is not compatible with + the {.val {link}} link function.", + "i" = "Use {.val cauchitlink} or {.val identitylink} instead." + ), + call = call + ) + } + invisible(NULL) +} + predict_VGAM_class_post <- function(x, object) { x <- apply(x, 1L, which.max) x <- ordered(object$lvl[x], object$lvl) diff --git a/R/ordinal_reg-ordinalNet.R b/R/ordinal_reg-ordinalNet.R index e534f16..61b7f82 100644 --- a/R/ordinal_reg-ordinalNet.R +++ b/R/ordinal_reg-ordinalNet.R @@ -6,13 +6,18 @@ #' penalties. #' @param x The predictor data. #' @param y The outcome vector. -#' @param weights An optional numeric vector of case weights. When provided, -#' the outcome is restructured into a multinomial matrix of weighted -#' indicators. -#' @param family The `ordinalNet` family function, as a character string (e.g. -#' `"cumulative"`, `"sratio"`, `"cratio"`, `"acat"`). -#' @param link The `ordinalNet` link function, as a character string (e.g. -#' `"logit"`, `"probit"`, `"cloglog"`, `"cauchit"`). +#' @param weights An optional numeric vector of case weights. When provided, the +#' outcome is restructured into a multinomial matrix of weighted indicators. +#' @param family The odds link function; either a standardized dial value +#' (`"cumulative_link"`, `"adjacent_categories"`, `"continuation_ratio"`, +#' `"stopping_ratio"`) or an `ordinalNet` native value (`"cumulative"`, +#' `"acat"`, `"cratio"`, `"sratio"`). +#' @param link The ordinal link function; either a standardized dial value (e.g. +#' `"logistic"`, `"probit"`) or a `ordinalNet` native value (e.g. `"logit"`, +#' `"probit"`). +#' @param parallel_reg Logical; whether predictors share effects across +#' thresholds. When `FALSE`, `parallelTerms` is set to `FALSE` and +#' `nonparallelTerms` to `TRUE`. #' @param parallelTerms Logical; whether to use parallel terms. #' @param nonparallelTerms Logical; whether to use non-parallel terms. #' @param parallelPenaltyFactor Numeric; scale factor applied to the penalty on @@ -73,11 +78,21 @@ ordinalNet_wrapper <- function( x, y, weights = NULL, family = "cumulative", link = "logit", + parallel_reg = NULL, parallelTerms = TRUE, nonparallelTerms = FALSE, parallelPenaltyFactor = 1, - ... + ..., + call = rlang::caller_env() ) { rlang::check_installed("ordinalNet") + # match standardized argument values to their `ordinalNet` natives + family <- match_ordinal_family(family, call = call) + link <- match_ordinal_link_ordinalNet(link, call = call) + if (isFALSE(parallel_reg)) { + parallelTerms <- FALSE + nonparallelTerms <- TRUE + } + # throw error if penalty factor would go unused if (! parallelTerms && parallelPenaltyFactor != 1) { cli::cli_abort( @@ -106,6 +121,36 @@ ordinalNet_wrapper <- function( rlang::eval_tidy(cl) } +match_ordinal_link_ordinalNet <- function(link, call = rlang::caller_env()) { + if (! is.character(link)) { + return(link) + } + check_string(link, arg = "ordinal_link", call = call) + # native values pass through unchanged (note `logit`, not `logistic`) + if (link %in% c("logit", "probit", "cloglog", "cauchit")) { + return(link) + } + link <- rlang::arg_match0( + link, + dials::values_ordinal_link, + arg_nm = "ordinal_link", + error_call = call + ) + if (link == "logistic") { + link <- "logit" + } + if (link == "loglog") { + cli::cli_abort( + c( + "The `ordinalNet` engine does not support the log-log ordinal link.", + "i" = "See `?ordinalNet::ordinalNet` for provided link functions." + ), + call = call + ) + } + link +} + #' @rdname ordinalNet_wrapper #' @export predict_ordinalNet_wrapper <- function( @@ -177,9 +222,11 @@ adjacent_penalties <- function(object, penalty, use_extreme = TRUE) { in_rng <- penalty >= min(ref) && penalty <= max(ref) have_extr <- is.null(object$args$lambdaVals) && object$args$includeLambda0 if (! in_rng && ! have_extr) { - cli::cli_abort("The penalty value {format(penalty, digits = 3)} is - outside the penalty range contained in the model object.", - call = rlang::call2("predict")) + cli::cli_abort( + "The penalty value {format(penalty, digits = 3)} is + outside the penalty range contained in the model object.", + call = rlang::call2("predict") + ) } above <- which.min(ifelse(ref < penalty, Inf, ref)) diff --git a/man/VGAM_vglm_wrapper.Rd b/man/VGAM_vglm_wrapper.Rd index 44ce50c..0452995 100644 --- a/man/VGAM_vglm_wrapper.Rd +++ b/man/VGAM_vglm_wrapper.Rd @@ -14,7 +14,8 @@ VGAM_vglm_wrapper( link = "logitlink", parallel = FALSE, Thresh = NULL, - ... + ..., + call = rlang::caller_env() ) VGAM_vgam_wrapper( @@ -24,7 +25,8 @@ VGAM_vgam_wrapper( link = "logitlink", parallel = FALSE, Thresh = NULL, - ... + ..., + call = rlang::caller_env() ) values_ordinal_link_VGAM @@ -36,10 +38,14 @@ values_threshold_structure_VGAM \item{data}{The data frame to pass.} -\item{family}{The \code{VGAM} family function, as a character string (e.g. -\code{"cumulative"}, \code{"acat"}, \code{"cratio"}, \code{"sratio"}).} +\item{family}{The \code{VGAM} family function, given either in the standardized +form (e.g. \code{"cumulative_link"}, \code{"adjacent_categories"}, +\code{"continuation_ratio"}, \code{"stopping_ratio"}) or natively (e.g. \code{"cumulative"}, +\code{"acat"}, \code{"cratio"}, \code{"sratio"}).} -\item{link}{The \code{VGAM} link function (e.g. \code{"logitlink"}).} +\item{link}{The \code{VGAM} link function, given either in the standardized form +(e.g. \code{"logistic"}, \code{"cloglog"}) or natively (e.g. \code{"logitlink"}, +\code{"clogloglink"}).} \item{parallel}{Logical; whether predictor effects are shared across thresholds. It corresponds to the standardized \code{parallel_reg} argument (see @@ -60,7 +66,7 @@ These wrappers reorganize arguments into proper calls to \code{\link[VGAM:vglm]{ \code{\link[VGAM:vgam]{VGAM::vgam()}}, which specialize to several families of ordinal regression models. The standardized argument values used by \code{parsnip::ordinal_reg()} and \code{parsnip::gen_additive_mod()} are matched and converted to the values native -to \code{VGAM} at translation time. +to \code{VGAM} within the wrappers themselves. } \details{ The vector \code{values_ordinal_link_VGAM} extends the default \code{ordinal_link} diff --git a/man/ordinalNet_wrapper.Rd b/man/ordinalNet_wrapper.Rd index 4f2af0f..3da90dc 100644 --- a/man/ordinalNet_wrapper.Rd +++ b/man/ordinalNet_wrapper.Rd @@ -16,10 +16,12 @@ ordinalNet_wrapper( weights = NULL, family = "cumulative", link = "logit", + parallel_reg = NULL, parallelTerms = TRUE, nonparallelTerms = FALSE, parallelPenaltyFactor = 1, - ... + ..., + call = rlang::caller_env() ) predict_ordinalNet_wrapper( @@ -64,11 +66,17 @@ predict_ordinalNet_wrapper( the outcome is restructured into a multinomial matrix of weighted indicators.} -\item{family}{The \code{ordinalNet} family function, as a character string (e.g. -\code{"cumulative"}, \code{"sratio"}, \code{"cratio"}, \code{"acat"}).} +\item{family}{The \code{ordinalNet} family function, given either in the +standardized form (e.g. \code{"cumulative_link"}, \code{"stopping_ratio"}) or natively +(e.g. \code{"cumulative"}, \code{"sratio"}, \code{"cratio"}, \code{"acat"}).} + +\item{link}{The \code{ordinalNet} link function, given either in the standardized +form (e.g. \code{"logistic"}) or natively (e.g. \code{"logit"}, \code{"probit"}, +\code{"cloglog"}, \code{"cauchit"}).} -\item{link}{The \code{ordinalNet} link function, as a character string (e.g. -\code{"logit"}, \code{"probit"}, \code{"cloglog"}, \code{"cauchit"}).} +\item{parallel_reg}{Logical; whether predictors share effects across +thresholds. When \code{FALSE}, \code{parallelTerms} is set to \code{FALSE} and +\code{nonparallelTerms} to \code{TRUE}.} \item{parallelTerms}{Logical; whether to use parallel terms.} diff --git a/tests/testthat/_snaps/gen_additive_mod-VGAM.md b/tests/testthat/_snaps/gen_additive_mod-VGAM.md index e0ac90c..fdfd302 100644 --- a/tests/testthat/_snaps/gen_additive_mod-VGAM.md +++ b/tests/testthat/_snaps/gen_additive_mod-VGAM.md @@ -64,8 +64,8 @@ Model fit template: ordered::VGAM_vgam_wrapper(formula = missing_arg(), data = missing_arg(), - weights = missing_arg(), parallel = TRUE, link = "clogloglink", - family = "sratio") + weights = missing_arg(), parallel = TRUE, link = "cloglog", + family = "stopping_ratio") --- diff --git a/tests/testthat/_snaps/ordinal_reg-VGAM.md b/tests/testthat/_snaps/ordinal_reg-VGAM.md index a27b579..19d659c 100644 --- a/tests/testthat/_snaps/ordinal_reg-VGAM.md +++ b/tests/testthat/_snaps/ordinal_reg-VGAM.md @@ -72,7 +72,7 @@ Model fit template: ordered::VGAM_vglm_wrapper(formula = missing_arg(), data = missing_arg(), - weights = missing_arg(), link = "clogloglink", family = "sratio", + weights = missing_arg(), link = "cloglog", family = "stopping_ratio", parallel = TRUE) --- @@ -81,3 +81,47 @@ set.seed(13) onet_arg_fit <- fit(onet_arg_spec, class ~ ., data = caco_train) +# standardized link, family, and threshold values are matched + + Code + match_ordinal_link_VGAM("loglog") + Condition + Error: + ! The VGAM engines do not support the log-log ordinal link. + i See `?VGAM::Links` for provided link functions. + +--- + + Code + match_ordinal_link_VGAM("logisitc") + Condition + Error: + ! `ordinal_link` must be one of "logistic", "probit", "loglog", "cloglog", "cauchit", "foldsqrt", "logc", "gord", "pord", or "nbord", not "logisitc". + i Did you mean "logistic"? + +--- + + Code + match_ordinal_family("cumu") + Condition + Error: + ! `odds_link` must be one of "cumulative_link", "adjacent_categories", "continuation_ratio", or "stopping_ratio", not "cumu". + i Did you mean "cumulative_link"? + +--- + + Code + match_threshold_structure_VGAM(c("flexible", "equidistant")) + Condition + Error: + ! `threshold_structure` must be a single string, not a character vector. + +# the adjacent categories family rejects incompatible links + + Code + check_ordinal_link_family_VGAM(family = "acat", link = "logitlink") + Condition + Error: + ! The "adjacent_categories" family is not compatible with the "logitlink" link function. + i Use "cauchitlink" or "identitylink" instead. + diff --git a/tests/testthat/_snaps/ordinal_reg-ordinalNet.md b/tests/testthat/_snaps/ordinal_reg-ordinalNet.md index a9df4ee..b3c8bbf 100644 --- a/tests/testthat/_snaps/ordinal_reg-ordinalNet.md +++ b/tests/testthat/_snaps/ordinal_reg-ordinalNet.md @@ -32,7 +32,7 @@ Model fit template: ordered::ordinalNet_wrapper(x = missing_arg(), y = missing_arg(), - weights = missing_arg(), link = "cloglog", family = "sratio", + weights = missing_arg(), link = "cloglog", family = "stopping_ratio", lambdaVals = 10^seq(-6, -1), alpha = 0.25) --- @@ -41,3 +41,30 @@ set.seed(13) onet_arg_fit <- fit(onet_arg_spec, class ~ ., data = caco_train) +# standardized link and family values are matched + + Code + match_ordinal_link_ordinalNet("logitlink") + Condition + Error: + ! `ordinal_link` must be one of "logistic", "probit", "loglog", "cloglog", or "cauchit", not "logitlink". + i Did you mean "logistic"? + +--- + + Code + match_ordinal_link_ordinalNet("logisitc") + Condition + Error: + ! `ordinal_link` must be one of "logistic", "probit", "loglog", "cloglog", or "cauchit", not "logisitc". + i Did you mean "logistic"? + +--- + + Code + match_ordinal_family("cumu") + Condition + Error: + ! `odds_link` must be one of "cumulative_link", "adjacent_categories", "continuation_ratio", or "stopping_ratio", not "cumu". + i Did you mean "cumulative_link"? + diff --git a/tests/testthat/test-dials.R b/tests/testthat/test-dials.R index fe9ab84..6cd5fdb 100644 --- a/tests/testthat/test-dials.R +++ b/tests/testthat/test-dials.R @@ -1,4 +1,4 @@ -test_that("threshold_structure dial values and customization", { +test_that("`threshold_structure` dial values and customization", { expect_equal( dials::threshold_structure()$values, dials::values_threshold_structure @@ -6,7 +6,19 @@ test_that("threshold_structure dial values and customization", { expect_equal(dials::threshold_structure(letters[1:3])$values, letters[1:3]) }) -test_that("parallel_reg dial values and customization", { +test_that("VGAM `ordinal_link` values extend the bundled dial", { + expect_true(all(dials::values_ordinal_link %in% values_ordinal_link_VGAM)) + expect_true(all(c("foldsqrt", "logc", "gord", "pord", "nbord") %in% + values_ordinal_link_VGAM)) +}) + +test_that("VGAM `threshold_structure` values extend the bundled dial", { + expect_true(all(dials::values_threshold_structure %in% + values_threshold_structure_VGAM)) + expect_true("qnorm" %in% values_threshold_structure_VGAM) +}) + +test_that("`parallel_reg` dial values and customization", { expect_equal( dials::parallel_reg()$values, dials::values_parallel_reg @@ -14,17 +26,17 @@ test_that("parallel_reg dial values and customization", { expect_equal(dials::parallel_reg(TRUE)$values, TRUE) }) -test_that("ordinalNet::ordinalNet dial customization", { +test_that("`ordinalNet::ordinalNet` dial customization", { expect_equal(parallel_penalty_factor(range = c(-2, 2))$range, list(lower = -2, upper = 2)) }) -test_that("rpartScore::rpartScore dial customization", { +test_that("`rpartScore::rpartScore` dial customization", { expect_equal(split_func(letters[1:3])$values, letters[1:3]) expect_equal(prune_func(letters[1:3])$values, letters[1:3]) }) -test_that("ordinalForest::ordfor dial customization", { +test_that("`ordinalForest::ordfor` dial customization", { expect_equal(naive_scores(TRUE)$values, TRUE) expect_equal(num_scores(3:4)$range, list(lower = 3L, upper = 4L)) expect_equal(num_score_perms(100:101)$range, list(lower = 100L, upper = 101L)) diff --git a/tests/testthat/test-ordinal_reg-VGAM.R b/tests/testthat/test-ordinal_reg-VGAM.R index f658428..40dca1b 100644 --- a/tests/testthat/test-ordinal_reg-VGAM.R +++ b/tests/testthat/test-ordinal_reg-VGAM.R @@ -289,4 +289,65 @@ test_that("parallel regression argument handles logicals", { } }) +# argument translation --------------------------------------------------------- + +test_that("standardized link, family, and threshold values are matched", { + expect_equal(match_ordinal_link_VGAM("logistic"), "logitlink") + expect_equal(match_ordinal_link_VGAM("cloglog"), "clogloglink") + expect_equal(match_ordinal_link_VGAM("probit"), "probitlink") + expect_equal(match_ordinal_link_VGAM("foldsqrtlink"), "foldsqrtlink") + expect_equal(match_ordinal_family("cumulative_link"), "cumulative") + expect_equal(match_ordinal_family("stopping_ratio"), "sratio") + expect_equal(match_ordinal_family("sratio"), "sratio") + expect_equal(match_threshold_structure_VGAM("equidistant"), "equid") + expect_equal(match_threshold_structure_VGAM("symmetric_zero"), "symm0") + expect_equal(match_threshold_structure_VGAM("qnorm"), "qnorm") + + expect_snapshot(error = TRUE, { + match_ordinal_link_VGAM("loglog") + }) + expect_snapshot(error = TRUE, { + match_ordinal_link_VGAM("logisitc") + }) + expect_snapshot(error = TRUE, { + match_ordinal_family("cumu") + }) + expect_snapshot(error = TRUE, { + match_threshold_structure_VGAM(c("flexible", "equidistant")) + }) +}) + +test_that("the adjacent categories family rejects incompatible links", { + expect_no_error( + check_ordinal_link_family_VGAM(family = "acat", link = "cauchitlink") + ) + expect_snapshot(error = TRUE, { + check_ordinal_link_family_VGAM(family = "acat", link = "logitlink") + }) +}) + +test_that("VGAM wrappers translate standardized argument values", { + skip_if_not_installed("MASS") + skip_if_not_installed("VGAM") + house_data <- + MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] + + # native values pass through unchanged + native <- VGAM_vglm_wrapper( + Sat ~ Infl + Type, data = house_data, + family = "sratio", link = "probitlink", Thresh = "symm1", parallel = TRUE + ) + expect_equal(native@family@infos()$link, "probitlink") + expect_equal(native@family@vfamily[1L], "sratio") + + # standardized values are converted + standardized <- VGAM_vglm_wrapper( + Sat ~ Infl + Type, data = house_data, + family = "stopping_ratio", link = "probit", parallel = TRUE, + Thresh = "symmetric_median" + ) + expect_equal(standardized@family@infos()$link, "probitlink") + expect_equal(standardized@family@infos()$parallel, TRUE) + expect_equal(standardized@family@vfamily[1L], "sratio") +}) diff --git a/tests/testthat/test-ordinal_reg-ordinalNet.R b/tests/testthat/test-ordinal_reg-ordinalNet.R index a886cfc..b19c899 100644 --- a/tests/testthat/test-ordinal_reg-ordinalNet.R +++ b/tests/testthat/test-ordinal_reg-ordinalNet.R @@ -512,3 +512,53 @@ test_that("parallel regression argument handles logicals", { expect_equal(orig_fit$coefs, tidy_fit$fit$coefs) }) + +# argument translation --------------------------------------------------------- + +test_that("standardized link and family values are matched", { + expect_equal(match_ordinal_link_ordinalNet("logistic"), "logit") + expect_equal(match_ordinal_link_ordinalNet("logit"), "logit") + expect_equal(match_ordinal_link_ordinalNet("cloglog"), "cloglog") + expect_equal(match_ordinal_link_ordinalNet("probit"), "probit") + expect_equal(match_ordinal_link_ordinalNet("cauchit"), "cauchit") + expect_equal(match_ordinal_family("cumulative_link"), "cumulative") + expect_equal(match_ordinal_family("sratio"), "sratio") + + expect_snapshot(error = TRUE, { + match_ordinal_link_ordinalNet("logitlink") + }) + expect_snapshot(error = TRUE, { + match_ordinal_link_ordinalNet("logisitc") + }) + expect_snapshot(error = TRUE, { + match_ordinal_family("cumu") + }) +}) + +test_that("ordinalNet wrapper translates standardized argument values", { + skip_if_not_installed("ordinalNet") + + # standardized values are converted and `parallel_reg = FALSE` is expanded + x <- matrix(rnorm(100), ncol = 2) + y <- factor(rep(1:3, length.out = 50), ordered = TRUE) + fits <- suppressWarnings(ordinalNet_wrapper( + x, y, + family = "cumulative_link", link = "cauchit", + parallel_reg = FALSE + )) + expect_equal(fits$args$family, "cumulative") + expect_equal(fits$args$link, "cauchit") + expect_false(fits$args$parallelTerms) + expect_true(fits$args$nonparallelTerms) + + # native values and `parallel_reg = NULL` leave the defaults unchanged + native <- ordinalNet_wrapper( + x, y, + family = "sratio", link = "logit", + parallel_reg = NULL + ) + expect_equal(native$args$family, "sratio") + expect_equal(native$args$link, "logit") + expect_true(native$args$parallelTerms) + expect_false(native$args$nonparallelTerms) +}) From b688ec7afd5848eff09f048620c6f685ee60c235 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Sat, 5 Sep 2026 16:00:33 -0400 Subject: [PATCH 25/45] harmonize penalty path control for ordinal_reg elastic net engines - pairs with parsnip@ed9b980c --- NAMESPACE | 1 + R/ordinal_reg-glmnetcr.R | 274 ++++++++++++------ R/ordinal_reg-ordinalNet.R | 103 ++++--- man/VGAM_vglm_wrapper.Rd | 27 +- man/ordinalNet_wrapper.Rd | 18 +- man/predict_glmnetcr_wrapper.Rd | 80 +++-- tests/testthat/_snaps/ordinal_reg-glmnetcr.md | 21 +- .../testthat/_snaps/ordinal_reg-ordinalNet.md | 3 +- tests/testthat/test-ordinal_reg-glmnetcr.R | 105 ++++++- 9 files changed, 419 insertions(+), 213 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 285eb65..329ac80 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ export(VGAM_vglm_wrapper) export(clm_wrapper) export(honesty) export(honesty_fraction) +export(multi_predict_glmnetcr_wrapper) export(naive_scores) export(num_score_perms) export(num_score_trees) diff --git a/R/ordinal_reg-glmnetcr.R b/R/ordinal_reg-glmnetcr.R index 82334f0..de188a7 100644 --- a/R/ordinal_reg-glmnetcr.R +++ b/R/ordinal_reg-glmnetcr.R @@ -1,20 +1,26 @@ -#' Predict wrapper for `glmnetcr` +#' Predict wrappers for `glmnetcr` #' -#' Selects predictions at a specific penalty value from the regularization path. -#' When the requested penalty lies between two path values, linearly -#' interpolates between the probability matrices at the neighboring steps. +#' Select predictions at a specific penalty value or a vector of penalty values. +#' For penalties between path values, linearly interpolate between the +#' probability matrices at the neighboring steps. For penalties outside the path +#' range, use the path endpoints. #' @param object A `glmnetcr` object. #' @param newx A predictor matrix. #' @param type Either `"class"` or `"prob"`. -#' @param lambda A penalty value at which to predict. If `NULL`, the step -#' minimizing `criteria` is used. +#' @param lambda A penalty value or vector at which to predict. If `NULL`, the +#' step minimizing `criteria` is used (single penalty only). #' @param criteria The criterion by which to select `lambda` within the path #' sequence. Defaults to `"bic"` for consistency with #' [glmnetcr::predict.glmnetcr()]. (NB: This contrasts with #' [predict_ordinalNet_wrapper()].) #' @keywords internal -#' @returns A character vector of class predictions or a matrix of class -#' probabilities. +#' @returns `predict_glmnetcr_wrapper()` returns a character vector of class +#' predictions or a matrix of class probabilities. +#' `multi_predict_glmnetcr_wrapper()` returns a numeric array with one slice +#' per penalty value for class probabilities, or a character matrix with one +#' column per penalty value for class predictions. +#' Both outputs mimic those of [glmnetcr::predict.glmnetcr()]. + #' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("glmnetcr") #' house_data <- #' MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] @@ -23,86 +29,139 @@ #' data = house_data, #' contrasts.arg = lapply(house_data[, 2:4], contrasts, contrasts = FALSE) #' ) -#' pen_vec <- 10 ^ seq(-1, -3, -.5) +#' pen_vec <- 10 ^ seq(-1, -2, -.25) #' fit <- glmnetcr::glmnetcr( #' house_matrix, y = house_data$Sat, #' lambda = pen_vec #' ) #' # predictions (may disagree if `lambda` is not on the path `fit$lambda`) -#' # probability +#' set.seed(34091) +#' house_submatrix <- house_matrix[sample(nrow(house_matrix), 6), ] +#' # single, probability #' predict( #' fit, -#' newx = head(house_matrix) -#' )$probs[, , which.min(abs(fit$lambda - 0.02))] +#' newx = house_submatrix +#' )$probs[, , which.min(abs(fit$lambda - .02))] #' predict_glmnetcr_wrapper( #' fit, -#' newx = head(house_matrix), +#' newx = house_submatrix, #' type = "prob", -#' lambda = 0.02 +#' lambda = .02 #' ) -#' # class +#' # single, class #' predict( #' fit, -#' newx = head(house_matrix) -#' )$class[, which.min(abs(fit$lambda - 0.02))] +#' newx = house_submatrix +#' )$class[, which.min(abs(fit$lambda - .02))] #' predict_glmnetcr_wrapper( #' fit, -#' newx = head(house_matrix), +#' newx = house_submatrix, +#' type = "class", +#' lambda = .02 +#' ) +#' # multiple, probabilities +#' predict( +#' fit, +#' newx = house_submatrix +#' )$probs +#' multi_predict_glmnetcr_wrapper( +#' fit, +#' newx = house_submatrix, +#' type = "prob", +#' lambda = c(.2, .02, .002) +#' ) +#' # multiple, class +#' predict( +#' fit, +#' newx = house_submatrix +#' )$class +#' multi_predict_glmnetcr_wrapper( +#' fit, +#' newx = house_submatrix, #' type = "class", -#' lambda = 0.02 +#' lambda = c(.2, .02, .002) #' ) #' @export predict_glmnetcr_wrapper <- function( object, newx, type, lambda, criteria = c("bic", "aic") ) { - # get all predictions - pred <- predict(object, newx = newx) + criteria <- match.arg(criteria) - # select step index if (is.null(lambda)) { - s_idx <- switch( + # select the step minimizing the criterion and predict at that penalty; + # `AIC`/`BIC` are only available from `predict.glmnetcr()` + pred <- predict(object, newx = newx) + lambda <- object$lambda[switch( criteria, "aic" = which.min(pred$AIC), "bic" = which.min(pred$BIC) - ) + )] + } + + # interpolate the penalty + res <- multi_predict_glmnetcr_wrapper(object, newx, type, lambda) + # return one slice/column + if (type == "class") { + res[, 1L] } else { - # `predict.glmnetcr()` returns paths of criterion values, class predictions, - # and probability predictions that track the penalty path (`$lambda`). This - # wrapper linearly interpolates between consecutive probabilities and then - # rescales them to add to 1. - - s_idx <- if (lambda < min(object$lambda)) { - which.min(object$lambda) - } else if (lambda > max(object$lambda)) { - which.max(object$lambda) - } else if (lambda %in% object$lambda) { - match(lambda, object$lambda) + res[, , 1L] + } +} + +#' @rdname predict_glmnetcr_wrapper +#' @export +multi_predict_glmnetcr_wrapper <- function( + object, newx, type, lambda +) { + type <- match.arg(type, c("prob", "class")) + + # a single call to `predict.glmnetcr()` returns arrays for the whole path + pred <- predict(object, newx = newx) + lams <- object$lambda + + # path step index, or pair of bracketing step indices, for a penalty value + s_idx <- lapply(lambda, function(lam) { + if (lam < min(lams)) { + which.min(lams) + } else if (lam > max(lams)) { + which.max(lams) + } else if (lam %in% lams) { + match(lam, lams) } else { # NB: `$lambda` must be decreasing - s0 <- max(which(object$lambda > lambda)) - s1 <- min(which(object$lambda < lambda)) - c(s0, s1) + c(max(which(lams > lam)), min(which(lams < lam))) + } + }) + + # probability matrix at a penalty value, linearly interpolated between + # bracketing steps and rescaled to add to 1 + probs_at <- function(lam, idx) { + if (length(idx) == 1L) { + pred$probs[, , idx] + } else { + w <- (lam - lams[idx[1L]]) / (lams[idx[2L]] - lams[idx[1L]]) + probs <- (1 - w) * pred$probs[, , idx[1L]] + w * pred$probs[, , idx[2L]] + sweep(probs, 1L, rowSums(probs), "/") } } - res <- if (length(s_idx) == 1L) { - switch( - type, - "class" = pred$class[, s_idx], - "prob" = pred$probs[, , s_idx] - ) + n <- nrow(newx) + n_pen <- length(lambda) + + if (type == "prob") { + res <- array(NA_real_, c(n, ncol(pred$probs), n_pen)) + for (k in seq_len(n_pen)) { + res[, , k] <- probs_at(lambda[k], s_idx[[k]]) + } + dimnames(res) <- list(NULL, colnames(pred$probs), NULL) } else { - s0 <- s_idx[1] - s1 <- s_idx[2] - w <- (lambda - object$lambda[s0]) / (object$lambda[s1] - object$lambda[s0]) - probs <- (1 - w) * pred$probs[, , s0] + w * pred$probs[, , s1] - switch( - type, - "class" = colnames(probs)[max.col(probs, ties.method = "first")], - "prob" = sweep(probs, 1L, rowSums(probs), "/") - ) + res <- matrix(NA_character_, nrow = n, ncol = n_pen) + for (k in seq_len(n_pen)) { + probs_k <- probs_at(lambda[k], s_idx[[k]]) + res[, k] <- colnames(probs_k)[max.col(probs_k, ties.method = "first")] + } + colnames(res) <- as.character(lambda) } - res } @@ -110,22 +169,28 @@ predict_glmnetcr_wrapper <- function( # classes "_glmnetcr" and "model_fit": # # predict() -# predict._glmnetcr(penalty = NULL) <-- checks and sets penalty -# predict.model_fit() <-- checks for extra vars in ... -# predict_() <-- dispatches by type -# predict_._glmnetcr() <-- evaluates spec arguments -# predict_.model_fit() <-- prepares tidy call -# eval_tidy() <-- evaluates tidy call -# predict_glmnetcr_wrapper() <-- interpolates penalty -# predict.glmnetcr() <-- generates predictions +# predict._glmnetcr(penalty = NULL) <-- checks and sets penalty +# predict.model_fit() <-- checks for extra vars in ... +# predict_() <-- dispatches by type +# predict_._glmnetcr() <-- evaluates spec arguments +# predict_.model_fit() <-- prepares tidy call +# eval_tidy() <-- evaluates tidy call +# predict_glmnetcr_wrapper() <-- selects lambda and delegates +# multi_predict_glmnetcr_wrapper() <-- interpolates a penalty vector +# predict.glmnetcr() <-- generates predictions # `glmnetcr` call stack using `multi_predict()` when object has # classes "_glmnetcr" and "model_fit": # # multi_predict() -# multi_predict._glmnetcr() <-- checks and sets penalty -# multi_predict__glmnetcr() <-- vectorizes over penalties -# predict._glmnetcr(multi = FALSE) <-- (see above) +# multi_predict._glmnetcr() <-- checks/encodes, sets penalty +# multi_predict__glmnetcr() <-- formats per row and penalty +# multi_predict_glmnetcr_wrapper() <-- interpolates a penalty vector +# predict.glmnetcr() <-- generates predictions + +# NB: `glmnetcr::predict.glmnetcr()` returns predictions for every step in the +# fitted penalty path; `multi_predict_glmnetcr_wrapper()` calls it once and +# matches or linearly interpolates between steps for each requested penalty. # S3 methods for parsnip's model_fit dispatch ---------------------------------- @@ -135,14 +200,23 @@ predict_glmnetcr_wrapper <- function( #' model specification. #' @export predict._glmnetcr <- function( - object, new_data, type = NULL, opts = list(), - penalty = NULL, ... + object, + new_data, + type = NULL, + opts = list(), + penalty = NULL, + multi = FALSE, + ... ) { if (is.null(penalty) && ! is.null(object$spec$args$penalty)) { penalty <- object$spec$args$penalty } - object$spec$args$penalty <- penalty + + object$spec$args$penalty <- + check_penalty_predict(penalty, object, multi) + object$spec <- eval_args(object$spec) + predict.model_fit(object, new_data = new_data, type = type, opts = opts, ...) } @@ -168,8 +242,12 @@ predict_classprob._glmnetcr <- function(object, new_data, ...) { #' used. #' @export multi_predict._glmnetcr <- function( - object, new_data, type = NULL, opts = list(), - penalty = NULL, ... + object, + new_data, + type = NULL, + opts = list(), + penalty = NULL, + ... ) { type <- check_pred_type(object, type) check_spec_pred_type(object, type) @@ -177,8 +255,6 @@ multi_predict._glmnetcr <- function( check_spec_levels(object) } - object$spec <- eval_args(object$spec) - if (is.null(penalty)) { if (! is.null(object$spec$args$penalty)) { penalty <- object$spec$args$penalty @@ -187,6 +263,9 @@ multi_predict._glmnetcr <- function( } } + object$spec$args$penalty <- + check_penalty_predict(penalty, object, multi = TRUE) + if (type != "raw" && length(opts) > 0L) { cli::cli_warn( "{.arg opts} is only used with {.arg type} = {.val raw} and was ignored." @@ -196,10 +275,15 @@ multi_predict._glmnetcr <- function( pred <- switch( type, "prob" = multi_predict_classprob_glmnetcr( - object, new_data = new_data, penalty = penalty + object$fit, + newx = parsnip::prepare_data(object, new_data), + penalty = penalty ), "class" = multi_predict_class_glmnetcr( - object, new_data = new_data, penalty = penalty + object$fit, + newx = parsnip::prepare_data(object, new_data), + penalty = penalty, + lvl = object$lvl ), "raw" = cli::cli_abort( "{.arg type} = {.val raw} is not yet supported for `multi_predict` @@ -210,27 +294,27 @@ multi_predict._glmnetcr <- function( pred } -multi_predict_classprob_glmnetcr <- function(object, new_data, penalty) { - purrr::map_dfr( - penalty, - ~ predict(object, new_data, type = "prob", penalty = .x) |> - tibble::as_tibble() |> - parsnip::add_rowindex() |> - dplyr::mutate(penalty = .x) |> - dplyr::relocate(penalty) - ) |> - tidyr::nest(.by = .row, .key = ".pred") |> - dplyr::select(-.row) +multi_predict_classprob_glmnetcr <- function(object, newx, penalty) { + probs <- multi_predict_glmnetcr_wrapper( + object, newx, type = "prob", lambda = penalty + ) + lbls <- paste0(".pred_", dimnames(probs)[[2]]) + nested <- lapply(seq_len(nrow(newx)), function(i) { + stats::setNames(tibble::as_tibble(t(probs[i, , ])), lbls) |> + tibble::add_column(penalty = penalty, .before = 1L) + }) + tibble::tibble(.pred = nested) } -multi_predict_class_glmnetcr <- function(object, new_data, penalty) { - purrr::map_dfr( - penalty, - ~ predict(object, new_data, type = "class", penalty = .x) |> - parsnip::add_rowindex() |> - dplyr::mutate(penalty = .x) |> - dplyr::relocate(penalty) - ) |> - tidyr::nest(.by = .row, .key = ".pred") |> - dplyr::select(-.row) +multi_predict_class_glmnetcr <- function(object, newx, penalty, lvl) { + classes <- multi_predict_glmnetcr_wrapper( + object, newx, type = "class", lambda = penalty + ) + nested <- lapply(seq_len(nrow(newx)), function(i) { + tibble::tibble( + penalty = penalty, + .pred_class = ordered(unname(classes[i, ]), levels = lvl) + ) + }) + tibble::tibble(.pred = nested) } diff --git a/R/ordinal_reg-ordinalNet.R b/R/ordinal_reg-ordinalNet.R index 61b7f82..f0b0ae3 100644 --- a/R/ordinal_reg-ordinalNet.R +++ b/R/ordinal_reg-ordinalNet.R @@ -207,31 +207,21 @@ predict_ordinalNet_wrapper <- function( ) } -# `use_extreme` is a placeholder for a policy that we need to set; do we error -# when predicting outside of the observed penalty range or do something else -# (such as predicting at the closest value in the path) --topepo - -# See `translate.ordinal_reg()` in {parsnip}. by using `nLambda` and -# `lambdaMinRatio` together with `includeLambda0`, we ensure that any penalty -# value can be "interpolated" (those above the maximum are equivalent to the -# maximum). The `have_extr` variable determines whether this was done based on -# the arguments retained in the `ordinalNet` object. --corybrunson - -adjacent_penalties <- function(object, penalty, use_extreme = TRUE) { - ref <- object$lambdaVals - in_rng <- penalty >= min(ref) && penalty <= max(ref) - have_extr <- is.null(object$args$lambdaVals) && object$args$includeLambda0 - if (! in_rng && ! have_extr) { - cli::cli_abort( - "The penalty value {format(penalty, digits = 3)} is - outside the penalty range contained in the model object.", - call = rlang::call2("predict") - ) +# return 1 or 2 (adjacent) penalty path indices: +# if 1, it is used; if 2, predictions are interpolated +adjacent_penalties <- function(object, penalty) { + + # NB: `$lambdaVals` must be unique and decreasing. + len <- length(object$lambdaVals) + if (penalty < object$lambdaVals[len]) { + return(len) + } else if (penalty > object$lambdaVals[1L]) { + return(1L) + } else if (penalty %in% object$lambdaVals) { + return(match(penalty, object$lambdaVals)) + } else { + return(which(object$lambdaVals < penalty)[1L] + c(-1L, 0L)) } - - above <- which.min(ifelse(ref < penalty, Inf, ref)) - below <- which.max(ifelse(ref > penalty, -Inf, ref)) - unique(sort(c(below, above))) } approx_prediction <- function(low, high, adjacent, penalty) { @@ -271,6 +261,9 @@ approx_prediction_row <- function(values, adjacent, penalty) { # multi_predict__ordinal_net() <-- vectorizes over penalties # predict._ordinalNet(multi = FALSE) <-- (see above) +# NB: `ordinalNet::predict.ordinalNet()` does not support multiple prediction, +# so `multi_predict()` merely vectorizes `predict(multi = FALSE)`. + #' @importFrom stats approx as.formula coef predict #' @importFrom parsnip eval_args predict_raw multi_predict #' @param penalty A numeric vector of penalty values. @@ -290,9 +283,8 @@ predict._ordinalNet <- function( penalty <- object$spec$args$penalty } - # TODO: Write unit test using `predict(multi = TRUE)`. object$spec$args$penalty <- - .check_ordinalNet_penalty_predict(penalty, object, multi) + check_penalty_predict(penalty, object, multi) object$spec <- eval_args(object$spec) @@ -327,7 +319,7 @@ multi_predict._ordinalNet <- function( } object$spec$args$penalty <- - .check_ordinalNet_penalty_predict(penalty, object, multi = TRUE) + check_penalty_predict(penalty, object, multi = TRUE) # adapted from `censored::multi_predict._coxnet` @@ -378,43 +370,46 @@ predict_class._ordinalNet <- function(object, new_data, ...) { predict_class.model_fit(object, new_data = new_data, ...) } -.check_ordinalNet_penalty_predict <- function( - penalty = NULL, object, multi = FALSE, call = rlang::caller_env() +# adapted from `parsnip:::.check_glmnet_penalty_predict()` +check_penalty_predict <- function( + penalty = NULL, + object, + multi = FALSE, + call = rlang::caller_env() ) { + engine <- object$spec$engine + penalty_path_arg <- switch( + engine, + "ordinalNet" = "lambdaVals", + "glmnetcr" = "lambda" + ) - if (multi) { - # ensure that there is a penalty path - if (is.null(penalty)) { - penalty <- object$fit$lambdaVals - } - penalty <- sort(unique(penalty)) - # REVIEW: This code prevents `tune_grid()` from working. - # if (length(penalty) < 2L) { - # cli::cli_abort("There should be at least 2 penalty values for - # {.fn multi_predict}; please use {.fn predict}) instead.", - # call = call) - # } - } else { - # FIXME: Allow `NULL` penalty so that ordinalNet method uses criterion. - if (! is.null(penalty) && length(penalty) != 1L) { + if (is.null(penalty)) { + penalty <- object$fit[[penalty_path_arg]] + } + + # when using `predict()`, allow for a single lambda + if (! multi) { + if (length(penalty) != 1) { cli::cli_abort( c( "{.arg penalty} should be a single numeric value.", - "i" = "{.fn multi_predict} can be used to get - multiple predictions per row of data." + "i" = "{.fn multi_predict} can be used to get multiple predictions + per row of data." ), call = call ) } } - # REVIEW: This might be unecessary because it lies outside the logic flow. - if (length(object$fit$lambdaVals) == 1L && penalty != object$fit$lambdaVals) { + if (length(object$fit[[penalty_path_arg]]) == 1L && + penalty != object$fit[[penalty_path_arg]]) { cli::cli_abort( c( - "The ordinalNet model was fit with a single penalty value of - {.arg object$fit$lambdaVals}. Predicting with a value of {.arg penalty} - will give incorrect results from `ordinalNet()`." + "The {.val {engine}} model was fit with a single penalty value of + {.arg object$fit[[penalty_path_arg]]}. Predicting with a value of + {.arg penalty} will give incorrect results from + {.fn {paste0(engine, '()')}}." ), call = call ) @@ -429,7 +424,8 @@ multi_predict_classprob_ordinal_net <- function(object, new_data, penalty) { ~ predict(object, new_data, type = "prob", penalty = .x) %>% tibble::as_tibble() %>% parsnip::add_rowindex() %>% - dplyr::mutate(penalty = .x) %>% dplyr::relocate(penalty) + dplyr::mutate(penalty = .x) %>% + dplyr::relocate(penalty) ) %>% tidyr::nest(.by = .row, .key = ".pred") %>% dplyr::select(-.row) @@ -440,7 +436,8 @@ multi_predict_class_ordinal_net <- function(object, new_data, penalty) { penalty, ~ predict(object, new_data, type = "class", penalty = .x) %>% parsnip::add_rowindex() %>% - dplyr::mutate(penalty = .x) %>% dplyr::relocate(penalty) + dplyr::mutate(penalty = .x) %>% + dplyr::relocate(penalty) ) %>% tidyr::nest(.by = .row, .key = ".pred") %>% dplyr::select(-.row) diff --git a/man/VGAM_vglm_wrapper.Rd b/man/VGAM_vglm_wrapper.Rd index 0452995..72ee0bc 100644 --- a/man/VGAM_vglm_wrapper.Rd +++ b/man/VGAM_vglm_wrapper.Rd @@ -38,21 +38,21 @@ values_threshold_structure_VGAM \item{data}{The data frame to pass.} -\item{family}{The \code{VGAM} family function, given either in the standardized -form (e.g. \code{"cumulative_link"}, \code{"adjacent_categories"}, -\code{"continuation_ratio"}, \code{"stopping_ratio"}) or natively (e.g. \code{"cumulative"}, -\code{"acat"}, \code{"cratio"}, \code{"sratio"}).} +\item{family}{The odds link function; either a standardized dial value +(\code{"cumulative_link"}, \code{"adjacent_categories"}, \code{"continuation_ratio"}, +\code{"stopping_ratio"}) or a \code{VGAM} native value (\code{"cumulative"}, \code{"acat"}, +\code{"cratio"}, \code{"sratio"}).} -\item{link}{The \code{VGAM} link function, given either in the standardized form -(e.g. \code{"logistic"}, \code{"cloglog"}) or natively (e.g. \code{"logitlink"}, +\item{link}{The ordinal link function; either a standardized dial value (e.g. +\code{"logistic"}, \code{"cloglog"}) or a \code{VGAM} native value (e.g. \code{"logitlink"}, \code{"clogloglink"}).} \item{parallel}{Logical; whether predictor effects are shared across thresholds. It corresponds to the standardized \code{parallel_reg} argument (see \code{\link[dials:parallel_reg]{dials::parallel_reg()}}).} -\item{Thresh}{Character; the threshold constraint pattern. It corresponds -to the standardized \code{threshold_structure} argument (see +\item{Thresh}{Character; the threshold constraint pattern. It corresponds to +the standardized \code{threshold_structure} argument (see \code{\link[dials:threshold_structure]{dials::threshold_structure()}}).} \item{...}{Additional arguments to pass.} @@ -66,7 +66,7 @@ These wrappers reorganize arguments into proper calls to \code{\link[VGAM:vglm]{ \code{\link[VGAM:vgam]{VGAM::vgam()}}, which specialize to several families of ordinal regression models. The standardized argument values used by \code{parsnip::ordinal_reg()} and \code{parsnip::gen_additive_mod()} are matched and converted to the values native -to \code{VGAM} within the wrappers themselves. +to \code{VGAM} within the wrappers. } \details{ The vector \code{values_ordinal_link_VGAM} extends the default \code{ordinal_link} @@ -106,18 +106,21 @@ house_data <- ( fit_wrap <- VGAM_vglm_wrapper( Sat ~ Type + Infl + Cont, family = "sratio", - link = "probitlink", parallel = TRUE, Thresh = "symm0", + link = "probitlink", parallel = TRUE, Thresh = "symmetric_zero", data = house_data ) ) # fit wrapper for additive model ( fit_orig <- VGAM::vgam( Sat ~ Type + Infl + Cont, - family = VGAM::cratio(link = "clogloglink", parallel = TRUE), + family = VGAM::cratio( + link = "clogloglink", parallel = TRUE, Thresh = "symm0", + ), data = house_data ) ) ( fit_wrap <- VGAM_vgam_wrapper( Sat ~ Type + Infl + Cont, - family = "cratio", link = "clogloglink", parallel = TRUE, + family = "cratio", + link = "cloglog", parallel = TRUE, Thresh = "symm0", data = house_data ) ) \dontshow{\}) # examplesIf} diff --git a/man/ordinalNet_wrapper.Rd b/man/ordinalNet_wrapper.Rd index 3da90dc..a2fd789 100644 --- a/man/ordinalNet_wrapper.Rd +++ b/man/ordinalNet_wrapper.Rd @@ -62,17 +62,17 @@ predict_ordinalNet_wrapper( \item{y}{The outcome vector.} -\item{weights}{An optional numeric vector of case weights. When provided, -the outcome is restructured into a multinomial matrix of weighted -indicators.} +\item{weights}{An optional numeric vector of case weights. When provided, the +outcome is restructured into a multinomial matrix of weighted indicators.} -\item{family}{The \code{ordinalNet} family function, given either in the -standardized form (e.g. \code{"cumulative_link"}, \code{"stopping_ratio"}) or natively -(e.g. \code{"cumulative"}, \code{"sratio"}, \code{"cratio"}, \code{"acat"}).} +\item{family}{The odds link function; either a standardized dial value +(\code{"cumulative_link"}, \code{"adjacent_categories"}, \code{"continuation_ratio"}, +\code{"stopping_ratio"}) or an \code{ordinalNet} native value (\code{"cumulative"}, +\code{"acat"}, \code{"cratio"}, \code{"sratio"}).} -\item{link}{The \code{ordinalNet} link function, given either in the standardized -form (e.g. \code{"logistic"}) or natively (e.g. \code{"logit"}, \code{"probit"}, -\code{"cloglog"}, \code{"cauchit"}).} +\item{link}{The ordinal link function; either a standardized dial value (e.g. +\code{"logistic"}, \code{"probit"}) or a \code{ordinalNet} native value (e.g. \code{"logit"}, +\code{"probit"}).} \item{parallel_reg}{Logical; whether predictors share effects across thresholds. When \code{FALSE}, \code{parallelTerms} is set to \code{FALSE} and diff --git a/man/predict_glmnetcr_wrapper.Rd b/man/predict_glmnetcr_wrapper.Rd index e79df7e..a22f860 100644 --- a/man/predict_glmnetcr_wrapper.Rd +++ b/man/predict_glmnetcr_wrapper.Rd @@ -2,11 +2,12 @@ % Please edit documentation in R/ordinal_reg-glmnetcr.R \name{predict_glmnetcr_wrapper} \alias{predict_glmnetcr_wrapper} +\alias{multi_predict_glmnetcr_wrapper} \alias{predict._glmnetcr} \alias{predict_class._glmnetcr} \alias{predict_classprob._glmnetcr} \alias{multi_predict._glmnetcr} -\title{Predict wrapper for \code{glmnetcr}} +\title{Predict wrappers for \code{glmnetcr}} \usage{ predict_glmnetcr_wrapper( object, @@ -16,7 +17,17 @@ predict_glmnetcr_wrapper( criteria = c("bic", "aic") ) -\method{predict}{`_glmnetcr`}(object, new_data, type = NULL, opts = list(), penalty = NULL, ...) +multi_predict_glmnetcr_wrapper(object, newx, type, lambda) + +\method{predict}{`_glmnetcr`}( + object, + new_data, + type = NULL, + opts = list(), + penalty = NULL, + multi = FALSE, + ... +) \method{predict_class}{`_glmnetcr`}(object, new_data, ...) @@ -38,8 +49,8 @@ predict_glmnetcr_wrapper( \item{type}{Either \code{"class"} or \code{"prob"}.} -\item{lambda}{A penalty value at which to predict. If \code{NULL}, the step -minimizing \code{criteria} is used.} +\item{lambda}{A penalty value or vector at which to predict. If \code{NULL}, the +step minimizing \code{criteria} is used (single penalty only).} \item{criteria}{The criterion by which to select \code{lambda} within the path sequence. Defaults to \code{"bic"} for consistency with @@ -51,13 +62,18 @@ penalty. If \code{NULL}, the regularization path stored in the model fit is used.} } \value{ -A character vector of class predictions or a matrix of class -probabilities. +\code{predict_glmnetcr_wrapper()} returns a character vector of class +predictions or a matrix of class probabilities. +\code{multi_predict_glmnetcr_wrapper()} returns a numeric array with one slice +per penalty value for class probabilities, or a character matrix with one +column per penalty value for class predictions. +Both outputs mimic those of \code{\link[glmnetcr:predict.glmnetcr]{glmnetcr::predict.glmnetcr()}}. } \description{ -Selects predictions at a specific penalty value from the regularization path. -When the requested penalty lies between two path values, linearly -interpolates between the probability matrices at the neighboring steps. +Select predictions at a specific penalty value or a vector of penalty values. +For penalties between path values, linearly interpolate between the +probability matrices at the neighboring steps. For penalties outside the path +range, use the path endpoints. } \examples{ \dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("glmnetcr")) withAutoprint(\{ # examplesIf} @@ -68,33 +84,57 @@ house_matrix <- model.matrix( data = house_data, contrasts.arg = lapply(house_data[, 2:4], contrasts, contrasts = FALSE) ) -pen_vec <- 10 ^ seq(-1, -3, -.5) +pen_vec <- 10 ^ seq(-1, -2, -.25) fit <- glmnetcr::glmnetcr( house_matrix, y = house_data$Sat, lambda = pen_vec ) # predictions (may disagree if `lambda` is not on the path `fit$lambda`) -# probability +set.seed(34091) +house_submatrix <- house_matrix[sample(nrow(house_matrix), 6), ] +# single, probability predict( fit, - newx = head(house_matrix) -)$probs[, , which.min(abs(fit$lambda - 0.02))] + newx = house_submatrix +)$probs[, , which.min(abs(fit$lambda - .02))] predict_glmnetcr_wrapper( fit, - newx = head(house_matrix), + newx = house_submatrix, type = "prob", - lambda = 0.02 + lambda = .02 ) -# class +# single, class predict( fit, - newx = head(house_matrix) -)$class[, which.min(abs(fit$lambda - 0.02))] + newx = house_submatrix +)$class[, which.min(abs(fit$lambda - .02))] predict_glmnetcr_wrapper( fit, - newx = head(house_matrix), + newx = house_submatrix, + type = "class", + lambda = .02 +) +# multiple, probabilities +predict( + fit, + newx = house_submatrix +)$probs +multi_predict_glmnetcr_wrapper( + fit, + newx = house_submatrix, + type = "prob", + lambda = c(.2, .02, .002) +) +# multiple, class +predict( + fit, + newx = house_submatrix +)$class +multi_predict_glmnetcr_wrapper( + fit, + newx = house_submatrix, type = "class", - lambda = 0.02 + lambda = c(.2, .02, .002) ) \dontshow{\}) # examplesIf} } diff --git a/tests/testthat/_snaps/ordinal_reg-glmnetcr.md b/tests/testthat/_snaps/ordinal_reg-glmnetcr.md index 566fd0f..3a6173a 100644 --- a/tests/testthat/_snaps/ordinal_reg-glmnetcr.md +++ b/tests/testthat/_snaps/ordinal_reg-glmnetcr.md @@ -3,18 +3,12 @@ Code translate(gcr_spec) Condition - Warning: - x The "glmnetcr" engine ignores `penalty` in favor of a path that enables prediction at interpolated penalty values. - ! `penalty` was passed 0 values. - i Use `path_values` to override the default path. - Output - Ordinal Regression Model Specification (classification) - - Computational engine: glmnetcr - - Model fit template: - glmnetcr::glmnetcr(x = missing_arg(), y = missing_arg(), weights = missing_arg(), - nlambda = 120L, lambda.min.ratio = 1e-08) + Error: + x For the "glmnetcr" engine, `penalty` must be a single number (or a value of `tune()`). + ! There are 0 values for `penalty`. + i To try multiple values for total regularization, use the tune package. + i To predict multiple penalties, use `multi_predict()`. + i To override the default path, use `path_values`. --- @@ -29,8 +23,7 @@ Computational engine: glmnetcr Model fit template: - glmnetcr::glmnetcr(x = missing_arg(), y = missing_arg(), weights = missing_arg(), - nlambda = 120L, lambda.min.ratio = 1e-08) + glmnetcr::glmnetcr(x = missing_arg(), y = missing_arg(), weights = missing_arg()) # arguments agree diff --git a/tests/testthat/_snaps/ordinal_reg-ordinalNet.md b/tests/testthat/_snaps/ordinal_reg-ordinalNet.md index b3c8bbf..ad60bf6 100644 --- a/tests/testthat/_snaps/ordinal_reg-ordinalNet.md +++ b/tests/testthat/_snaps/ordinal_reg-ordinalNet.md @@ -12,8 +12,7 @@ Model fit template: ordered::ordinalNet_wrapper(x = missing_arg(), y = missing_arg(), - weights = missing_arg(), nLambda = 120L, lambdaMinRatio = 1e-08, - includeLambda0 = TRUE) + weights = missing_arg()) # arguments agree diff --git a/tests/testthat/test-ordinal_reg-glmnetcr.R b/tests/testthat/test-ordinal_reg-glmnetcr.R index 4c27d6b..e8fde27 100644 --- a/tests/testthat/test-ordinal_reg-glmnetcr.R +++ b/tests/testthat/test-ordinal_reg-glmnetcr.R @@ -218,6 +218,102 @@ test_that("prob prediction", { # multiple prediction ---------------------------------------------------------- +test_that("multi-penalty wrapper output structure", { + skip_if_not_installed("MASS") + skip_if_not_installed("glmnetcr") + house_sub <- get_house()$sub + + tidy_fit <- suppressWarnings( + ordinal_reg(engine = "glmnetcr", penalty = 1) |> + fit(Sat ~ Type + Cont, data = house_sub) + ) + fit <- tidy_fit$fit + n <- nrow(house_sub) + pen_vals <- fit$lambda[length(fit$lambda) * seq(4) / 5] + + house_vars <- model.matrix( + Sat ~ Type + Cont + 0, data = house_sub, + contrasts.arg = lapply(house_sub[, 3:4], contrasts, contrasts = FALSE) + ) + + # probability: array [nrow, nclass, npenalty] + prob_res <- multi_predict_glmnetcr_wrapper( + fit, house_vars, type = "prob", lambda = pen_vals + ) + expect_equal(dim(prob_res), c(n, length(tidy_fit$lvl), length(pen_vals))) + + # class: matrix [nrow, npenalty] + class_res <- multi_predict_glmnetcr_wrapper( + fit, house_vars, type = "class", lambda = pen_vals + ) + expect_equal(dim(class_res), c(n, length(pen_vals))) +}) + +test_that("multi-penalty wrapper endpoint use", { + skip_if_not_installed("MASS") + skip_if_not_installed("glmnetcr") + house_sub <- get_house()$sub + + tidy_fit <- suppressWarnings( + ordinal_reg(engine = "glmnetcr", penalty = 1) |> + fit(Sat ~ Type + Cont, data = house_sub) + ) + fit <- tidy_fit$fit + house_vars <- model.matrix( + Sat ~ Type + Cont + 0, data = house_sub, + contrasts.arg = lapply(house_sub[, 3:4], contrasts, contrasts = FALSE) + ) + + prob_lo <- multi_predict_glmnetcr_wrapper( + fit, house_vars, "prob", lambda = min(fit$lambda) / 10 + ) + prob_at <- multi_predict_glmnetcr_wrapper( + fit, house_vars, "prob", lambda = min(fit$lambda) + ) + expect_equal(prob_lo, prob_at) + + prob_hi <- multi_predict_glmnetcr_wrapper( + fit, house_vars, "prob", lambda = max(fit$lambda) * 10 + ) + prob_at <- multi_predict_glmnetcr_wrapper( + fit, house_vars, "prob", lambda = max(fit$lambda) + ) + expect_equal(prob_hi, prob_at) +}) + +test_that("single- and multi-penalty wrappers agree", { + skip_if_not_installed("MASS") + skip_if_not_installed("glmnetcr") + house_sub <- get_house()$sub + + tidy_fit <- suppressWarnings( + ordinal_reg(engine = "glmnetcr", penalty = 1) |> + fit(Sat ~ Type + Cont, data = house_sub) + ) + fit <- tidy_fit$fit + house_vars <- model.matrix( + Sat ~ Type + Cont + 0, data = house_sub, + contrasts.arg = lapply(house_sub[, 3:4], contrasts, contrasts = FALSE) + ) + pen_vals <- fit$lambda[length(fit$lambda) * seq(4) / 5] + + for (type in c("class", "prob")) { + multi_res <- multi_predict_glmnetcr_wrapper( + fit, house_vars, type = type, lambda = pen_vals + ) + for (i in seq_along(pen_vals)) { + single_res <- predict_glmnetcr_wrapper( + fit, house_vars, type = type, lambda = pen_vals[i] + ) + if (type == "prob") { + expect_equal(multi_res[, , i], single_res) + } else { + expect_equal(multi_res[, i], single_res) + } + } + } +}) + test_that("multiple prediction structure", { skip_if_not_installed("MASS") skip_if_not_installed("glmnetcr") @@ -334,14 +430,7 @@ test_that("interfaces agree", { ordinal_reg() |> set_mode("classification") |> set_engine("glmnetcr") - expect_snapshot(gcr_spec |> translate()) - - suppressWarnings( - expect_warning( - fit(gcr_spec, class ~ ., data = caco_train), - regexp = "penalty.*path_values" - ) - ) + expect_snapshot(gcr_spec |> translate(), error = TRUE) gcr_spec <- ordinal_reg(penalty = 1) |> From d6f0fb94dc25d57ee5631cd076b0074183ffb407 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 7 Sep 2026 09:20:55 -0400 Subject: [PATCH 26/45] announce modified handling of penalty paths --- NEWS.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/NEWS.md b/NEWS.md index e2eeac0..40f48ee 100644 --- a/NEWS.md +++ b/NEWS.md @@ -12,6 +12,11 @@ Now `predictvglm()` is used instead. `ordinal_reg()` argument value translation has been moved from the `translate()` method in parsnip to engine wrappers in ordered, with the exception of penalty path assembly for `ordinalNet` and `glmnetcr`, in coordination with [parsnip PR #1393](https://github.com/tidymodels/parsnip/pull/1393). +### penalty paths (breaking change) + +Penalty path arguments in `ordinalNet` are no longer silently internally modified; for example, the user must specify `includeLambda0 = TRUE` if they want the path to inclue zero. +Extrapolative predictions, which err in `ordinalNet`, are overridden to use path endpoint values for consistency with `glmnet` and `glmnetcr`. + ## new features ### additional ordinal regression and random forest engines From 7d39c4c464e4841e8c1e161e776611316260666b Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 13:55:15 -0400 Subject: [PATCH 27/45] accommodate VGAM version 1.1-9 + miscellaneous edits --- DESCRIPTION | 1 + NEWS.md | 2 +- R/ordinal_reg-VGAM.R | 120 ++++++++++++++++---- R/ordinal_reg-rms.R | 6 +- man/VGAM_vglm_wrapper.Rd | 48 +++++++- man/clm_parameters.Rd | 9 +- man/ordered-package.Rd | 1 - man/ordinalForest_parameters.Rd | 7 +- man/ordinalNet_parameters.Rd | 2 +- man/orf_parameters.Rd | 4 +- man/predict_lrm_wrapper.Rd | 6 +- man/rpartScore_parameters.Rd | 2 +- tests/testthat/test-gen_additive_mod-VGAM.R | 9 ++ tests/testthat/test-ordinal_reg-VGAM.R | 38 +++++-- 14 files changed, 208 insertions(+), 47 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 552e177..e5d49e1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -57,3 +57,4 @@ URL: https://corybrunson.github.io/ordered/ BugReports: https://github.com/corybrunson/ordered/issues Config/Needs/website: rmarkdown Config/roxygen2/version: 8.0.0 +RoxygenNote: 7.3.3 diff --git a/NEWS.md b/NEWS.md index 40f48ee..a309f65 100644 --- a/NEWS.md +++ b/NEWS.md @@ -14,7 +14,7 @@ Now `predictvglm()` is used instead. ### penalty paths (breaking change) -Penalty path arguments in `ordinalNet` are no longer silently internally modified; for example, the user must specify `includeLambda0 = TRUE` if they want the path to inclue zero. +Penalty path arguments in `ordinalNet` are no longer silently internally modified; for example, the user must specify `includeLambda0 = TRUE` if they want the path to include zero. Extrapolative predictions, which err in `ordinalNet`, are overridden to use path endpoint values for consistency with `glmnet` and `glmnetcr`. ## new features diff --git a/R/ordinal_reg-VGAM.R b/R/ordinal_reg-VGAM.R index cabcaa0..29d9989 100644 --- a/R/ordinal_reg-VGAM.R +++ b/R/ordinal_reg-VGAM.R @@ -46,10 +46,45 @@ #' dials::ordinal_link(values = values_ordinal_link_VGAM) #' values_threshold_structure_VGAM #' dials::threshold_structure(values = values_threshold_structure_VGAM) - -#' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("VGAM") +#' #' house_data <- #' MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] + +#' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("VGAM") && utils::packageVersion("VGAM") == package_version("1.1.9") +#' # {VGAM} version 1.1-9 +#' +#' # fit wrapper for linear model +#' ( fit_orig <- VGAM::vglm( +#' Sat ~ Type + Infl + Cont, +#' family = VGAM::sratio( +#' link = "probitlink", parallel = TRUE, threshold = "symmetric0" +#' ), +#' data = house_data +#' ) ) +#' ( fit_wrap <- VGAM_vglm_wrapper( +#' Sat ~ Type + Infl + Cont, +#' family = "sratio", +#' link = "probitlink", parallel = TRUE, Thresh = "symmetric_zero", +#' data = house_data +#' ) ) +#' # fit wrapper for additive model +#' ( fit_orig <- VGAM::vgam( +#' Sat ~ Type + Infl + Cont, +#' family = VGAM::cratio( +#' link = "clogloglink", parallel = TRUE, threshold = "symmetric0", +#' ), +#' data = house_data +#' ) ) +#' ( fit_wrap <- VGAM_vgam_wrapper( +#' Sat ~ Type + Infl + Cont, +#' family = "cratio", +#' link = "cloglog", parallel = TRUE, Thresh = "symmetric0", +#' data = house_data +#' ) ) + +#' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("VGAM") && utils::packageVersion("VGAM") > package_version("1.1.9") +#' # {VGAM} version >= 1.1-10 +#' #' # fit wrapper for linear model #' ( fit_orig <- VGAM::vglm( #' Sat ~ Type + Infl + Cont, @@ -89,6 +124,7 @@ VGAM_vglm_wrapper <- function( call = rlang::caller_env() ) { rlang::check_installed("VGAM") + VGAM_1_1_9 <- utils::packageVersion("VGAM") == package_version("1.1.9") # TODO: Ensure that `formula = cbind(...) ~ ...` is disallowed, for this and # for other `ordinal_reg()` engines. @@ -96,14 +132,25 @@ VGAM_vglm_wrapper <- function( # match standardized argument values to their `VGAM` natives link <- match_ordinal_link_VGAM(link, call = call) family <- match_ordinal_family(family, call = call) - Thresh <- match_threshold_structure_VGAM(Thresh, call = call) + Thresh <- match_threshold_structure_VGAM( + Thresh, + v_1_1_9 = VGAM_1_1_9, + call = call + ) check_ordinal_link_family_VGAM(family = family, link = link, call = call) # execute nested call on modified inputs - family_call <- rlang::call2( - .fn = family, .ns = "VGAM", - link = link, parallel = parallel, Thresh = Thresh - ) + family_call <- if (VGAM_1_1_9) { + rlang::call2( + .fn = family, .ns = "VGAM", + link = link, parallel = parallel, threshold = Thresh + ) + } else { + rlang::call2( + .fn = family, .ns = "VGAM", + link = link, parallel = parallel, Thresh = Thresh + ) + } cl <- rlang::call2( .fn = "vglm", .ns = "VGAM", formula = rlang::expr(formula), data = rlang::expr(data), @@ -125,18 +172,30 @@ VGAM_vgam_wrapper <- function( call = rlang::caller_env() ) { rlang::check_installed("VGAM") + VGAM_1_1_9 <- utils::packageVersion("VGAM") == package_version("1.1.9") # match standardized argument values to their `VGAM` natives link <- match_ordinal_link_VGAM(link, call = call) family <- match_ordinal_family(family, call = call) - Thresh <- match_threshold_structure_VGAM(Thresh, call = call) + Thresh <- match_threshold_structure_VGAM( + Thresh, + v_1_1_9 = VGAM_1_1_9, + call = call + ) check_ordinal_link_family_VGAM(family = family, link = link, call = call) # execute nested call on modified inputs - family_call <- rlang::call2( - .fn = family, .ns = "VGAM", - link = link, parallel = parallel, Thresh = Thresh - ) + family_call <- if (VGAM_1_1_9) { + rlang::call2( + .fn = family, .ns = "VGAM", + link = link, parallel = parallel, threshold = Thresh + ) + } else { + rlang::call2( + .fn = family, .ns = "VGAM", + link = link, parallel = parallel, Thresh = Thresh + ) + } cl <- rlang::call2( .fn = "vgam", .ns = "VGAM", formula = rlang::expr(formula), data = rlang::expr(data), @@ -228,7 +287,7 @@ match_ordinal_link_VGAM <- function(link, call = rlang::caller_env()) { } match_threshold_structure_VGAM <- function( - Thresh, + Thresh, v_1_1_9 = FALSE, call = rlang::caller_env() ) { if (! is.character(Thresh)) { @@ -236,9 +295,15 @@ match_threshold_structure_VGAM <- function( } check_string(Thresh, arg = "threshold_structure", call = call) + native_vals <- if (v_1_1_9) { + c("unconstrained", "equidistant", "symmetric1", "symmetric0") + } else { + c("free", "symm1", "symm0", "equid", "qnorm") + } + if ( # keep native values - ! Thresh %in% c("free", "symm1", "symm0", "equid", "qnorm") + ! Thresh %in% native_vals ) { # modify standardized values Thresh <- rlang::arg_match0( @@ -247,14 +312,25 @@ match_threshold_structure_VGAM <- function( arg_nm = "threshold_structure", error_call = call ) - Thresh <- switch( - Thresh, - flexible = "free", - symmetric_median = "symm1", - symmetric_zero = "symm0", - equidistant = "equid", - qnorm = "qnorm" - ) + # match to native values + if (v_1_1_9) { + Thresh <- switch( + Thresh, + flexible = "unconstrained", + symmetric_median = "symmetric1", + symmetric_zero = "symmetric0", + equidistant = "equidistant" + ) + } else { + Thresh <- switch( + Thresh, + flexible = "free", + symmetric_median = "symm1", + symmetric_zero = "symm0", + equidistant = "equid", + qnorm = "qnorm" + ) + } } Thresh diff --git a/R/ordinal_reg-rms.R b/R/ordinal_reg-rms.R index 611ee24..6d5b26f 100644 --- a/R/ordinal_reg-rms.R +++ b/R/ordinal_reg-rms.R @@ -1,4 +1,4 @@ -#' Predict wrapper for `rms` +#' Wrapper for `rms` predictions #' #' `rms::lrm()` and `rms::orm()` use [rms::predictrms()] internally, which #' does not accept tibble inputs. This wrapper ensures that `newdata` is @@ -6,10 +6,10 @@ #' @param object A fitted model object of class `"lrm"` or `"orm"`. #' @param newdata A data frame or tibble of predictors. #' @param type The prediction type, passed to the underlying method. -#' @param ... Additional arguments to pass. +#' @param ... Additional arguments passed to the underlying method. #' @keywords internal #' @returns The result of [stats::predict()] dispatched on `object`. -#' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("rms") +#' @examplesIf rlang::is_installed("rms") && rlang::is_installed("MASS") #' house_data <- #' MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] #' ( fit <- rms::lrm(Sat ~ Infl + Type + Cont, data = house_data) ) diff --git a/man/VGAM_vglm_wrapper.Rd b/man/VGAM_vglm_wrapper.Rd index 72ee0bc..6a0a2c8 100644 --- a/man/VGAM_vglm_wrapper.Rd +++ b/man/VGAM_vglm_wrapper.Rd @@ -1,11 +1,17 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ordinal_reg-VGAM.R +\docType{data} \name{VGAM_vglm_wrapper} \alias{VGAM_vglm_wrapper} \alias{VGAM_vgam_wrapper} \alias{values_ordinal_link_VGAM} \alias{values_threshold_structure_VGAM} \title{Fit wrappers for \code{VGAM}} +\format{ +An object of class \code{character} of length 10. + +An object of class \code{character} of length 5. +} \usage{ VGAM_vglm_wrapper( formula, @@ -70,12 +76,12 @@ to \code{VGAM} within the wrappers. } \details{ The vector \code{values_ordinal_link_VGAM} extends the default \code{ordinal_link} -options encoded in \code{\link[dials:values_ordinal_link]{dials::values_ordinal_link}} to those accepted by +options encoded in \code{\link[dials:ordinal_link]{dials::values_ordinal_link}} to those accepted by \code{\link[VGAM:vglm]{VGAM::vglm()}} and \code{\link[VGAM:vgam]{VGAM::vgam()}}. The vector \code{values_threshold_structure_VGAM} extends the default \code{threshold_structure} options encoded in -\code{\link[dials:values_threshold_structure]{dials::values_threshold_structure}} to those accepted by \code{\link[VGAM:vglm]{VGAM::vglm()}} +\code{\link[dials:threshold_structure]{dials::values_threshold_structure}} to those accepted by \code{\link[VGAM:vglm]{VGAM::vglm()}} and \code{\link[VGAM:vgam]{VGAM::vgam()}}. Note that \code{VGAM::vglm()} and \code{VGAM::vgam()} treat the rows of \code{data} @@ -92,9 +98,44 @@ values_ordinal_link_VGAM dials::ordinal_link(values = values_ordinal_link_VGAM) values_threshold_structure_VGAM dials::threshold_structure(values = values_threshold_structure_VGAM) -\dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("VGAM")) withAutoprint(\{ # examplesIf} + house_data <- MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] +\dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("VGAM") && utils::packageVersion("VGAM") == package_version("1.1.9")) withAutoprint(\{ # examplesIf} +# {VGAM} version 1.1-9 + +# fit wrapper for linear model +( fit_orig <- VGAM::vglm( + Sat ~ Type + Infl + Cont, + family = VGAM::sratio( + link = "probitlink", parallel = TRUE, threshold = "symmetric0" + ), + data = house_data +) ) +( fit_wrap <- VGAM_vglm_wrapper( + Sat ~ Type + Infl + Cont, + family = "sratio", + link = "probitlink", parallel = TRUE, Thresh = "symmetric_zero", + data = house_data +) ) +# fit wrapper for additive model +( fit_orig <- VGAM::vgam( + Sat ~ Type + Infl + Cont, + family = VGAM::cratio( + link = "clogloglink", parallel = TRUE, threshold = "symmetric0", + ), + data = house_data +) ) +( fit_wrap <- VGAM_vgam_wrapper( + Sat ~ Type + Infl + Cont, + family = "cratio", + link = "cloglog", parallel = TRUE, Thresh = "symmetric0", + data = house_data +) ) +\dontshow{\}) # examplesIf} +\dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("VGAM") && utils::packageVersion("VGAM") > package_version("1.1.9")) withAutoprint(\{ # examplesIf} +# {VGAM} version >= 1.1-10 + # fit wrapper for linear model ( fit_orig <- VGAM::vglm( Sat ~ Type + Infl + Cont, @@ -125,4 +166,5 @@ house_data <- ) ) \dontshow{\}) # examplesIf} } +\keyword{datasets} \keyword{internal} diff --git a/man/clm_parameters.Rd b/man/clm_parameters.Rd index e1aec46..713cb4d 100644 --- a/man/clm_parameters.Rd +++ b/man/clm_parameters.Rd @@ -1,19 +1,23 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/param-engine-clm.R +\docType{data} \name{clm_parameters} \alias{clm_parameters} \alias{values_ordinal_link_clm} \title{Dials for \code{ordinal} engine parameters} +\format{ +An object of class \code{character} of length 7. +} \usage{ values_ordinal_link_clm } \value{ An object of S3 parent class \code{param} and primary class \code{qual_param}; -see \code{\link[dials:new_qual_param]{dials::new_qual_param()}}. +see \code{\link[dials:new-param]{dials::new_qual_param()}}. } \description{ The vector \code{values_ordinal_link_clm} extends the default \code{ordinal_link} -options encoded in \code{\link[dials:values_ordinal_link]{dials::values_ordinal_link}} to those accepted by +options encoded in \code{\link[dials:ordinal_link]{dials::values_ordinal_link}} to those accepted by \code{\link[ordinal:clm]{ordinal::clm()}}. } \details{ @@ -25,4 +29,5 @@ values_ordinal_link_clm dials::ordinal_link(values = values_ordinal_link_clm) dials::threshold_structure(values = dials::values_threshold_structure) } +\keyword{datasets} \keyword{internal} diff --git a/man/ordered-package.Rd b/man/ordered-package.Rd index 77db786..1a61ada 100644 --- a/man/ordered-package.Rd +++ b/man/ordered-package.Rd @@ -61,7 +61,6 @@ Useful links: Authors: \itemize{ - \item Jason Cory Brunson \email{cornelioid@gmail.com} (\href{https://orcid.org/0000-0003-3126-9494}{ORCID}) \item Max Kuhn \email{max@posit.co} (\href{https://orcid.org/0000-0003-2402-136X}{ORCID}) } diff --git a/man/ordinalForest_parameters.Rd b/man/ordinalForest_parameters.Rd index 19278b7..1aaea6c 100644 --- a/man/ordinalForest_parameters.Rd +++ b/man/ordinalForest_parameters.Rd @@ -1,5 +1,6 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/param-engine-ordinalForest.R +\docType{data} \name{ordinalForest_parameters} \alias{ordinalForest_parameters} \alias{naive_scores} @@ -10,6 +11,9 @@ \alias{ord_metric} \alias{values_ord_metric} \title{Dials for \code{ordinalForest} engine parameters} +\format{ +An object of class \code{character} of length 4. +} \usage{ naive_scores(values = c(FALSE, TRUE)) @@ -39,7 +43,7 @@ no transformation, \code{NULL}.} } \value{ An object of S3 parent class \code{param} and primary class \code{qual_param} -or \code{quant_param}; see \code{\link[dials:new_qual_param]{dials::new_qual_param()}} and +or \code{quant_param}; see \code{\link[dials:new-param]{dials::new_qual_param()}} and [dials::new_quant_param(). } \description{ @@ -83,3 +87,4 @@ ord_metric() \seealso{ \code{\link[dials:trees]{dials::trees()}} } +\keyword{datasets} diff --git a/man/ordinalNet_parameters.Rd b/man/ordinalNet_parameters.Rd index 3b075f8..bf0bbd2 100644 --- a/man/ordinalNet_parameters.Rd +++ b/man/ordinalNet_parameters.Rd @@ -22,7 +22,7 @@ no transformation, \code{NULL}.} } \value{ An object of S3 parent class \code{param} and primary class -\code{quant_param}; see \code{\link[dials:new_quant_param]{dials::new_quant_param()}}. +\code{quant_param}; see \code{\link[dials:new-param]{dials::new_quant_param()}}. } \description{ These parameters are auxiliary to ordinal regression models that use the diff --git a/man/orf_parameters.Rd b/man/orf_parameters.Rd index cf3f224..b84a506 100644 --- a/man/orf_parameters.Rd +++ b/man/orf_parameters.Rd @@ -27,8 +27,8 @@ no transformation, \code{NULL}.} } \value{ An object of S3 parent class \code{param} and primary class \code{qual_param} -or \code{quant_param}; see \code{\link[dials:new_qual_param]{dials::new_qual_param()}} and -\code{\link[dials:new_quant_param]{dials::new_quant_param()}}. +or \code{quant_param}; see \code{\link[dials:new-param]{dials::new_qual_param()}} and +\code{\link[dials:new-param]{dials::new_quant_param()}}. } \description{ These parameters are auxiliary to random forest models that use the diff --git a/man/predict_lrm_wrapper.Rd b/man/predict_lrm_wrapper.Rd index 946f726..ee8f0af 100644 --- a/man/predict_lrm_wrapper.Rd +++ b/man/predict_lrm_wrapper.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/ordinal_reg-rms.R \name{predict_lrm_wrapper} \alias{predict_lrm_wrapper} -\title{Predict wrapper for \code{rms}} +\title{Wrapper for \code{rms} predictions} \usage{ predict_lrm_wrapper(object, newdata, type, ...) } @@ -13,7 +13,7 @@ predict_lrm_wrapper(object, newdata, type, ...) \item{type}{The prediction type, passed to the underlying method.} -\item{...}{Additional arguments to pass.} +\item{...}{Additional arguments passed to the underlying method.} } \value{ The result of \code{\link[stats:predict]{stats::predict()}} dispatched on \code{object}. @@ -24,7 +24,7 @@ does not accept tibble inputs. This wrapper ensures that \code{newdata} is converted to a plain data frame before the S3 method is dispatched. } \examples{ -\dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("rms")) withAutoprint(\{ # examplesIf} +\dontshow{if (rlang::is_installed("rms") && rlang::is_installed("MASS")) withAutoprint(\{ # examplesIf} house_data <- MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] ( fit <- rms::lrm(Sat ~ Infl + Type + Cont, data = house_data) ) diff --git a/man/rpartScore_parameters.Rd b/man/rpartScore_parameters.Rd index 4e7ab0d..75f3f3d 100644 --- a/man/rpartScore_parameters.Rd +++ b/man/rpartScore_parameters.Rd @@ -15,7 +15,7 @@ prune_func(values = c("mr", "mc")) } \value{ An object of S3 parent class \code{param} and primary class \code{qual_param}; -see \code{\link[dials:new_qual_param]{dials::new_qual_param()}}. +see \code{\link[dials:new-param]{dials::new_qual_param()}}. } \description{ These parameters are auxiliary to decision tree models that use the diff --git a/tests/testthat/test-gen_additive_mod-VGAM.R b/tests/testthat/test-gen_additive_mod-VGAM.R index f677e78..ecd8dcd 100644 --- a/tests/testthat/test-gen_additive_mod-VGAM.R +++ b/tests/testthat/test-gen_additive_mod-VGAM.R @@ -120,11 +120,15 @@ test_that("case weights", { test_that("class prediction", { skip_if_not_installed("MASS") skip_if_not_installed("VGAM") + skip_if_not(utils::packageVersion("VGAM") > package_version("1.1.9")) skip_if_not_installed("QSARdata") # for `s()` and friends in GAM formula suppressPackageStartupMessages(library(VGAM)) + # FIXME: Errs with message "something went wrong in the C function 'vbfa'". + # Likely due to {VGAM} v1.1-9; if tests are conditioned on this version (as + # done now), then documentation should include a note about it. tidy_fit <- gen_additive_mod(engine = "vgam", mode = "classification") |> fit(class ~ s(mol_weight) + volume + s(ClogP), data = caco_train) @@ -145,11 +149,13 @@ test_that("class prediction", { test_that("probability prediction", { skip_if_not_installed("MASS") skip_if_not_installed("VGAM") + skip_if_not(utils::packageVersion("VGAM") > package_version("1.1.9")) skip_if_not_installed("QSARdata") # for `s()` and friends in GAM formula suppressPackageStartupMessages(library(VGAM)) + # FIXME: See above. tidy_fit <- gen_additive_mod(engine = "vgam", mode = "classification") |> fit(class ~ mol_weight + s(volume) + s(ClogP), data = caco_train) @@ -169,11 +175,13 @@ test_that("probability prediction", { test_that("linear_pred prediction", { skip_if_not_installed("MASS") skip_if_not_installed("VGAM") + skip_if_not(utils::packageVersion("VGAM") > package_version("1.1.9")) skip_if_not_installed("QSARdata") # for `s()` and friends in GAM formula suppressPackageStartupMessages(library(VGAM)) + # FIXME: See above. tidy_fit <- gen_additive_mod(engine = "vgam", mode = "classification") |> fit(class ~ s(mol_weight) + volume + s(ClogP), data = caco_train) @@ -188,6 +196,7 @@ test_that("linear_pred prediction", { test_that("interfaces agree", { skip_if_not_installed("VGAM") + skip_if_not(utils::packageVersion("VGAM") > package_version("1.1.9")) skip_if_not_installed("QSARdata") onet_spec <- diff --git a/tests/testthat/test-ordinal_reg-VGAM.R b/tests/testthat/test-ordinal_reg-VGAM.R index 40dca1b..7c3a2e4 100644 --- a/tests/testthat/test-ordinal_reg-VGAM.R +++ b/tests/testthat/test-ordinal_reg-VGAM.R @@ -35,9 +35,15 @@ test_that("model object", { set.seed(seed) orig_fit <- VGAM::vglm( Sat ~ Type + Infl + Cont, - family = VGAM::cratio( - link = "probitlink", parallel = TRUE, Thresh = "symm1" - ), + family = if (utils::packageVersion("VGAM") == package_version("1.1.9")) { + VGAM::cratio( + link = "probitlink", parallel = TRUE, threshold = "symmetric1" + ) + } else { + VGAM::cratio( + link = "probitlink", parallel = TRUE, Thresh = "symm1" + ) + }, data = house_sub ) @@ -184,6 +190,7 @@ test_that("linear_pred prediction", { test_that("interfaces agree", { skip_if_not_installed("VGAM") + skip_if_not(utils::packageVersion("VGAM") > package_version("1.1.9")) skip_if_not_installed("QSARdata") onet_spec <- @@ -302,6 +309,14 @@ test_that("standardized link, family, and threshold values are matched", { expect_equal(match_threshold_structure_VGAM("equidistant"), "equid") expect_equal(match_threshold_structure_VGAM("symmetric_zero"), "symm0") expect_equal(match_threshold_structure_VGAM("qnorm"), "qnorm") + expect_equal( + match_threshold_structure_VGAM("equidistant", v_1_1_9 = TRUE), + "equidistant" + ) + expect_equal( + match_threshold_structure_VGAM("symmetric_zero", v_1_1_9 = TRUE), + "symmetric0" + ) expect_snapshot(error = TRUE, { match_ordinal_link_VGAM("loglog") @@ -334,10 +349,19 @@ test_that("VGAM wrappers translate standardized argument values", { MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] # native values pass through unchanged - native <- VGAM_vglm_wrapper( - Sat ~ Infl + Type, data = house_data, - family = "sratio", link = "probitlink", Thresh = "symm1", parallel = TRUE - ) + native <- if (utils::packageVersion("VGAM") == package_version("1.1.9")) { + VGAM_vglm_wrapper( + Sat ~ Infl + Type, data = house_data, + family = "sratio", link = "probitlink", + threshold = "symmetric1", parallel = TRUE + ) + } else { + VGAM_vglm_wrapper( + Sat ~ Infl + Type, data = house_data, + family = "sratio", link = "probitlink", + Thresh = "symm1", parallel = TRUE + ) + } expect_equal(native@family@infos()$link, "probitlink") expect_equal(native@family@vfamily[1L], "sratio") From bbed5d1ffcece77b7efdff2f16b6c5e0e8dcef27 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 14:34:55 -0400 Subject: [PATCH 28/45] alert users to prediction issue with VGAM 1.1-9 --- R/ordinal_reg-VGAM.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/ordinal_reg-VGAM.R b/R/ordinal_reg-VGAM.R index 29d9989..d185e8a 100644 --- a/R/ordinal_reg-VGAM.R +++ b/R/ordinal_reg-VGAM.R @@ -14,6 +14,9 @@ #' `threshold_structure` options encoded in #' [`dials::values_threshold_structure`] to those accepted by [`VGAM::vglm()`] #' and [`VGAM::vgam()`]. +#' +#' NB: Prediction with `vgam` models under {VGAM} version 1.1-9 does not yet +#' support the use of smoothers `s()`. #' @param formula The formula to pass. #' @param data The data frame to pass. #' @param family The odds link function; either a standardized dial value From 796bffcc930a40795c749daf0544f08f9af17e00 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 14:36:27 -0400 Subject: [PATCH 29/45] announce accommodation of VGAM version 1.1-9 --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index a309f65..07a23ac 100644 --- a/NEWS.md +++ b/NEWS.md @@ -50,7 +50,7 @@ Coordinated with [parsnip PR #1391](https://github.com/tidymodels/parsnip/pull/1 ### threshold structure and parallel regression model arguments The `threshold_structure` model argument for `ordinal_reg()` controls what constraints, if any, are imposed on the ordered thresholds. -It can be used by the `clm` and `vglm` engines. +It can be used by the `clm` and `vglm` engines, including with VGAM version 1.1-9. The `parallel_reg` model argument for `ordinal_reg()` controls the parallel regression assumption with a logical value applied to all predictors. It can be used by the `clm`, `vglm`, and `ordinalNet` engines. From 07dc4aa0a59d9c6f0ec17b62c6e7e455263a137d Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 14:53:58 -0400 Subject: [PATCH 30/45] rm obsolete parsnip remote --- DESCRIPTION | 1 - 1 file changed, 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e5d49e1..d8038f7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -47,7 +47,6 @@ Suggests: spelling, testthat (>= 3.0.0) Remotes: - corybrunson/parsnip@parallel-reg, corybrunson/dials@parallel-reg Config/testthat/edition: 3 Encoding: UTF-8 From 9c2f8b21cc6e27ad1108b296ff1533fdae8f088d Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 14:56:53 -0400 Subject: [PATCH 31/45] oops - restore & update parsnip remote --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index d8038f7..9f1ea1b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -47,6 +47,7 @@ Suggests: spelling, testthat (>= 3.0.0) Remotes: + tidymodels/parsnip, corybrunson/dials@parallel-reg Config/testthat/edition: 3 Encoding: UTF-8 From 9f0c3aa3c146df25c9091769fb0df0aff90b9f34 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 15:08:07 -0400 Subject: [PATCH 32/45] rm tests of parallel_reg argument accepting formula & list values --- tests/testthat/test-ordinal_reg.R | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/tests/testthat/test-ordinal_reg.R b/tests/testthat/test-ordinal_reg.R index e79b3e1..c373542 100644 --- a/tests/testthat/test-ordinal_reg.R +++ b/tests/testthat/test-ordinal_reg.R @@ -37,17 +37,6 @@ test_that("parallel_reg accepts logical input", { expect_snapshot(ordinal_reg(parallel_reg = FALSE)) }) -test_that("parallel_reg accepts formula input", { - expect_snapshot(ordinal_reg(parallel_reg = TRUE ~ x)) - expect_snapshot(ordinal_reg(parallel_reg = FALSE ~ y + z)) -}) - -test_that("parallel_reg accepts list input", { - expect_snapshot(ordinal_reg(parallel_reg = list(TRUE ~ x))) - expect_snapshot(ordinal_reg(parallel_reg = list(FALSE ~ x, TRUE ~ y))) - expect_snapshot(ordinal_reg(parallel_reg = list(FALSE, TRUE ~ y))) -}) - test_that("parallel_reg rejects invalid inputs", { skip_if_not_installed("MASS") house_sub <- MASS::housing[rep(seq(nrow(MASS::housing)), @@ -67,13 +56,4 @@ test_that("parallel_reg rejects invalid inputs", { fit(Sat ~ Infl + Cont, data = house_sub), error = TRUE ) - # list with > 2 elements - expect_snapshot( - ordinal_reg( - parallel_reg = list(TRUE ~ Infl, FALSE ~ Cont, TRUE) - ) |> - set_engine("clm") |> - fit(Sat ~ Infl + Cont, data = house_sub), - error = TRUE - ) }) From 1185fd834ca26adfe37d02cd9e4d45441e47aa83 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 16:17:32 -0400 Subject: [PATCH 33/45] update snapshots --- tests/testthat/_snaps/ordinal_reg.md | 74 ---------------------------- 1 file changed, 74 deletions(-) diff --git a/tests/testthat/_snaps/ordinal_reg.md b/tests/testthat/_snaps/ordinal_reg.md index 33093e1..a2af0d5 100644 --- a/tests/testthat/_snaps/ordinal_reg.md +++ b/tests/testthat/_snaps/ordinal_reg.md @@ -66,71 +66,6 @@ Computational engine: polr -# parallel_reg accepts formula input - - Code - ordinal_reg(parallel_reg = TRUE ~ x) - Output - Ordinal Regression Model Specification (classification) - - Main Arguments: - parallel_reg = TRUE ~ x - - Computational engine: polr - - ---- - - Code - ordinal_reg(parallel_reg = FALSE ~ y + z) - Output - Ordinal Regression Model Specification (classification) - - Main Arguments: - parallel_reg = FALSE ~ y + z - - Computational engine: polr - - -# parallel_reg accepts list input - - Code - ordinal_reg(parallel_reg = list(TRUE ~ x)) - Output - Ordinal Regression Model Specification (classification) - - Main Arguments: - parallel_reg = list(TRUE ~ x) - - Computational engine: polr - - ---- - - Code - ordinal_reg(parallel_reg = list(FALSE ~ x, TRUE ~ y)) - Output - Ordinal Regression Model Specification (classification) - - Main Arguments: - parallel_reg = list(FALSE ~ x, TRUE ~ y) - - Computational engine: polr - - ---- - - Code - ordinal_reg(parallel_reg = list(FALSE, TRUE ~ y)) - Output - Ordinal Regression Model Specification (classification) - - Main Arguments: - parallel_reg = list(FALSE, TRUE ~ y) - - Computational engine: polr - - # parallel_reg rejects invalid inputs Code @@ -149,12 +84,3 @@ Error in `fit()`: ! `parallel_reg` must be `TRUE`, `FALSE`, or `NULL`, not a object. ---- - - Code - fit(set_engine(ordinal_reg(parallel_reg = list(TRUE ~ Infl, FALSE ~ Cont, TRUE)), - "clm"), Sat ~ Infl + Cont, data = house_sub) - Condition - Error in `fit()`: - ! `parallel_reg` must be `TRUE`, `FALSE`, or `NULL`, not a list. - From bca0b20795de4e3807b5f24cb61af6ea8466bceb Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 16:19:15 -0400 Subject: [PATCH 34/45] update parsnip remote following pr merge --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 552e177..cb6ccef 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -47,7 +47,7 @@ Suggests: spelling, testthat (>= 3.0.0) Remotes: - corybrunson/parsnip@parallel-reg, + tidymodels/parsnip, corybrunson/dials@parallel-reg Config/testthat/edition: 3 Encoding: UTF-8 From 0326ca64ed144f809b8a8ef693ac2bc8c44dd9c0 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 16:29:42 -0400 Subject: [PATCH 35/45] rm tests of deprecated parallel_reg behavior --- tests/testthat/_snaps/ordinal_reg.md | 18 ------------------ tests/testthat/test-ordinal_reg.R | 21 --------------------- 2 files changed, 39 deletions(-) diff --git a/tests/testthat/_snaps/ordinal_reg.md b/tests/testthat/_snaps/ordinal_reg.md index a2af0d5..17db7b9 100644 --- a/tests/testthat/_snaps/ordinal_reg.md +++ b/tests/testthat/_snaps/ordinal_reg.md @@ -66,21 +66,3 @@ Computational engine: polr -# parallel_reg rejects invalid inputs - - Code - fit(set_engine(ordinal_reg(parallel_reg = "TRUE"), "clm"), Sat ~ Infl + Cont, - data = house_sub) - Condition - Error in `fit()`: - ! `parallel_reg` must be `TRUE`, `FALSE`, or `NULL`, not the string "TRUE". - ---- - - Code - fit(set_engine(ordinal_reg(parallel_reg = Sat ~ Infl), "clm"), Sat ~ Infl + - Cont, data = house_sub) - Condition - Error in `fit()`: - ! `parallel_reg` must be `TRUE`, `FALSE`, or `NULL`, not a object. - diff --git a/tests/testthat/test-ordinal_reg.R b/tests/testthat/test-ordinal_reg.R index c373542..c7daf56 100644 --- a/tests/testthat/test-ordinal_reg.R +++ b/tests/testthat/test-ordinal_reg.R @@ -36,24 +36,3 @@ test_that("parallel_reg accepts logical input", { expect_snapshot(ordinal_reg(parallel_reg = TRUE)) expect_snapshot(ordinal_reg(parallel_reg = FALSE)) }) - -test_that("parallel_reg rejects invalid inputs", { - skip_if_not_installed("MASS") - house_sub <- MASS::housing[rep(seq(nrow(MASS::housing)), - MASS::housing$Freq), -5] - - # not logical or formula - expect_snapshot( - ordinal_reg(parallel_reg = "TRUE") |> - set_engine("clm") |> - fit(Sat ~ Infl + Cont, data = house_sub), - error = TRUE - ) - # formula without logical LHS - expect_snapshot( - ordinal_reg(parallel_reg = Sat ~ Infl) |> - set_engine("clm") |> - fit(Sat ~ Infl + Cont, data = house_sub), - error = TRUE - ) -}) From 5a25e9a659297fcdaeb3a599cf22917c8064b9d3 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 16:29:53 -0400 Subject: [PATCH 36/45] update documentation --- man/VGAM_vglm_wrapper.Rd | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/VGAM_vglm_wrapper.Rd b/man/VGAM_vglm_wrapper.Rd index 6a0a2c8..8175ca5 100644 --- a/man/VGAM_vglm_wrapper.Rd +++ b/man/VGAM_vglm_wrapper.Rd @@ -84,6 +84,9 @@ The vector \code{values_threshold_structure_VGAM} extends the default \code{\link[dials:threshold_structure]{dials::values_threshold_structure}} to those accepted by \code{\link[VGAM:vglm]{VGAM::vglm()}} and \code{\link[VGAM:vgam]{VGAM::vgam()}}. +NB: Prediction with \code{vgam} models under {VGAM} version 1.1-9 does not yet +support the use of smoothers \code{s()}. + Note that \code{VGAM::vglm()} and \code{VGAM::vgam()} treat the rows of \code{data} as the units of observation: Compressed \code{data} with one row per predictor set will be understood as having a multinomial-valued outcome; only From 64ce15085150480a9949360b2529b69542209f38 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 16:38:10 -0400 Subject: [PATCH 37/45] use includelambda0 engine argument to prevent out-of-range error --- vignettes/articles/examples.Rmd | 2 +- vignettes/template/build-examples.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/vignettes/articles/examples.Rmd b/vignettes/articles/examples.Rmd index 803fe4b..7b3e944 100644 --- a/vignettes/articles/examples.Rmd +++ b/vignettes/articles/examples.Rmd @@ -188,7 +188,7 @@ We can define the model with specific parameters: ```{r} or_spec <- ordinal_reg(penalty = .001, mixture = .5) |> - set_engine("ordinalNet") |> + set_engine("ordinalNet", includeLambda0 = TRUE) |> set_mode("classification") or_spec ``` diff --git a/vignettes/template/build-examples.R b/vignettes/template/build-examples.R index 6202038..8ebba6d 100644 --- a/vignettes/template/build-examples.R +++ b/vignettes/template/build-examples.R @@ -39,7 +39,7 @@ list( # values must be character-ized list( polr = list(), - ordinalNet = list(), + ordinalNet = list(includeLambda0 = "TRUE"), vglm = list(), vgam = list(family = "\"stopping_ratio\""), rpartScore = list(split = "\"quad\""), From a46c77188df269de83eb5713f6b8a4c783715f3e Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 16:44:03 -0400 Subject: [PATCH 38/45] require ordinal for clm test --- tests/testthat/test-ordinal_reg-clm.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-ordinal_reg-clm.R b/tests/testthat/test-ordinal_reg-clm.R index 604574c..12b1e9d 100644 --- a/tests/testthat/test-ordinal_reg-clm.R +++ b/tests/testthat/test-ordinal_reg-clm.R @@ -4,6 +4,7 @@ seed <- 144688L test_that("specification handles model parameters", { skip_if_not_installed("MASS") + skip_if_not_installed("ordinal") house_sub <- get_house()$sub # a legitimate ordinal link function not recognized by {dials} From 16cabcfcd78ab960c685c348adea79ef2bea1def Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 16:48:32 -0400 Subject: [PATCH 39/45] specify minimal version of VGAM --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index cb6ccef..09ff8c9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,7 +39,7 @@ Suggests: ordinalNet, rms (>= 7.0.0), glmnetcr, - VGAM, + VGAM (>= 1.1-9), rpartScore, ordinalForest, orf, From 0c4adbf2c3e6870631768ba04926170d278c35cd Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 17:01:43 -0400 Subject: [PATCH 40/45] rm braces around pkg name + update documentation w/ roxygen2 version 8.1.0 --- DESCRIPTION | 3 +-- NAMESPACE | 18 +++++++++++------- R/ordinal_reg-VGAM.R | 2 +- man/VGAM_vglm_wrapper.Rd | 13 +++---------- man/clm_parameters.Rd | 9 ++------- man/ordered-package.Rd | 1 + man/ordinalForest_parameters.Rd | 7 +------ man/ordinalNet_parameters.Rd | 2 +- man/orf_parameters.Rd | 4 ++-- man/rpartScore_parameters.Rd | 2 +- 10 files changed, 24 insertions(+), 37 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 637fd6a..5d30423 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -56,5 +56,4 @@ Roxygen: list(markdown = TRUE) URL: https://corybrunson.github.io/ordered/ BugReports: https://github.com/corybrunson/ordered/issues Config/Needs/website: rmarkdown -Config/roxygen2/version: 8.0.0 -RoxygenNote: 7.3.3 +Config/roxygen2/version: 8.1.0 diff --git a/NAMESPACE b/NAMESPACE index 329ac80..4ad4113 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -38,10 +38,14 @@ export(values_ordinal_link_clm) export(values_threshold_structure_VGAM) import(parsnip) import(rlang) -importFrom(parsnip,eval_args) -importFrom(parsnip,multi_predict) -importFrom(parsnip,predict_raw) -importFrom(stats,approx) -importFrom(stats,as.formula) -importFrom(stats,coef) -importFrom(stats,predict) +importFrom(parsnip, + eval_args, + multi_predict, + predict_raw +) +importFrom(stats, + approx, + as.formula, + coef, + predict +) diff --git a/R/ordinal_reg-VGAM.R b/R/ordinal_reg-VGAM.R index d185e8a..9544d4e 100644 --- a/R/ordinal_reg-VGAM.R +++ b/R/ordinal_reg-VGAM.R @@ -15,7 +15,7 @@ #' [`dials::values_threshold_structure`] to those accepted by [`VGAM::vglm()`] #' and [`VGAM::vgam()`]. #' -#' NB: Prediction with `vgam` models under {VGAM} version 1.1-9 does not yet +#' NB: Prediction with `vgam` models under VGAM version 1.1-9 does not yet #' support the use of smoothers `s()`. #' @param formula The formula to pass. #' @param data The data frame to pass. diff --git a/man/VGAM_vglm_wrapper.Rd b/man/VGAM_vglm_wrapper.Rd index 8175ca5..8f4536d 100644 --- a/man/VGAM_vglm_wrapper.Rd +++ b/man/VGAM_vglm_wrapper.Rd @@ -1,17 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ordinal_reg-VGAM.R -\docType{data} \name{VGAM_vglm_wrapper} \alias{VGAM_vglm_wrapper} \alias{VGAM_vgam_wrapper} \alias{values_ordinal_link_VGAM} \alias{values_threshold_structure_VGAM} \title{Fit wrappers for \code{VGAM}} -\format{ -An object of class \code{character} of length 10. - -An object of class \code{character} of length 5. -} \usage{ VGAM_vglm_wrapper( formula, @@ -76,15 +70,15 @@ to \code{VGAM} within the wrappers. } \details{ The vector \code{values_ordinal_link_VGAM} extends the default \code{ordinal_link} -options encoded in \code{\link[dials:ordinal_link]{dials::values_ordinal_link}} to those accepted by +options encoded in \code{\link[dials:values_ordinal_link]{dials::values_ordinal_link}} to those accepted by \code{\link[VGAM:vglm]{VGAM::vglm()}} and \code{\link[VGAM:vgam]{VGAM::vgam()}}. The vector \code{values_threshold_structure_VGAM} extends the default \code{threshold_structure} options encoded in -\code{\link[dials:threshold_structure]{dials::values_threshold_structure}} to those accepted by \code{\link[VGAM:vglm]{VGAM::vglm()}} +\code{\link[dials:values_threshold_structure]{dials::values_threshold_structure}} to those accepted by \code{\link[VGAM:vglm]{VGAM::vglm()}} and \code{\link[VGAM:vgam]{VGAM::vgam()}}. -NB: Prediction with \code{vgam} models under {VGAM} version 1.1-9 does not yet +NB: Prediction with \code{vgam} models under VGAM version 1.1-9 does not yet support the use of smoothers \code{s()}. Note that \code{VGAM::vglm()} and \code{VGAM::vgam()} treat the rows of \code{data} @@ -169,5 +163,4 @@ house_data <- ) ) \dontshow{\}) # examplesIf} } -\keyword{datasets} \keyword{internal} diff --git a/man/clm_parameters.Rd b/man/clm_parameters.Rd index 713cb4d..e1aec46 100644 --- a/man/clm_parameters.Rd +++ b/man/clm_parameters.Rd @@ -1,23 +1,19 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/param-engine-clm.R -\docType{data} \name{clm_parameters} \alias{clm_parameters} \alias{values_ordinal_link_clm} \title{Dials for \code{ordinal} engine parameters} -\format{ -An object of class \code{character} of length 7. -} \usage{ values_ordinal_link_clm } \value{ An object of S3 parent class \code{param} and primary class \code{qual_param}; -see \code{\link[dials:new-param]{dials::new_qual_param()}}. +see \code{\link[dials:new_qual_param]{dials::new_qual_param()}}. } \description{ The vector \code{values_ordinal_link_clm} extends the default \code{ordinal_link} -options encoded in \code{\link[dials:ordinal_link]{dials::values_ordinal_link}} to those accepted by +options encoded in \code{\link[dials:values_ordinal_link]{dials::values_ordinal_link}} to those accepted by \code{\link[ordinal:clm]{ordinal::clm()}}. } \details{ @@ -29,5 +25,4 @@ values_ordinal_link_clm dials::ordinal_link(values = values_ordinal_link_clm) dials::threshold_structure(values = dials::values_threshold_structure) } -\keyword{datasets} \keyword{internal} diff --git a/man/ordered-package.Rd b/man/ordered-package.Rd index 1a61ada..77db786 100644 --- a/man/ordered-package.Rd +++ b/man/ordered-package.Rd @@ -61,6 +61,7 @@ Useful links: Authors: \itemize{ + \item Jason Cory Brunson \email{cornelioid@gmail.com} (\href{https://orcid.org/0000-0003-3126-9494}{ORCID}) \item Max Kuhn \email{max@posit.co} (\href{https://orcid.org/0000-0003-2402-136X}{ORCID}) } diff --git a/man/ordinalForest_parameters.Rd b/man/ordinalForest_parameters.Rd index 1aaea6c..19278b7 100644 --- a/man/ordinalForest_parameters.Rd +++ b/man/ordinalForest_parameters.Rd @@ -1,6 +1,5 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/param-engine-ordinalForest.R -\docType{data} \name{ordinalForest_parameters} \alias{ordinalForest_parameters} \alias{naive_scores} @@ -11,9 +10,6 @@ \alias{ord_metric} \alias{values_ord_metric} \title{Dials for \code{ordinalForest} engine parameters} -\format{ -An object of class \code{character} of length 4. -} \usage{ naive_scores(values = c(FALSE, TRUE)) @@ -43,7 +39,7 @@ no transformation, \code{NULL}.} } \value{ An object of S3 parent class \code{param} and primary class \code{qual_param} -or \code{quant_param}; see \code{\link[dials:new-param]{dials::new_qual_param()}} and +or \code{quant_param}; see \code{\link[dials:new_qual_param]{dials::new_qual_param()}} and [dials::new_quant_param(). } \description{ @@ -87,4 +83,3 @@ ord_metric() \seealso{ \code{\link[dials:trees]{dials::trees()}} } -\keyword{datasets} diff --git a/man/ordinalNet_parameters.Rd b/man/ordinalNet_parameters.Rd index bf0bbd2..3b075f8 100644 --- a/man/ordinalNet_parameters.Rd +++ b/man/ordinalNet_parameters.Rd @@ -22,7 +22,7 @@ no transformation, \code{NULL}.} } \value{ An object of S3 parent class \code{param} and primary class -\code{quant_param}; see \code{\link[dials:new-param]{dials::new_quant_param()}}. +\code{quant_param}; see \code{\link[dials:new_quant_param]{dials::new_quant_param()}}. } \description{ These parameters are auxiliary to ordinal regression models that use the diff --git a/man/orf_parameters.Rd b/man/orf_parameters.Rd index b84a506..cf3f224 100644 --- a/man/orf_parameters.Rd +++ b/man/orf_parameters.Rd @@ -27,8 +27,8 @@ no transformation, \code{NULL}.} } \value{ An object of S3 parent class \code{param} and primary class \code{qual_param} -or \code{quant_param}; see \code{\link[dials:new-param]{dials::new_qual_param()}} and -\code{\link[dials:new-param]{dials::new_quant_param()}}. +or \code{quant_param}; see \code{\link[dials:new_qual_param]{dials::new_qual_param()}} and +\code{\link[dials:new_quant_param]{dials::new_quant_param()}}. } \description{ These parameters are auxiliary to random forest models that use the diff --git a/man/rpartScore_parameters.Rd b/man/rpartScore_parameters.Rd index 75f3f3d..4e7ab0d 100644 --- a/man/rpartScore_parameters.Rd +++ b/man/rpartScore_parameters.Rd @@ -15,7 +15,7 @@ prune_func(values = c("mr", "mc")) } \value{ An object of S3 parent class \code{param} and primary class \code{qual_param}; -see \code{\link[dials:new-param]{dials::new_qual_param()}}. +see \code{\link[dials:new_qual_param]{dials::new_qual_param()}}. } \description{ These parameters are auxiliary to decision tree models that use the From 87ce95ffbf0a99077a96b64fa884076ef7172856 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 21 Sep 2026 21:31:33 -0400 Subject: [PATCH 41/45] replace engine arg with superseding model arg --- R/ordered-package.R | 2 +- man/ordered-package.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/ordered-package.R b/R/ordered-package.R index 48b9e57..b2416f8 100644 --- a/R/ordered-package.R +++ b/R/ordered-package.R @@ -34,7 +34,7 @@ #' #' fit_orf <- rand_forest(mode = "classification") %>% #' set_engine("ordinalForest") %>% -#' set_args(nsets = 50, ntreefinal = 100, perffunction = "probability") %>% +#' set_args(nsets = 50, trees = 100, perffunction = "probability") %>% #' fit(Sat ~ Infl + Type + Cont, data = house_train) #' predict(fit_orf, house_test, type = "prob") #' diff --git a/man/ordered-package.Rd b/man/ordered-package.Rd index 77db786..db11d3d 100644 --- a/man/ordered-package.Rd +++ b/man/ordered-package.Rd @@ -40,7 +40,7 @@ if (rlang::is_installed("ordinalForest")) { fit_orf <- rand_forest(mode = "classification") \%>\% set_engine("ordinalForest") \%>\% - set_args(nsets = 50, ntreefinal = 100, perffunction = "probability") \%>\% + set_args(nsets = 50, trees = 100, perffunction = "probability") \%>\% fit(Sat ~ Infl + Type + Cont, data = house_train) predict(fit_orf, house_test, type = "prob") From dc6323ef3eb65c76e285fbc8e958c0f386ccfc6b Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Wed, 23 Sep 2026 18:07:57 -0400 Subject: [PATCH 42/45] use manual dependency for VGAM version dependencies + specify R version --- DESCRIPTION | 3 ++- R/ordinal_reg-VGAM.R | 16 ++++++++++------ man/VGAM_vglm_wrapper.Rd | 14 +++++++++----- 3 files changed, 21 insertions(+), 12 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5d30423..4459996 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -22,7 +22,8 @@ Description: Bindings, methods, and tuners for using ordinal classification of Hornung (2020) in 'ordinalForest'. License: MIT + file LICENSE -Depends: +Depends: + R (>= 4.1), parsnip (> 1.6.0) Imports: cli, diff --git a/R/ordinal_reg-VGAM.R b/R/ordinal_reg-VGAM.R index 9544d4e..8aaf233 100644 --- a/R/ordinal_reg-VGAM.R +++ b/R/ordinal_reg-VGAM.R @@ -50,11 +50,12 @@ #' values_threshold_structure_VGAM #' dials::threshold_structure(values = values_threshold_structure_VGAM) #' + +#' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("VGAM") #' house_data <- #' MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] - -#' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("VGAM") && utils::packageVersion("VGAM") == package_version("1.1.9") -#' # {VGAM} version 1.1-9 +#' +#' if (utils::packageVersion("VGAM") == package_version("1.1.9")) {#VGAM=1.1-9 #' #' # fit wrapper for linear model #' ( fit_orig <- VGAM::vglm( @@ -84,9 +85,10 @@ #' link = "cloglog", parallel = TRUE, Thresh = "symmetric0", #' data = house_data #' ) ) - -#' @examplesIf rlang::is_installed("MASS") && rlang::is_installed("VGAM") && utils::packageVersion("VGAM") > package_version("1.1.9") -#' # {VGAM} version >= 1.1-10 +#' +#' }#VGAM=1.1-9 +#' +#' if (utils::packageVersion("VGAM") > package_version("1.1.9")) {#VGAM>1.1-9 #' #' # fit wrapper for linear model #' ( fit_orig <- VGAM::vglm( @@ -116,6 +118,8 @@ #' link = "cloglog", parallel = TRUE, Thresh = "symm0", #' data = house_data #' ) ) +#' +#' }#VGAM>1.1-9 #' @export VGAM_vglm_wrapper <- function( formula, data, diff --git a/man/VGAM_vglm_wrapper.Rd b/man/VGAM_vglm_wrapper.Rd index 8f4536d..7054c9a 100644 --- a/man/VGAM_vglm_wrapper.Rd +++ b/man/VGAM_vglm_wrapper.Rd @@ -96,10 +96,11 @@ dials::ordinal_link(values = values_ordinal_link_VGAM) values_threshold_structure_VGAM dials::threshold_structure(values = values_threshold_structure_VGAM) +\dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("VGAM")) withAutoprint(\{ # examplesIf} house_data <- MASS::housing[rep(seq(nrow(MASS::housing)), MASS::housing$Freq), -5] -\dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("VGAM") && utils::packageVersion("VGAM") == package_version("1.1.9")) withAutoprint(\{ # examplesIf} -# {VGAM} version 1.1-9 + +if (utils::packageVersion("VGAM") == package_version("1.1.9")) {#VGAM=1.1-9 # fit wrapper for linear model ( fit_orig <- VGAM::vglm( @@ -129,9 +130,10 @@ house_data <- link = "cloglog", parallel = TRUE, Thresh = "symmetric0", data = house_data ) ) -\dontshow{\}) # examplesIf} -\dontshow{if (rlang::is_installed("MASS") && rlang::is_installed("VGAM") && utils::packageVersion("VGAM") > package_version("1.1.9")) withAutoprint(\{ # examplesIf} -# {VGAM} version >= 1.1-10 + +}#VGAM=1.1-9 + +if (utils::packageVersion("VGAM") > package_version("1.1.9")) {#VGAM>1.1-9 # fit wrapper for linear model ( fit_orig <- VGAM::vglm( @@ -161,6 +163,8 @@ house_data <- link = "cloglog", parallel = TRUE, Thresh = "symm0", data = house_data ) ) + +}#VGAM>1.1-9 \dontshow{\}) # examplesIf} } \keyword{internal} From 050007a09f92364d864565e597170330ab4dace8 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 28 Sep 2026 15:48:57 -0400 Subject: [PATCH 43/45] specify parsnip cran version + rm specific remote --- DESCRIPTION | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4459996..3425f63 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -24,7 +24,7 @@ Description: Bindings, methods, and tuners for using ordinal classification License: MIT + file LICENSE Depends: R (>= 4.1), - parsnip (> 1.6.0) + parsnip (>= 1.6.1) Imports: cli, dials (> 1.4.4), @@ -48,7 +48,6 @@ Suggests: spelling, testthat (>= 3.0.0) Remotes: - tidymodels/parsnip, corybrunson/dials@parallel-reg Config/testthat/edition: 3 Encoding: UTF-8 From 47ec7d20a8605851c0a59e46e55218db9ad7a116 Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 28 Sep 2026 15:56:18 -0400 Subject: [PATCH 44/45] tweak language + re-knit --- README.Rmd | 2 +- README.md | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/README.Rmd b/README.Rmd index c002661..82c5312 100644 --- a/README.Rmd +++ b/README.Rmd @@ -94,7 +94,7 @@ get_from_env("models") |> ## Tunable model arguments -`ordinal_reg` recognizes several model arguments, shared by at least two engines in ordered, that have parameter generating functions in dials: +`ordinal_reg` recognizes several model arguments, each shared by at least two engines in ordered, that have parameter generating functions in dials: ```{r, echo=FALSE, message=FALSE} ordinal_reg_formals <- names(formals(ordinal_reg)) diff --git a/README.md b/README.md index 5f3efb3..2717426 100644 --- a/README.md +++ b/README.md @@ -102,8 +102,9 @@ for `ordinal_reg()`: ## Tunable model arguments -`ordinal_reg` recognizes several tunable arguments shared by at least -two engines in ordered: +`ordinal_reg` recognizes several model arguments, each shared by at +least two engines in ordered, that have parameter generating functions +in dials: | engine | ordinal_link | odds_link | threshold_structure | parallel_reg | penalty | mixture | |:---|:---|:---|:---|:---|:---|:---| From 4baa9bfd0afaf0f34af7f33b3858484af8ae84ec Mon Sep 17 00:00:00 2001 From: Jason Cory Brunson Date: Mon, 28 Sep 2026 16:33:46 -0400 Subject: [PATCH 45/45] add missing announcement & content --- NEWS.md | 6 ++++-- _pkgdown.yml | 1 + 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 07a23ac..e302aa6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -21,10 +21,10 @@ Extrapolative predictions, which err in `ordinalNet`, are overridden to use path ### additional ordinal regression and random forest engines -This version introduces source code and unit tests for new engines: +This version introduces source code and unit tests for new engines and dials: * `clm` from the **ordinal** package - cumulative link ordinal regression - - fit wrapper to translate formulae + - fit wrapper - additional `ordinal_link` dial values * `lrm` and `orm` from the **rms** package - regularized cumulative probability ordinal regression @@ -37,6 +37,8 @@ This version introduces source code and unit tests for new engines: - conditional probability ordered random forests - fit wrapper - dials for `sample.fraction`, `honesty`, and `honesty.fraction` arguments +* `ordinalNet` from the **ordinalNet** package (pre-existing engine) + - dial for the `parallelPenaltyFactor` argument Coordinated with [parsnip PR #1384](https://github.com/tidymodels/parsnip/pull/1384). diff --git a/_pkgdown.yml b/_pkgdown.yml index 24c6799..9995157 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -14,6 +14,7 @@ reference: Wrappers for Ordinal Classification Engines contents: - '`clm_wrapper`' + - '`predict_lrm_wrapper`' - '`ordinalNet_wrapper`' - '`predict_glmnetcr_wrapper`' - '`VGAM_vglm_wrapper`'