r - 从 Shiny 的输入创建数据框

Question

我正在尝试创建一个 Shiny 的应用程序，我可以在其中从侧边栏面板输入输入，以在名为表格的第二个选项卡面板上创建数据框。我可以有 1 行数据，但是当我按下提交按钮时，它会刷新这些数据，而不是添加另一行。非常感谢您的帮助。

这是我的代码:

library(shiny)
library(ggplot2)


ui <- fluidPage(
  titlePanel("Team"),
  tags$img(height = 100, width = 100,
           src = "Logo"),
    sidebarPanel(
    textInput(inputId = "date",
            label = "Date", 
            value = "yyyy/mm/dd"),
  textInput(inputId = "team",
            label = "Team Name", 
            value = "Team Name"),
  textInput(inputId = "pnumber",
            label = "Player Number", 
            value = "#"),
  selectInput("shot", "shot type:",
              list(`Shot Type` = list("wrist shot", "slap shot", "snap shot"))),
  selectInput("situation", "scoring opportunity:",
              list(`Green` = list("Double cross", "dot line pass"),
                   `Yellow` = list("2vs1", "same side quick"),
                   `Red` = list("clear", "wrap"))),
  submitButton("Add")),
  
  mainPanel(tabsetPanel(
            tabPanel("Track", plotOutput(outputId = "hockeyplot")),
            tabPanel("Data", tableOutput(outputId = "table")),
            tabPanel("Chart", plotOutput(outputId = "chart")))),)
  

server <- function(input, output){
  Reactive_Var<-reactive({
    results=data.frame(Date = input$date, Team = input$team, Player = input$pnumber, ShotType = input$shot, Situation = input$situation)})
  observeEvent(input$Add, {df<- data.frame(Date = input$date, Team = input$team, Player = input$pnumber, ShotType = input$shot, Situation = input$situation)})
  output$table<-renderTable({
    Reactive_Var()
  })
  
}

shinyApp(ui = ui, server = server)
```

Answer 1

这是一种方法:

首先，将使用 actionButton 而不是 submitButton (这通常是更可取的)。请参阅here使用操作按钮了解更多信息。

其次，您可以创建一个存储在 reactiveValues 中的空数据框(默认)。选择“添加”按钮后，将使用 rbind 将新行数据添加到此数据框中。

然后，renderTable 将显示更新后的 reactiveValues 数据框。

library(shiny)
library(ggplot2)

ui <- fluidPage(
  titlePanel("Team"),
  tags$img(height = 100, width = 100,
           src = "Logo"),
  sidebarPanel(
    textInput(inputId = "date",
              label = "Date", 
              value = "yyyy/mm/dd"),
    textInput(inputId = "team",
              label = "Team Name", 
              value = "Team Name"),
    textInput(inputId = "pnumber",
              label = "Player Number", 
              value = "#"),
    selectInput("shot", "shot type:",
                list(`Shot Type` = list("wrist shot", "slap shot", "snap shot"))),
    selectInput("situation", "scoring opportunity:",
                list(`Green` = list("Double cross", "dot line pass"),
                     `Yellow` = list("2vs1", "same side quick"),
                     `Red` = list("clear", "wrap"))),
    actionButton("Add", "Add")),
  
  mainPanel(tabsetPanel(
    tabPanel("Track", plotOutput(outputId = "hockeyplot")),
    tabPanel("Data", tableOutput(outputId = "table")),
    tabPanel("Chart", plotOutput(outputId = "chart")))))


server <- function(input, output){
  
  rv <- reactiveValues(
    df = data.frame(
      Date = as.Date(character()),
      Team = character(),
      Player = character(),
      ShotType = character(),
      Situation = character()
    )
  )
  
  observeEvent(input$Add, {
    rv$df <- rbind(rv$df, data.frame(Date = input$date, 
                                     Team = input$team, 
                                     Player = input$pnumber, 
                                     ShotType = input$shot, 
                                     Situation = input$situation))
  })
  
  output$table<-renderTable({
    rv$df
  })
  
}

shinyApp(ui = ui, server = server)