Merge pull request #121 from hesim-dev/s3-fixes

fix: CRAN NOTEs related to S3 methods

NAMESPACE

@@ -22,6 +22,7 @@ S3method(create_IndivCtstmTrans,params_surv)
 S3method(create_IndivCtstmTrans,params_surv_list)
 S3method(create_PsmCurves,flexsurvreg_list)
 S3method(create_PsmCurves,params_surv_list)
+S3method(create_StateVals,eval_model)
 S3method(create_StateVals,lm)
 S3method(create_StateVals,stateval_tbl)
 S3method(create_input_mats,flexsurvreg)
@@ -46,6 +47,7 @@ S3method(format,icer)
 S3method(format,summary.ce)
 S3method(plot_ceac,cea)
 S3method(plot_ceac,cea_pw)
+S3method(plot_ceac,default)
 S3method(print,eval_rng)
 S3method(print,input_mats)
 S3method(print,params_lm)
@@ -59,6 +61,7 @@ S3method(qmatrix,data.frame)
 S3method(qmatrix,data.table)
 S3method(qmatrix,matrix)
 S3method(qmatrix,msm)
+S3method(sim_ev,"NULL")
 S3method(sim_ev,stateprobs)
 S3method(sim_stateprobs,survival)
 S3method(summary,ce)
@@ -74,6 +77,7 @@ S3method(summary,tpmatrix)
 S3method(tparams_transprobs,array)
 S3method(tparams_transprobs,data.frame)
 S3method(tparams_transprobs,data.table)
+S3method(tparams_transprobs,eval_model)
 S3method(tparams_transprobs,tpmatrix)
 export(CohortDtstm)
 export(CohortDtstmTrans)

R/hesim_data.R

@@ -142,46 +142,47 @@ new_hesim_data <- function(strategies, patients, states = NULL,
   return(data)
 }
 
-check.hesim_data <- function(x){
+check.hesim_data <- function(object, ...){
+
   # Strategies
-  if (is.null(x$strategies)){
+  if (is.null(object$strategies)){
     stop("'strategies' cannot be NULL'.",
          call. = FALSE)
   }
-  check_hesim_data_type(x$strategies, "strategies")
-  if (!"strategy_id" %in% colnames(x$strategies)){
+  check_hesim_data_type(object$strategies, "strategies")
+  if (!"strategy_id" %in% colnames(object$strategies)){
     stop("'strategies' must contain the column 'strategy_id'.",
          call. = FALSE)
   }
 
   # Patients
-  if (!is.null(x$patients)){
-    check_hesim_data_type(x$patients, "patients")
-    if (!"patient_id" %in% colnames(x$patients)){
+  if (!is.null(object$patients)){
+    check_hesim_data_type(object$patients, "patients")
+    if (!"patient_id" %in% colnames(object$patients)){
       stop("'patients' must contain the column 'patient_id'.", 
            call. = FALSE)
     }
   }
 
   # States
-  if (!is.null(x$states)){
-    check_hesim_data_type(x$states, "states")
-    if (!"state_id" %in% colnames(x$states)){
+  if (!is.null(object$states)){
+    check_hesim_data_type(object$states, "states")
+    if (!"state_id" %in% colnames(object$states)){
       stop("'states' must contain the column 'state_id'.", 
            call. = FALSE)
     }
   }
 
   # Transitions
-  if (!is.null(x$transitions)){
-    check_hesim_data_type(x$transitions, "transitions")
-    if (!"transition_id" %in% colnames(x$transitions)){
+  if (!is.null(object$transitions)){
+    check_hesim_data_type(object$transitions, "transitions")
+    if (!"transition_id" %in% colnames(object$transitions)){
       stop("'transitions' must contain the column 'transition_id'.", 
            call. = FALSE)
     }
   }
 
-  return(x)
+  return(object)
 }
 
 check_hesim_data_type <- function(tbl, tbl_name){
@@ -457,7 +458,7 @@ new_id_attributes <- function(strategy_id, n_strategies,
 }
 
 #' @rdname check
-check.id_attributes <- function(object){
+check.id_attributes <- function(object, ...){
   # ID variables to check
   id_vars <- c("sample", "strategy_id", "patient_id", "state_id", 
                "transition_id", "time_id")

R/input_mats.R

@@ -67,7 +67,7 @@ new_input_mats <- function(X, ...){
 }
 
 #' @rdname check
-check.input_mats <- function(object){
+check.input_mats <- function(object, ...){
   # Check X
   if (!is.list(object$X)){
     stop("'X' must be a list or a list of lists.", call. = FALSE)

R/model_def.R

@@ -162,7 +162,7 @@ print.eval_rng <- function(x, ...) {
   invisible(x)
 }
 
-check.eval_rng <- function(object){
+check.eval_rng <- function(object, ...){
 
   object <- as.list(object)
 
@@ -701,14 +701,14 @@ define_model <- function(tparams_def, rng_def, params = NULL,
   return(x)
 }
 
-check.model_def <- function(x){
-  if (!all(sapply(x$tparams_def, function (z) inherits(z, "tparams_def")))){
+check.model_def <- function(object, ...){
+  if (!all(sapply(object$tparams_def, function (z) inherits(z, "tparams_def")))){
     stop(paste0("tparams_def must either be of class 'tparams_def'",
                 "or a list of objects of class 'tparams_def'"),
          call. = FALSE)
   }
-  if (!is.null(x$rng_def)) check_is_class(x$rng_def, class = "rng_def")
-  if (!is.null(x$n_states)) check_scalar(x$n_states, "n_states")
+  if (!is.null(object$rng_def)) check_is_class(object$rng_def, class = "rng_def")
+  if (!is.null(object$n_states)) check_scalar(object$n_states, "n_states")
 }
 
 
@@ -864,24 +864,24 @@ eval_model <- function(x, input_data){
   return(res)
 }
 
-check.eval_model <- function(x){
+check.eval_model <- function(object, ...){
   # Number of states
   ## Can't be NULL
-  if (is.null(x$n_states)){
+  if (is.null(object$n_states)){
     stop("'n_states' cannot be NULL.", call. = FALSE)
   }
 
   ## Correct number 
   check_n_states <- function(z, name){
     if (length(dim(z)) == 2){
-      if (ncol(z) != (x$n_states - 1)){
+      if (ncol(z) != (object$n_states - 1)){
         stop(paste0("The number of columns in ", name, " must equal ",
                     "'n_states' - 1."),
              call. = FALSE)
       }
     }
   }
-  check_n_states(x$utility, "'utility'")
-  lapply(x$costs, check_n_states, "each element of 'costs'")
+  check_n_states(object$utility, "'utility'")
+  lapply(object$costs, check_n_states, "each element of 'costs'")
 }
 

R/params_lm.R

@@ -54,7 +54,7 @@ new_params_lm <- function(coefs, sigma, n_samples){
 }
 
 #' @rdname check
-check.params_lm <- function(object){
+check.params_lm <- function(object, ...){
   if(object$n_samples != length(object$sigma)){
     stop("Number of samples in 'sigma' is not equal to the number of samples in 'coefs'.",
          call. = FALSE)

R/params_mlogit.R

@@ -97,7 +97,7 @@ new_params_mlogit <- function(coefs, n_samples){
 }
 
 #' @rdname check
-check.params_mlogit <- function(object){
+check.params_mlogit <- function(object, ...){
   if (!(is.numeric(object$coefs) && is_3d_array(object$coefs))) {
     stop("'coefs' must be a numeric 3D array.")
   } 

R/params_surv.R

@@ -228,7 +228,7 @@ new_params_surv <- function(coefs, dist, n_samples, aux = NULL){
 }
 
 #' @rdname check
-check.params_surv <- function(object){
+check.params_surv <- function(object, ...){
   # Check coefficients
   if (list_depth(object$coefs) !=1 | length(object$dist) !=1){
     stop("'coefs' must only contain one survival model.", call. = FALSE)

R/params_surv_list.R

@@ -36,7 +36,7 @@ params_surv_list <- function(...){
 }
 
 #' @rdname check
-check.params_surv_list <- function(object){
+check.params_surv_list <- function(object, ...){
   check_params_list(object)
 }
 

R/plot.R

@@ -86,6 +86,7 @@ plot_ceac <- function(x, ...) {
   UseMethod("plot_ceac", x)
 }
 
+#' @export
 plot_ceac.default <- function(x, labels = NULL, ceaf = FALSE, ...) {
   best <- NULL
 

R/sim-general.R

@@ -392,6 +392,7 @@ sim_ev <- function (object, ...) {
   UseMethod("sim_ev", object)
 }
 
+#' @export
 sim_ev.NULL <- function(object, ...) {
   if (is.null(object)) {
     stop("You must first simulate state probabilities using '$sim_stateprobs'.",

R/statevals.R

@@ -522,8 +522,9 @@ create_StateVals.stateval_tbl <- function(object, hesim_data = NULL, n = 1000, .
   return(StateVals$new(params = tparams, ...))
 }
 
+#' @export
 create_StateVals.eval_model <- function(object, cost = TRUE, name = NULL,
-                                        init_args = NULL){
+                                        init_args = NULL, ...){
   out <- if (cost) object[["costs"]][[name]] else object$utility
   n_states <- object$n_states - 1 # The non-death states
   id  <- object$id[[attr(out, "id_index")]]

R/tparams_transprobs.R

@@ -122,7 +122,7 @@ create_tparams_transprobs <- function(value, ...){
 }
 
 #' @rdname check
-check.tparams_transprobs <- function(object){
+check.tparams_transprobs <- function(object, ...){
   stopifnot(is.array(object$value))
   stopifnot(is.numeric(object$sample))
   stopifnot(is.numeric(object$n_samples))
@@ -220,7 +220,7 @@ new_tparams_transprobs_array6 <- function (object, times = NULL,
 
 
 new_tparams_transprobs.array <- function (object, tpmatrix_id = NULL, times = NULL, 
-                                          grp_id = NULL, patient_wt = NULL) {
+                                          grp_id = NULL, patient_wt = NULL, ...) {
   # Checks
   n_dim <- length(dim(object))
   if(!n_dim %in% c(3, 6)){
@@ -252,7 +252,7 @@ tparams_transprobs.array <- function (object, tpmatrix_id = NULL, times = NULL,
   return(check(res))
 }
 
-new_tparams_transprobs.data.table <- function (object) {
+new_tparams_transprobs.data.table <- function (object, ...) {
   id_args <- tparams_transprobs_id(object)
   indices <- grep("^prob_", colnames(object))
   if (length(indices) == 0) {
@@ -289,6 +289,7 @@ tparams_transprobs.tpmatrix <- function(object, tpmatrix_id, ...) {
   return(do.call("create_tparams_transprobs", c(list(value = value), id_args)))
 }
 
+#' @export
 tparams_transprobs.eval_model <- function(object, ...){
   id_index <- attr(object$tpmatrix, "id_index")
   return(tparams_transprobs(object$tpmatrix, object$id[[id_index]]))

R/utils.R

@@ -333,7 +333,8 @@ coeflist <- function(coefs){
   return(coefs)
 }
 
-check.coeflist <- function(coefs){
+check.coeflist <- function(object, ...){
+  coefs = object
   # Each element of 'coefs' must be a matrix
   matrix_bool <- unlist(lapply(coefs, is.matrix))
   if(sum(!matrix_bool) > 0){

cran-comments.md

@@ -3,22 +3,99 @@ The primary purpose of this release is to fix problems identified by the
 CRAN checks. Additional details of the release can be found at:
 https://hesim-dev.github.io/hesim/news/index.html#hesim-054
 
+This is a re-submission to fix additional NOTEs caught during the submission:
+
+```
+Flavor: r-devel-linux-x86_64-debian-gcc, r-devel-windows-x86_64
+Check: S3 generic/method consistency, Result: NOTE
+  Mismatches for apparent methods not registered:
+  create_StateVals:
+    function(object, ...)
+  create_StateVals.eval_model:
+    function(object, cost, name, init_args)
+
+  check:
+    function(object, ...)
+  check.params_lm:
+    function(object)
+
+  check:
+    function(object, ...)
+  check.params_surv:
+    function(object)
+
+  check:
+    function(object, ...)
+  check.eval_model:
+    function(x)
+
+  check:
+    function(object, ...)
+  check.hesim_data:
+    function(x)
+
+  check:
+    function(object, ...)
+  check.input_mats:
+    function(object)
+
+  check:
+    function(object, ...)
+  check.tparams_transprobs:
+    function(object)
+
+  check:
+    function(object, ...)
+  check.id_attributes:
+    function(object)
+
+  check:
+    function(object, ...)
+  check.params_mlogit:
+    function(object)
+
+  check:
+    function(object, ...)
+  check.eval_rng:
+    function(object)
+
+  check:
+    function(object, ...)
+  check.coeflist:
+    function(coefs)
+
+  check:
+    function(object, ...)
+  check.params_surv_list:
+    function(object)
+
+  check:
+    function(object, ...)
+  check.model_def:
+    function(x)
+
+  new_tparams_transprobs:
+    function(object, ...)
+  new_tparams_transprobs.data.table:
+    function(object)
+
+  new_tparams_transprobs:
+    function(object, ...)
+  new_tparams_transprobs.array:
+    function(object, tpmatrix_id, times, grp_id, patient_wt)
+
+  Apparent methods for exported generics not registered:
+    create_StateVals.eval_model plot_ceac.default sim_ev.NULL
+    tparams_transprobs.eval_model
+```
+
+
 ## Test environments
 * Local OS X, R 4.2.2
 * Ubuntu 20.04.6 (on GitHub actions), R-devel, R 4.3.2
 * Microsoft Windows Server 2022 10.0.20348 (on GitHub actions) R 4.3.2
 * win-builder (devel, release)
 * R-hub builder
 
-## Local R CMD check results
-0 errors | 0 warnings | 2 notes
-
-* checking installed package size ... NOTE
-    installed size is  5.9Mb
-    sub-directories of 1Mb or more:
-      doc    2.2Mb
-      libs   1.8Mb
-
-* checking dependencies in R code ... NOTE
-  Namespace in Imports field not imported from: ‘R6’
-    All declared Imports should be used.
+## Win Builder R-devel results
+0 errors | 0 warnings | 0 notes