A Shiny App to Compare Stats

For a recent publication comparing null hypothesis testing p-values to Bayes Factors and Observation Oriented Modeling, we created a Shiny app to graph all of our complex plots. I particularly pleased with the plotly 3D graph - as I usually think that 3D graphs are impossible to read. This plot shows what we found in our study (albeit I would recommend viewing the 2D plots more):

  • Bayes Factors and p-values follow a power function, as we expected.
  • Bayes Factors and OOM values follow an interesting pattern, wherein as sample size increases, BF expands outwards, while PCC values tend to constrict.
  • p-values will always decrease to floor, and PCC values still tend to constrict toward the simulated effect size range.

Another component of this app I wanted to show off was the interactive response points, wherein the input options (on the left) change based on a user selected input option. Therefore, options that are normally only input are both input and output in the traditional Shiny set up.

You can see that by having the selection (first part) and the changing selection (second part) in the fluid page:

selectInput("Nselect", "Select N Scaling:",
                  c("N" = "N",
                    "Log N" = "log")),
                    
htmlOutput("slider_selector")

Which is connected to the server function below:

  ####change the slider####
  output$slider_selector = renderUI({ 
    
    if (input$Nselect == "N") { minN = 10; maxN = 1000; stepN = 10}
    if (input$Nselect == "log") { minN = round(log(10),1) 
                                  maxN = round(log(1000),1)
                                  stepN = .1}
    
    sliderInput("xaxisrange", "X-Axis Range:",
                min = minN, max = maxN,
                value = c(minN,maxN),
                sep = "",
                round = -1,
                step = stepN)
  })

These two pieces feed information back and forth depending on the user input to show either X on a real scale or X on a log scale.

Code is included below, and when our server isn’t being cranky, the app is here. The code is pretty long due to the sheer number of graphs, so it’s edited down to just the shiny parts - when you see ####GRAPH#### that’s some kicking ggplot2 graphs you can view in our github repo.

Check out the project OSF page here. You can download the entire app from our github repo (also other shiny apps!).

library(shiny)
library(ggplot2)
library(reshape)
library(plotly)

####remove data loading and reshaping####

####user interface####
ui <- fluidPage (
  
  titlePanel("Valentine et al. Interactive Graphics"),
  
  sidebarLayout(
    
    ##sidebarpanel
    sidebarPanel(
      
      br(),
      
      ##put input boxes here
      tags$em("All Graphs:"),
      selectInput("sizeselect", "Select Effect Size:",
                  c("Negligible" = "None",
                    "Small" = "Small",
                    "Medium" = "Medium",
                    "Large" = "Large")),
      
      tags$em("Percent Graphs:"),
      selectInput("Nselect", "Select N Scaling:",
                  c("N" = "N",
                    "Log N" = "log")),
      
      htmlOutput("slider_selector"),
      
      tags$em("Comparison Graphs:"),
      
      selectInput("graphselect", "Select Graph:",
                  c("PCC - p" = "pccp",
                    "PCC - BF" = "pccbf",
                    "BF - p" = "bfp")),
      
      sliderInput("bfrange", "Log BF Range:",
                  min = -5, max = 600,
                  value = c(-5,600),
                  sep = "",
                  step = 10),
      
      sliderInput("prange", "p Range:",
                  min = 0, max = 1,
                  value = c(0,1),
                  step = .01),
      
      sliderInput("pccrange", "PCC Range:",
                  min = 0, max = 1,
                  value = c(0,1),
                  step = .01)
      
    ), #close sidebar panel
    
    mainPanel(
      
      tabsetPanel(
        tabPanel("Significant", plotOutput("sigpic"),
                 br(),
                 helpText("Complete dataset avaliable at: https://osf.io/u9hf4/")),
        tabPanel("Non-Significant", plotOutput("nonpic"),
                 br(),
                 helpText("Complete dataset avaliable at: https://osf.io/u9hf4/")),
        tabPanel("Omnibus Agreement", plotOutput("omniagree"),
                 br(),
                 helpText("Complete dataset avaliable at: https://osf.io/u9hf4/")),
        tabPanel("Posthoc Agreement", plotOutput("postagree"),
                 br(),
                 helpText("Complete dataset avaliable at: https://osf.io/u9hf4/")),
        tabPanel("Criterion Comparison", plotOutput("compare"), 
                 br(),
                 helpText("Complete dataset avaliable at: https://osf.io/u9hf4/",br(), 
                          "BF values have been log transformed to show the entire range of the data.")),
        tabPanel("3D Comparison", plotlyOutput("compare3d"), 
                 br(),
                 helpText("Complete dataset avaliable at: https://osf.io/u9hf4/",br(), 
                          "BF values have been log transformed to show the entire range of the data."))
      )
      
    ) #close main panel 
    
  ) #close sidebar layout

) #close fluid page

####server functions####
server <- function(input, output) {
   
  ####change the slider####
  output$slider_selector = renderUI({ 
    
    if (input$Nselect == "N") { minN = 10; maxN = 1000; stepN = 10}
    if (input$Nselect == "log") { minN = round(log(10),1) 
                                  maxN = round(log(1000),1)
                                  stepN = .1}
    
    sliderInput("xaxisrange", "X-Axis Range:",
                min = minN, max = maxN,
                value = c(minN,maxN),
                sep = "",
                round = -1,
                step = stepN)
  })
  
   ####SIGNIFICANT EFFECTS####
   output$sigpic <- renderPlot({

     graphdata = subset(long_graph, Significance=="Sig" & Effect == input$sizeselect)
     
     ##log N
     if (input$Nselect == "log") { graphdata$N = log(graphdata$N) 
                                    xlabel = "Log N" } else { xlabel = "N"}
     
     ####GRAPH####
   })
   
   ####NONSIGNIFICANT EFFECTS####
   output$nonpic <- renderPlot({
     
     nsgraphdata = subset(long_graph, Significance=="Non" & Effect == input$sizeselect)
     
     ##log N
     if (input$Nselect == "log") { nsgraphdata$N = log(nsgraphdata$N)  
                                   xlabel = "Log N" } else { xlabel = "N"}
     
     ####GRAPH####
   })
   
   ####OMNIBUS AGREEMENT####
   output$omniagree <- renderPlot({
     
     ##log n to get a better graph
     if (input$Nselect == "log") { agreelong$N = log(agreelong$N)
                                   xlabel = "Log N" } else { xlabel = "N"}
     
     ####GRAPH####
   })
   
   ####POST HOC AGREEMENT####
   output$postagree <- renderPlot({
     
     ##log n to get a better graph
     if (input$Nselect == "log") { agreelong$N = log(agreelong$N)
     xlabel = "Log N" } else { xlabel = "N"}
     
     ####GRAPH####
   })
   
   ####COMPARISON GRAPHS####
   output$compare <- renderPlot({
     
     if (input$graphselect == "pccp"){
       
       ####GRAPH####
       
     } else if (input$graphselect == "pccbf"){
       
       ####GRAPH####
       
     } else if (input$graphselect == "bfp"){
       
       ####GRAPH####
       
     }
     
   })
   
   ####3D COMPARISON GRAPHS####
   output$compare3d <- renderPlotly({
     
     ####GRAPH SET UP####
     
     overall = plot_ly(overallgraph3d, 
                       x = ~overallBF,
                       y = ~oompcc,
                       z = ~omniP,
                       color = ~N,
                       symbol = ~star,
                       symbols=c("circle","cross"),
                       mode="markers") %>%
       add_markers() %>%
       layout(scene = list(xaxis = list(title = 'Bayes Factors'),
                           yaxis = list(title = 'OOM PCC'),
                           zaxis = list(title = 'p-Value')),
              annotations = list(
                x = 1.13,
                y = 1.05,
                text = colorlabel,
                xref = 'paper',
                yref = 'paper',
                showarrow = FALSE
              ))
     
     overall
     
   })
   
} #close server functions

# Run the application 
shinyApp(ui = ui, server = server)
comments powered by Disqus