Replace Matrix package for expm package

CITATION.cff

@@ -226,24 +226,24 @@ references:
   year: '2025'
   doi: 10.32614/CRAN.package.loo
 - type: software
-  title: Matrix
-  abstract: 'Matrix: Sparse and Dense Matrix Classes and Methods'
+  title: expm
+  abstract: 'expm: Matrix Exponential, Log, ''etc'''
   notes: Imports
-  url: https://R-forge.R-project.org/tracker/?atid=294&group_id=61
-  repository: https://CRAN.R-project.org/package=Matrix
+  url: https://R-forge.R-project.org/tracker/?atid=472&group_id=107
+  repository: https://CRAN.R-project.org/package=expm
   authors:
-  - family-names: Bates
-    given-names: Douglas
-    orcid: https://orcid.org/0000-0001-8316-9503
   - family-names: Maechler
     given-names: Martin
-    email: mmaechler+Matrix@gmail.com
+    email: maechler@stat.math.ethz.ch
     orcid: https://orcid.org/0000-0002-8685-9910
-  - family-names: Jagan
-    given-names: Mikael
-    orcid: https://orcid.org/0000-0002-3542-2938
+  - family-names: Dutang
+    given-names: Christophe
+    orcid: https://orcid.org/0000-0001-6732-1501
+  - family-names: Goulet
+    given-names: Vincent
+    orcid: https://orcid.org/0000-0002-9315-5719
   year: '2025'
-  doi: 10.32614/CRAN.package.Matrix
+  doi: 10.32614/CRAN.package.expm
 - type: software
   title: methods
   abstract: 'R: A Language and Environment for Statistical Computing'

DESCRIPTION

@@ -46,7 +46,7 @@ Imports:
     glue,
     graphics,
     loo,
-    Matrix,
+    expm,
     methods,
     purrr,
     Rcpp (>= 0.12.0),
@@ -71,7 +71,7 @@ LinkingTo:
     StanHeaders (>= 2.18.0)
 VignetteBuilder: 
     knitr
-Additional_repositories:https://mc-stan.org/r-packages/
+Additional_repositories: https://mc-stan.org/r-packages/
 Biarch: true
 Config/Needs/website: epiverse-trace/epiversetheme
 Config/testthat/edition: 3

R/simulate_serosurvey.R

@@ -334,7 +334,7 @@ prob_seroprev_gen_by_age <- function(
   probabilities <- vector(length = max_age)
   for (i in seq_along(probabilities)) {
     A_sum <- sum_of_A(max_age, max_age - i, construct_A_fun, ...)
-    Y <- as.matrix(Matrix::expm(A_sum)) %*% initial_conditions
+    Y <- expm::expm(A_sum) %*% initial_conditions
     probabilities[i] <- calculate_seroprev_fun(Y)
   }
 

tests/testthat/test-plot_seromodel.R

@@ -13,7 +13,7 @@ serosurvey <- veev2012
 suppressWarnings(
   seromodel_constant <- fit_seromodel(
     serosurvey = serosurvey,
-    iter = 500
+    iter = 100
   )
 )
 
@@ -24,7 +24,7 @@ suppressWarnings(
     foi_index = get_foi_index(serosurvey, group_size = 20, model_type = "age"),
     is_seroreversion = TRUE,
     seroreversion_prior = sf_normal(0, 1e-4),
-    iter = 200
+    iter = 100
   )
 )
 
@@ -33,7 +33,7 @@ suppressWarnings(
     serosurvey = serosurvey,
     model_type = "time",
     foi_index = get_foi_index(serosurvey, group_size = 10, model_type = "time"),
-    iter = 200
+    iter = 100
   )
 )
 

tests/testthat/test-simulate_serosurvey.R

@@ -659,202 +659,3 @@ test_that("simulate_serosurvey handles invalid model inputs", {
   expect_error(simulate_serosurvey("invalid_model", foi_df, survey_features),
                "model must be one of 'age', 'time', or 'age-time'.")
 })
-
-test_that("prob_seroprev_gen_by_age reduces to time-varying model under
-          appropriate limits", {
-
-    # simple time-varying FoI model
-    construct_A <- function(t, tau, lambda) {
-      A <- matrix(0, ncol = 2, nrow = 2)
-      A[1, 1] <- -lambda[t]
-      A[2, 1] <- lambda[t]
-      A
-    }
-
-    # determines the sum of seropositive compartments of those still alive
-    calculate_seroprev_fun <- function(Y) {
-      Y[2]
-    }
-
-    # initial conditions in 12D state vector
-    initial_conditions <- rep(0, 2)
-    initial_conditions[1] <- 1
-
-    # random FOIs
-    lambda <- runif(70, 0, 0.01)
-
-    # solve linear system of ODEs
-    seropositive_linear_system <- prob_seroprev_gen_by_age(
-      construct_A,
-      calculate_seroprev_fun,
-      initial_conditions,
-      max_age=length(lambda),
-      lambda
-    )
-
-    foi_df <- data.frame(
-      year=seq_along(lambda),
-      foi=lambda
-    )
-
-    seropositive_true <- prob_seroprev_by_age(
-      model = "time",
-      foi = foi_df,
-      seroreversion_rate = 0
-    )
-
-    expect_equal(seropositive_true, seropositive_linear_system)
-
-})
-
-test_that("prob_seroprev_gen_by_age reduces to age-varying model under
-          appropriate limits", {
-
-  # simple age-varying FoI model
-  construct_A <- function(t, tau, lambda) {
-    A <- matrix(0, ncol = 2, nrow = 2)
-    A[1, 1] <- -lambda[t - tau]
-    A[2, 1] <- lambda[t - tau]
-    A
-  }
-
-  # determines the sum of seropositive compartments of those still alive
-  calculate_seroprev_fun <- function(Y) {
-    Y[2]
-  }
-
-  # initial conditions in 12D state vector
-  initial_conditions <- rep(0, 2)
-  initial_conditions[1] <- 1
-
-  # random FOIs
-  lambda <- runif(70, 0, 0.01)
-
-  # solve linear system of ODEs
-  seropositive_linear_system <- prob_seroprev_gen_by_age(
-    construct_A,
-    calculate_seroprev_fun,
-    initial_conditions,
-    max_age=length(lambda),
-    lambda
-  )
-
-  foi_df <- data.frame(
-    age=seq_along(lambda),
-    foi=lambda
-  )
-
-  seropositive_true <- prob_seroprev_by_age(
-    model = "age",
-    foi = foi_df,
-    seroreversion_rate = 0
-  )
-
-  expect_equal(seropositive_true, seropositive_linear_system)
-
-})
-
-test_that("prob_seroprev_gen_by_age reduces to age- and time-varying model under
-          appropriate limits", {
-
-  # age- and time-varying FoI model
-  construct_A <- function(t, tau, u, v) {
-    A <- matrix(0, ncol = 2, nrow = 2)
-    u_bar <- u[t - tau]
-    v_bar <- v[t]
-
-    A[1, 1] <- -u_bar * v_bar
-    A[2, 1] <- u_bar * v_bar
-    A
-  }
-
-  # determines the sum of seropositive compartments of those still alive
-  calculate_seroprev_fun <- function(Y) {
-    Y[2]
-  }
-
-  # initial conditions in 12D state vector
-  initial_conditions <- rep(0, 2)
-  initial_conditions[1] <- 1
-
-  # age and time-varying FOIs
-  ages <- seq(1, 70, 1)
-  foi_age <- 2 * dlnorm(
-    ages, meanlog = 3.5, sdlog = 0.5)
-
-  foi_df_age <- data.frame(
-    age = ages,
-    foi = foi_age
-  )
-
-  foi_time <- c(rep(0, 30), rep(1, 40))
-  foi_df_time <- data.frame(
-    year = seq(1956, 2025, 1),
-    foi = foi_time
-  )
-
-  u <- foi_df_age$foi
-  v <- foi_df_time$foi
-
-  # solve linear system of ODEs
-  seropositive_linear_system <- prob_seroprev_gen_by_age(
-    construct_A,
-    calculate_seroprev_fun,
-    initial_conditions,
-    max_age = nrow(foi_df_time),
-    u,
-    v
-  )
-
-  foi_df <- expand.grid(
-    year=foi_df_time$year,
-    age=foi_df_age$age
-  ) |>
-    dplyr::left_join(foi_df_age, by = "age") |>
-    dplyr::rename(foi_age = foi) |>
-    dplyr::left_join(foi_df_time, by = "year") |>
-    dplyr::rename(foi_time = foi) |>
-    dplyr::mutate(foi = foi_age * foi_time) |>
-    dplyr::select(-c("foi_age", "foi_time"))
-
-  seropositive_true <- prob_seroprev_by_age(
-    model = "age-time",
-    foi = foi_df,
-    seroreversion_rate = 0
-  )
-
-  expect_equal(seropositive_true, seropositive_linear_system)
-
-  # simulate survey from age and time FoI
-  survey_features <- data.frame(
-    age_min = seq(1, 70, 10),
-    age_max = seq(10, 70, 10),
-    n_sample = 1e9)
-
-  serosurvey <- simulate_serosurvey_general(
-    construct_A,
-    calculate_seroprev_fun,
-    initial_conditions,
-    survey_features,
-    u,
-    v
-  ) |>
-    dplyr::mutate(
-      seropositivity = n_seropositive / n_sample
-    )
-
-  seropositive_true_age_group <- base::colSums(matrix(
-    seropositive_linear_system$seropositivity, 10
-    )) / 10
-
-  expect_true(
-    all(
-      dplyr::near(
-        serosurvey$seropositivity,
-        seropositive_true_age_group,
-        tol = 1e-4
-      )
-    )
-  )
-
-})