Merge pull request #24 from yjunechoe/chore-lintr

[chore] lintr 1.0.6

R/clusters_methods.R

@@ -12,13 +12,13 @@ format.empirical_clusters <- function(x, ...) {
   time <- attr(x, "time")
   statistic <- attr(x, "statistic")
   threshold <- attr(x, "threshold")
-  binned <- attr(x, "binned")
+  # binned <- attr(x, "binned")
   zero_clusters <- x[missing_clusters]
   valid_clusters <- x[!missing_clusters]
   if (!is.null(pvalues)) valid_clusters <- valid_clusters[names(pvalues)]
   cli::cli_format_method(
     {
-      cli::cli_rule(left = paste("{.strong Empirical clusters}", format_threshold(statistic)), right = "{.cls empirical_clusters}")
+      cli::cli_rule(left = paste("{.strong Empirical clusters}", format_threshold(statistic, threshold)), right = "{.cls empirical_clusters}")
       for (i in seq_along(valid_clusters)) {
         predictor <- names(valid_clusters)[[i]]
         cli::cli_text("{.el {predictor}}", if (statistic == "chisq") " ({.emph df = {predictor_dfs[[predictor]]}}){?*}")
@@ -61,11 +61,11 @@ format.null_cluster_dists <- function(x, levels = 0.95, ...) {
   predictor_dfs <- attr(term_groups, "dfs")
   statistic <- attr(x, "statistic")
   threshold <- attr(x, "threshold")
-  binned <- attr(x, "binned")
+  # binned <- attr(x, "binned")
   cluster_stats <- lapply(x, extract_null_cluster_stats, levels)
   cli::cli_format_method(
     {
-      cli::cli_rule(left = paste("{.strong Null cluster-mass distribution}", format_threshold(statistic)), right = "{.cls null_cluster_dists}")
+      cli::cli_rule(left = paste("{.strong Null cluster-mass distribution}", format_threshold(statistic, threshold)), right = "{.cls null_cluster_dists}")
       for (i in seq_along(cluster_stats)) {
         predictor <- names(x)[[i]]
         cli::cli_text("{.el {predictor}} (n = {cluster_stats[[i]]$n}", if (statistic == "chisq") ", {.emph df = {predictor_dfs[[predictor]]}}{?*}", ")")
@@ -94,7 +94,7 @@ extract_null_cluster_stats <- function(x, levels) {
   list("Mean (SD)" = mean_se, "Coverage intervals" = cis, n = nrow(x))
 }
 
-format_threshold <- function(statistic) {
+format_threshold <- function(statistic, threshold) {
   if (statistic == "t") {
     "(t > {.val {threshold}})"
   } else if (statistic == "chisq") {

R/compute_timewise_statistics.R

@@ -79,8 +79,8 @@ compute_timewise_statistics <- function(jlmer_spec, family = c("gaussian", "bino
     dimnames(out$t_matrix) <- out[c("Predictor", "Time")]
     out$t_matrix <- out$t_matrix[out$Predictor != "1", , drop = FALSE]
   } else {
-    Predictors <- names(term_groups$r)
-    dimnames(out$t_matrix) <- c(list(Predictor = Predictors[Predictors != "1"]), out["Time"])
+    predictors <- names(term_groups$r)
+    dimnames(out$t_matrix) <- c(list(Predictor = predictors[predictors != "1"]), out["Time"])
   }
 
   structure(out$t_matrix,

R/extract_clusters.R

@@ -126,6 +126,7 @@ extract_null_cluster_dists <- function(null_statistics, threshold, binned = FALS
   null_cluster_dists <- apply(null_statistics, 3, function(t_matrix) {
     t_matrix <- t_matrix[!is.nan(rowSums(t_matrix)), ]
     largest_clusters <- df_from_DF(.jlmerclusterperm$jl$extract_clusters(t_matrix, binned, 1L))
+    largest_clusters
   }, simplify = FALSE)
   structure(null_cluster_dists,
     class = "null_cluster_dists",

R/jlmer_spec.R

@@ -101,7 +101,7 @@ make_jlmer_spec <- function(formula, data, subject = NULL, trial = NULL, time =
   }
 
   terms_compact <- fe_term_labels
-  terms_expanded <- colnames(model_matrix)
+  # terms_expanded <- colnames(model_matrix)
   terms_grouping <- setNames(attr(model_matrix, "assign"), colnames(model_matrix))
   has_intercept <- 0 %in% terms_grouping
   if (has_intercept) {

R/permute.R

@@ -65,7 +65,6 @@ permute_by_predictor <- function(jlmer_spec, predictors, predictor_type = c("gue
   df_jl <- JuliaConnectoR::juliaCall("DataFrame", as.data.frame(df))
   subject <- jlmer_spec$meta$subject
   trial <- jlmer_spec$meta$trial
-  time <- jlmer_spec$meta$time
   predictor_type <- match.arg(predictor_type)
   if (predictor_type == "guess") {
     predictor_type <- .jlmerclusterperm$jl$guess_shuffle_as(df_jl, predictors, subject, trial)

R/permute_timewise_statistics.R

@@ -86,10 +86,10 @@ permute_timewise_statistics <- function(jlmer_spec, family = c("gaussian", "bino
     #   out$z_array <- out$z_array[, , predictors_keep, drop = FALSE]
     # }
   } else if (statistic == "chisq") {
-    Predictors <- Filter(function(x) any(dimnames(out$z_array)$Predictor %in% x), jlmer_spec$meta$term_groups)
-    pruned <- which(!duplicated(rep(names(Predictors), lengths(Predictors))))
+    predictors <- Filter(function(x) any(dimnames(out$z_array)$Predictor %in% x), jlmer_spec$meta$term_groups)
+    pruned <- which(!duplicated(rep(names(predictors), lengths(predictors))))
     out$z_array <- out$z_array[, , pruned, drop = FALSE]
-    dimnames(out$z_array)$Predictor <- names(Predictors)
+    dimnames(out$z_array)$Predictor <- names(predictors)
   }
 
   if (is.null(dimnames(out$z_array)$Predictor)) {

R/tidy.R

@@ -212,15 +212,15 @@ generics::glance
 #' @export
 glance.jlmer_mod <- function(x, ...) {
   is_mixed <- JuliaConnectoR::juliaLet("x isa MixedModel", x = x)
-  is_REML <- is_mixed && JuliaConnectoR::juliaLet("x.optsum.REML", x = x)
+  is_reml <- is_mixed && JuliaConnectoR::juliaLet("x.optsum.REML", x = x)
   nobs <- JuliaConnectoR::juliaCall("nobs", x)
   sigma <- if (is_mixed) {
     JuliaConnectoR::juliaLet("x.sigma", x = x) %|0|% NA
   } else {
     has_dispersion <- JuliaConnectoR::juliaCall("GLM.dispersion_parameter", x)
     if (has_dispersion) JuliaConnectoR::juliaLet("dispersion(x.model)", x = x) else NA
   }
-  ll <- if (is_REML) {
+  ll <- if (is_reml) {
     list(logLik = NA, AIC = NA, BIC = NA)
   } else {
     list(

inst/julia/JlmerClusterPerm/src/03-compute_timewise_statistics.jl

@@ -147,14 +147,9 @@ function timewise_lme(
                 end
             else
                 try
-                    time_mod = fit(
-                        MixedModel,
-                        formula,
-                        data_at_time,
-                        family;
-                        contrasts=contrasts,
-                        opts...,
-                    )
+                    time_mod = MixedModel(formula, data_at_time, family; contrasts)
+                    time_mod.optsum.ftol_rel = 1e-8
+                    fit!(time_mod; opts...)
                     # test statistic
                     if statistic == "chisq"
                         if drop_formula isa Vector

inst/scripts/generate_logo.R

@@ -1,6 +1,6 @@
 library(ggplot2)
 
-df <- data.frame(x = (1:25 * 4)/100)
+df <- data.frame(x = (1:25 * 4) / 100)
 df$y1 <- plogis(df$x * 3 - 1)
 df$y2 <- plogis(df$x * 6 - 1.5)
 df
@@ -11,7 +11,7 @@ p <- ggplot(df, aes(x)) +
   geom_ribbon(
     aes(ymin = y1, ymax = y2),
     fill = alpha("black", .5),
-    data = ~ .x[10:18,]
+    data = ~ .x[10:18, ]
   ) +
   geom_line(
     aes(y = y1),

tests/testthat/helper-skip.R

@@ -2,10 +2,10 @@ no_julia <- !JuliaConnectoR::juliaSetupOk()
 skip_conditionally <- function() {
   # skip_on_cran()
   if (no_julia) {
-    skip("No Julia installation detected.")
+    testthat::skip("No Julia installation detected.")
   }
   if (!julia_version_compatible()) {
-    skip("Julia version >=1.8 required.")
+    testthat::skip("Julia version >=1.8 required.")
   }
   invisible()
 }