Таблица как вывод на основе пользовательского ввода в R блестящий

Question

Я хочу создать приложение R Shiny, которое создает таблицу, в которой отображаются входные значения от пользователя и суммирует значения для двух числовых c входных переменных.

Я определил следующий вход

# 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

Найдите ниже маленький рабочий пример. Фрейм данных, который вы хотите отобразить, хранится в reactiveValues (согласно Добавить значения в реактивную таблицу в блестящем ). Строка добавляется после нажатия кнопки (которую я превратил в actionButton с именем submitButton) через строку observeEvent(...).

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)

Answer 2

Это приложение добавляет столбец общего балла, оно также автоматически сортирует данные по дате, на случай, если пользователь не добавляет даты в хронологическом порядке.

Что касается моего комментария к строке «Общая оценка», я установил имя строки «Общая оценка» на «Общая оценка», в результате чего итоговая оценка будет помещена в последнюю строку, а не номер строки, например для остальных рядов. Общая оценка показывает дату самой последней даты во фрейме данных, а не дату последнего пользовательского ввода.

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)