Merge pull request #13 from Zadchow/testing

Testing

DESCRIPTION

@@ -3,8 +3,8 @@ Package: concurve
 Title: Computes and Plots Compatibility (Confidence) Intervals,
     P-Values, S-Values, & Likelihood Intervals to Form Consonance,
     Surprisal, & Likelihood Functions
-Version: 2.3.0.1
-Date: 2019-12-08
+Version: 2.4.0
+Date: 2019-12-09
 Authors@R: 
     c(person(given = "Zad R.",
              family = "Chow",
@@ -59,14 +59,15 @@ Suggests:
     spelling,
     testthat,
     rmarkdown,
-    Lock5Data
+    Lock5Data,
+    carData
 VignetteBuilder: 
     knitr
 ByteCompile: true
 Encoding: UTF-8
 Language: en-US
 LazyData: true
-Roxygen: list(markdown = TRUE)
+Roxygen: list(markdown = TRUE, old_usage = TRUE)
 RoxygenNote: 7.0.2
 X-schema.org-keywords: confidence, compatibility, consonance,
     surprisal, interval, function, curve

NEWS.md

@@ -1,3 +1,20 @@
+# concurve 2.4.0
+
+## Major changes 
+* `curve_boot()` can utilize parametric Bca bootstrap methods to compute functions.
+* Corrected error where order of labels in columns for `curve_boot()` tables was incorrect.
+* Corrected error where order of labels in columns for `curve_meta()` tables was incorrect.
+* Set minimum version of `R` to 3.5.0.
+* included `install.packages("concurve", dep = TRUE)` as solution to installation problems for some individuals. 
+* Removed `MASS`, `compiler`, and `Rlang` from `DESCRIPTION` `IMPORTS`, since these weren't used.
+* Wrote new unit tests examing the class of each of the objects created from the functions. 
+
+
+## Minor changes 
+* `ggcurve()` theme has been changed from `theme_bw()` to `theme_minimal()`.
+* Several new examples in the "[Examples in R](https://data.lesslikely.com/concurve/articles/examples.html)" article.
+
+
 # concurve 2.3.0
 
 ## Major changes 

R/curve_boot.R

@@ -1,13 +1,22 @@
 #' Generate Consonance Functions via Bootstrapping
 #'
-#' Use the BCa bootstrap method and the t boostrap method from the bcaboot and boot packages
+#' Use the Bca bootstrap method and the t-boostrap method from the bcaboot and boot packages
 #' to generate consonance distrbutions.
 #'
 #' @param data Dataset that is being used to create a consonance function.
 #' @param func Custom function that is used to create parameters of interest that
 #' will be bootstrapped.
 #' @param method The boostrap method that will be used to generate the functions.
-#' Methods include "bca" which is the default and "t".
+#' Methods include "bca" which is the default, "bcapar", which is parametric
+#' bootstrapping using the bca method and "t", for the t-bootstrap/percentile method.
+#' @param t0 	Only used for the "bcapar" method.
+#' Observed estimate of theta, usually by maximum likelihood.
+#' @param tt Only used for the "bcapar" method.
+#' A vector of parametric bootstrap replications of theta of length B,
+#' usually large, say B = 2000
+#' @param bb Only used for the "bcapar" method.
+#' A B by p matrix of natural sufficient vectors,
+#' where p is the dimension of the exponential family.
 #' @param replicates Indicates how many bootstrap replicates are to be performed.
 #' The defaultis currently 20000 but more may be desirable, especially to make
 #' the functions more smooth.
@@ -21,32 +30,29 @@
 #' statistics should be generated. The default is TRUE and generates a table
 #' which is included in the list object.
 #'
-#' @return A list with the dataframe of values in the first list and the table
-#' in the second if table = TRUE.
+#' @return A list with 7 items where the dataframe of standard values is in the first
+#' list and the table for it in the second if table = TRUE. The Bca intervals and table
+#' are found in the third and fourth list. The values for the density function are in
+#' the fifth object, while the Bca stats are in the sixth and seventh objects.
 #'
-#' @examples
+#' @references
 #'
-#' \donttest{
-#' data(diabetes, package = "bcaboot")
-#' Xy <- cbind(diabetes$x, diabetes$y)
-#' rfun <- function(Xy) {
-#'   y <- Xy[, 11]
-#'   X <- Xy[, 1:10]
-#'   return(summary(lm(y ~ X))$adj.r.squared)
-#' }
+#' Efron, B., and Tibshirani, R. J. (1994), An Introduction to the Bootstrap, CRC Press.
 #'
-#' x <- curve_boot(data = Xy, func = rfun, method = "bca", replicates = 200, steps = 1000)
+#' Efron, B., and Narasimhan, B. (2018), “The automatic construction of bootstrap confidence intervals,” 17.
 #'
-#' ggcurve(data = x[[1]])
-#' ggcurve(data = x[[3]])
+#' Schweder, T., and Hjort, N. L. (2016), Confidence, Likelihood, Probability:
+#' Statistical Inference with Confidence Distributions, Cambridge University Press.
 #'
-#' plot_compare(x[[1]], x[[3]])
-#' }
+#' Xie, M., and Singh, K. (2013), “Confidence Distribution, the Frequentist Distribution Estimator of a Parameter:
+#' A Review,” International Statistical Review, 81, 3–39.
 #'
-curve_boot <- function(data = data, func = func, method = "bca", replicates = 2000, steps = 1000, table = TRUE) {
+#'
+
+curve_boot <- function(data = data, func = func, method = "bca", t0, tt, bb, replicates = 2000, steps = 1000, table = TRUE) {
 
 
-  # BCA Bootstrap Method  ---------------------------------------------------
+  # BCA Non-Parametric Bootstrap Method  ---------------------------------------------------
 
   if (method == "bca") {
     intrvls <- 0.5 / steps
@@ -61,6 +67,17 @@ curve_boot <- function(data = data, func = func, method = "bca", replicates = 20
     z$alphaperc <- as.numeric(z$alphaperc)
     1:length(alpha)
 
+
+    # Bootstrap Statistics ----------------------------------------------------
+
+    bootstats <- result[["stats"]]
+    bootstats <- as.data.frame(bootstats)
+    class(bootstats) <- c("data.frame", "concurve")
+
+    bcastats <- result[["ustats"]]
+    bcastats <- as.data.frame(bcastats)
+    class(bcastats) <- c("data.frame", "concurve")
+
     # Data Frame with BCA Intervals ------------------------------
 
     bca <- pbmclapply(1:length(alpha), FUN = function(i) c(nth(z$bca, i), nth(z$bca, -i)), mc.cores = getOption("mc.cores", 1L))
@@ -74,12 +91,12 @@ curve_boot <- function(data = data, func = func, method = "bca", replicates = 20
     levels <- data.frame(do.call(rbind, bews))
     colnames(levels) <- "intrvl.level"
 
-    df_bca <- data.frame(bcaintervals$lower.limit, bcaintervals$upper.limit, levels$intrvl.level, width$intrvl.width)
-    df_names <- c("lower.limit", "upper.limit", "intrvl.level", "intrvl.width")
+    df_bca <- data.frame(bcaintervals$lower.limit, bcaintervals$upper.limit, width$intrvl.width, levels$intrvl.level)
+    df_names <- c("lower.limit", "upper.limit", "intrvl.width", "intrvl.level")
     colnames(df_bca) <- df_names
+    df_bca$cdf <- (abs(df_bca$intrvl.level / 2)) + 0.5
     df_bca$pvalue <- 1 - df_bca$intrvl.level
     df_bca$svalue <- -log2(df_bca$pvalue)
-    df_bca$cdf <- (abs(df_bca$intrvl.level / 2)) + 0.5
     df_bca <- head(df_bca, -1)
     df_bca <- df_bca[-1, ]
     class(df_bca) <- c("data.frame", "concurve")
@@ -97,12 +114,12 @@ curve_boot <- function(data = data, func = func, method = "bca", replicates = 20
     levels <- data.frame(do.call(rbind, bews))
     colnames(levels) <- "intrvl.level"
 
-    df_std <- data.frame(stdintervals$lower.limit, stdintervals$upper.limit, levels$intrvl.level, width$intrvl.width)
-    df_names <- c("lower.limit", "upper.limit", "intrvl.level", "intrvl.width")
+    df_std <- data.frame(stdintervals$lower.limit, stdintervals$upper.limit, width$intrvl.width, levels$intrvl.level)
+    df_names <- c("lower.limit", "upper.limit", "intrvl.width", "intrvl.level")
     colnames(df_std) <- df_names
+    df_std$cdf <- (abs(df_std$intrvl.level / 2)) + 0.5
     df_std$pvalue <- 1 - df_std$intrvl.level
     df_std$svalue <- -log2(df_std$pvalue)
-    df_std$cdf <- (abs(df_std$intrvl.level / 2)) + 0.5
     df_std <- head(df_std, -1)
     df_std <- df_std[-1, ]
     class(df_std) <- c("data.frame", "concurve")
@@ -116,13 +133,109 @@ curve_boot <- function(data = data, func = func, method = "bca", replicates = 20
       class(bca_subintervals) <- c("data.frame", "concurve")
       (std_subintervals <- (curve_table(df_std, levels, type = "c", format = "data.frame")))
       class(std_subintervals) <- c("data.frame", "concurve")
-      dataframes <- list(df_std, std_subintervals, df_bca, bca_subintervals)
-      names(dataframes) <- c("Standard Intervals", "Standard Table", "BCA Intervals", "BCA Table")
+      dataframes <- list(df_std, std_subintervals, df_bca, bca_subintervals, bootstats, bcastats)
+      names(dataframes) <- c("Standard Intervals", "Standard Table", "BCA Intervals", "BCA Table", "Bootstrap Statistics", "BCA Statistics")
+      class(dataframes) <- "concurve"
+      return(dataframes)
+    } else if (table == FALSE) {
+      dataframes <- list(df_std, df_bca, bootstats, bcastats)
+      names(dataframes) <- c("Standard", "BCA", "Bootstrap Statistics", "BCA Statistics")
+      class(dataframes) <- "concurve"
+      return(dataframes)
+    }
+
+
+    # Parametric BCA Bootstrap Method -----------------------------------------
+  } else if (method == "bcapar") {
+    intrvls <- 0.5 / steps
+    alpha <- seq(0.00, 0.50, intrvls)
+
+    result <- bcapar(t0 = t0, tt = tt, bb = bb, alpha = alpha, cd = 1)
+
+    # Parametric Bootstrap Statistics -----------------------------------------
+
+    bootstats <- result[["stats"]]
+    bootstats <- as.data.frame(bootstats)
+    class(bootstats) <- c("data.frame", "concurve")
+
+    bcastats <- result[["ustats"]]
+    bcastats <- as.data.frame(bcastats)
+    class(bcastats) <- c("data.frame", "concurve")
+
+
+    # Parametric BCA Bootstrap Density ----------------------------------------
+
+    densdf <- result[["w"]]
+    densdf <- as.data.frame(densdf)
+    class(densdf) <- c("data.frame", "concurve")
+    colnames(densdf) <- "x"
+
+    z <- result[["lims"]]
+    z <- as.data.frame(z)
+    z <- as_tibble(rownames_to_column(z))
+    colnames(z)[1] <- "alphaperc"
+    z$alphaperc <- as.numeric(z$alphaperc)
+    1:length(alpha)
+
+    bca <- pbmclapply(1:length(alpha), FUN = function(i) c(nth(z$bca, i), nth(z$bca, -i)), mc.cores = getOption("mc.cores", 1L))
+    bcaintervals <- data.frame(do.call(rbind, bca))
+    intrvl.limit <- c("lower.limit", "upper.limit")
+    colnames(bcaintervals) <- intrvl.limit
+    news <- pbmclapply(1:length(alpha), FUN = function(i) nth(z$bca, -i) - nth(z$bca, i), mc.cores = getOption("mc.cores", 1L))
+    width <- data.frame(do.call(rbind, news))
+    colnames(width) <- "intrvl.width"
+    bews <- pbmclapply(1:length(alpha), FUN = function(i) nth(z$alphaperc, -i) - nth(z$alphaperc, i), mc.cores = getOption("mc.cores", 1L))
+    levels <- data.frame(do.call(rbind, bews))
+    colnames(levels) <- "intrvl.level"
+
+    df_bca <- data.frame(bcaintervals$lower.limit, bcaintervals$upper.limit, width$intrvl.width, levels$intrvl.level)
+    df_names <- c("lower.limit", "upper.limit", "intrvl.width", "intrvl.level")
+    colnames(df_bca) <- df_names
+    df_bca$cdf <- (abs(df_bca$intrvl.level / 2)) + 0.5
+    df_bca$pvalue <- 1 - df_bca$intrvl.level
+    df_bca$svalue <- -log2(df_bca$pvalue)
+    df_bca <- head(df_bca, -1)
+    df_bca <- df_bca[-1, ]
+    class(df_bca) <- c("data.frame", "concurve")
+
+    # Data Frame with Standard Intervals ------------------------------
+
+    std <- pbmclapply(1:length(alpha), FUN = function(i) c(nth(z$std, i), nth(z$std, -i)), mc.cores = getOption("mc.cores", 1L))
+    stdintervals <- data.frame(do.call(rbind, std))
+    intrvl.limit <- c("lower.limit", "upper.limit")
+    colnames(stdintervals) <- intrvl.limit
+    news <- pbmclapply(1:length(alpha), FUN = function(i) nth(z$std, -i) - nth(z$std, i), mc.cores = getOption("mc.cores", 1L))
+    width <- data.frame(do.call(rbind, news))
+    colnames(width) <- "intrvl.width"
+    bews <- pbmclapply(1:length(alpha), FUN = function(i) nth(z$alphaperc, -i) - nth(z$alphaperc, i), mc.cores = getOption("mc.cores", 1L))
+    levels <- data.frame(do.call(rbind, bews))
+    colnames(levels) <- "intrvl.level"
+
+    df_std <- data.frame(stdintervals$lower.limit, stdintervals$upper.limit, width$intrvl.width, levels$intrvl.level)
+    df_names <- c("lower.limit", "upper.limit", "intrvl.width", "intrvl.level")
+    colnames(df_std) <- df_names
+    df_std$cdf <- (abs(df_std$intrvl.level / 2)) + 0.5
+    df_std$pvalue <- 1 - df_std$intrvl.level
+    df_std$svalue <- -log2(df_std$pvalue)
+    df_std <- head(df_std, -1)
+    df_std <- df_std[-1, ]
+    class(df_std) <- c("data.frame", "concurve")
+
+    # Combine Data Frames -----------------------------------------------------
+
+    if (table == TRUE) {
+      levels <- c(0.25, 0.50, 0.75, 0.80, 0.85, 0.90, 0.95, 0.975, 0.99)
+      (bca_subintervals <- (curve_table(df_bca, levels, type = "c", format = "data.frame")))
+      class(bca_subintervals) <- c("data.frame", "concurve")
+      (std_subintervals <- (curve_table(df_std, levels, type = "c", format = "data.frame")))
+      class(std_subintervals) <- c("data.frame", "concurve")
+      dataframes <- list(df_std, std_subintervals, df_bca, bca_subintervals, densdf, bootstats, bcastats)
+      names(dataframes) <- c("Standard Intervals", "Standard Table", "BCA Intervals", "BCA Table", "BCA Density", "Bootstrap Statistics", "BCA Statistics")
       class(dataframes) <- "concurve"
       return(dataframes)
     } else if (table == FALSE) {
-      dataframes <- list(df_std, df_bca)
-      names(dataframes) <- c("Standard", "BCA")
+      dataframes <- list(df_std, df_bca, densdf, bootstats, bcastats)
+      names(dataframes) <- c("Standard", "BCA", "BCA Density", "Bootstrap Statistics", "BCA Statistics")
       class(dataframes) <- "concurve"
       return(dataframes)
     }

R/curve_compare.R

@@ -1,4 +1,4 @@
-#' Compares two functions and produces an AUC score to show the amount of consonance.
+#' Compare Two Functions and Produces An AUC Score
 #'
 #' Compares the p-value/s-value, and likelihood functions and computes an AUC number.
 #'
@@ -15,7 +15,7 @@
 #' @param plot by default it is set to TRUE and will use the plot_compare() function
 #' to plot the two functions.
 #' @param ... Can be used to pass further arguments to plot_compare().
-#'
+#' @return Computes an AUC score and returns a plot that graphs two functions.
 #' @examples
 #' \donttest{
 #' library(concurve)
@@ -28,10 +28,14 @@
 #' RandomData2 <- data.frame(GroupA2, GroupB2)
 #' model <- lm(GroupA2 ~ GroupB2, data = RandomData2)
 #' randomframe <- curve_gen(model, "GroupB2")
-#' (curve_compare(intervalsdf[[1]], randomframe[[1]]))
-#' (curve_compare(intervalsdf[[1]], randomframe[[1]], type = "s"))
+#' curve_compare(intervalsdf[[1]], randomframe[[1]])
+#' curve_compare(intervalsdf[[1]], randomframe[[1]], type = "s")
 #' }
 #'
+#' @seealso [plot_compare()]
+#' @seealso [ggcurve()]
+#' @seealso [curve_table()]
+#'
 curve_compare <- function(data1, data2, type = "c", plot = TRUE, ...) {
 
   # Consonance Function -----------------------------------------------------
@@ -85,7 +89,7 @@ curve_compare <- function(data1, data2, type = "c", plot = TRUE, ...) {
       AUC_2 <- integrate(f1, min(df2$x), max(df2$x))$value
       AUC_shared <- integrate(f, domain[1], domain[2])$value
 
-      AUC_overlap <- (AUC_shared / (AUC_1 + AUC_2 - AUC_shared))
+      AUC_overlap <- (AUC_shared / (AUC_1 + AUC_2 - AUC_shared)) * 100
       AUC_ratio <- (AUC_shared / (AUC_1 + AUC_2 - 2 * AUC_shared))
 
       AUC_results <- data.frame(AUC_1, AUC_2, AUC_shared, AUC_overlap, AUC_ratio)
@@ -154,7 +158,7 @@ curve_compare <- function(data1, data2, type = "c", plot = TRUE, ...) {
       AUC_2 <- integrate(f1, min(df2$x), max(df2$x))$value
       AUC_shared <- integrate(f, domain[1], domain[2])$value
 
-      AUC_overlap <- (AUC_shared / (AUC_1 + AUC_2 - AUC_shared))
+      AUC_overlap <- (AUC_shared / (AUC_1 + AUC_2 - AUC_shared)) * 100
       AUC_ratio <- (AUC_shared / (AUC_1 + AUC_2 - 2 * AUC_shared))
 
       AUC_results <- data.frame(AUC_1, AUC_2, AUC_shared, AUC_overlap, AUC_ratio)

R/curve_corr.R

@@ -1,4 +1,4 @@
-#' Computes Consonance Intervals for Correlations
+#' Consonance Functions for Correlations
 #'
 #' Computes consonance intervals to produce P- and S-value functions for
 #' correlational analysesusing the cor.test function in base R and places the
@@ -25,6 +25,10 @@
 #' statistics should be generated. The default is TRUE and generates a table
 #' which is included in the list object.
 #'
+#' @return A list with 3 items where the dataframe of values is in the first
+#' object, the values needed to calculate the density function in the second,
+#' and the table for the values in the third if table = TRUE.
+#'
 #' @examples
 #'
 #' GroupA <- rnorm(50)

R/curve_gen.R

@@ -1,5 +1,4 @@
-#' General Consonance Functions Using Profile Likelihood, Wald,
-#' or the bootstrap method for linear models.
+#' Consonance Functions For Linear Models.
 #'
 #' Computes thousands of consonance (confidence) intervals for
 #' the chosen parameter in the selected model
@@ -30,6 +29,10 @@
 #' statistics should be generated. The default is TRUE and generates a table
 #' which is included in the list object.
 #'
+#' @return A list with 3 items where the dataframe of values is in the first
+#' object, the values needed to calculate the density function in the second,
+#' and the table for the values in the third if table = TRUE.
+#'
 #' @examples
 #'
 #' \donttest{

R/curve_lik.R

@@ -1,4 +1,4 @@
-#' Compute the Profile Likelihood Functions
+#' Compute Profile Likelihood Functions
 #'
 #' @param likobject An object from the ProfileLikelihood package
 #' @param data The dataframe that was used to create the likelihood
@@ -7,6 +7,9 @@
 #' statistics should be generated. The default is TRUE and generates a table
 #' which is included in the list object.
 #'
+#' @return A list with 2 items where the dataframe of values is in the first
+#' object, and the table for the values in the second if table = TRUE.
+#'
 #' @examples
 #'
 #' library(ProfileLikelihood)