Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

fix: CRAN NOTEs related to S3 methods #121

Merged
merged 2 commits into from
Feb 11, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -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)
Expand Down
31 changes: 16 additions & 15 deletions R/hesim_data.R
Original file line number Diff line number Diff line change
Expand Up @@ -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){
Expand Down Expand Up @@ -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")
Expand Down
2 changes: 1 addition & 1 deletion R/input_mats.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
20 changes: 10 additions & 10 deletions R/model_def.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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")
}


Expand Down Expand Up @@ -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'")
}

2 changes: 1 addition & 1 deletion R/params_lm.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion R/params_mlogit.R
Original file line number Diff line number Diff line change
Expand Up @@ -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.")
}
Expand Down
2 changes: 1 addition & 1 deletion R/params_surv.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion R/params_surv_list.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}

Expand Down
1 change: 1 addition & 0 deletions R/plot.R
Original file line number Diff line number Diff line change
Expand Up @@ -86,6 +86,7 @@ plot_ceac <- function(x, ...) {
UseMethod("plot_ceac", x)
}

#' @export
plot_ceac.default <- function(x, labels = NULL, ceaf = FALSE, ...) {
best <- NULL

Expand Down
1 change: 1 addition & 0 deletions R/sim-general.R
Original file line number Diff line number Diff line change
Expand Up @@ -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'.",
Expand Down
3 changes: 2 additions & 1 deletion R/statevals.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")]]
Expand Down
7 changes: 4 additions & 3 deletions R/tparams_transprobs.R
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down Expand Up @@ -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)){
Expand Down Expand Up @@ -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) {
Expand Down Expand Up @@ -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]]))
Expand Down
3 changes: 2 additions & 1 deletion R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -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){
Expand Down
101 changes: 89 additions & 12 deletions cran-comments.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Loading
Loading