Merge pull request #54 from arcaldwell49/df_lmer_limit

Df lmer limit

NEWS.md

@@ -3,6 +3,9 @@
 # SimplyAgree 0.2.1
 
 - Add sympercent options for log transformed results in `tolerance_limit` and `agreement_limit`
+- Add argument to `agreement_limit` to allow of asymptotic confidence intervals to avoid errors related `emmeans` calculations
+  - Only a problem for "big" data with > 1000 observations
+- Small edit to `reli_stats` documentation
 
 # SimplyAgree 0.2.0
 

R/agreement_limit.R

@@ -16,6 +16,8 @@
 #' @param log_tf_display The type of presentation for log-transformed results. The differences between methods can be displayed as a "ratio" or "sympercent".
 #' @param data_type The type of data structure. Options include "simple" (all independent data points), "nest" (nested data) and "reps" (replicated data points).
 #' @param loa_calc The method by which the limits of agreement confidence intervals are calculated. Options are "mover" (Methods of Recovering Variances method) or "blandlatman" (Bland-Altman method).
+#' @param lmer_df Degrees of freedom method, only matters for if data_type is "nest". Default is "satterthwaite". The "asymptotic" method is faster but more liberal.
+#' @param lmer_limit Sample size limit for degrees of freedom method. If number of observations exceeds this limit, then the "asymptotic" method is utilized.
 #' @return Returns single loa class object with the results of the agreement analysis.
 #'
 #'   - `loa`: A data frame containing the Limits of Agreement.
@@ -69,7 +71,11 @@ agreement_limit = function(x,
                            alpha = 0.05,
                            prop_bias = FALSE,
                            log_tf = FALSE,
-                           log_tf_display = c("ratio","sympercent")){
+                           log_tf_display = c("ratio","sympercent"),
+                           lmer_df = c("satterthwaite",
+                                       "asymptotic"),
+                           lmer_limit = 3000){
+  lmer_df = match.arg(lmer_df)
   data_type = match.arg(data_type)
   loa_calc = match.arg(loa_calc)
   conf.level = 1- alpha
@@ -127,7 +133,9 @@ agreement_limit = function(x,
       conf.level = conf.level,
       agree.level = agree.level,
       loa_calc = loa_calc,
-      prop_bias = prop_bias
+      prop_bias = prop_bias,
+      lmer_df = lmer_df,
+      lmer_limit = lmer_limit
     )
   }
 
@@ -427,7 +435,9 @@ calc_loa_nest = function(df,
                           conf.level = .95,
                           agree.level = .95,
                           loa_calc,
-                          prop_bias = FALSE){
+                          prop_bias = FALSE,
+                         lmer_df,
+                         lmer_limit){
   agreeq = qnorm(1 - (1 - agree.level) / 2)
   agree_l = 1 - (1 - agree.level) / 2
   agree_u = (1 - agree.level) / 2
@@ -479,25 +489,58 @@ calc_loa_nest = function(df,
     ((between_variance)^2/(n_sub-1) + (1 - 1/mh)^2 * (within_variance)^2/(n_obs-n_sub))
 
   if (prop_bias == FALSE) {
-    bias_values = emmeans(model, ~1, lmer.df = "satterthwaite") %>%
+    if(n_obs <= lmer_limit & lmer_df == "satterthwaite"){
+    bias_values = emmeans(model, ~1, lmer.df = "satterthwaite",
+                          lmerTest.limit = lmer_limit) %>%
       as.data.frame() %>%
       rename(bias = emmean) %>%
       mutate(avg = "overall") %>%
       select(avg, bias, SE, df, lower.CL, upper.CL)
+    }
+
+    if(n_obs >= lmer_limit | lmer_df == "asymptotic"){
+      bias_values = emmeans(model, ~1, lmer.df = "asymptotic") %>%
+        as.data.frame() %>%
+        rename(bias = emmean) %>%
+        mutate(avg = "overall") %>%
+        select(avg, bias, SE, df, asymp.LCL, asymp.UCL) %>%
+        rename(lower.CL=asymp.LCL, upper.CL=asymp.UCL)
+
+    }
 
   } else {
-    bias_values = ref_grid(model,
-                           at = list(
-                             avg = c(
-                               min(df$avg, na.rm = TRUE),
-                               mean(df$avg, na.rm = TRUE),
-                               max(df$avg, na.rm = TRUE)
-                             )
-                           )) %>%
-      emmeans(~avg, lmer.df = "satterthwaite") %>%
-      as.data.frame() %>%
-      rename(bias = emmean) %>%
-      select(avg, bias, SE, df, lower.CL, upper.CL)
+    if(n_obs <= lmer_limit & lmer_df == "satterthwaite"){
+      bias_values = ref_grid(model,
+                             at = list(
+                               avg = c(
+                                 min(df$avg, na.rm = TRUE),
+                                 mean(df$avg, na.rm = TRUE),
+                                 max(df$avg, na.rm = TRUE)
+                               )
+                             )) %>%
+        emmeans(~avg, lmer.df = "satterthwaite",
+                lmerTest.limit = lmer_limit) %>%
+        as.data.frame() %>%
+        rename(bias = emmean) %>%
+        select(avg, bias, SE, df, lower.CL, upper.CL)
+    }
+
+    if(n_obs >= lmer_limit | lmer_df == "asymptotic"){
+      bias_values = ref_grid(model,
+                             at = list(
+                               avg = c(
+                                 min(df$avg, na.rm = TRUE),
+                                 mean(df$avg, na.rm = TRUE),
+                                 max(df$avg, na.rm = TRUE)
+                               )
+                             )) %>%
+        emmeans(~avg, lmer.df = "asymptotic") %>%
+        as.data.frame() %>%
+        rename(bias = emmean) %>%
+        select(avg, bias, SE, df, asymp.LCL, asymp.UCL) %>%
+        rename(lower.CL=asymp.LCL, upper.CL=asymp.UCL)
+    }
+
 
   }
 

R/globals.R

@@ -71,4 +71,5 @@ utils::globalVariables(c("boot_bias",
                          "SEM", "SEP",
                          "Tolerance Limits", "replicates",
                          "upper.PL", "upper.TL",
-                         "lower.PL", "lower.TL"))
+                         "lower.PL", "lower.TL",
+                         "asymp.LCL","asymp.UCL"))

R/reli_stats.R

@@ -18,7 +18,7 @@
 #' @param cv_calc Coefficient of variation (CV) calculation. This function allows for 3 versions of the CV. "MSE" is the default.
 #' @param other_ci Logical value (TRUE or FALSE) indicating whether to calculate confidence intervals for the CV, SEM, SEP, and SEE. Note: this will dramatically increase the computation time.
 #' @param se_type Type of standard error calculation. The default is to use the mean square error (MSE). Otherwise, the total sums of squares and the ICC are utilized to estimate the SEM, SEE, and SEP.
-#' @param type A character string representing the type of bootstrap confidence intervals. Only "norm", "basic", and "perc" currently supported. Bias-corrected and accelerated, bca, is the default. See ?boot::boot.ci for more details.
+#' @param type A character string representing the type of confidence intervals for the CV, SEM, SEP, and SEE. Only "norm", "basic", and "perc" currently supported for parametric bootstrap CI. An approximate method, chisq, is the default. See ?boot::boot.ci for more details on bootstrap methods.
 #' @param replicates 	The number of bootstrap replicates. Passed on to the boot function. Default is 1999.
 #'
 #' @details