do not use F as a variable name from exported C++ functions

Author: boennecd

R/PF.R

@@ -740,7 +740,7 @@ PF_forward_filter.data.frame <- function(
     fixed_terms = static_args$fixed_terms, tstart = static_args$tstart,
     tstop = static_args$tstop, risk_obj = static_args$risk_obj,
     debug = static_args$debug, model = static_args$model, Q = Q, Q_0 = Q_0,
-    F = Fmat, R = R, is_forward = TRUE, a_0 = a_0, N_fw_n_bw = N_fw,
+    Fmat = Fmat, R = R, is_forward = TRUE, a_0 = a_0, N_fw_n_bw = N_fw,
     N_first = N_first, nu = if(is.null(control$nu)) 0L else control$nu,
     forward_backward_ESS_threshold = control$forward_backward_ESS_threshold,
     method = control$method, n_threads = control$n_threads, Q_tilde = Q_tilde,
@@ -780,14 +780,14 @@ get_Q_tilde <- function(x, n_vars)
     !is.null(G), !is.null(J), !is.null(K), !is.null(theta), !is.null(psi),
     !is.null(phi))
   if(is_restricted){
-    fit_call[["F"]]   <- F. <- .get_F(G, theta)
+    fit_call[["Fmat"]]   <- F. <- .get_F(G, theta)
     fit_call[["Q"]]   <- Q  <- .get_Q(J, K, psi, phi)$Q
     fit_call[["a_0"]] <- eval(fit_call[["a_0"]], parent.frame())
     G_tilde <- .get_cum_mat(nrow(F.), ncol(F.)) %*% G
     J_qr <- qr(J)
 
   } else {
-    fit_call[["F"]]   <- eval(fit_call[["F."]] , parent.frame())
+    fit_call[["Fmat"]]   <- eval(fit_call[["F."]] , parent.frame())
     fit_call[["a_0"]] <- eval(fit_call[["a_0"]], parent.frame())
     fit_call[["Q"]]   <- eval(fit_call[["Q"]]  , parent.frame())
 
@@ -799,18 +799,18 @@ get_Q_tilde <- function(x, n_vars)
   # print Q and F structure
   if(trace > 0 && is_restricted){
     tmp <- list(
-      F = .get_F(G, seq_along(theta)), R = R,
+      Fmat = .get_F(G, seq_along(theta)), R = R,
       Q = .get_Q(J, K, seq_along(psi), seq_along(phi))$Q)
     tmp <- .set_PF_names(tmp, rng_names = row.names(X), fixed_names = NULL)
 
     # start with F
     if(all(rowSums(G) < 2, G %in% c(0, 1))){
-      tmp$F <- structure(
-        sapply(tmp$F, sprintf, fmt = "t%d"), dimnames = dimnames(tmp$F),
-        dim = dim(tmp$F))
-      tmp$F[tmp$F == "t0"] <- NA_character_
+      tmp$Fmat <- structure(
+        sapply(tmp$Fmat, sprintf, fmt = "t%d"), dimnames = dimnames(tmp$F),
+        dim = dim(tmp$Fmat))
+      tmp$Fmat[tmp$Fmat == "t0"] <- NA_character_
       cat(sQuote("F"), "matrix is of the following form\n")
-      print(tmp$F, quote = FALSE, na.print = "")
+      print(tmp$Fmat, quote = FALSE, na.print = "")
       cat("\n")
 
     }
@@ -880,7 +880,7 @@ get_Q_tilde <- function(x, n_vars)
       }
       if(type == "VAR"){
         cat("F is:\n")
-        print(fit_call$F)
+        print(fit_call$Fmat)
       }
 
       print_covmat(fit_call$Q, "Q")
@@ -924,13 +924,13 @@ get_Q_tilde <- function(x, n_vars)
       cat("Updating parameters in state model...\n")
     a_0_old <- fit_call$a_0
     Q_old <- fit_call$Q
-    F_old <- fit_call$F
+    F_old <- fit_call$Fmat
     fixed_params_old <- fixed_params
 
     if(type == "RW"){
       sum_stats <- compute_PF_summary_stats(
         clouds, n_threads, a_0 = a_0, Q = Q, Q_0 = Q_0, R = R,
-        debug = trace > 2, F = F.)
+        debug = trace > 2, Fmat = F.)
       if(est_a_0)
         a_0 <- drop(sum_stats[[1]]$E_xs)
       Q <- Reduce(
@@ -956,13 +956,13 @@ get_Q_tilde <- function(x, n_vars)
           G_tilde, kronecker(solve(Q), crossprod(QR_R)) %*% G_tilde)
         theta <- drop(solve(t2, t1))
         # TODO: need to change for higher order models
-        fit_call$F <- F. <- .get_F(G, theta)
+        fit_call$Fmat <- F. <- .get_F(G, theta)
 
         if(trace > 0)
           cat("Running second conditional maximization step\n")
         sum_stats <- compute_PF_summary_stats(
           clouds, n_threads, a_0 = a_0, Q = Q, Q_0 = Q_0, R = R,
-          debug = trace > 2, F = F., do_use_F = TRUE, do_compute_E_x = FALSE)
+          debug = trace > 2, Fmat = F., do_use_F = TRUE, do_compute_E_x = FALSE)
         Z <- Reduce(
           "+", lapply(sum_stats, "[[", "E_x_less_x_less_one_outers"))
 
@@ -1036,7 +1036,7 @@ get_Q_tilde <- function(x, n_vars)
           clouds, n_threads, a_0 = a_0, Q = Q, Q_0 = Q_0, R = R,
           debug = trace > 1, only_QR = FALSE)
         # TODO: need to change for higher order models
-        fit_call$F <- F. <- new_params$R_top_F
+        fit_call$Fmat <- F. <- new_params$R_top_F
         fit_call$Q <- Q <- new_params$Q
 
       }
@@ -1083,13 +1083,13 @@ get_Q_tilde <- function(x, n_vars)
         fit_call$fixed_params <- fixed_params <- colMeans(
           fixed_params_it[avg_idx, , drop = FALSE])
 
-      fit_call$F <- F. <- apply(F_it[, , avg_idx, drop = FALSE], 1:2, mean)
-      fit_call$Q <- Q  <- apply(Q_it[, , avg_idx, drop = FALSE], 1:2, mean)
+      fit_call$Fmat <- F. <- apply(F_it[, , avg_idx, drop = FALSE], 1:2, mean)
+      fit_call$Q    <- Q  <- apply(Q_it[, , avg_idx, drop = FALSE], 1:2, mean)
 
     }
 
     if(type == "VAR")
-      Q_0 <- fit_call$Q_0 <- get_Q_0(Qmat = fit_call$Q, Fmat = fit_call$F)
+      Q_0 <- fit_call$Q_0 <- get_Q_0(Qmat = fit_call$Q, Fmat = fit_call$Fmat)
 
     # compute norms
     Q_relative_norm <- norm(Q_old - Q) / (norm(Q_old) + 1e-8)
@@ -1136,7 +1136,7 @@ get_Q_tilde <- function(x, n_vars)
 
   out <- structure(list(
     call = cl, clouds = clouds, a_0 = a_0, fixed_effects = fixed_params, Q = Q,
-    F = fit_call$F, R = R, EM_ests = list(
+    F = fit_call$Fmat, R = R, EM_ests = list(
       a_0             = a_0_it         [1:i, , drop = FALSE],
       fixed_effects   = fixed_params_it[1:i, , drop = FALSE],
       F = F_it[, , 1:i, drop = FALSE],
@@ -1745,7 +1745,7 @@ PF_get_score_n_hess <- function(object, debug = FALSE, use_O_n_sq = FALSE){
       fixed_terms = static_args$fixed_terms, tstart = static_args$tstart,
       tstop = static_args$tstop, risk_obj = static_args$risk_obj,
       debug = debug, model = static_args$model, Q = Q, Q_0 = Q_0,
-      F = Fmat, R = R, is_forward = TRUE, a_0 = a_0, N_fw_n_bw = N_fw,
+      Fmat = Fmat, R = R, is_forward = TRUE, a_0 = a_0, N_fw_n_bw = N_fw,
       N_first = N_first, nu = if(is.null(ctrl$nu)) 0L else ctrl$nu,
       forward_backward_ESS_threshold = ctrl$forward_backward_ESS_threshold,
       method = ctrl$method, n_threads = ctrl$n_threads, Q_tilde = Q_tilde,
@@ -1785,7 +1785,7 @@ PF_get_score_n_hess <- function(object, debug = FALSE, use_O_n_sq = FALSE){
     if(ctrl$fix_seed)
       assign(".Random.seed", seed, envir = .GlobalEnv)
     cpp_res <- PF_get_score_n_hess_cpp(
-      fw_cloud = fw_cloud, Q = Q, F = Fmat,
+      fw_cloud = fw_cloud, Q = Q, Fmat = Fmat,
       risk_obj = static_args$risk_obj, ran_vars = static_args$X,
       fixed_terms = static_args$fixed_terms, tstart = static_args$tstart,
       tstop = static_args$tstop, fixed_params = fixed_effects,

R/RcppExports.R

@@ -1,24 +1,24 @@
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
-PF_smooth <- function(n_fixed_terms_in_state_vec, X, fixed_terms, tstart, tstop, a_0, R, Q_0, Q, Q_tilde, risk_obj, F, n_max, n_threads, fixed_params, N_fw_n_bw, N_smooth, N_smooth_final, covar_fac, ftol_rel, forward_backward_ESS_threshold, debug, N_first, type, nu, method, smoother, model) {
-    .Call(`_dynamichazard_PF_smooth`, n_fixed_terms_in_state_vec, X, fixed_terms, tstart, tstop, a_0, R, Q_0, Q, Q_tilde, risk_obj, F, n_max, n_threads, fixed_params, N_fw_n_bw, N_smooth, N_smooth_final, covar_fac, ftol_rel, forward_backward_ESS_threshold, debug, N_first, type, nu, method, smoother, model)
+PF_smooth <- function(n_fixed_terms_in_state_vec, X, fixed_terms, tstart, tstop, a_0, R, Q_0, Q, Q_tilde, risk_obj, Fmat, n_max, n_threads, fixed_params, N_fw_n_bw, N_smooth, N_smooth_final, covar_fac, ftol_rel, forward_backward_ESS_threshold, debug, N_first, type, nu, method, smoother, model) {
+    .Call(`_dynamichazard_PF_smooth`, n_fixed_terms_in_state_vec, X, fixed_terms, tstart, tstop, a_0, R, Q_0, Q, Q_tilde, risk_obj, Fmat, n_max, n_threads, fixed_params, N_fw_n_bw, N_smooth, N_smooth_final, covar_fac, ftol_rel, forward_backward_ESS_threshold, debug, N_first, type, nu, method, smoother, model)
 }
 
-particle_filter <- function(n_fixed_terms_in_state_vec, X, fixed_terms, tstart, tstop, a_0, R, Q_0, Q, Q_tilde, risk_obj, F, n_threads, fixed_params, N_fw_n_bw, forward_backward_ESS_threshold, debug, N_first, nu, type, is_forward, method, model, covar_fac, ftol_rel) {
-    .Call(`_dynamichazard_particle_filter`, n_fixed_terms_in_state_vec, X, fixed_terms, tstart, tstop, a_0, R, Q_0, Q, Q_tilde, risk_obj, F, n_threads, fixed_params, N_fw_n_bw, forward_backward_ESS_threshold, debug, N_first, nu, type, is_forward, method, model, covar_fac, ftol_rel)
+particle_filter <- function(n_fixed_terms_in_state_vec, X, fixed_terms, tstart, tstop, a_0, R, Q_0, Q, Q_tilde, risk_obj, Fmat, n_threads, fixed_params, N_fw_n_bw, forward_backward_ESS_threshold, debug, N_first, nu, type, is_forward, method, model, covar_fac, ftol_rel) {
+    .Call(`_dynamichazard_particle_filter`, n_fixed_terms_in_state_vec, X, fixed_terms, tstart, tstop, a_0, R, Q_0, Q, Q_tilde, risk_obj, Fmat, n_threads, fixed_params, N_fw_n_bw, forward_backward_ESS_threshold, debug, N_first, nu, type, is_forward, method, model, covar_fac, ftol_rel)
 }
 
-compute_PF_summary_stats <- function(rcpp_list, n_threads, a_0, Q, Q_0, R, debug, F, do_use_F = FALSE, do_compute_E_x = TRUE) {
-    .Call(`_dynamichazard_compute_PF_summary_stats`, rcpp_list, n_threads, a_0, Q, Q_0, R, debug, F, do_use_F, do_compute_E_x)
+compute_PF_summary_stats <- function(rcpp_list, n_threads, a_0, Q, Q_0, R, debug, Fmat, do_use_F = FALSE, do_compute_E_x = TRUE) {
+    .Call(`_dynamichazard_compute_PF_summary_stats`, rcpp_list, n_threads, a_0, Q, Q_0, R, debug, Fmat, do_use_F, do_compute_E_x)
 }
 
 PF_est_params_dens <- function(rcpp_list, n_threads, a_0, Q, Q_0, R, debug, do_est_a_0 = FALSE, only_QR = FALSE) {
     .Call(`_dynamichazard_PF_est_params_dens`, rcpp_list, n_threads, a_0, Q, Q_0, R, debug, do_est_a_0, only_QR)
 }
 
-PF_get_score_n_hess_cpp <- function(fw_cloud, Q, F, risk_obj, ran_vars, fixed_terms, tstart, tstop, fixed_params, family, max_threads, debug, a_0, R, Q_0, Q_tilde, N_fw_n_bw, N_first, nu, covar_fac, ftol_rel, method, forward_backward_ESS_threshold, use_O_n_sq = FALSE, only_score = FALSE) {
-    .Call(`_dynamichazard_PF_get_score_n_hess_cpp`, fw_cloud, Q, F, risk_obj, ran_vars, fixed_terms, tstart, tstop, fixed_params, family, max_threads, debug, a_0, R, Q_0, Q_tilde, N_fw_n_bw, N_first, nu, covar_fac, ftol_rel, method, forward_backward_ESS_threshold, use_O_n_sq, only_score)
+PF_get_score_n_hess_cpp <- function(fw_cloud, Q, Fmat, risk_obj, ran_vars, fixed_terms, tstart, tstop, fixed_params, family, max_threads, debug, a_0, R, Q_0, Q_tilde, N_fw_n_bw, N_first, nu, covar_fac, ftol_rel, method, forward_backward_ESS_threshold, use_O_n_sq = FALSE, only_score = FALSE) {
+    .Call(`_dynamichazard_PF_get_score_n_hess_cpp`, fw_cloud, Q, Fmat, risk_obj, ran_vars, fixed_terms, tstart, tstop, fixed_params, family, max_threads, debug, a_0, R, Q_0, Q_tilde, N_fw_n_bw, N_first, nu, covar_fac, ftol_rel, method, forward_backward_ESS_threshold, use_O_n_sq, only_score)
 }
 
 pf_fixed_effect_get_QR <- function(clouds, risk_obj, ran_vars, fixed_terms, R_top, tstart, tstop, fixed_params, family, max_threads, debug) {
@@ -161,36 +161,36 @@ linear_mapper_test <- function(A, x, X, z, Z, type, R) {
     .Call(`_dynamichazard_linear_mapper_test`, A, x, X, z, Z, type, R)
 }
 
-check_state_fw <- function(parent, parent1, child, child1, F, Q) {
-    .Call(`_dynamichazard_check_state_fw`, parent, parent1, child, child1, F, Q)
+check_state_fw <- function(parent, parent1, child, child1, Fmat, Q) {
+    .Call(`_dynamichazard_check_state_fw`, parent, parent1, child, child1, Fmat, Q)
 }
 
-check_state_bw <- function(parent, parent1, child, child1, F, Q) {
-    .Call(`_dynamichazard_check_state_bw`, parent, parent1, child, child1, F, Q)
+check_state_bw <- function(parent, parent1, child, child1, Fmat, Q) {
+    .Call(`_dynamichazard_check_state_bw`, parent, parent1, child, child1, Fmat, Q)
 }
 
-check_artificial_prior <- function(state, F, Q, m_0, Q_0, t1, t2, t3) {
-    .Call(`_dynamichazard_check_artificial_prior`, state, F, Q, m_0, Q_0, t1, t2, t3)
+check_artificial_prior <- function(state, Fmat, Q, m_0, Q_0, t1, t2, t3) {
+    .Call(`_dynamichazard_check_artificial_prior`, state, Fmat, Q, m_0, Q_0, t1, t2, t3)
 }
 
 check_observational_cdist <- function(X, is_event, offsets, tstart, tstop, bin_start, bin_stop, multithreaded, fam, state, state1) {
     .Call(`_dynamichazard_check_observational_cdist`, X, is_event, offsets, tstart, tstop, bin_start, bin_stop, multithreaded, fam, state, state1)
 }
 
-check_fw_bw_comb <- function(F, Q, parent, parent1, grand_child, grand_child1, x, nu) {
-    .Call(`_dynamichazard_check_fw_bw_comb`, F, Q, parent, parent1, grand_child, grand_child1, x, nu)
+check_fw_bw_comb <- function(Fmat, Q, parent, parent1, grand_child, grand_child1, x, nu) {
+    .Call(`_dynamichazard_check_fw_bw_comb`, Fmat, Q, parent, parent1, grand_child, grand_child1, x, nu)
 }
 
-check_prior_bw_comb <- function(F, Q, m_0, Q_0, child, child1, parent, t1, t2) {
-    .Call(`_dynamichazard_check_prior_bw_comb`, F, Q, m_0, Q_0, child, child1, parent, t1, t2)
+check_prior_bw_comb <- function(Fmat, Q, m_0, Q_0, child, child1, parent, t1, t2) {
+    .Call(`_dynamichazard_check_prior_bw_comb`, Fmat, Q, m_0, Q_0, child, child1, parent, t1, t2)
 }
 
-check_prior_bw_state_comb <- function(X, is_event, offsets, tstart, tstop, bin_start, bin_stop, fam, F, Q, m_0, Q_0, child, child1, parent, t1, Q_xtra, nu = -1L, covar_fac = -1, ftol_rel = 1e-8) {
-    .Call(`_dynamichazard_check_prior_bw_state_comb`, X, is_event, offsets, tstart, tstop, bin_start, bin_stop, fam, F, Q, m_0, Q_0, child, child1, parent, t1, Q_xtra, nu, covar_fac, ftol_rel)
+check_prior_bw_state_comb <- function(X, is_event, offsets, tstart, tstop, bin_start, bin_stop, fam, Fmat, Q, m_0, Q_0, child, child1, parent, t1, Q_xtra, nu = -1L, covar_fac = -1, ftol_rel = 1e-8) {
+    .Call(`_dynamichazard_check_prior_bw_state_comb`, X, is_event, offsets, tstart, tstop, bin_start, bin_stop, fam, Fmat, Q, m_0, Q_0, child, child1, parent, t1, Q_xtra, nu, covar_fac, ftol_rel)
 }
 
-logLike_cpp <- function(X, risk_obj, F, Q_0, Q, a_t_d_s, tstart, tstop, fixed_effects_offsets, order_, model) {
-    .Call(`_dynamichazard_logLike_cpp`, X, risk_obj, F, Q_0, Q, a_t_d_s, tstart, tstop, fixed_effects_offsets, order_, model)
+logLike_cpp <- function(X, risk_obj, Fmat, Q_0, Q, a_t_d_s, tstart, tstop, fixed_effects_offsets, order_, model) {
+    .Call(`_dynamichazard_logLike_cpp`, X, risk_obj, Fmat, Q_0, Q, a_t_d_s, tstart, tstop, fixed_effects_offsets, order_, model)
 }
 
 parallelglm <- function(X, Ys, family, beta0, weights, offsets, tol = 1e-8, nthreads = 1L, it_max = 25L, trace = FALSE, method = "Quick") {

R/loglike.R

@@ -55,7 +55,7 @@ logLik.ddhazard = function(object, data = NULL, id, ...){
   }
 
   val <- logLike_cpp(
-    X = X$X, risk_obj = risk_obj, F = object$F_,
+    X = X$X, risk_obj = risk_obj, Fmat = object$F_,
     Q_0 = object$Q_0, Q = object$Q, a_t_d_s = t(object$state_vecs),
     tstart = X$Y[, 1], tstop = X$Y[, 2], order_ = object$order,
     model = object$model, fixed_effects_offsets = fixed_effects_offsets)

cran-comments.md

@@ -16,3 +16,80 @@ fixed.
 There were no WARNINGs or ERRORs.
 
 There is a NOTE about the package size in some cases.
+
+## Resubmission
+This is a resubmission. I have addressed the issues stated below.
+
+> Please write TRUE and FALSE instead of T and F. (Please don't use 'T' or
+> 'F' as vector names.)
+
+`T` and `F` is no longer used. Instead `TRUE` and `FALSE` is used. Also, T and F 
+are no longer used for vector names.
+
+Please add \value to .Rd files regarding exported methods and explain
+the functions results in the documentation. Please write about the
+structure of the output (class) and also what the output means. (If a
+function does not return a value, please document that too, e.g.
+\value{No return value, called for side effects} or similar)
+Missing Rd-tags:
+      ddFixed.Rd: \value
+      ddhazard_app.Rd: \value
+      logLik.ddhazard.Rd: \value
+      plot.ddhazard_space_errors.Rd: \value
+      plot.ddhazard.Rd: \value
+      predict.ddhazard.Rd: \value
+      print.ddhazard_boot.Rd: \value
+      residuals.ddhazard.Rd: \value
+
+\dontrun{} should only be used if the example really cannot be executed
+(e.g. because of missing additional software, missing API keys, ...) by
+the user. That's why wrapping examples in \dontrun{} adds the comment
+("# Not run:") as a warning for the user.
+Does not seem necessary in every case.
+
+Please unwrap the examples if they are executable in < 5 sec, or replace
+\dontrun{} with \donttest{}.
+
+
+You are setting options(warn=-1) in your function. This is not allowed.
+Please rather use suppressWarnings() if really needed.
+
+Please make sure that you do not change the user's options, par or
+working directory. If you really have to do so within functions, please
+ensure with an *immediate* call of on.exit() that the settings are reset
+when the function is exited. e.g.:
+...
+oldpar <- par(no.readonly = TRUE)    # code line i
+on.exit(par(oldpar))            # code line i + 1
+...
+par(mfrow=c(2,2))            # somewhere after
+...
+
+e.g.: inst/doc.. files
+
+
+Please always make sure to reset to user's options(), working directory
+or par() after you changed it in examples and vignettes and demos.
+e.g.: ddsurvcurve.Rd
+oldpar <- par(mfrow = c(1,2))
+...
+par(oldpar)
+
+old <- options(digits = 3)
+...
+options(old)
+
+Please do not modify the .GlobalEnv. This is not allowed by the CRAN
+policies.
+
+Please do not modify the global environment (e.g. by using <<-) in your
+functions. This is not allowed by the CRAN policies.
+
+Please ensure that you do not use more than 2 cores in your examples,
+vignettes, etc.
+
+
+Additionally:
+Have the issues why your package was archived been fixed?
+Please explain this in the submission comments.
+