Merge pull request #53 from arcaldwell49/sympercent

Sympercent
arcaldwell49 · Oct 9, 2024 · cdd546f · cdd546f
2 parents 5cae6fa + 69a6949
commit cdd546f
Show file tree

Hide file tree

Showing 96 changed files with 1,733 additions and 1,226 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: SimplyAgree
 Type: Package
 Title: Flexible and Robust Agreement and Reliability Analyses
-Version: 0.2.0
+Version: 0.2.1
 Authors@R: person("Aaron", "Caldwell", email = "[email protected]",
                   role = c("aut", "cre"))
 Maintainer: Aaron Caldwell <[email protected]>

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,9 @@
 # NEWS
 
+# SimplyAgree 0.2.1
+
+- Add sympercent options for log transformed results in `tolerance_limit` and `agreement_limit`
+
 # SimplyAgree 0.2.0
 
 - Add universal tolerance limits function: `tolerance_limit`

diff --git a/R/agreement_limit.R b/R/agreement_limit.R
@@ -13,6 +13,7 @@
 #' @param prop_bias Logical indicator (TRUE/FALSE) of whether proportional bias should be considered for the limits of agreement calculations.
 #' @param alpha The alpha-level for confidence levels.
 #' @param log_tf Calculate limits of agreement using log-transformed data.
+#' @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).
 #' @return Returns single loa class object with the results of the agreement analysis.
@@ -67,10 +68,12 @@ agreement_limit = function(x,
                            agree.level = 0.95,
                            alpha = 0.05,
                            prop_bias = FALSE,
-                           log_tf = FALSE){
+                           log_tf = FALSE,
+                           log_tf_display = c("ratio","sympercent")){
   data_type = match.arg(data_type)
   loa_calc = match.arg(loa_calc)
   conf.level = 1- alpha
+  log_tf_display = match.arg(log_tf_display)
 
   call2 = match.call()
   call2$data_type = data_type
@@ -81,6 +84,7 @@ agreement_limit = function(x,
   call2$id = id
   call2$prop_bias  = prop_bias
   call2$log_tf = log_tf
+  call2$log_tf_display = log_tf_display
 
   df = loa_data_org(
     data = data,

diff --git a/R/loa_plot_functions.R b/R/loa_plot_functions.R
@@ -7,9 +7,19 @@ simple_loa_plot = function(x,
   colnames(df) = c("y","x","id","mean","delta")
 
   df_loa = x$loa
-  if(x$call$log){
-    df_loa = exp(df_loa)
-    df$delta = exp(df$delta)
+  if(x$call$log_tf){
+    if(x$call$log_tf_display == "ratio"){
+      df_loa = df_loa  %>% mutate_if(is.numeric,exp)
+      df$delta = exp(df$delta)
+    }
+
+    if(x$call$log_tf_display == "sympercent"){
+      df_loa = df_loa  %>% mutate_if(is.numeric,~100*.)
+      df$delta = 100*(df$delta)
+    }
+
+    df$x = exp(df$x)
+    df$y = exp(df$y)
   }
   scalemin = min(c(min(df$x, na.rm = TRUE),min(df$y, na.rm = TRUE)))
   scalemax = max(c(max(df$x, na.rm = TRUE),max(df$y, na.rm = TRUE)))
@@ -91,8 +101,10 @@ simple_loa_plot = function(x,
                     position = pd2,
                     inherit.aes = FALSE)+
     labs(x = paste0("Average of ", x_lab ," & ", y_lab),
-         y = ifelse(call2$log,
-                    paste0("Ratio of Methods (x/y)"),
+         y = ifelse(call2$log_tf,
+                    ifelse(call2$log_tf_display == "ratio",
+                           paste0("Ratio of Methods (x/y)"),
+                           paste0("Sympercent Difference between Methods (s%)")),
                     paste0("Difference between Methods (x - y)")),
          caption = cap1,
          color = "") +
@@ -129,7 +141,7 @@ bias_loa_plot = function(x,
   df = model.frame(x$call$lm_mod)
   colnames(df) = c("y","x","id","mean","delta")
   df_loa = x$loa
-  if(x$call$log){
+  if(x$call$log_tf){
     df_loa = exp(df_loa)
     df$delta = exp(df$delta)
   }
@@ -215,7 +227,7 @@ bias_loa_plot = function(x,
       scale_color_viridis_d(option = "C", end = .8) +
       scale_fill_viridis_d(option = "C", end = .8) +
       labs(x = paste0("Average of ", x_name ," & ", y_name),
-           y = ifelse(call2$log,
+           y = ifelse(call2$log_tf,
                       paste0("Ratio of Methods (x/y)"),
                       paste0("Difference between Methods (x - y)")),
            caption = cap1,

diff --git a/R/methods.loa.R b/R/methods.loa.R
@@ -41,7 +41,14 @@ print.loa <- function(x,
            lower_loa_ci,
            upper_loa_ci)
   if(call2$log_tf){
-    pr_table = pr_table %>% mutate_if(is.numeric,exp)
+    if(call2$log_tf_display == "ratio"){
+      pr_table = pr_table %>% mutate_if(is.numeric,exp)
+    }
+
+    if(call2$log_tf_display == "sympercent"){
+      pr_table = pr_table %>% mutate_if(is.numeric,~100*.)
+    }
+
     if(call2$prop_bias){
       pr_table = pr_table %>%
         mutate(avg = log(avg))
@@ -96,6 +103,15 @@ print.loa <- function(x,
            "Bland-Altman"),
     " Limits of Agreement (LoA)"
   )
+  if(x$call$log_tf){
+    if(x$call$log_tf_display == "ratio"){
+      title1 = paste0(title1, " of the Ratio (x/y)")
+    }
+
+    if(x$call$log_tf_display == "sympercent"){
+      title1 = paste0(title1, " of the Sympercent Difference (s%)")
+    }
+  }
   subtitle1 = paste0(
     x$call$agree.level*100,
     "% LoA @ ",
@@ -114,7 +130,10 @@ print.loa <- function(x,
   var_print = switch(ifelse(call2$log_tf,"log","norm"),
                      "log" = paste0(
                        "Coefficient of Variation (%) = ",
-                       round((exp(x$loa$sd_delta[1])-1)*100,digits=digits)
+                       ifelse(call2$log_tf_display == "ratio",
+                       round((exp(x$loa$sd_delta[1])-1)*100,digits=digits),
+                       round(((x$loa$sd_delta[1]))*100,digits=digits)
+                       )
                      ),
                      "norm" =  paste0(
                        "SD of Differences = ",

diff --git a/R/methods.tolerance_delta.R b/R/methods.tolerance_delta.R
@@ -44,16 +44,32 @@ print.tolerance_delta <- function(x,
            lower.TL,
            upper.TL)
   if(call2$log_tf){
-    pr_table = pr_table %>%
-      mutate_at(c(
-        "bias",
-        "lower.CL",
-        "upper.CL",
-        "lower.PL",
-        "upper.PL",
-        "lower.TL",
-        "upper.TL"
-      ),exp)
+    if(call2$log_tf_display == "ratio") {
+      pr_table = pr_table %>%
+        mutate_at(c(
+          "bias",
+          "lower.CL",
+          "upper.CL",
+          "lower.PL",
+          "upper.PL",
+          "lower.TL",
+          "upper.TL"
+        ),exp)
+    }
+
+    if(call2$log_tf_display == "sympercent") {
+      pr_table = pr_table %>%
+        mutate_at(c(
+          "bias",
+          "lower.CL",
+          "upper.CL",
+          "lower.PL",
+          "upper.PL",
+          "lower.TL",
+          "upper.TL"
+        ),~100*.)
+    }
+
 
   }
 
@@ -140,7 +156,14 @@ print.tolerance_delta <- function(x,
   )
 
   if(call2$log_tf){
-    title1 = "Agreement between Measures (Ratio: x/y)"
+    if(call2$log_tf_display == "ratio"){
+      title1 = "Agreement between Measures (Ratio: x/y)"
+    }
+
+    if(call2$log_tf_display == "sympercent"){
+      title1 = "Sympercent Difference between Methods (s%)"
+    }
+
   }
   #var_print = switch(ifelse(call2$log_tf,"log","norm"),
   #                   "log" = paste0(
@@ -189,21 +212,46 @@ plot.tolerance_delta <- function(x,
   df = model.frame(x$call$lm_mod)
   colnames(df) = c("y","x","id","mean","delta","condition","time")
   df_loa = x$limits
-  if(x$call$log){
-    df_loa = df_loa %>%
-      mutate_at(
-        c(
-          "bias",
-          "lower.CL",
-          "upper.CL",
-          "lower.PL",
-          "upper.PL",
-          "lower.TL",
-          "upper.TL"
-        ),
-        exp
-      )
-    df$delta = exp(df$delta)
+
+  if(call2$log_tf){
+    if(call2$log_tf_display == "ratio"){
+      df_loa = df_loa %>%
+        mutate_at(
+          c(
+            "bias",
+            "lower.CL",
+            "upper.CL",
+            "lower.PL",
+            "upper.PL",
+            "lower.TL",
+            "upper.TL"
+          ),
+          exp
+        )
+      df$delta = exp(df$delta)
+      df$x = exp(df$x)
+      df$y = exp(df$y)
+    }
+
+    if(call2$log_tf_display == "sympercent"){
+      df_loa = df_loa %>%
+        mutate_at(
+          c(
+            "bias",
+            "lower.CL",
+            "upper.CL",
+            "lower.PL",
+            "upper.PL",
+            "lower.TL",
+            "upper.TL"
+          ),
+          ~100*.
+        )
+      df$delta = 100*(df$delta)
+      df$x = exp(df$x)
+      df$y = exp(df$y)
+    }
+
   }
   scalemin = min(c(min(df$x, na.rm = TRUE),min(df$y, na.rm = TRUE)))
   scalemax = max(c(max(df$x, na.rm = TRUE),max(df$y, na.rm = TRUE)))
@@ -345,8 +393,10 @@ plot.tolerance_delta <- function(x,
     #scale_color_viridis_d(option = "C", end = .8) +
     #scale_fill_viridis_d(option = "C", end = .8) +
     labs(x = paste0("Average of ", x_name ," & ", y_name),
-         y = ifelse(call2$log,
-                    paste0("Ratio of Methods (x/y)"),
+         y = ifelse(call2$log_tf,
+                    ifelse(call2$log_tf_display == "ratio",
+                           paste0("Ratio of Methods (x/y)"),
+                           paste0("Sympercent Difference between Methods (s%)")),
                     paste0("Difference between Methods (x - y)")),
          caption = cap1,
          guides = "") +

diff --git a/R/tolerance_limit.R b/R/tolerance_limit.R
@@ -17,6 +17,7 @@
 #' @param tol_method Method for calculating the tolerance interval. Options are "approx" for a chi-square based approximation and "perc" for a parametric percentile bootstrap method.
 #' @param prop_bias Whether to include a proportional bias term in the model. Determines whether proportional bias should be considered for the prediction/tolerance limits calculations.
 #' @param log_tf Calculate limits of agreement using log-transformed data.
+#' @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 cor_type The type of correlation structure. "sym" is for Compound Symmetry, "car1" is for continuous autocorrelation structure of order 1, or "ar1" for autocorrelation structure of order 1.
 #' @param correlation an optional corStruct object describing the within-group correlation structure that overrides the default setting. See the documentation of corClasses for a description of the available corStruct classes. If a grouping variable is to be used, it must be specified in the form argument to the corStruct constructor. Defaults to NULL.
 #' @param weights an optional varFunc object or one-sided formula describing the within-group heteroskedasticity structure that overrides the default setting. If given as a formula, it is used as the argument to varFixed, corresponding to fixed variance weights. See the documentation on varClasses for a description of the available varFunc classes.
@@ -68,6 +69,7 @@ tolerance_limit = function(data,
                                tol_method = c("approx","perc"),
                                prop_bias = FALSE,
                                log_tf = FALSE,
+                           log_tf_display = c("ratio", "sympercent"),
                                cor_type = c("sym", "car1", "ar1", "none"),
                                correlation = NULL,
                                weights = NULL,
@@ -78,6 +80,7 @@ tolerance_limit = function(data,
   # match args -----
   cor_type = match.arg(cor_type)
   tol_method = match.arg(tol_method)
+  log_tf_display = match.arg(log_tf_display)
   # set call ----
   call2 = match.call()
   call2$id = id
@@ -89,7 +92,7 @@ tolerance_limit = function(data,
   call2$cor_type = cor_type
   call2$correlation = correlation
   call2$weights = weights
-
+  call2$log_tf_display = log_tf_display
   # organize data -----
   temp_frame = data[c(x,y,id,condition,time)]
   names(temp_frame)[names(temp_frame) == x] <- "x"

diff --git a/docs/404.html b/docs/404.html
diff --git a/docs/CODE_OF_CONDUCT.html b/docs/CODE_OF_CONDUCT.html