handle other issues raised by CRAN

Author: boennecd

.sandbox/Sim_study_with_logit/Sim_study_with_logit.Rmd

@@ -40,24 +40,11 @@ All method use the logistic link function. We will do three runs of experiments
 
 where correct or incorrect binning intervals refers to whether or not we bin at the same time where the coefficient are simulated to change. For example, we bin correctly where we simulate the coefficients to change at time $1,2,\dots,d$ and we estimate the coefficient at time $1,2,\dots,d$. The models will be compared in terms of Brier score, median absolute residuals and standard deviation of the absolute residuals. All metrics will be reported on out-sample data or out-of-time data. All plots will have true coefficients as continuous lines while dashed lines are estimates.
 
-You can install the version of the library used to make this vignettes from github with the `devtools` library as follows:
-
-```{r echo=FALSE}
-current_sha <- httr::content(
-  httr::GET("https://api.github.com/repos/boennecd/dynamichazard/git/refs/heads/master")
-  )$object$sha
-
-stopifnot(length(current_sha) > 0 && class(current_sha) == "character")
-
-current_version <- paste0("boennecd/dynamichazard@", current_sha)
-```
-
-```{r}
-current_version # The string to pass devtools::install_github
-```
+You can install the version of the library used to make this vignettes from github with the `remotes` library as follows:
 
 ```{r eval=FALSE}
-devtools::install_github(current_version)
+# install.packages("remotes")
+remotes::install_github("boennecd/dynamichazard")
 ```
 
 You can also get the latest version on CRAN by calling:

NEWS.md

@@ -1,6 +1,7 @@
 # dynamichazard 0.6.8
 * fix issue due to changes in speedglm.
 * add documentation and fix other issues raised by CRAN.
+* `getOption("ddhazard_max_threads")` defaults to one.
 
 # dynamichazard 0.6.7
 * solve issue because of changes in `all.equal`.

R/PF.R

@@ -76,7 +76,7 @@ PF_effective_sample_size <- function(object){
 #' The function is still under development so the output and API may change.
 #'
 #' @examples
-#'\dontrun{
+#' \donttest{
 #'#####
 #'# Fit model with lung data set from survival
 #'# Warning: long-ish computation time
@@ -94,9 +94,10 @@ PF_effective_sample_size <- function(object){
 #'  Q_0 = diag(1, 2), Q = diag(.5^2, 2),
 #'  max_T = 800,
 #'  control = PF_control(
-#'     N_fw_n_bw = 500, N_first = 2500, N_smooth = 5000,
+#'     # these number should be larger! Small for CRAN checks
+#'     N_fw_n_bw = 100L, N_first = 250L, N_smooth = 100L,
 #'     n_max = 50, eps = .001, Q_tilde = diag(.2^2, 2), est_a_0 = FALSE,
-#'     n_threads = max(parallel::detectCores(logical = FALSE), 1)))
+#'     n_threads = 2))
 #'
 #'# Plot state vector estimates
 #'plot(pf_fit, cov_index = 1)
@@ -105,7 +106,7 @@ PF_effective_sample_size <- function(object){
 #'# Plot log-likelihood
 #'plot(pf_fit$log_likes)
 #'}
-#'\dontrun{
+#' \donttest{
 #'######
 #'# example with fixed intercept
 #'
@@ -144,11 +145,12 @@ PF_effective_sample_size <- function(object){
 #'   by = 100, id = pbc2$id,
 #'   model = "exponential", max_T = 3600,
 #'   control = PF_control(
-#'     N_fw_n_bw = 500, N_smooth = 2500, N_first = 1000, eps = 1e-3,
+#'     # these number should be larger! Small for CRAN checks
+#'     N_fw_n_bw = 100, N_smooth = 250, N_first = 100, eps = 1e-3,
 #'     method = "AUX_normal_approx_w_cloud_mean", est_a_0 = FALSE,
 #'     Q_tilde = as.matrix(.1^2),
 #'     n_max = 25, # just take a few iterations as an example
-#'     n_threads = max(parallel::detectCores(logical = FALSE), 1)))
+#'     n_threads = 2))
 #'
 #'# compare results
 #'plot(ddfit)
@@ -157,7 +159,7 @@ PF_effective_sample_size <- function(object){
 #'sqrt(pf_fit$Q)
 #'rbind(ddfit$fixed_effects, pf_fit$fixed_effects)
 #'}
-#'\dontrun{
+#' \donttest{
 #' #####
 #' # simulation example with `random` and `fixed` argument and a restricted
 #' # model
@@ -264,35 +266,35 @@ PF_effective_sample_size <- function(object){
 #'     N_fw_n_bw = 100L, N_smooth = 100L, N_first = 500L,
 #'     method = "AUX_normal_approx_w_cloud_mean",
 #'     nu = 5L, # sample from multivariate t-distribution
-#'     n_max = 100L,  averaging_start = 50L,
+#'     n_max = 60L,  averaging_start = 50L,
 #'     smoother = "Fearnhead_O_N", eps = 1e-4, covar_fac = 1.2,
-#'     n_threads = 4L # depends on your cpu(s)
+#'     n_threads = 2L # depends on your cpu(s)
 #'   ),
 #'   trace = 1L)
 #' plot(fit$log_likes) # log-likelihood approximation at each iterations
 #'
-#' # take more iterations with more particles
-#' cl <- fit$call
-#' ctrl <- cl[["control"]]
-#' ctrl[c("N_fw_n_bw", "N_smooth", "N_first", "n_max",
-#'        "averaging_start")] <- list(500L, 2000L, 5000L, 200L, 30L)
-#' cl[["control"]] <- ctrl
-#' cl[c("phi", "psi", "theta")] <- list(fit$phi, fit$psi, fit$theta)
-#' fit_extra <- eval(cl)
+#' # you can take more iterations by uncommenting the following
+#' # cl <- fit$call
+#' # ctrl <- cl[["control"]]
+#' # ctrl[c("N_fw_n_bw", "N_smooth", "N_first", "n_max",
+#' #        "averaging_start")] <- list(500L, 2000L, 5000L, 200L, 30L)
+#' # cl[["control"]] <- ctrl
+#' # cl[c("phi", "psi", "theta")] <- list(fit$phi, fit$psi, fit$theta)
+#' # fit_extra <- eval(cl)
 #'
-#' plot(fit_extra$log_likes) # log-likelihood approximation at each iteration
+#' plot(fit$log_likes) # log-likelihood approximation at each iteration
 #'
 #' # check estimates
-#' sqrt(diag(fit_extra$Q))
+#' sqrt(diag(fit$Q))
 #' sqrt(diag(Q))
-#' cov2cor(fit_extra$Q)
+#' cov2cor(fit$Q)
 #' cov2cor(Q)
-#' fit_extra$F
+#' fit$F
 #' F.
 #'
 #' # plot predicted state variables
 #' for(i in 1:p){
-#'   plot(fit_extra, cov_index = i)
+#'   plot(fit, cov_index = i)
 #'   abline(h = 0, lty = 2)
 #'   lines(1:nrow(alphas) - 1, alphas[, i] - beta[i], lty = 3)
 #' }
@@ -553,7 +555,7 @@ PF_EM <- function(
 #' The function is still under development so the output and API may change.
 #'
 #' @examples
-#' \dontrun{
+#' \donttest{
 #' # head-and-neck cancer study data. See Efron, B. (1988) doi:10.2307/2288857
 #' is_censored <- c(
 #'   6, 27, 34, 36, 42, 46, 48:51, 51 + c(15, 30:28, 33, 35:37, 39, 40, 42:45))
@@ -574,7 +576,7 @@ PF_EM <- function(
 #' ctrl <- PF_control(
 #'   N_fw_n_bw = 500, N_smooth = 2500, N_first = 2000,
 #'   n_max = 1, # set to one as an example
-#'   n_threads = max(parallel::detectCores(logical = FALSE), 1),
+#'   n_threads = 2,
 #'   eps = .001, Q_tilde = as.matrix(.3^2), est_a_0 = FALSE)
 #' pf_fit <- suppressWarnings(
 #'   PF_EM(
@@ -726,12 +728,12 @@ PF_forward_filter.data.frame <- function(
     # set the seed
     old_seed <- .GlobalEnv$.Random.seed
     # to make sure the user has the same `rng.kind`
-    on.exit(.GlobalEnv$.Random.seed <- old_seed)
+    on.exit(assign(".Random.seed", old_seed, envir = .GlobalEnv))
 
     stopifnot(length(seed) > 1) # make sure user did not use seed as in
     # `set.seed`
     if(control$fix_seed)
-      .GlobalEnv$.Random.seed <- seed
+      assign(".Random.seed", seed, envir = .GlobalEnv)
   }
 
   out <- particle_filter(
@@ -1632,7 +1634,7 @@ get_cloud_quantiles.PF_clouds <- function(
 #' \code{FALSE}.}
 #'
 #' @examples
-#' \dontrun{
+#' \donttest{
 #' library(dynamichazard)
 #' .lung <- lung[!is.na(lung$ph.ecog), ]
 #' # standardize
@@ -1649,7 +1651,7 @@ get_cloud_quantiles.PF_clouds <- function(
 #'   control = PF_control(
 #'     N_fw_n_bw = 250, N_first = 2000, N_smooth = 500, covar_fac = 1.1,
 #'     nu = 6, n_max = 1000L, eps = 1e-4, averaging_start = 200L,
-#'     n_threads = max(parallel::detectCores(logical = FALSE), 1)))
+#'     n_threads = 2))
 #'
 #' # compute score and observed information matrix
 #' comp_obj <- PF_get_score_n_hess(pf_fit)

R/boot_est.R

@@ -23,7 +23,7 @@ if(getRversion() >= "2.15.1")
 #'
 #'
 #' @examples
-#'\dontrun{
+#'\donttest{
 #'library(dynamichazard)
 #'set.seed(56219373)
 #'fit <- ddhazard(

R/get_design_matrix.R

@@ -187,18 +187,22 @@ get_design_matrix <- function(
 #'
 #' @param object expression that would be used in formula. E.g. \code{x} or \code{poly(x, degree = 3)}.
 #'
-#'@examples
-#'# we can get a time-invariant effect of `x1` by
-#'\dontrun{
-#' ddhazard(Surv(stop, event) ~ ddFixed(x1), data)
-#'}
+#' @return
+#' Returns the passed object.
 #'
-#'# all of the calls below will yield the same result with a time-invariant
-#'# intercept:
-#'\dontrun{
-#' ddhazard(Surv(stop, event) ~ ddFixed_intercept() + x1, data)
-#' ddhazard(Surv(stop, event) ~ -1 + ddFixed_intercept() + x1, data)
-#'}
+#' @examples
+#' # we can get a time-invariant effect of `x1` by
+#' set.seed(1)
+#' dat <- data.frame(stop = 1:20, event = rep(c(TRUE, FALSE), 10L), x1 = rnorm(20))
+#' ddhazard(Surv(stop, event) ~ ddFixed(x1), dat,
+#'          Q_0 = diag(1), by = 1, Q = diag(1))
+#'
+#' # all of the calls below will yield the same result with a time-invariant
+#' # intercept:
+#' ddhazard(Surv(stop, event) ~ ddFixed_intercept() + x1, dat,
+#'          Q_0 = diag(1), by = 1, Q = diag(1))
+#' ddhazard(Surv(stop, event) ~ -1 + ddFixed_intercept() + x1, dat,
+#'          Q_0 = diag(1), by = 1, Q = diag(1))
 #' @export
 ddFixed <- function(object){
   if(all(object == 1)){

R/loglike.R

@@ -11,6 +11,9 @@
 #' @param id the individual identifiers as in \code{\link{ddhazard}}.
 #' @param ... unused.
 #'
+#' @return
+#' Returns an ojbect of class \code{logLik}. See \code{\link{logLik}}.
+#'
 #' @examples
 #'library(dynamichazard)
 #'fit <- ddhazard(

R/options.R

@@ -9,8 +9,7 @@ cur_load = if(exists(".onLoad()")) .onLoad else function() { NULL }
   op <- options()
 
   # TODO: avoid this by doing as e.g., in `boot::boot` by using `getOption`
-  op.dynhazard <- list(
-    ddhazard_max_threads = -1)
+  op.dynhazard <- list(ddhazard_max_threads = 1)
   toset <- !(names(op.dynhazard) %in% names(op))
   if(any(toset))
     options(op.dynhazard[toset])

R/plot.R

@@ -15,6 +15,9 @@
 #' @details
 #' Creates a plot of state variables or adds state variables to a plot with indices \code{cov_index}. Pointwise 1.96 std. confidence intervals are provided with the smoothed co-variance matrices from the fit.
 #'
+#' @return
+#' Returns \code{NULL} using \code{\link{invisible}}.
+#'
 #' @importFrom graphics matplot matpoints
 #'
 #' @examples
@@ -55,8 +58,8 @@ plot.ddhazard = function(x, xlab = "Time",
 
     n_plots <- length(cov_index)
     if(!add && do_alter_mfcol && n_plots > 1){
-      org_mfcol <- par()$mfcol
-      on.exit(par(mfcol = org_mfcol))
+      par_old <- par(no.readonly = TRUE)
+      on.exit(par(par_old))
       par(mfcol =
             if(n_plots <= 2) c(2,1) else
               if(n_plots <= 4) c(2,2) else
@@ -146,6 +149,9 @@ plot.ddhazard = function(x, xlab = "Time",
 #' @param x_tick_loc,x_tick_mark \code{at} and \code{labels} arguments passed to \code{axis}.
 #' @param ... arguments passed to \code{\link{plot.default}}.
 #'
+#' @return
+#' Returns \code{NULL} using \code{\link{invisible}}.
+#'
 #' @importFrom graphics abline axis par plot points
 #' @export
 plot.ddhazard_space_errors = function(x, mod, cov_index = NA, t_index = NA,

R/predict.R

@@ -46,6 +46,9 @@
 #' \item{\code{istop}}{numeric vector with stop time for each element in \code{fits}.}
 #'}
 #'
+#' @return
+#' Returns a list with elements as described in the Term and Response sections.
+#'
 #' @examples
 #' fit <- ddhazard(
 #'  Surv(time, status == 2) ~ log(bili), pbc, id = pbc$id, max_T = 3600,
@@ -375,7 +378,7 @@ predict_response <- function(
 #'
 #' # predict with default which is all covariates set to zero
 #' ddcurve <- ddsurvcurve(f1)
-#' par(mar = c(4.5, 4, .5, .5))
+#' par_old <- par(mar = c(4.5, 4, .5, .5))
 #' plot(ddcurve, col = "DarkBlue", lwd = 2)
 #'
 #' # compare with cox model
@@ -448,6 +451,7 @@ predict_response <- function(
 #'       col = "DarkBlue")
 #' lines(survfit(Surv(stop, event) ~ 1, head_neck_cancer, subset = group == 2),
 #'       col = "DarkOrange")
+#' par(par_old) # As per CRAN policy, the settings are reset
 #'
 #' @export
 #' @importFrom utils head

R/print.R

@@ -9,6 +9,9 @@
 #' @description
 #' Arguments have the same effects as for an object from a \code{\link{boot}} call. See \code{\link[=print.boot]{print}}.
 #'
+#' @return
+#' Returns \code{x} using \code{\link{invisible}}.
+#'
 #' @seealso
 #' \code{\link{ddhazard_boot}}
 #'
@@ -44,7 +47,6 @@ print.ddhazard_boot <-
     invisible(boot.out)
   }
 
-
 #' @export
 print.ddhazard<- function(x, ...){
   cat("Call:", paste(deparse(x$call), sep = "\n", collapse = "\n"), sep = "\n")