Problems with form data in RShiny

shiny
1

Hi.

I'm new to developing RShiny apps and am having trouble creating a form in which a user (1) selects a response, (2) and scores the responses by pressing the "submit" button. I've created a simplified ReprEx below.

require(shiny)
require(tidyverse)

fieldsAll <- c("nervous")

saveData <- function(data) 
{
  data <- as.data.frame(t(data))
  if (exists("responses"))
  {
    responses <<- rbind(data)
  } else {
    responses <<- data
  }

  score <<-(apply(responses, 1, sum))
  
  names(responses) <- c('Feeling nervous/on edge')
}


loadData <- function() {
  if (exists("responses")) {
    responses
  }
}

loadScore <- function() {
  if (exists("score")) {
    score
  }
}

resp.options <- c('Not at all' = 0, 'Several days' = 1, 'More than half the days' = 2, 'Nearly every day' = 3)


ui <- fluidPage(
  titlePanel("Flawed Example"),
  fluidRow(
    column(6,
           selectInput("nervous", "Over the last 2 weeks, how much have you been bothered by feeling nervous or on edge?", 
                       resp.options),
           textOutput("score"),
    ),
  ),
  fluidRow(
    actionButton("submit", "Submit")
  ),
  fluidRow(
    DT::dataTableOutput("responses", width = 200),
    tags$hr()
  )
  
)

server <- function(input, output, session) {
  
  # Whenever a field is filled, aggregate all form data
  formData <- reactive({
    data <- sapply(fieldsAll, function(x) input[[x]])
    data
  })
  
  # When the Submit button is clicked, save the form data
  observeEvent(input$submit, {
    saveData(formData())
  })
  
  # Show the previous responses
  # (update with current response when Submit is clicked)
  output$responses <- DT::renderDataTable({
    input$submit
    loadData()
  },
  options=list(dom = 't',
               ordering = FALSE)
  )
  
}
shinyApp(  ui = ui, server = server)

Thanks in advance.
Ethan

2

I would probably do it like this:

require(shiny)
require(tidyverse)

fieldsAll <- c("nervous","other")

resp.options <- c('Not at all' = 0, 'Several days' = 1, 'More than half the days' = 2, 'Nearly every day' = 3)


ui <- fluidPage(
  titlePanel("Flawed Example"),
  fluidRow(
    column(6,
           selectInput("nervous", "Over the last 2 weeks, how much have you been bothered by feeling nervous or on edge?", 
                       resp.options),
           selectInput("other", "Over the last 2 weeks, how much have you been bothered by feeling nervous or on edge?", 
                       resp.options),
           textOutput("score"),
    ),
  ),
  fluidRow(
    actionButton("submit", "Submit")
  ),
  fluidRow(
    DT::dataTableOutput("responses", width = 200),
    tags$hr()
  )
  
)

server <- function(input, output, session) {
  formLog <- reactiveVal(NULL)
  # Whenever a field is filled, aggregate all form data
  formData <- reactive({
    map(fieldsAll,~input[[.x]]) %>% 
      set_names(fieldsAll) %>% 
      as_tibble(data)

  })
  
  # When the Submit button is clicked, save the form data
  observeEvent(input$submit, {
    formLog(
      bind_rows(formLog(),formData()))
            
  })
 
table_to_show <- eventReactive(input$submit, {
  formLog()
})
    
  # Show the previous responses
  # (update with current response when Submit is clicked)
  output$responses <- DT::renderDataTable({
    req(table_to_show())
  },
  options=list(#dom = 't',
               ordering = FALSE)
  )
  
}
shinyApp(  ui = ui, server = server)
1 Like
3

Thank you, this is helpful.

What if I wanted to remove the search bar at the top of the data table?

4

https://rstudio.github.io/DT/options.html
Check the 4.2 Dom options, it also links to datatable documentation 5mthat lists them out.

1 Like