Help Requested - Operation Aborted, Feedback Failing, and Score Counter Not Functioning

Hello! I have gotten a bit farther working on my shiny R code. I am trying to make a game for students to practice estimating the standard deviation of a set of data using a histogram and a chosen sample size. I am having trouble making it a scored game where the student must submit their guess, followed by feedback and a change in their score.

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(
    
    # Application title
    titlePanel("Standard Deviation Estimation Practice"),
    
    # Sidebar with a slider input for sample size 
    sidebarLayout(
        sidebarPanel( 
            sliderInput("samplesize", h3("Enter a positive whole number as a sample size"), min = 10, max = 500, value = 250),
            actionButton(
                inputId = "submit_hist",
                label = "Press for new Histogram"),
            numericInput("guess", "What is your estimation of the standard deviation of the data in the histogram?", ""),
            actionButton(
                inputId = "submit_guess",
                label = "Press to Submit Guess"),
            tags$style("body{background-color: white; color: black}")
        ),
        # Show a plot of the generated distribution
        mainPanel(
            plotOutput("distPlot"),
            textOutput("result")
        )
    ),
    sidebarLayout(
        sidebarPanel("Made for Introductory Statistics for Biology", width = 3),
        mainPanel("score"),
))


# Define server logic required to make a histogram
server <- function(input, output){
    x_val <- eventReactive(input$submit_hist, {
        seed1 <- sample.int(1000000, 1)
        set.seed(seed1)
        sd1 <- sample.int(25, 1)
        mean1 <- sample((-300):400, 1)
        rnorm(n = req(input$samplesize), mean = mean1, sd = sd1)
    })
    
    y_val <- eventReactive(input$submit_hist, {
        sd(req(x_val()))}
        )
    
    output$distPlot <- renderPlot({
        # draw the histogram with the specified sample size
        hist(req(x_val()),
             main = "Histogram",
             xlab = "Sample Values",
             ylab = "Frequency Count",
             col = "darkgray",
             border = "white"
        )
    })
    
    output$result <-
        
        eventReactive(input$submit_guess, {
        q <- input$guess
        
        
        # print(y_val())
        ifelse(q() >= (y_val() - 1.0), ifelse(q() <= (y_val() + 1.0), 
                                            "That is a correct estimation! Good job! Enter a new sample size.", 
                                            "That estimate is too big. Try again!"),
               "That estimate is too small. Try again!")
        
        
    })

    output$score <- {counter <- reactiveValues(countervalue = 0)
    observeEvent({(q() >= (y_val() - 1.0)) & (q() <= (y_val() + 1.0))}, {
        counter$countervalue = counter$countervalue + 1})
    observeEvent({(q() <= (y_val() - 1.0)) | (q() >= (y_val() + 1.0))}, {
        counter$countervalue = counter$countervalue + 0})
    
    output$score <- renderText({paste("Your Score is ", counter$countervalue)})
    }
    }
# Run the application 
shinyApp(ui = ui, server = server)

below is the code for a simpler version of the app that worked before (thanks for the help, Nir)

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(
  
  # Application title
  titlePanel("Standard Deviation Estimation Practice"),
  
  # Sidebar with a slider input for sample size 
  sidebarLayout(
    sidebarPanel( 
      sliderInput("samplesize", h3("Enter a positive whole number as a sample size"), min = 10, max = 500, value = 250),
      actionButton(
        inputId = "submit_hist",
        label = "Press for new Histogram"),
      numericInput("guess", "What is your estimation of the standard deviation of the data in the histogram?", ""),
      tags$style("body{background-color: white; color: black}")
    ),
    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("distPlot"),
      textOutput("result")
    )
  ),
    sidebarPanel("Made for Introductory Statistics for Biology", width = 3) 
  )


# Define server logic required to make a histogram
server <- function(input, output){
  x_val <- eventReactive(input$submit_hist, {
    seed1 <- sample.int(1000000, 1)
    set.seed(seed1)
    sd1 <- sample.int(25, 1)
    mean1 <- sample((-300):400, 1)
    rnorm(n = req(input$samplesize), mean = mean1, sd = sd1)
  })
  
  y_val <- reactive({
    sd(req(x_val()))
  })
  
  output$distPlot <- renderPlot({
    # draw the histogram with the specified sample size
    hist(req(x_val()),
         main = "Histogram",
         xlab = "Sample Values",
         ylab = "Frequency Count",
         col = "darkgray",
         border = "white"
    )
  })
  
  output$result <- renderText({
    q <- req(input$guess)
    
    if (!isTruthy(q)) {
      return(NULL)
    }
    
    # print(y_val())
    ifelse(q >= (y_val() - 1.0), ifelse(q <= (y_val() + 1.0), 
                                        "That is a correct estimation! Good job! Enter a new sample size.", 
                                        "That estimate is too big. Try again!"),
                                        "That estimate is too small. Try again!")
  })
}

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

Now it aborts the program when running all together. Thank you for your help.

Hello,
firstly mainPanel("score") when you want a textoutput called score should be like
mainPanel( textOutput("score"))
You've mistakenly started to refer to q (which is only an alias for input$guess) as q(),
and also in later steps where the q is out of scope

finally, you have an outer output$score <- definition which wraps another output$score <-
this is not going to work :slight_smile:

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(
  
  # Application title
  titlePanel("Standard Deviation Estimation Practice"),
  
  # Sidebar with a slider input for sample size 
  sidebarLayout(
    sidebarPanel( 
      sliderInput("samplesize", h3("Enter a positive whole number as a sample size"), min = 10, max = 500, value = 250),
      actionButton(
        inputId = "submit_hist",
        label = "Press for new Histogram"),
      numericInput("guess", "What is your estimation of the standard deviation of the data in the histogram?", ""),
      actionButton(
        inputId = "submit_guess",
        label = "Press to Submit Guess"),
      tags$style("body{background-color: white; color: black}")
    ),
    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("distPlot"),
      textOutput("result")
    )
  ),
  sidebarLayout(
    sidebarPanel("Made for Introductory Statistics for Biology", width = 3),
    mainPanel(
      textOutput("totalguess"),
      textOutput("score")
  )))

# Define server logic required to make a histogram
server <- function(input, output){
  counter <- reactiveValues(correct = 0,
                            guess=0)

  x_val <- eventReactive(input$submit_hist, {
    seed1 <- sample.int(1000000, 1)
    set.seed(seed1)
    sd1 <- sample.int(25, 1)
    mean1 <- sample((-300):400, 1)
    rnorm(n = req(input$samplesize), mean = mean1, sd = sd1)
  })
  
  y_val <- eventReactive(input$submit_hist, {
    sd(req(x_val()))}
  )
  
  output$distPlot <- renderPlot({
    # draw the histogram with the specified sample size
    hist(req(x_val()),
         main = "Histogram",
         xlab = "Sample Values",
         ylab = "Frequency Count",
         col = "darkgray",
         border = "white"
    )
  })
  # browser()

  output$result <-eventReactive(input$submit_guess, {
      q <- input$guess
      
      if(q < (y_val() - 1.0)){
        counter$guess = counter$guess + 1
        return("That estimate is too small. Try again!")
      } else if(q > (y_val() + 1.0)){
        counter$guess = counter$guess + 1
        return("That estimate is too big. Try again!")
      } else {
        counter$correct = counter$correct +1
        return("That is a correct estimation! Good job! Enter a new sample size.")
      }
    })
 
  
  output$score <- renderText({paste("Your Score is ", counter$correct)})  
  output$totalguess <- renderText({paste("Your guesses ", counter$guess)})

}
# Run the application 
shinyApp(ui = ui, server = server)
1 Like

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