表作为基于 R 闪亮中的用户输入的输出

Question

我想构建一个 R 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("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)
)

作为输出，我想为每个输入返回一个包含新行的表，例如使用“提交”按钮时，三列（日期、杰克得分、琼斯得分）和表格末尾的一行将两个得分列相加。我尝试使用 renderTable 函数，但到目前为止没有产生任何结果。在搜索类似问题时，我找到了使用 DT 包的解决方法。但是，它似乎已经不存在了。

我是 Shiny 的新手，所以很感激任何意见。

Answer 1

这个应用程序添加了一个总分列，它还会自动按日期对数据进行排序，以防用户没有按时间顺序添加日期。

关于我对总分行的评论，我已将总分行的行名设置为“总分”，这会将总分放在最后一行，而不是像其余行一样的行号的行。总分显示数据框中最近日期的日期，而不是最后一次用户输入的日期。

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

在下面找到一个小的工作示例。您要渲染的数据框存储在reactiveValues 中（根据Add values to a reactive table in shiny）。一旦通过observeEvent(...) 行单击按钮（我将其变成actionButton 并命名为“submitButton”），就会添加一行。

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)