Merge pull request #1 from Zadchow/testing

v 2.0

Author: zadrafi

.DS_Store

@@ -1,8 +1,8 @@
 Package: concurve
 Type: Package
-Date: 2019-05-16
+Date: 2019-07-10
 Title: Computes and Plots Consonance (Confidence) Intervals, P-Values, and S-Values to Form Consonance and Surprisal Functions
-Version: 1.1.0
+Version: 2.0
 Authors@R: c(
     person("Zad R.", "Chow", , "zad@lesslikely.com", role = c("aut", "cre"),
       comment = c(ORCID = "0000-0003-1545-8199")
@@ -13,9 +13,11 @@ Authors@R: c(
     )
 Maintainer: Zad R. Chow <zad@lesslikely.com>
 Description: Allows one to compute consonance (confidence) intervals for various statistical tests along with their corresponding P-values and S-values. The intervals can be plotted to create consonance and surprisal functions allowing one to see what effect sizes are compatible with the test model at various consonance levels rather than being limited to one interval estimate such as 95%. These methods are discussed by Poole C. (1987) <doi:10.2105/AJPH.77.2.195>, Schweder T, Hjort NL. (2002) <doi:10.1111/1467-9469.00285>, Singh K, Xie M, Strawderman WE. (2007) <arXiv:0708.0976>, Rothman KJ, Greenland S, Lash TL. (2008, ISBN:9781451190052), Amrhein V, Trafimow D, Greenland S. (2019) <doi:10.1080/00031305.2018.1543137>, and Greenland S. (2019) <doi:10.1080/00031305.2018.1529625>.
-Imports: ggplot2,
+Imports: parallel,
+         ggplot2,
          metafor,
-         dplyr, 
+         dplyr,
+         tibble,
          survival, 
          survminer,
          scales

DESCRIPTION

@@ -1,10 +1,15 @@
 exportPattern("^[[:alpha:]]+")
+import(parallel)
 import(ggplot2)
 import(dplyr)
+import(tibble)
 import(survival)
 import(survminer)
 import(metafor)
 import(scales)
 importFrom("stats", "coef", "confint", "confint.default", "confint.lm",
                 "lm", "quantile", "t.test", "cor.test", "qnorm")
+importFrom("graphics", "axis", "par", "polygon", "text")
+importFrom("stats", "logLik", "model.frame", "model.matrix",
+             "model.response", "na.fail")
 importFrom("utils", "head")

NAMESPACE

@@ -1,10 +1,23 @@
+# concurve 2.0
+
+## Major changes 
+
+* The `plotpint()` function which plotted consonance functions has been repackaged into `ggconcurve()`.
+* The `plotsint()` function which plotted surprisal functions has been repackaged into `ggconcurve()`.
+* Functions can now also be plotted with base R via the `plot_concurve()` function.
+* Consonance functions can be plotted as a pyramid (right side up) or inverted (upside down) via the "position" item in `ggconcurve()`.
+* Null values (for means & ratios) can be plotted via the `ggconcurve()` function to show how much of the interval surrounds it.
+* Log transformations included in all the plotting functions for ratio measures. 
+* Parallel programming has now been implemented into the computations via the `mclapply()` function from the *parallel* package.  
+
+
 # concurve 1.08
 
 ## Major changes
 
-* Can produce consonance and surprisal functions for correlations via the `corrintervals` function.
-* Now able to construct consonance and surprisal functions from the point estiate, and confidence limits via the `reveng` function.
-* Graphs produced via the `plotpint` or `plotsint` function now able to take custom titles, subtitles, x-axis titles, and captions.
+* Can produce consonance and surprisal functions for correlations via the `corrintervals()` function.
+* Now able to construct consonance and surprisal functions from the point estiate, and confidence limits via the `rev_eng()` function.
+* Graphs produced via the `plotpint()` or `plotsint()` function now able to take custom titles, subtitles, x-axis titles, and captions.
 
 # concurve 1.07
 

NEWS.md

@@ -1,25 +1,26 @@
-corrintervals <- function(x, y, alternative, method, steps = 10000) {
-
-  if(is.numeric(x) != TRUE){
+curve_corr <- function(x, y, alternative, method, steps = 10000) {
+  if (is.numeric(x) != TRUE) {
     stop("Error: 'x' must be a numeric vector")
   }
-  if(is.numeric(y) != TRUE){
+  if (is.numeric(y) != TRUE) {
     stop("Error: 'y' must be a numeric vector")
   }
-  if(is.numeric(steps) != TRUE){
+  if (is.numeric(steps) != TRUE) {
     stop("Error: 'steps' must be a numeric vector")
   }
 
-  intrvls <- (0:steps)/steps
-  results <- lapply(intrvls, FUN = function(i) cor.test(x, y, alternative = alternative,  method = method,
-                                                          exact = NULL, conf.level = i, continuity = FALSE)$conf.int[])
-  df<-data.frame(do.call(rbind, results))
+  intrvls <- (0:steps) / steps
+  results <- mclapply(intrvls, FUN = function(i) cor.test(x, y,
+      alternative = alternative, method = method,
+      exact = NULL, conf.level = i, continuity = FALSE
+    )$conf.int[])
+  df <- data.frame(do.call(rbind, results))
   intrvl.limit <- c("lower.limit", "upper.limit")
   colnames(df) <- intrvl.limit
   df$intrvl.level <- intrvls
   df$pvalue <- 1 - intrvls
   df$svalue <- -log2(df$pvalue)
-  df<-head(df, -1)
+  df <- head(df, -1)
   return(df)
 }
 

R/.DS_Store

@@ -0,0 +1,44 @@
+# General Consonance Functions Using Profile Likelihood, Wald, or the bootstrap method for linear models.
+
+curve_gen <- function(model, var, method = "default", replicates = 1000, steps = 10000) {
+  if (is.list(model) != TRUE) {
+    stop("Error: 'model' must be an object with a statistical model")
+  }
+  if (is.character(method) != TRUE) {
+    stop("Error: 'method' must be a character vector")
+  }
+  if (is.numeric(replicates) != TRUE) {
+    stop("Error: 'replicates' must be a numeric vector")
+  }
+  if (is.numeric(steps) != TRUE) {
+    stop("Error: 'steps' must be a numeric vector")
+  }
+  intrvls <- (0:steps) / steps
+  if (method == "default") {
+    results <- mclapply(intrvls, FUN = function(i) confint(object = model, level = i)[var, ])
+  } else if (method == "Wald") {
+    results <- mclapply(intrvls, FUN = function(i) confint.default(object = model, level = i)[var, ])
+  } else if (method == "lm") {
+    results <- mclapply(intrvls, FUN = function(i) confint.lm(object = model, level = i)[var, ])
+  } else if (method == "boot") {
+    effect <- coef(model)[[var]]
+    boot_dist <- replicate(replicates,
+      expr = coef(lm(model$call$formula,
+        data = model$model[sample(nrow(model$model), replace = T), ]
+      ))[[var]]
+    ) - effect
+    results <- mclapply(intrvls, FUN = function(i) effect - quantile(boot_dist, probs = (1 + c(i, -i)) / 2))
+  }
+
+  df <- data.frame(do.call(rbind, results))
+  intrvl.limit <- c("lower.limit", "upper.limit")
+  colnames(df) <- intrvl.limit
+  df$intrvl.level <- intrvls
+  df$pvalue <- 1 - intrvls
+  df$svalue <- -log2(df$pvalue)
+  df <- head(df, -1)
+  return(df)
+}
+
+# RMD Check
+utils::globalVariables(c("df", "lower.limit", "upper.limit", "intrvl.level", "pvalue", "svalue"))

R/corrintervals.R R/curve_corr.RR/corrintervals.R renamed to R/curve_corr.R

@@ -0,0 +1,48 @@
+# Mean Interval Consonance Function
+
+curve_mean <- function(x, y, data, paired = F, method = "default", replicates = 1000, steps = 10000) {
+  if (is.numeric(x) != TRUE) {
+    stop("Error: 'x' must be a numeric vector")
+  }
+  if (is.numeric(y) != TRUE) {
+    stop("Error: 'y' must be a numeric vector")
+  }
+  if (is.data.frame(data) != TRUE) {
+    stop("Error: 'data' must be a data frame")
+  }
+  if (is.numeric(replicates) != TRUE) {
+    stop("Error: 'replicates' must be a numeric vector")
+  }
+  if (is.numeric(steps) != TRUE) {
+    stop("Error: 'steps' must be a numeric vector")
+  }
+  intrvls <- (0:steps) / steps
+  if (method == "default") {
+    results <- mclapply(intrvls, FUN = function(i) t.test(x, y, data = data, paired = paired, conf.level = i)$conf.int[])
+  } else if (method == "boot") {
+    diff <- mean(x) - mean(y)
+    if (paired) {
+      diffs <- x - y
+      boot_dist <- replicate(replicates,
+        expr = mean(diffs[sample(length(diffs), replace = T)])
+      ) - diff
+    } else {
+      boot_dist <- replicate(replicates,
+        expr = mean(sample(x, length(x), replace = T)) -
+          mean(sample(y, length(y), replace = T))
+      ) - diff
+    }
+    results <- mclapply(intrvls, FUN = function(i) diff - quantile(boot_dist, probs = (1 + c(i, -i)) / 2))
+  }
+  df <- data.frame(do.call(rbind, results))
+  intrvl.limit <- c("lower.limit", "upper.limit")
+  colnames(df) <- intrvl.limit
+  df$intrvl.level <- intrvls
+  df$pvalue <- 1 - intrvls
+  df$svalue <- -log2(df$pvalue)
+  df <- head(df, -1)
+  return(df)
+}
+
+# RMD Check
+utils::globalVariables(c("df", "lower.limit", "upper.limit", "intrvl.level", "pvalue", "svalue"))

R/curve_gen.R

@@ -1,31 +1,31 @@
 # Meta-analytic Consonance Function
 
-metaintervals<-function(x, measure = "default", steps = 10000) {
-  if(is.list(x) != TRUE){
+curve_meta <- function(x, measure = "default", steps = 10000) {
+  if (is.list(x) != TRUE) {
     stop("Error: 'x' must be a list from 'metafor'")
   }
-  if(is.character(measure) != TRUE){
+  if (is.character(measure) != TRUE) {
     stop("Error: 'measure' must be a string such as 'default' or 'ratio'")
   }
-  if(is.numeric(steps) != TRUE){
+  if (is.numeric(steps) != TRUE) {
     stop("Error: 'steps' must be a numeric vector")
   }
-  intrvls <- (0:steps)/steps
-  results <- lapply(intrvls, FUN = function(i) confint.default(object = x, fixed = TRUE, random = FALSE, level = i)[])
-  df<-data.frame(do.call(rbind, results))
+  intrvls <- (0:steps) / steps
+  results <- mclapply(intrvls, FUN = function(i) confint.default(object = x, fixed = TRUE, random = FALSE, level = i)[])
+  df <- data.frame(do.call(rbind, results))
   intrvl.limit <- c("lower.limit", "upper.limit")
   colnames(df) <- intrvl.limit
   df$intrvl.level <- intrvls
   df$pvalue <- 1 - intrvls
   df$svalue <- -log2(df$pvalue)
-  if(measure == "default") {
+  if (measure == "default") {
     df$lower.limit <- df$lower.limit
     df$upper.limit <- df$upper.limit
-  } else if(measure == "ratio") {
+  } else if (measure == "ratio") {
     df$lower.limit <- exp(df$lower.limit)
     df$upper.limit <- exp(df$upper.limit)
   }
-  df<-head(df, -1)
+  df <- head(df, -1)
   return(df)
 }
 

R/curve_mean.R

@@ -0,0 +1,49 @@
+# Reverse Engineer Consonance Functions Using the Point Estimate and Confidence Limits
+
+curve_rev <- function(point, LL, UL, measure = "default") {
+  if (is.numeric(point) != TRUE) {
+    stop("Error: 'x' must be a numeric vector")
+  }
+  if (is.numeric(LL) != TRUE) {
+    stop("Error: 'y' must be a numeric vector")
+  }
+  if (is.numeric(UL) != TRUE) {
+    stop("Error: 'y' must be a numeric vector")
+  }
+  if (is.character(measure) != TRUE) {
+    stop("Error: 'measure' must be a string such as 'default' or 'ratio'")
+  }
+
+  intrvls <- (1:10000) / 10000
+  z <- qnorm(1 - intrvls / 2)
+
+  if (measure == "default") {
+    se <- (UL / LL) / 3.92
+    LL <- mclapply(z, FUN = function(i) point + (i * se))
+    UL <- mclapply(z, FUN = function(i) point - (i * se))
+    df <- data.frame(do.call(rbind, UL), do.call(rbind, LL))
+    intrvl.limit <- c("lower.limit", "upper.limit")
+    colnames(df) <- intrvl.limit
+  }
+
+  else if (measure == "ratio") {
+    se <- log(UL / LL) / 3.92
+    logpoint <- log(point)
+    logLL <- mclapply(z, FUN = function(i) logpoint + (i * se))
+    logUL <- mclapply(z, FUN = function(i) logpoint - (i * se))
+    df <- data.frame(do.call(rbind, logUL), do.call(rbind, logLL))
+    intrvl.limit <- c("lower.limit", "upper.limit")
+    colnames(df) <- intrvl.limit
+    df$lower.limit <- exp(df$lower.limit)
+    df$upper.limit <- exp(df$upper.limit)
+  }
+
+  df$intrvl.level <- 1 - intrvls
+  df$pvalue <- 1 - (1 - intrvls)
+  df$svalue <- -log2(df$pvalue)
+  df <- head(df, -1)
+  return(df)
+}
+
+# RMD Check
+utils::globalVariables(c("df", "lower.limit", "upper.limit", "intrvl.level", "pvalue", "svalue"))