Table as output based on user input in R shiny

Question

I want to build an R Shiny app which creates a table showing input values from user and sums the up for the two numeric input variables.

I have defined the following input

# Define UI for application that returns table based on input values
ui <- fluidPage(

    # Application title
    titlePanel("Jack & Jones battle over the Castle!"),

    # Input
    dateInput('date', "Choose today's date:", value = NULL, min = NULL, max = NULL,
              format = "yyyy-mm-dd", startview = "month", weekstart = 0,
              language = "en", width = NULL),
    numericInput("Score Jack", label = "Submit Score Jack", value = 0, min = 0, max = 300, step = 1, width = '10%'),
    numericInput("Score Jones", label = "Submit Score Jones", value = 0, min = 0, max = 300, step = 1, width = '10%'),
    submitButton("Submit Scores", icon("Submit") , width = NULL)
)

As an output I would like to return a table with a new row for each of the inputs e.g. three columns (date, score Jack, score Jones) and a row at the end of the table to sum the two score columns when the 'Submit' button is used. I've tried to work with the renderTable function, but so far yielded no results. When searching for similar questions, I found work arounds using the DT package. However, it does no seem to exist anymore.

I'm new to Shiny so would appreciate any input.

Answer 1

This app adds a total score column, it also automatically sorts the data by date, just in case a user does not add dates chronologically.

With regards to my comment about the Total Score row, I've set the row name of the total score row to "Total Score", which will put Total Score in the final row rather than the row number like for the rest of the rows. The total score shows the date of the most recent date in the data frame rather than the date of the last user input.

library(shiny)

ui <- fluidPage(

  # Application title
  titlePanel("Jack & Jones battle over the Castle!"),

  # Input
  dateInput('date', "Choose today's date:", value = NULL, min = NULL, max = NULL,
            format = "yyyy-mm-dd", startview = "month", weekstart = 0,
            language = "en", width = NULL),
  numericInput("Score Jack", label = "Submit Score Jack", value = 0, min = 0, max = 300, step = 1, width = '10%'),
  numericInput("Score Jones", label = "Submit Score Jones", value = 0, min = 0, max = 300, step = 1, width = '10%'),
  actionButton("submit", "Submit Scores", icon("Submit") , width = NULL, style="color: #fff; background-color: #337ab7; border-color: #2e6da4"), 
  DT::DTOutput("score_table")
)

table_data <- data.frame(Date = as.Date(as.character()), `Score Jack` = as.numeric(), `Score Jones` = as.numeric(), check.names = FALSE)

server <- function(input, output, session) {

  tableValues <- reactiveValues(df = data.frame(Date = as.Date(as.character()), `Score Jack` = as.numeric(), `Score Jones` = as.numeric(), check.names = FALSE))


  observeEvent(input$submit, {

    temp <- tableValues$m

    newRow <- data.frame(Date = input$date, `Score Jack` = input$`Score Jack`, `Score Jones` = input$`Score Jones`, check.names = FALSE)


    if(!is.null(temp)) {

      if(isolate(input$date) < temp[nrow(temp), 1]) {
        temp <- rbind(temp, newRow)
        temp <- dplyr::arrange(temp, Date)
      } else {
        temp <- rbind(temp, newRow)
      }
    } else {
      temp <- rbind(temp, newRow)
    }

    tableValues$m <- temp

  })


  output$score_table <- DT::renderDataTable({

    if(!is.null(tableValues$m)){

      table_data <- tableValues$m

      totalScore <- data.frame(Date = table_data[nrow(table_data),1], `Score Jack` =  sum(table_data$`Score Jack`), `Score Jones` = sum(table_data$`Score Jones`), check.names = FALSE)

      table_data <- rbind(table_data, totalScore)

      if(nrow(table_data > 2)){
        table_data <- dplyr::arrange(table_data, Date)
      }
    }
    rownames(table_data)[nrow(table_data)] <- "Score Total"
    table_data

  })

  observe({print(colnames(tableValues$m))})
  observe({print(!is.null(tableValues$m))})

}

shinyApp(ui, server)

Answer 2

Find below a small working example. The data frame you want to render is stored in a reactiveValues (as per Add values to a reactive table in shiny). A row is added once the button (which I turned into an actionButton and named "submitButton") is clicked, via the observeEvent(...) line.

library(shiny)

# Define UI for application that returns table based on input values
ui <- fluidPage(

    # Application title
    titlePanel("Jack & Jones battle over the Castle!"),

    # Input
    dateInput('date', "Choose today's date:", value = NULL, min = NULL, max = NULL,
              format = "yyyy-mm-dd", startview = "month", weekstart = 0,
              language = "en", width = NULL),
    numericInput("scoreJack", label = "Submit Score Jack", value = 0, min = 0, max = 300, step = 1, width = '10%'),
    numericInput("scoreJones", label = "Submit Score Jones", value = 0, min = 0, max = 300, step = 1, width = '10%'),
    actionButton("submitButton", "Submit Scores", icon("Submit") , width = NULL),

    # Output
    tableOutput("table")
)

# Define server logic required to render the table
server <- function(input, output) {
    values <- reactiveValues()
    values$df <- data.frame(data = character(), jack = character(), jones = character())

    observeEvent(input$submitButton, {
        new_row <- data.frame(data = strftime(input$date, "%Y-%m-%d"), jack = input$scoreJack, jones = input$scoreJones)
        values$df <- rbind(values$df, new_row)
    })

    output$table <- renderTable(values$df)
}

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