diff --git a/DESCRIPTION b/DESCRIPTION index 7921924c..71d787cd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: fwildclusterboot Title: Fast Wild Cluster Bootstrap Inference for Linear Models -Version: 0.14.0 +Version: 0.15 Authors@R: c( person("Alexander", "Fischer", , "alexander-fischer1801@t-online.de", role = c("aut", "cre")), person("David", "Roodman", role = "aut"), @@ -75,6 +75,8 @@ Suggests: testthat (>= 3.0.0), tibble, MASS +Remotes: + kylebutts/fixest/tree/sparse-matrix LinkingTo: Rcpp, RcppArmadillo, diff --git a/NAMESPACE b/NAMESPACE index 4596da39..c693d610 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -54,6 +54,7 @@ importFrom(dreamerr,check_value_plus) importFrom(dreamerr,set_up) importFrom(dreamerr,validate_dots) importFrom(dreamerr,warn_up) +importFrom(fixest,sparse_model_matrix) importFrom(generics,glance) importFrom(generics,tidy) importFrom(gtools,permutations) diff --git a/R/arg_checks.R b/R/arg_checks.R index 75e82ae6..21e71ec1 100644 --- a/R/arg_checks.R +++ b/R/arg_checks.R @@ -123,17 +123,17 @@ check_boottest_args_plus <- function( # e.g. fml = y ~ x1 + I(x2^2) shold be possible #' @srrstats {G2.4c} *explicit conversion to character via `as.character()` #' (and not `paste` or `paste0`)* Done - + ("fixef_vars" %in% names(object) && grepl("[", Reduce(paste, as.character(as.formula(object$fml_all$fixef))), - fixed = TRUE - )) + fixed = TRUE) && + !is.null(fe) + ) # note: whitespace ~ - for IV # grepl("~", deparse_fml, fixed = TRUE) ) { - rlang::abort("Varying slopes in fixest / fixest via [] to interact - fixed effects is currently not supported in boottest().") + rlang::abort("Varying slopes fixed effects in `fixest::feols()` are currently not supported in boottest() when fe are projected out in the bootstrap via the `fe` function argument.") } diff --git a/R/boot_aggregate.R b/R/boot_aggregate.R index 7ee10778..c454b388 100644 --- a/R/boot_aggregate.R +++ b/R/boot_aggregate.R @@ -217,7 +217,7 @@ boot_aggregate <- function( # note: all boottest function arguments are tested in boottest() # therefore, only check for supported subset of features - check_arg(bootstrap_type, "charin(fnw11)") + check_arg(bootstrap_type, "charin(fnw11, 11, 31, 13, 33)") check_arg(full, "logical scalar") # => later => extend it to more than one set of vars to agg @@ -312,10 +312,26 @@ boot_aggregate <- function( val <- gsub(paste0(".*", agg, ".*"), "\\2", cname_select, perl = TRUE) } - mm <- model.matrix(x) - - cat("Run the wild bootstrap: this might take some time...(but - hopefully not too much time =) ).", "\n") + if(inherits(x, "etwfe")){ + X <- fixest:::model.matrix.fixest(x, type = "rhs") + mm2 <- sparse_model_matrix(x, type = c("fixef")) |> as.matrix() |> as.data.frame() + mm <- cbind(X, mm2) + + + if(agg %in% c("att", "period", "cohort", "TRUE")){ + rlang::abort( + paste0("`agg='", agg, "'` works for fixest::sunab(), but is not implemented for objects of type `etwfe`. For `etwfe`, you will have to do the aggregation by hand. See `?boot_aggregate` for examples.") + ) + } + + } else { + # varying slopes only allowed for objects of type "etwfe" + check_no_varying_slopes(x) + mm <- model.matrix(x) + + } + + rlang::inform("Run the wild bootstrap: this might take some time...(but hopefully not too much time =) ).") name_df <- unique(data.frame(root, val, stringsAsFactors = FALSE)) @@ -330,7 +346,6 @@ boot_aggregate <- function( for(i in 1:nk){ - r <- name_df[i, 1] v <- name_df[i, 2] v_names <- cname_select[root == r & val == v] @@ -393,8 +408,6 @@ boot_aggregate <- function( ssc = ssc ) - setTxtProgressBar(pb,i) - pvalues[i] <- pval(boot_fit) teststat[i] <- teststat(boot_fit) if(!is.null(clustid)){ @@ -402,6 +415,8 @@ boot_aggregate <- function( } else { conf_int[i,] <- rep(NA, 2) } + + setTxtProgressBar(pb,i) } # th z & p values @@ -425,5 +440,30 @@ boot_aggregate <- function( } +check_no_varying_slopes <- function(object){ + + has_fixef <- "fixef_vars" %in% names(object) + + if ( + # '^' illegal in fixef argument, but legal in main formula - + # e.g. fml = y ~ x1 + I(x2^2) shold be possible + #' @srrstats {G2.4c} *explicit conversion to character via `as.character()` + #' (and not `paste` or `paste0`)* Done + + (has_fixef && + grepl("[", + Reduce(paste, as.character(as.formula(object$fml_all$fixef))), + fixed = TRUE) && + !is.null(fe) + ) + # note: whitespace ~ - for IV + # grepl("~", deparse_fml, fixed = TRUE) + ) { + rlang::abort("Varying slopes fixed effects in `fixest::feols()` are currently not supported in boottest() when fe are projected out in the bootstrap via the `fe` function argument.") + } + +} + + diff --git a/R/boot_algo_fastnreliable.R b/R/boot_algo_fastnreliable.R index c163de6c..c158da7e 100644 --- a/R/boot_algo_fastnreliable.R +++ b/R/boot_algo_fastnreliable.R @@ -162,7 +162,10 @@ boot_algo_fastnreliable <- function( inv_tXX_tXgXg <- lapply( 1:G, - function(x) inv(tXX - tXgXg[[x]], x) + function(x) inv(tXX - tXgXg[[x]], + paste0( + "Matrix inversion error when computing beta(g) for cluster ", g, ". Using Pseudo-Inverse instead. Potentially, you can suppress this message by specifying a cluster fixed effect in the bootstrap via the `fe` argument of `boottest()`.") + ) ) beta_1g_tilde <- lapply( @@ -189,7 +192,10 @@ boot_algo_fastnreliable <- function( if(is.null(inv_tXX_tXgXg)){ inv_tXX_tXgXg <- lapply( 1:G, - function(x) inv((tXX - tXgXg[[x]]), x) + function(g) inv((tXX - tXgXg[[g]]), + paste0( + "Matrix inversion error when computing beta(g) for cluster ", g, ". Using Pseudo-Inverse instead. Potentially, you can suppress this message by specifying a cluster fixed effect in the bootstrap via the `fe` argument of `boottest()`.") + ) ) } } @@ -352,14 +358,13 @@ boot_algo_fastnreliable <- function( } -inv <- function(x, g){ +inv <- function(x, message){ tryCatch( { Matrix::solve(x) }, error = function(e) { - rlang::warn(message = paste0( - "Matrix inversion error when computing beta(g) for cluster ", g, ". Using Pseudo-Inverse instead. Potentially, you can suppress this message by specifying a cluster fixed effect in the bootstrap via the `fe` argument of `boottest()`."), + rlang::warn(message = message, use_cli_format = TRUE) eigen_pinv(as.matrix(x)) } diff --git a/R/boot_algo_fastnwild.R b/R/boot_algo_fastnwild.R index 4889a4c8..e860fca6 100644 --- a/R/boot_algo_fastnwild.R +++ b/R/boot_algo_fastnwild.R @@ -112,7 +112,7 @@ boot_algo_fastnwild <- # weights_mat <- Matrix::Diagonal(N, weights) # if no weights - N x N identity matrix weights_sq <- sqrt(weights) # sqrt fine because diagonal matrix - A <- solve(crossprod(weights_sq * X)) # k x k + A <- inv(crossprod(weights_sq * X), "Matrix inversion failure: Using a generalized inverse instead. Check the produced t-statistic, does it match the one of your regression package (under the same small sample correction)? If yes, this is likely not something to worry about.") # k x k # XXinv <- solve(crossprod(X)) # k x k WX <- weights * X @@ -172,47 +172,47 @@ boot_algo_fastnwild <- # as.vector(bootcluster[[1]]) # ) # ) # N x c* - + # preallocate lists CC <- vector(mode = "list", length = length(names(clustid))) DD <- vector(mode = "list", length = length(names(clustid))) CD <- vector(mode = "list", length = length(names(clustid))) - + # CC <- matrix(NA, length(names(clustid)), B + 1) # CD <- matrix(NA, length(names(clustid)), B + 1) # DD <- matrix(NA, length(names(clustid)), B + 1) - - + + if (is.null(W)) { # if there are no fixed effects - term (2) in equ. (62) fast & wild # does not arise # note - W refers to W_bar in fast & wild, not regression weights. # If no fixed effects # in the model / bootstrap, W is NULL - + for (x in seq_along(names(clustid))) { SXinvXXRX <- collapse::fsum(WXARX, clustid[x]) # c* x f SXinvXXRXA <- SXinvXXRX %*% A # part of numerator independent of both bootstrap errors and r - + # P2_bootcluster has been collapsed over "bootcluster", # now collapse over cluster c P2 <- #Matrix.utils::aggregate.Matrix(P2_bootcluster, clustid[x]) # c* x c collapse::fsum(P2_bootcluster, clustid[x]) P_all <- P2 - tcrossprod(SXinvXXRXA, P1) # formerly _a - + Q2 <- #Matrix.utils::aggregate.Matrix(Q2_bootcluster, clustid[x]) collapse::fsum(Q2_bootcluster, clustid[x]) Q_all <- Q2 - tcrossprod(SXinvXXRXA, Q1) - + C <- eigenMapMatMult(as.matrix(P_all), v, nthreads) # c* x (B + 1) D <- eigenMapMatMult(as.matrix(Q_all), v, nthreads) # c* x (B + 1) - + CC[[x]] <- colSums(C * C) DD[[x]] <- colSums(D * D) CD[[x]] <- colSums(C * D) @@ -221,32 +221,32 @@ boot_algo_fastnwild <- # project out fe Q3_2 <- crosstab(as.matrix(weights * W %*% Q), - var1 = bootcluster, - var2 = fixed_effect + var1 = bootcluster, + var2 = fixed_effect ) # f x c* P3_2 <- crosstab(as.matrix(weights * W %*% P), - var1 = bootcluster, - var2 = fixed_effect + var1 = bootcluster, + var2 = fixed_effect ) # f x c* - + for (x in seq_along(names(clustid))) { SXinvXXRX <- collapse::fsum(WXARX, clustid[x]) # c* x f SXinvXXRXA <- SXinvXXRX %*% A # part of numerator independent of both bootstrap errors and r - + CT_cfe <- crosstab(WXAR, var1 = clustid[x], var2 = fixed_effect) # c x f, formerly S_XinvXXR_F - + # a P3 <- t(tcrossprod(P3_2, CT_cfe)) # formerly prod_a P2 <- #Matrix.utils::aggregate.Matrix(P2_bootcluster, clustid[x]) # c* x c collapse::fsum(P2_bootcluster, clustid[x]) P_all <- P2 - tcrossprod(SXinvXXRXA, P1) - P3 - + # b: note that from here, if impose_null = TRUE, _b suffix objects and # D, DD, CD need not be computed, they are always objects of 0's only Q3 <- t(tcrossprod(Q3_2, CT_cfe)) @@ -256,20 +256,20 @@ boot_algo_fastnwild <- Q_all <- Q2 - tcrossprod(SXinvXXRXA, Q1) - Q3 C <- eigenMapMatMult(as.matrix(P_all), v, nthreads) D <- eigenMapMatMult(as.matrix(Q_all), v, nthreads) - + CC[[x]] <- colSums(C * C) DD[[x]] <- colSums(D * D) CD[[x]] <- colSums(C * D) } } - + # calculate numerator: numer_a <- collapse::fsum(as.vector(WXARP), g) numer_b <- collapse::fsum(as.vector(WXARQ), g) # calculate A, B A <- crossprod(as.matrix(numer_a), v) # q x (B+1) -> q = 1 B <- crossprod(numer_b, v) # q x (B+1) -> q = 1 - + p_val_res <- p_val_null2( r = r, @@ -299,10 +299,10 @@ boot_algo_fastnwild <- CD = CD, DD = DD ) - - + + # compute confidence interval - + if (is.null(conf_int) || conf_int == TRUE) { # guess for standard errors if (impose_null == TRUE) { @@ -312,8 +312,8 @@ boot_algo_fastnwild <- } else if (impose_null == FALSE) { se_guess <- abs((point_estimate - r) / t_stat) } - - + + conf_int <- invert_p_val( ABCD = ABCD, small_sample_correction = small_sample_correction, @@ -335,7 +335,7 @@ boot_algo_fastnwild <- test_vals = NA ) } - + res <- list( p_val = p_val, conf_int = conf_int$conf_int, @@ -352,8 +352,8 @@ boot_algo_fastnwild <- ABCD = ABCD # , # small_sample_correction = small_sample_correction ) - + class(res) <- "boot_algo" - + invisible(res) } diff --git a/R/fixest_fetch_data.R b/R/fixest_fetch_data.R new file mode 100644 index 00000000..5763b6ed --- /dev/null +++ b/R/fixest_fetch_data.R @@ -0,0 +1,88 @@ +fetch_data = function(x, prefix = "", suffix = ""){ + + #' fetch data from environment + #' @noRd + + # x: fixest estimation + # We try different strategies: + # 1) using the environment where the estimation was done + # 2) the "parent.frame()" defined as the frame on top of ALL fixest functions + # 3) the global environment, if it wasn't in 1) + + # Maybe I should keep only 1) => is there a reason to add the others? + + # 1) safest + # 2) less safe but OK => note ??? + # 3) kind of dangerous => warning() ??? + + if(is.null(x$call$data)) return(NULL) + + # 1) Environment of the call + + data = NULL + try(data <- eval(x$call$data, x$call_env), silent = TRUE) + + if(!is.null(data)){ + return(data) + } + + # 2) First non fixest frame + + fixest_funs = ls(getNamespace("fixest")) + + i = 2 + sysOrigin = sys.parent(i) + while(sysOrigin != 0 && as.character(sys.call(sysOrigin)[[1]]) %in% fixest_funs){ + i = i + 1 + sysOrigin = sys.parent(i) + } + + if(sysOrigin != 0){ + # We try again... + try(data <- eval(x$call$data, parent.frame(sysOrigin)), silent = TRUE) + + if(!is.null(data)){ + return(data) + } + } + + # 3) Global environment + + if(!identical(parent.env(x$call_env), .GlobalEnv)){ + # ...and again + try(data <- eval(x$call$data, .GlobalEnv), silent = TRUE) + + if(!is.null(data)){ + return(data) + } + } + + # => Error message + + if(nchar(prefix) == 0){ + msg = "W" + } else { + s = ifelse(grepl(" $", prefix), "", " ") + if(grepl("\\. *$", prefix)){ + msg = paste0(prefix, s, "W") + } else { + msg = paste0(prefix, s, "w") + } + } + + if(nchar(prefix) == 0){ + msg = "W" + } else if(grepl("\\. *$", prefix)){ + msg = paste0(gsub(" +$", "", prefix), " W") + } else { + msg = paste0(gsub(prefix, " +$", ""), " w") + } + + if(nchar(suffix) > 0){ + suffix = gsub("^ +", "", suffix) + } + + stop_up(msg, "e fetch the data in the enviroment where the estimation was made, but the data does not seem to be there any more (btw it was ", charShorten(deparse(x$call$data)[1], 15), "). ", suffix) + + +} \ No newline at end of file diff --git a/R/model_matrix.R b/R/model_matrix.R index 2e6918bb..fd6c4a51 100644 --- a/R/model_matrix.R +++ b/R/model_matrix.R @@ -97,19 +97,18 @@ model_matrix.fixest <- ) } else if (type == "fixef") { mm <- - model.matrix( + fixest::sparse_model_matrix( object, - type = type, - na.rm = TRUE, - collin.rm = collin.rm, - as.df = TRUE + type = c("rhs"), + na.rm = TRUE, + collin.rm = collin.rm ) # make sure that all fixef vars are of type factor #' @srrstats {G2.4} - i <- seq_along(mm) - mm[, i] <- lapply(i, function(x) { - factor(mm[, x]) - }) + # i <- seq_along(mm) + # mm[, i] <- lapply(i, function(x) { + # factor(mm[, x]) + # }) } mm diff --git a/R/preprocess2.R b/R/preprocess2.R index 74574564..11aa11db 100644 --- a/R/preprocess2.R +++ b/R/preprocess2.R @@ -14,6 +14,7 @@ preprocess2 <- function(object, ...) { UseMethod("preprocess2") } + preprocess2.fixest <- function(object, clustid, @@ -41,8 +42,10 @@ preprocess2.fixest <- #' by MacKinnon, Nielsen & Webb (2022) #' #' @noRd + #' @importFrom fixest sparse_model_matrix #' #' @method preprocess2 fixest + call <- object$call call_env <- object$call_env fml <- formula(object) @@ -61,14 +64,7 @@ preprocess2.fixest <- use_cli_format = TRUE ) } - # if (!is.null(object$is_sunab)) { - # if(object$is_sunab == TRUE){ - # rlang::abort( - # "boottest() does not support the Sun-Abrams - # estimator via `sunab()`." - # ) - # } - # } + is_iv <- ifelse(!is.null(object$fml_all$iv), TRUE, FALSE) has_fe <- ifelse(!is.null(object$fml_all$fixef), TRUE, FALSE) if (!is_iv) { @@ -164,12 +160,7 @@ preprocess2.fixest <- } # iv prep instruments <- X_exog <- X_endog <- NULL - # if(is_iv){ - # R0 <- rep(0, n_exog + n_endog) - # R0[ - # match(param, c(names(object$exogenous), names(object$endogenous)))] <- R - # names(R0) <- c(names(object$exogenous), names(object$endogenous)) - # } else { + if (!is.matrix(R)) { R0 <- rep(0, length(colnames(X))) R0[match(param, colnames(X))] <- R @@ -180,7 +171,7 @@ preprocess2.fixest <- R0 <- matrix(0, q, ncol(X)) R0[, 1:p] <- R } - # } + res <- list( Y = Y, X = X, @@ -242,6 +233,8 @@ preprocess2.felm <- #' @noRd #' #' @method preprocess2 felm + #' + call <- object$call call_env <- environment(formula(object)) fml <- formula(object) @@ -412,6 +405,7 @@ preprocess2.lm <- #' @noRd #' #' @method preprocess2 lm + call <- object$call call_env <- environment(formula(object)) fml <- formula(object) @@ -686,10 +680,11 @@ transform_fe <- #' be projected out #' #' @noRd + all_fe <- model_matrix(object, type = "fixef", collin.rm = TRUE) - # make sure all fixed effects variables are characters + n_fe <- ncol(all_fe) - all_fe_names <- names(all_fe) + all_fe_names <- colnames(all_fe) k2 <- Reduce("+", lapply(all_fe, function(x) { length(unique(x)) })) @@ -742,21 +737,42 @@ transform_fe <- } } else { - add_fe <- all_fe - add_fe_names <- names(add_fe) - fml_fe <- reformulate(add_fe_names, response = NULL) - if(engine == "R" && bootstrap_type %in% c("11", "31", "13","33")){ - add_fe_dummies <- - Matrix::sparse.model.matrix(fml_fe, model.frame(fml_fe, data = as.data.frame(add_fe))) + + # sparse matrices for all both "fnw11" && engine == "R" + run_sparse <- ( engine == "R" && bootstrap_type %in% c("11", "31", "13","33")) || (engine == "R-lean") + + if(run_sparse){ + + + if(inherits(object, "fixest")){ + add_fe_dummies <- sparse_model_matrix(object, type = "fixef") + } else { + add_fe <- all_fe + add_fe_names <- names(add_fe) + fml_fe <- reformulate(add_fe_names, response = NULL) + add_fe_dummies <- + Matrix::sparse.model.matrix(fml_fe, model.frame(fml_fe, data = as.data.frame(add_fe))) + } } else { - add_fe_dummies <- - model.matrix(fml_fe, model.frame(fml_fe, data = as.data.frame(add_fe))) + if(inherits(object, "fixest")){ + # need sparse matrix to handle varying slopes etc + add_fe_dummies <- sparse_model_matrix(object, type = "fixef") + add_fe_dummies <- as.matrix(add_fe_dummies) + } else { + add_fe <- all_fe + add_fe_names <- names(add_fe) + fml_fe <- reformulate(add_fe_names, response = NULL) + add_fe_dummies <- + Matrix::sparse.model.matrix(fml_fe, model.frame(fml_fe, data = as.data.frame(add_fe))) + } + + } + X <- cbind(X, as.matrix(add_fe_dummies)) + if(engine == "R-lean"){ + x <- as.matrix(X) } - - X <- cbind(X, add_fe_dummies) - } res <- list( @@ -819,54 +835,12 @@ get_cluster <- # doi: 10.18637/jss.v095.i01 (URL: https://doi.org/10.18637/jss.v095.i01). # changes by Alexander Fischer: # no essential changes, but slight reorganization of pieces of code + dreamerr::check_arg(clustid_char, "character scalar|charakter vector") dreamerr::check_arg(bootcluster, "character scalar | character vector") clustid_fml <- reformulate(clustid_char) - # Step 1: create cluster df - - manipulate_object <- function(object){ - if(inherits(object, "fixest")){ - if(!is.null(object$fixef_vars)){ - update(object, . ~ + 1 | . + 1) - } else { - update(object, . ~ + 1 ) - } - } else { - object - } - } - - cluster_tmp <- - if ("Formula" %in% loadedNamespaces()) { - ## FIXME to suppress potential warnings due to | in Formula - suppressWarnings( - expand.model.frame( - model = - manipulate_object(object), - extras = clustid_fml, - na.expand = FALSE, - envir = call_env - ) - ) - } else { - expand.model.frame( - model = - manipulate_object(object), - extras = clustid_fml, - na.expand = FALSE, - envir = call_env - ) - } - - cluster_df <- - model.frame(clustid_fml, cluster_tmp, na.action = na.pass) - # without cluster intersection - N_G <- - vapply(cluster_df, function(x) { - length(unique(x)) - }, numeric(1)) # Step 1: decode bootcluster variable # create a bootcluster vector if (length(bootcluster) == 1) { @@ -883,22 +857,104 @@ get_cluster <- bootcluster_char <- bootcluster } - # add bootcluster variable to formula of clusters - cluster_bootcluster_fml <- - update( - clustid_fml, paste( - "~ . +", paste( - bootcluster_char, - collapse = " + " + + + if(inherits(object, "fixest")){ + + data <- fetch_data(object) + # Check that cluster vars are in the original estimation dataset + cluster_vars_in_data <- clustid_char %in% colnames(data) + if (any(!(cluster_vars_in_data))) { + stop(paste0( + "The following variables are not found in the dataset used in your `feols` call: ", + paste(clustid_char[!cluster_vars_in_data], collapse = ", ") + )) + } + + cluster_df <- cluster <- data[,clustid_char, drop = FALSE] + + if(N != nrow(cluster)){ + cluster <- cluster[unlist(object$obs_selection), drop = FALSE] + } + + bootcluster <- data[, bootcluster_char, drop = FALSE] + if(N != nrow(bootcluster)){ + bootcluster <- bootcluster[unlist(object$obs_selection), drop = FALSE] + } + + if(clustid_char == bootcluster_char){ + cluster_bootcluster_df <- cluster + } else { + cluster_bootcluster_df <- cbind(cluster, bootcluster) + } + + + } else { + + + manipulate_object <- function(object){ + if(inherits(object, "fixest")){ + if(!is.null(object$fixef_vars)){ + update(object, . ~ + 1 | . + 1) + } else { + update(object, . ~ + 1 ) + } + } else { + object + } + } + + cluster_tmp <- + if ("Formula" %in% loadedNamespaces()) { + ## FIXME to suppress potential warnings due to | in Formula + suppressWarnings( + expand.model.frame( + model = + manipulate_object(object), + extras = clustid_fml, + na.expand = FALSE, + envir = call_env + ) + ) + + + expand.model.frame( + model = + manipulate_object(object), + extras = clustid_fml, + na.expand = FALSE, + envir = call_env + ) + } + + cluster_df <- + model.frame(clustid_fml, cluster_tmp, na.action = na.pass) + + # add bootcluster variable to formula of clusters + cluster_bootcluster_fml <- + update( + clustid_fml, paste( + "~ . +", paste( + bootcluster_char, + collapse = " + " + ) ) ) - ) - cluster_bootcluster_tmp <- - if ("Formula" %in% loadedNamespaces()) { - ## FIXME to suppress potential warnings due to | in Formula - suppressWarnings( + cluster_bootcluster_tmp <- + if ("Formula" %in% loadedNamespaces()) { + ## FIXME to suppress potential warnings due to | in Formula + suppressWarnings( + expand.model.frame( + model = + manipulate_object(object), + extras = cluster_bootcluster_fml, + na.expand = FALSE, + envir = call_env + ) + ) + } else { expand.model.frame( model = manipulate_object(object), @@ -906,28 +962,21 @@ get_cluster <- na.expand = FALSE, envir = call_env ) - ) - } else { - expand.model.frame( - model = - manipulate_object(object), - extras = cluster_bootcluster_fml, - na.expand = FALSE, - envir = call_env - ) - } + } - # data.frame as needed for WildBootTests.jl - cluster_bootcluster_df <- model.frame( - cluster_bootcluster_fml, - cluster_bootcluster_tmp, - na.action = na.pass - ) + # data.frame as needed for WildBootTests.jl + cluster_bootcluster_df <- model.frame( + cluster_bootcluster_fml, + cluster_bootcluster_tmp, + na.action = na.pass + ) + + # data.frames with clusters, bootcluster + cluster <- cluster_bootcluster_df[, clustid_char, drop = FALSE] + bootcluster <- + cluster_bootcluster_df[, bootcluster_char, drop = FALSE] - # data.frames with clusters, bootcluster - cluster <- cluster_bootcluster_df[, clustid_char, drop = FALSE] - bootcluster <- - cluster_bootcluster_df[, bootcluster_char, drop = FALSE] + } if (!any(bootcluster_char %in% clustid_char)) { is_subcluster <- TRUE @@ -985,6 +1034,13 @@ get_cluster <- use_cli_format = TRUE ) } + + # without cluster intersection + N_G <- + vapply(cluster_df, function(x) { + length(unique(x)) + }, numeric(1)) + clustid_dims <- length(clustid_char) #' @srrstats {G2.4} #' @srrstats {G2.4c} *explicit conversion to character via `as.character()` diff --git a/cran-comments.md b/cran-comments.md index 1fcbcd20..3d745b8a 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,3 +1,52 @@ +## Sumbission of 0.14 + +I have tested the package on: +- rhub +- win devel +- github actions + +rhub gave the following notes: + +- Found the following (possibly) invalid URLs: + URL: https://journals.sagepub.com/doi/pdf/10.1177/1536867X19830877 + From: inst/doc/Literature.html + Status: 403 + Message: Forbidden + URL: https://onlinelibrary.wiley.com/doi/abs/10.1002/jrsm.1554 + From: inst/doc/Literature.html + Status: 403 + Message: Forbidden + URL: https://www.tandfonline.com/doi/abs/10.1198/jbes.2009.07221 + From: inst/doc/Literature.html + inst/doc/fwildclusterboot.html + README.md + Status: 403 + Message: Forbidden + + these URLs are valid, I have checked them manually + + +- checking top-level files ... NOTE +Non-standard file/directory found at top level: + 'codemeta.json' + + Having a codemeta.json file should be ok? + +- checking for non-standard things in the check directory ... NOTE +Found the following files/directories: + ''NULL'' + + This appears to be an issue with rhub checks. + +- checking for detritus in the temp directory ... NOTE +Found the following files/directories: + 'lastMiKTeXException' + + This one I always get =) + +No other issues/ notes etc were found on github actions and win-dev. + + ## Submission of 0.13 I have tested the package on: