Merge pull request #56 from dajmcdon/weight-normalization

dajmcdon · web-flow · commit f0bb7355e958 · 2025-06-10T18:55:18.000-04:00
Weight normalization
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -3,7 +3,7 @@ Package: sparsegl
 Title: Sparse Group Lasso
 Version: 1.1.1.9000
 Authors@R: c(
-    person("Daniel J.", "McDonald", , "daniel@stat.ubc.ca", role = c("aut", "cre")),
+    person("Daniel J.", "McDonald", , "daniel@stat.ubc.ca", role = c("aut", "cre", "cph")),
     person("Xiaoxuan", "Liang", , "xiaoxuan.liang@stat.ubc.ca", role = "aut"),
     person("Anibal", "Solón Heinsfeld", , "anibalsolon@gmail.com", role = "aut"),
     person("Aaron", "Cohen", , "cohenaa@indiana.edu", role = "aut"),
@@ -19,7 +19,7 @@ Authors@R: c(
     person("James", "Yang", role = "ctb")
   )
 Description: Efficient implementation of sparse group lasso with optional
-    bound constraints on the coefficients; see
+    bound constraints on the coefficients; see Liang, et al., (2024)
     <doi:10.18637/jss.v110.i06>.  It supports the use of a sparse design
     matrix as well as returning coefficient estimates in a sparse matrix.
     Furthermore, it correctly calculates the degrees of freedom to allow
@@ -36,7 +36,6 @@ Imports:
     cli,
     dotCall64,
     ggplot2,
-    magrittr,
     Matrix,
     methods,
     rlang,
diff --git a/LICENSE b/LICENSE
@@ -1,2 +1,2 @@
-YEAR: 2024
+YEAR: 2025
 COPYRIGHT HOLDER: sparsegl authors
diff --git a/LICENSE.md b/LICENSE.md
@@ -1,6 +1,6 @@
 # MIT License
 
-Copyright (c) 2024 sparsegl authors
+Copyright (c) 2025 sparsegl authors
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal
diff --git a/NAMESPACE b/NAMESPACE
@@ -22,7 +22,6 @@ S3method(print,summary.cvsparsegl)
 S3method(print,summary.sparsegl)
 S3method(summary,cv.sparsegl)
 S3method(summary,sparsegl)
-export("%>%")
 export(cv.sparsegl)
 export(estimate_risk)
 export(gr_one_norm)
@@ -45,7 +44,6 @@ importFrom(dotCall64,.C64)
 importFrom(dotCall64,integer_dc)
 importFrom(dotCall64,numeric_dc)
 importFrom(dotCall64,vector_dc)
-importFrom(magrittr,"%>%")
 importFrom(methods,as)
 importFrom(methods,cbind2)
 importFrom(methods,rbind2)
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,8 @@
 # sparsegl (development version)
 
+* Force `weights` to sum to `nobs` for all IRWLS cases.
+* Remove `magrittr` from imports
+
 # sparsegl 1.1.1
 
 * Add CITATION and links to JSS article
diff --git a/R/data.R b/R/data.R
@@ -46,13 +46,13 @@
 #' \dontrun{
 #' library(splines)
 #' library(dplyr)
-#' library(magrittr)
 #' df <- 10
 #'
-#' trust_experts <- trust_experts %>%
-#'   mutate(across(
+#' trust_experts <- mutate(
+#'   trust_experts,
+#'   across(
 #'     where(is.factor),
-#'     ~ set_attr(.x, "contrasts", contr.sum(nlevels(.x), FALSE, TRUE))
+#'     ~ rlang::set_attrs(.x, "contrasts", contr.sum(nlevels(.x), FALSE, TRUE))
 #'   ))
 #'
 #' x <- Matrix::sparse.model.matrix(
diff --git a/R/plot.cv.sparsegl.R b/R/plot.cv.sparsegl.R
@@ -36,8 +36,7 @@ plot.cv.sparsegl <- function(x, log_axis = c("xy", "x", "y", "none"),
   )
   log_axis <- match.arg(log_axis)
   sign.lambda <- sign(sign.lambda)
-  g <- dat %>%
-    ggplot2::ggplot(ggplot2::aes(x = .data$X, y = .data$y)) +
+  g <- ggplot2::ggplot(dat, ggplot2::aes(x = .data$X, y = .data$y)) +
     ggplot2::geom_errorbar(
       ggplot2::aes(ymin = .data$lower, ymax = .data$upper),
       color = "darkgrey"
diff --git a/R/plot.sparsegl.R b/R/plot.sparsegl.R
@@ -60,8 +60,7 @@ plot.sparsegl <- function(x,
 
   df$lambda <- x$lambda
   df$penalty <- sgnorm / max(sgnorm)
-  df <- df %>%
-    tidyr::pivot_longer(!c(.data$lambda, .data$penalty), names_to = y_axis)
+  df <- tidyr::pivot_longer(df, !c(.data$lambda, .data$penalty), names_to = y_axis)
 
   plot_layer <- ggplot2::ggplot(
     df, ggplot2::aes(
diff --git a/R/sgl_irwls.R b/R/sgl_irwls.R
@@ -52,7 +52,7 @@ sgl_irwls <- function(
   if (is.null(weights)) {
     weights <- rep(1, nobs)
   } else {
-    weights <- weights / sum(weights)
+    weights <- weights / sum(weights) * nobs
   }
   etastart <- 0
   mustart <- NULL
diff --git a/R/sparsegl-package.R b/R/sparsegl-package.R
@@ -11,7 +11,7 @@
 #' @keywords internal
 #' @references Liang, X., Cohen, A., Sólon Heinsfeld, A., Pestilli, F., and
 #'   McDonald, D.J. 2024.
-#'   \emph{sparsegl: An `R` Package for Estimating Sparse Group Lasso.}
-#'   Journal of Statistical Software, Vol. 110(6): 1–23.
-#'   \doi{10.18637/jss.v110.i06}.
+#'   "sparsegl: An `R` Package for Estimating Sparse Group Lasso."
+#'   _Journal of Statistical Software_, **110**(6): 1–23.
+#'   [doi:10.18637/jss.v110.i06](https://doi.org/10.18637/jss.v110.i06).
 "_PACKAGE"
diff --git a/R/sparsegl.R b/R/sparsegl.R
@@ -84,7 +84,8 @@
 #'   or of length the number of groups. Must be non-negative numbers only.
 #'   Default value for each entry is `Inf`.
 #' @param weights Double vector. Optional observation weights. These can
-#'   only be used with a [stats::family()] object.
+#'   only be used with a [stats::family()] object. Internally coerced to sum
+#'   to the number of observations.
 #' @param offset Double vector. Optional offset (constant predictor without a
 #'   corresponding coefficient). These can only be used with a
 #'   [stats::family()] object.
diff --git a/R/utils-pipe.R b/R/utils-pipe.R
diff --git a/data-raw/trust-experts.R b/data-raw/trust-experts.R
@@ -2,44 +2,44 @@ library(tidyverse)
 ## Downloaded on 18 November 2022
 covidcast_url <- "https://www.cmu.edu/delphi-web/surveys/monthly-rollup/monthly_state_all_indicators_age_gender_raceethnicity.csv.gz"
 symp <- read_csv(covidcast_url)
-symp <- symp %>%
+symp <- symp |>
   select(period_start, region, age, gender, raceethnicity, starts_with("val_"))
-trust_experts <- symp %>%
+trust_experts <- symp |>
   select(
     period_start, region, age, gender, raceethnicity,
     contains("val_pct_trust_covid_info"),
     val_pct_cli,
     val_pct_hh_cmnty_cli,
     val_pct_wearing_mask_5d, val_pct_wearing_mask_7d
-  ) %>%
-  mutate(period = lubridate::ymd(period_start)) %>%
-  filter(period > lubridate::ymd("2021-05-01")) %>% # remove pre-survey period
-  select(-period_start) %>%
+  ) |>
+  mutate(period = lubridate::ymd(period_start)) |>
+  filter(period > lubridate::ymd("2021-05-01")) |> # remove pre-survey period
+  select(-period_start) |>
   mutate(
     age = str_c(replace_na(age, "NotReported")),
     gender = str_c(replace_na(gender, "NotReported")),
     raceethnicity = str_c(replace_na(raceethnicity, "NotReported"))
-  ) %>%
+  ) |>
   rename_with(~ str_remove(.x, "val_pct_"), starts_with("val_pct"))
 
 
 
-trust_experts <- trust_experts %>%
-  select(!(trust_covid_info_politicians:trust_covid_info_religious)) %>%
+trust_experts <- trust_experts |>
+  select(!(trust_covid_info_politicians:trust_covid_info_religious)) |>
   mutate(
     region = as.factor(region),
     age = as.factor(age),
     gender = as.factor(gender),
     raceethnicity = as.factor(raceethnicity),
     period = as.factor(period)
-  ) %>%
-  rowwise() %>%
+  ) |>
+  rowwise() |>
   mutate(
     trust_experts = mean(c_across(starts_with("trust_covid")), na.rm = TRUE),
     masking = mean(c_across(starts_with("wearing_mask")), na.rm = TRUE)
-  ) %>%
-  select(!starts_with("trust_covid") & !starts_with("wearing_mask")) %>%
-  select(!masking) %>%
+  ) |>
+  select(!starts_with("trust_covid") & !starts_with("wearing_mask")) |>
+  select(!masking) |>
   ungroup()
 
 cc <- complete.cases(trust_experts)
diff --git a/man/cv.sparsegl.Rd b/man/cv.sparsegl.Rd
diff --git a/man/pipe.Rd b/man/pipe.Rd
diff --git a/man/sparsegl-package.Rd b/man/sparsegl-package.Rd
diff --git a/man/sparsegl.Rd b/man/sparsegl.Rd
diff --git a/man/trust_experts.Rd b/man/trust_experts.Rd
diff --git a/vignettes/sparsegl.Rmd b/vignettes/sparsegl.Rmd
@@ -270,11 +270,11 @@ risk <- estimate_risk(fit1, X, approx_df = FALSE)
 library(dplyr)
 library(tidyr)
 library(ggplot2)
-er <- risk %>%
-  dplyr::select(-df) %>%
+er <- risk |>
+  dplyr::select(-df) |>
   pivot_longer(-lambda, values_to = "risk")
-err <- er %>%
-  group_by(name) %>%
+err <- er |>
+  group_by(name) |>
   summarise(lambda = lambda[which.min(risk)])
 ggplot(er, aes(lambda, risk, color = name)) +
   geom_line() +

Original file line number	Diff line number	Diff line change
`@@ -1,2 +1,2 @@`
`1`		`-YEAR: 2024`
	`1`	`+YEAR: 2025`
`2`	`2`	`COPYRIGHT HOLDER: sparsegl authors`
Original file line number	Diff line number	Diff line change
`@@ -52,7 +52,7 @@ sgl_irwls <- function(`
`52`	`52`	`if (is.null(weights)) {`
`53`	`53`	`weights <- rep(1, nobs)`
`54`	`54`	`} else {`
`55`		`- weights <- weights / sum(weights)`
	`55`	`+ weights <- weights / sum(weights) * nobs`
`56`	`56`	`}`
`57`	`57`	`etastart <- 0`
`58`	`58`	`mustart <- NULL`