r - 如何创建删除最后一个输入/行的操作按钮（通过单击输入），但能够继续在 R 中输入数据闪亮

Question

我正在尝试插入一个操作按钮，该按钮将删除最后一个输入/数据行（通过单击输入），但我希望能够通过随后单击来继续输入数据。我总结我有一个数据框，每次单击绘图时都会累积数据，我想要一个操作按钮来删除最后一次单击和数据框中随之而来的数据，但我希望之后能够继续。我尝试了一个简单的解决方案，因为我觉得它应该很简单，但我无法得到它。非常感谢您的帮助。

library(shiny)
library(ggplot2)

ui <- fluidPage(
  titlePanel("team"),
  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"),
                     `Red` = list("clear", "wrap"))),
    actionButton("reset", "Clear")),
  mainPanel(tabsetPanel(
    tabPanel("Track", plotOutput(outputId = "hockeyplot", click = "plot_click", dblclick = "plot_dblclick")),
    tabPanel("Data", tableOutput(outputId = "table"),  downloadLink("downloadData", "Download")),
    tabPanel("Chart", plotOutput(outputId = "chart")))))


server <- function(input, output){
  
  rv <- reactiveValues(
    df = data.frame(
      x = numeric(),
      y = numeric(),
      Date = as.Date(character()),
      Team = character(),
      Player = character(),
      ShotType = character(),
      Situation = character(),
      Type = factor()
    )
  )
  
  output$hockeyplot = renderPlot({ 
    ggplot(rv$df,
           aes(x = x, y = y)) + coord_flip() + lims(x = c(0, 100), y = c(42.5, -42.5))+ geom_point( aes(colour = factor(Type)), size = 5 ) + theme(legend.position = "none")})
  
  observeEvent(input$plot_click, {
    rv$df <- rbind(rv$df, data.frame(
      x = input$plot_click$y,
      y = input$plot_click$x,
      Date = input$date, 
      Team = input$team, 
      Player = input$pnumber, 
      ShotType = input$shot, 
      Situation = input$situation,
      Type = "Shot"))
  })
  
  observeEvent(input$plot_dblclick, {
    rv$df <- rbind(rv$df, data.frame(
      x = input$plot_dblclick$y,
      y = input$plot_dblclick$x,
      Date = input$date, 
      Team = input$team, 
      Player = input$pnumber, 
      ShotType = input$shot, 
      Situation = input$situation,
      Type = "Goal"))
  })
  
   observeEvent(input$reset,{
    rv$df( rv$df()[-nrow(rv$df()),])
  })
  
  output$table<-renderTable({
    rv$df
    
  })
  
  output$downloadData <- downloadHandler(
    filename = function() {
      paste("MHdata-", Sys.Date(), ".csv", sep="")
    },
    content = function(file) {
      write.csv(rv$df, file)
    }
  )
  
}

shinyApp(ui = ui, server = server)

标签： rshiny

Answer 1

您在使用 reactiveValues 时混淆了一些括号。基本上，您可以在没有(.

library(shiny)
library(ggplot2)

ui <- fluidPage(
  titlePanel("team"),
  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"),
                     `Red` = list("clear", "wrap"))),
    actionButton("reset", "Clear")),
  mainPanel(tabsetPanel(
    tabPanel("Track", plotOutput(outputId = "hockeyplot", click = "plot_click", dblclick = "plot_dblclick")),
    tabPanel("Data", tableOutput(outputId = "table"),  downloadLink("downloadData", "Download")),
    tabPanel("Chart", plotOutput(outputId = "chart")))))


server <- function(input, output){
  
  rv <- reactiveValues(
    df = data.frame(
      x = numeric(),
      y = numeric(),
      Date = as.Date(character()),
      Team = character(),
      Player = character(),
      ShotType = character(),
      Situation = character(),
      Type = factor()
    )
  )
  
  output$hockeyplot = renderPlot({ 
    ggplot(rv$df,
           aes(x = x, y = y)) + coord_flip() + lims(x = c(0, 100), y = c(42.5, -42.5))+ geom_point( aes(colour = factor(Type)), size = 5 ) + theme(legend.position = "none")})
  
  observeEvent(input$plot_click, {
    rv$df <- rbind(rv$df, data.frame(
      x = input$plot_click$y,
      y = input$plot_click$x,
      Date = input$date, 
      Team = input$team, 
      Player = input$pnumber, 
      ShotType = input$shot, 
      Situation = input$situation,
      Type = "Shot"))
  })
  
  observeEvent(input$plot_dblclick, {
    rv$df <- rbind(rv$df, data.frame(
      x = input$plot_dblclick$y,
      y = input$plot_dblclick$x,
      Date = input$date, 
      Team = input$team, 
      Player = input$pnumber, 
      ShotType = input$shot, 
      Situation = input$situation,
      Type = "Goal"))
  })
  
# NO BRACKETS NEEDED
  observeEvent(input$reset,{
    rv$df <- rv$df[-nrow(rv$df),]
  })
  
  output$table<-renderTable({
    rv$df
    
  })
  
  output$downloadData <- downloadHandler(
    filename = function() {
      paste("MHdata-", Sys.Date(), ".csv", sep="")
    },
    content = function(file) {
      write.csv(rv$df, file)
    }
  )
  
}

shinyApp(ui = ui, server = server)