Initial Commit

I am able to draw an arc across groups and calculate an arbitrary test statistic for those groups

.Rbuildignore

@@ -0,0 +1,2 @@
+^.*\.Rproj$
+^\.Rproj\.user$

.gitignore

@@ -0,0 +1,4 @@
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata

DESCRIPTION

@@ -0,0 +1,14 @@
+Package: ggsignif
+Type: Package
+Title: What the Package Does (Title Case)
+Version: 0.1.0
+Author: Who wrote it
+Maintainer: The package maintainer <yourself@somewhere.net>
+Description: More about what it does (maybe more than one line)
+    Use four spaces when indenting paragraphs within the Description.
+License: What license is it under?
+Encoding: UTF-8
+LazyData: true
+Imports:
+  ggplot2   (>= 2.0.0)
+Suggests: testthat

NAMESPACE

@@ -0,0 +1 @@
+exportPattern("^[[:alpha:]]+")

R/experiments.R

@@ -0,0 +1,29 @@
+# StatLm <- ggproto("StatLm", Stat,
+#                   required_aes = c("x", "y"),
+#
+#                   compute_group = function(data, scales, params, n = 100, formula = y ~ x) {
+#                     rng <- range(data$x, na.rm = TRUE)
+#                     grid <- data.frame(x = seq(rng[1], rng[2], length = n))
+#
+#                     mod <- lm(formula, data = data)
+#                     grid$y <- predict(mod, newdata = grid)
+#
+#                     grid
+#                   }
+# )
+#
+# stat_lm <- function(mapping = NULL, data = NULL, geom = "line",
+#                     position = "identity", na.rm = FALSE, show.legend = NA,
+#                     inherit.aes = TRUE, n = 50, formula = y ~ x,
+#                     ...) {
+#   layer(
+#     stat = StatLm, data = data, mapping = mapping, geom = geom,
+#     position = position, show.legend = show.legend, inherit.aes = inherit.aes,
+#     params = list(n = n, formula = formula, na.rm = na.rm, ...)
+#   )
+# }
+#
+# ggplot(mpg, aes(displ, hwy)) +
+#   geom_point() +
+#   stat_lm(formula = y ~ poly(x, 10), n=3) +
+#   stat_lm(formula = y ~ poly(x, 10), geom = "point", colour = "red", n = 20)

R/significance_annotation.R

@@ -0,0 +1,48 @@
+
+
+SignifAnnot <- ggplot2::ggproto("SignifAnnot", ggplot2::Stat,
+                  required_aes = c("x", "y"),
+                  setup_params = function(data, params) {
+                    if (is.character(params$test)) params$test <- match.fun(params$test)
+                    params$complete_data <- data
+                    return(params)
+                  },
+                  compute_group = function(data, scales, comparisons, test, complete_data) {
+                    # if(interactive())browser()
+                    i <- -1
+                    result <- lapply(comparisons, function(comp){
+                      i <<- i + 1
+                      # All entries in group should be the same
+                      if(scales$x$map(comp[1]) == data$group[1]){
+                        # if(interactive())browser()
+                        group_1 <- complete_data$y[complete_data$x == scales$x$map(comp[1])]
+                        group_2 <- complete_data$y[complete_data$x == scales$x$map(comp[2])]
+                        test_result <- do.call(test, list(group_1, group_2))
+                        print(test_result)
+                        y_scale_range <- (scales$y$range$range[2] - scales$y$range$range[1])
+                        y_pos <- scales$y$range$range[2] + y_scale_range * 0.05 + y_scale_range * 0.02 * i
+                        data.frame(x=c(min(comp[1],comp[2]),min(comp[1],comp[2]),max(comp[1],comp[2])),
+                                   xend=c(min(comp[1],comp[2]),max(comp[1],comp[2]),max(comp[1],comp[2])),
+                                   y=c(y_pos - y_scale_range*0.05, y_pos, y_pos),
+                                   yend=c(y_pos, y_pos, y_pos-y_scale_range*0.05),
+                                   p.value=test_result$p.value)
+                      }
+                    })
+
+                    do.call(rbind, result)
+                  }
+)
+
+stat_signif <- function(mapping = NULL, data = NULL,
+                    position = "identity", na.rm = FALSE, show.legend = NA,
+                    inherit.aes = TRUE, comparisons=NULL, test="wilcox.test",
+                    ...) {
+  # if(interactive()) browser()
+  ggplot2::layer(
+    stat = SignifAnnot, data = data, mapping = mapping, geom = "segment",
+    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
+    params = list(comparisons=comparisons, test=test, na.rm = na.rm, ...)
+  )
+}
+
+

ggsignif.Rproj

@@ -0,0 +1,20 @@
+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
+AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source

tests/testthat.R

@@ -0,0 +1,4 @@
+library(testthat)
+library(ggsignif)
+
+test_check("ggsignif")

tests/testthat/test-significance_annotation.R

@@ -0,0 +1,13 @@
+
+
+library(ggplot2)
+
+test_that("the correct columns are used", {
+  print(
+    ggplot(mpg, aes(x=manufacturer, y=displ)) +
+      geom_boxplot()  +
+      stat_signif(comparisons=list(c("audi", "ford"), c("dodge", "nissan")),
+                  test=t.test) +
+      theme(axis.text.x = element_text(angle = 90, hjust = 1))
+  )
+})