Data Frame in Shiny

Hello!

I am making an app to practice Goodness of Fit testing, and I am running into a problem with making a frequency table for the data show up in the main panel. Would you mind taking a look? As I have tried to manipulate the code, I have gotten errors saying that, "Reading from shinyoutput object is not allowed" as well as, "'data' must be 2-dimensional (e.g. data frame or matrix)." I thought I made it 2-d, but I guess not.

library(shiny)

# Define UI for application that draws a histogram, and allows for test givens
ui <- fluidPage(
  
  # Application title
  titlePanel("Goodness-of-Fit Testing Hypothesis Practice"),
  
  # Sidebar with a slider input for sample size 
  sidebarLayout(
    sidebarPanel(
      radioButtons("distribution", label = h3("Pick the type of distribution you would like to practice"), choices = c("Poisson" = "pois", "Binomial" = "binom", "Uniform" = "unif")),
      actionButton(
        inputId = "submit_dist",
        label = "Press for new distribution"),
      numericInput("teststatistic", "What is your calculated chi-squared test statistic?", ""),
      actionButton(
        inputId = "submit_guess",
        label = "Press to submit"),
      tags$style("body{background-color: white; color: black}")
    ),
    mainPanel(
      plotOutput("distPlot"),
      dataTableOutput("table1")
    )
))

# Define server logic required to make a histogram
server <- function(input, output){
  
  x_val <- eventReactive(input$submit_dist, {
    
    seed1 <- sample.int(1000000, 1)
    set.seed(seed1)
    n1 <- 250
    lambda1 <- sample.int(10, 1)
    size1 <- sample.int(100, 1)
    sampleprop <- sample(c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9), 1)
    
    if(input$distribution == "Poisson"){
      rpois(n1, lambda1)
    }
    else if(input$distribution == "Binomial"){
      rbinom(n1, size1, sampleprop)
    }
    else (input$distribution == "Uniform")
    {
     runif(n1, max = lambda1) 
    }
    })
  
  output$distPlot <- renderPlot({
    hist(req(x_val()),
         main = "Distribution",
         xlab = "Sample Values",
         ylab = "Frequency Count",
         col = "darkgray",
         border = "white") })  #I took the breaks out because it wasn't making a good graph...here's the code I was using "breaks = ceiling(max(req(x_val())))"
  
  #making the table
  
  table1 <- eventReactive(output$distPlot, {
  
    Frequency <- c(rep(NA, ceiling(max(x_val()))))
    
    for(i in 1:ceiling(max(x_val()))){
      Frequency[i] <- length(x_val[x_val() <= i & x_val() > (i-1)])
    }
    
    expvals <- rep((1/ceiling(max(x_val()))), ceiling(max(x_val())))
    expvals <- expvals*n1
    
    data.frame(c(1:length(Frequency)), Frequency, c(1:5))
  })
  
  

  output$table1 <- renderDataTable(req(table1()))
    
    #eventReactive(output$distPlot, {renderDataTable(table1)})

}

# Run the application 
shinyApp(ui = ui, server = server)

Thank you for your help!

Hello! This is my first answer, so please let me know if I misinterpreted anything!

Three things stand out to me in your code:

  1. you call data.frame(c(1:length(Frequency)), Frequency, c(1:5)). This will break whenever Frequency has a length that isn't a multiple of 5. Is that always guaranteed to be the case?
> Frequency <- 1:8
> data.frame(c(1:length(Frequency)), Frequency, c(1:5))
Error in data.frame(c(1:length(Frequency)), Frequency, c(1:5)) : 
  arguments imply differing number of rows: 8, 5
  1. You assign table1 to be an eventReactive that responds to output$distPlot, which I think is what is causing your error. I don't think reactive events are supposed to be linked to outputs? In this case, I assume that you want table1 to update every time distPlot does, right? For that, just being a normal reactive is good enough: since it requires x_val, it will update each time x_val changes, just like distPlot. So they should update at the same time.

  2. You call x_val() a lot in the table1 code. Do you actually need to run the function that many times? Instead, you can say x_val <- x_val() first, and then you'll only be running the function once in the table1 code.

Here's an updated version of your code that might do what you want:

library(shiny)

# Define UI for application that draws a histogram, and allows for test givens
ui <- fluidPage(
  
  # Application title
  titlePanel("Goodness-of-Fit Testing Hypothesis Practice"),
  
  # Sidebar with a slider input for sample size 
  sidebarLayout(
    sidebarPanel(
      radioButtons("distribution", label = h3("Pick the type of distribution you would like to practice"), choices = c("Poisson" = "pois", "Binomial" = "binom", "Uniform" = "unif")),
      actionButton(
        inputId = "submit_dist",
        label = "Press for new distribution"),
      numericInput("teststatistic", "What is your calculated chi-squared test statistic?", ""),
      actionButton(
        inputId = "submit_guess",
        label = "Press to submit"),
      tags$style("body{background-color: white; color: black}")
    ),
    mainPanel(
      plotOutput("distPlot"),
      dataTableOutput("table1")
    )
  ))

# Define server logic required to make a histogram
server <- function(input, output){
  
  x_val <- eventReactive(input$submit_dist, {
    
    seed1 <- sample.int(1000000, 1)
    set.seed(seed1)
    n1 <- 250
    lambda1 <- sample.int(10, 1)
    size1 <- sample.int(100, 1)
    sampleprop <- sample(c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9), 1)
    
    if(input$distribution == "Poisson"){
      rpois(n1, lambda1)
    }
    else if(input$distribution == "Binomial"){
      rbinom(n1, size1, sampleprop)
    }
    else (input$distribution == "Uniform")
    {
      runif(n1, max = lambda1) 
    }
  })
  
  output$distPlot <- renderPlot({
    hist(req(x_val()),
         main = "Distribution",
         xlab = "Sample Values",
         ylab = "Frequency Count",
         col = "darkgray",
         border = "white") })  #I took the breaks out because it wasn't making a good graph...here's the code I was using "breaks = ceiling(max(req(x_val())))"
  
  #making the table
  
  table1 <- reactive({
    x_val <- x_val()
    
    Frequency <- c(rep(NA, ceiling(max(x_val))))
    
    for(i in 1:ceiling(max(x_val))){
      Frequency[i] <- length(x_val[x_val <= i & x_val > (i-1)])
    }
    
    expvals <- rep((1/ceiling(max(x_val))), ceiling(max(x_val)))
    expvals <- expvals*n1
    
    data.frame(c(1:length(Frequency)), Frequency)
  })
  
  
  
  output$table1 <- renderDataTable(req(table1()))
  
}

# Run the application 
shinyApp(ui = ui, server = server)

Output:

Hi Julian,

Yes, that is exactly what I was trying to do! I was testing it to try to understand what was going with the data frame in another R script, and accidentally forgot to remove the c(1:5).

Thank you for your help! I'm working on learning shiny on my own, and this was very helpful for understanding reactive versus eventReactive. That makes sense that eventReactives can't be linked to outputs, because I tried to do something similar when producing the histogram and it also didn't work.

Thank you again!

1 Like

Hi again,

I've gotten a bit farther, but now I'm stuck as I'm trying to make a data table that gives the counts of the numbers in each of the bins as shown in the figure. I'm trying to make it dynamic so that it changes as the user changes the number of bins. Do you have any suggestions @julianstanley ? My code is below.

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(
  
  # Application title
  titlePanel("Goodness-of-Fit Testing Hypothesis Practice"),
  
  # Sidebar with a slider input for sample size 
  sidebarLayout(
    sidebarPanel(
      radioButtons("distribution", label = h3("Pick the type of distribution you would like to practice"), choices = c("Poisson" = "pois", "Binomial" = "binom", "Uniform" = "unif")),
      actionButton(
        inputId = "submit_dist",
        label = "Press for new distribution"),
      sliderInput("bins", h3("Enter the number of bins"), min = 5, max = 15, value = 10, step = 1),
      numericInput("teststatistic", "What is your calculated chi-squared test statistic?", ""),
      actionButton(
        inputId = "submit_guess",
        label = "Press to submit"),
      tags$style("body{background-color: white; color: black}")
    ),
    mainPanel(
      plotOutput("distPlot"),
      dataTableOutput("table1")
    )
))

# Define server logic required to make a histogram
server <- function(input, output){
  
  x_val <- eventReactive(input$submit_dist, {
    
    seed1 <- sample.int(1000000, 1)
    set.seed(seed1)
    n1 <- 250
    lambda1 <- sample.int(5:15, 1)
    size1 <- sample.int(10:100, 1)
    sampleprop <- sample(c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9), 1)
    
    if(input$distribution == "Poisson"){
      rpois(n1, lambda1)
    }
    else if(input$distribution == "Binomial"){
      rbinom(n1, size1, sampleprop)
    }
    else (input$distribution == "Uniform")
    {
      runif(n1, max = lambda1) 
    }
  })
  
  bins <- reactive({input$bins})
  
  output$distPlot <- renderPlot({
    
    bins1 <- bins()
    
    hist(req(x_val()),
         main = "Distribution",
         xlab = "Sample Values",
         ylab = "Frequency Count",
         col = "darkgray",
         border = "white", breaks = bins1)})  #I took the breaks out because it wasn't making a good graph...here's the code I was using "breaks = ceiling(max(req(x_val())))"
  
  #making the table
  
  table1 <- reactive({
    
    x_val <- x_val()
    bins1 <- bins()
    
    #Frequency <- c(rep(NA, bins1))
    
    #for(i in 1:bins1){
    #   Frequency[i] <- length(x_val[x_val <= i & x_val > (i-1)])
    #}
    
    #expvals <- rep((1/ceiling(max(x_val))), ceiling(max(x_val)))
    #expvals <- expvals*n1
    
    data.frame(c(1:length(hist(x_val, breaks = bins1)$counts)), hist(x_val, breaks = bins1)$counts)
  })
  
  
  
  output$table1 <- renderDataTable(req(table1()))
  
}

# Run the application 
shinyApp(ui = ui, server = server)

Thank you.

plotly may be a good option for that, e.g.: https://community.plotly.com/t/how-to-label-the-histogram-bars-with-its-respective-frequency-counts-for-each-bin/3848/2 -- or, just the default tooltip will have counts when you hover

Edit: Ahh, I misread your original post: for some reason, I thought you were talking about making a histogram with counts labeled in the bins. So, glad that hadley posted below!

1 Like

The code to make a reactive table is relatively straightforward once you do a little refactoring of your existing server function to make the structure more clear:

server <- function(input, output) {
  x_val <- eventReactive(input$submit_dist, {
    simulate(input$distribution)
  })

  output$distPlot <- renderPlot({
    hist(x_val(), breaks = input$bins)
  })
  
  output$table <- renderTable({
    data <- hist(x_val(), breaks = input$bins, plot = FALSE)
    data.frame(counts = data$counts)
  })
}

Here I've pulled out a separate simulate function so the logic can live outside the app, removed the redundant req() (which doesn't appear to do anything hear), and removed the bins reactive since it was just a wrapper around an input. I also removed all the histogram display tweaking since that's not related to the problem at hand, and just makes it harder to see the overall structure.

When I pulled out the simulation code I also simplified it by using switch(), which I think makes the structure more clear:

simulate <- function(dist, n = 250) {
  lambda1 <- sample.int(5:15, 1)
  size1 <- sample.int(10:100, 1)
  sampleprop <- sample(c(0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9), 1)

  switch(dist,
    pois = rpois(n, lambda1),
    binom = rbinom(n, size1, sampleprop),
    unif = runif(n, max = lambda1),
    stop("Unknown `dist`")
  )
}

I also simplified your UI to make it easier to understand what the structure is:

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      radioButtons("distribution", label = "dist", choices = c("Poisson" = "pois", "Binomial" = "binom", "Uniform" = "unif")),
      actionButton("submit_dist", "simulate"),
      sliderInput("bins", "bins", min = 5, max = 15, value = 10, step = 1),
    ),
    mainPanel(
      plotOutput("distPlot"),
      tableOutput("table")
    )
  )
)
2 Likes

Got it. That is very helpful. Thank you for your help!

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.