current version (04/29/2019)

TwoProportionResamplingTest/TwoProportionResamplingTest.R

 # ------------------------------------------------------------------------------
 # File: TwoProportionResamplingTest.R
 # Authors: Camille Fairbourn, Scott Manski
-# Date: 03/26/2019 
+# Date: 04/29/2019 
 # Desc: This app performs a two proportion test via randomization. The 
 #       resampling test mimics Fisher's Exact Test.
 # Published Location: 
@@ -29,6 +29,12 @@ enableBookmarking(store = "server")
 # custom ggplot2 themes.
 source("TwoProportionSource.R")
 
+# colors for plots
+hist.fill.color <- "grey70" # histogram bar fill color
+hist.outline.color <- "black" # histogram bar outline color
+dot.fill.color <- "grey70" # dotplot dot fill color
+cutoff.color <- "#F05133" # color for cutoff values
+
 # defines the presets
 Presets <- list()
 # Presets`preset name` <- c(Top Left, Bottom Left, Top Right, Bottom Right, 
@@ -84,7 +90,6 @@ ui <- function(request) {
                                                samples that are greater/less than your value."),
                                     tags$p("Selecting 'beyond' will highlight the samples that are further away
                                                from 0 than your value."),
-                                    tags$p("Press the Reset button whenever you change the values in the table."),
                                     hr(),
                                     hr(),
                                     tags$p("Written by Scott Manski"),
@@ -116,12 +121,6 @@ server <- function(input, output, session) {
   values$props <- vector()
   values$table <- matrix(rep(NA, 9), ncol=3)
   
-  # colors for plots
-  values$hist.fill.color <- "grey70" # histogram bar fill color
-  values$hist.outline.color <- "black" # histogram bar outline color
-  values$dot.fill.color <- "grey70" # dotplot dot fill color
-  values$cutoff.color <- "#F05133" # color for cutoff values
-  
   # observe any changes in table
   observe({
     values$table[1, 1] <- as.numeric(input$TL) # top left position
@@ -288,8 +287,8 @@ server <- function(input, output, session) {
           n <- 4
         }
         # gets the dotplot locations for the dotplot
-        df <- dotplot_locs(values$props, n, input$cutoff, values$cutoff.color,
-                           values$dot.fill.color, input$inequality)
+        df <- dotplot_locs(values$props, n, input$cutoff, cutoff.color,
+                           dot.fill.color, input$inequality)
         df <- df[df$x < values$x.lim & df$x > -values$x.lim, ]
         
         myplot <- ggplot(df)  +
@@ -325,12 +324,12 @@ server <- function(input, output, session) {
         } else {
           to.color <- NA
         }
-          fill.color <- rep(values$hist.fill.color, length(names.counts))
-          fill.color[to.color] <- values$cutoff.color
+          fill.color <- rep(hist.fill.color, length(names.counts))
+          fill.color[to.color] <- cutoff.color
           # the histogram is plotted
           myplot <- ggplot(df, aes(x=x)) + 
             geom_histogram(binwidth = max(diff(unique.vals)), fill = fill.color, 
-                           col = values$hist.outline.color) +
+                           col = hist.outline.color) +
             labs(x = "Shuffled Difference in Proportions", y = "Count") +
             scale_x_continuous(limits = c(-values$x.lim, values$x.lim)) +
             plaintheme + axistheme
@@ -360,7 +359,7 @@ server <- function(input, output, session) {
       if (is.na(values$prob)){
         " "
       } else if (!is.na(as.numeric(input$cutoff))){
-        paste("<font color=", values$cutoff.color, "><b>",values$count, "/",
+        paste("<font color=", cutoff.color, "><b>",values$count, "/",
               length(values$props), " (", round(values$prob, 4), ")",
               "</b></font>", sep = "")
       } else if (nchar(input$cutoff)!=0){

TwoProportionResamplingTest/TwoProportionSource.R

@@ -65,18 +65,18 @@ html_table <- HTML("<script type='text/javascript'>
                    <tbody>
                    <tr>
                    <td></td>
-                   <td><input size='1' id='C1N'type = 'text' onchange='Expand2();' oninput='Expand2();' value='Column A'></td>
-                   <td><input size='1' id='C2N'type = 'text' onchange='Expand3();' oninput='Expand3();' value='Column B'></td>
+                   <td><input size='10' id='C1N'type = 'text' onchange='Expand2();' oninput='Expand2();' value='Column A'></td>
+                   <td><input size='10' id='C2N'type = 'text' onchange='Expand3();' oninput='Expand3();' value='Column B'></td>
                    <td><div style='padding: 1px 8px'>Total</div></td>
                    </tr>
                    <tr>
-                   <td><input size='1' id='R1N'type = 'text' onchange='Expand1();' oninput='Expand1();' value='Row 1'></td>
+                   <td><input size='6' id='R1N'type = 'text' onchange='Expand1();' oninput='Expand1();' value='Row 1'></td>
                    <td><input size='1' id='TL' type='text' onchange='Expand2();' oninput='Expand2();' value='0'></td>
                    <td><input size='1' id='TR' type = 'text' onchange='Expand3();' oninput='Expand3();' value='0'></td>
                    <td><div size='1' style='padding: 1px 8px' id='TRT' class='shiny-text-output'></div></td>
                    </tr>
                    <tr>
-                   <td><input size='1' id='R2N' type = 'text' onchange='Expand1();' oninput='Expand1();' value='Row 2'></td>
+                   <td><input size='6' id='R2N' type = 'text' onchange='Expand1();' oninput='Expand1();' value='Row 2'></td>
                    <td><input size='1' id='BL' type = 'text' onchange='Expand2();' oninput='Expand2();' value='0'></td>
                    <td><input size='1' id='BR' type = 'text' onchange='Expand3();' oninput='Expand3();' value='0'></td>
                    <td><div size='1' style='padding: 1px 8px' id='TRB' class='shiny-text-output'></div></td>