Question

我有一个按钮，当您单击它时，它会显示一个表格，当您单击一行时，它会在 verbatimTextOutput

中显示行号

我有一个反应变量 o（），它保存了所有已选择的行，并且当未选择任何行时，它均显示“ nothing”。

启动应用程序时，它显示几次“无”，我不明白为什么。

在启动应用程序时，如何重做代码以避免出现这些多次出现？

library(shiny)

ui <- fluidPage(
  DT::dataTableOutput("table"),
  verbatimTextOutput("output", placeholder = TRUE),
  actionButton("updateTable", "Show data table")
)

server <- function(input, output) {

  dt <- reactiveVal()
  o <- reactiveVal()

  val <- reactive(
    tail(
      as.character(dt()[input$table_rows_selected, 2]),
      n=1)
  )

  val2 <- reactiveVal()    

  observeEvent(input$updateTable, {
    # the datatable
    dt(data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10)))
    output$table <- DT::renderDataTable({
      DT::datatable(dt(), selection = list(target = 'row'))
    })
    if(is.null(val())){ val2("nothing")}
  })

  observeEvent(val(), {
    if(length(input$table_rows_selected) > 0){
      val2(val())
      o(c(o(), "\n", "You chose :", val2()))
    } else{
      val2("nothing")
      o(c(o(), "\n", "You chose :", val2()))
    }
    output$output <- renderText({ o() })
  })
}

shinyApp(ui = ui, server = server)

解决方案1 

library(shiny)

ui <- fluidPage(
  DT::dataTableOutput("table"),
  verbatimTextOutput("output", placeholder = TRUE),
  actionButton("showTable", "Show data table")
)

server <- function(input, output) {

  val <- reactiveVal()
  o   <- reactiveVal()
  dt  <- reactiveVal()

  observe({
    val(as.character(dt()[input$table_rows_selected, 2]))
  })


  observeEvent(input$showTable, {
    dt(data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10)))
    output$table <- DT::renderDataTable({
      DT::datatable(dt(), selection = list(target = 'row'))
    })
    o(c(o(), "\n", "Display of the table"))
  })


  output$output <- renderText({
    if(input$showTable)
    {
      if(!identical(val(), character(0))){
        o(c( isolate(o()), "\n", "You chose: ", isolate(val())))
      } else{
        o(c( isolate(o()), "\n", "You chose: ", "nothing"))
      }
      o()
    }
  })
}

shinyApp(ui = ui, server = server)

解决方案2

library(shiny)

ui <- fluidPage(
  DT::dataTableOutput("table"),
  verbatimTextOutput("output", placeholder = TRUE),
  actionButton("showTable", "Show data table")
)

server <- function(input, output) {

  o   <- reactiveVal()
  dt  <- reactiveVal()

  observeEvent(input$showTable, {
    dt(data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10)))
    output$table <- DT::renderDataTable({
      DT::datatable(dt(), selection = list(target = 'row'))
    })
    o(c(o(), "\n", "Display of the table"))
  })

  val <- reactive({
    if(!is.null(input$table_rows_selected)){
      tail(
        as.character(dt()[input$table_rows_selected, 2]),
        n = 1
      )
    } else{ "nothing" }
  })

  observeEvent(val(), {
    if(input$showTable)
    {
      o(c(o(), "\n", "You chose: ", val()))
    }

  })

  output$output <- renderText({ o() })
}

shinyApp(ui = ui, server = server)

Answer 1

这是由于显示该表时您的反应性值正在更新。最简单的解决方案是删除将"\n", "You chose :", val2()添加到列表中，并将其作为o()的默认选项。

请参见下面的代码：

library(shiny)

ui <- fluidPage(
  DT::dataTableOutput("table"),
  verbatimTextOutput("output", placeholder = TRUE),
  actionButton("updateTable", "Show data table")
)

server <- function(input, output) {

  dt <- reactiveVal()
  o <- reactiveVal()

  val <- reactive(
    tail(
      as.character(dt()[input$table_rows_selected, 2]),
      n=1)
  )

  val2 <- reactiveVal()    

  observeEvent(input$updateTable, {
    # the datatable
    dt(data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10)))
    output$table <- DT::renderDataTable({
      DT::datatable(dt(), selection = list(target = 'row'))
    })
    if(is.null(val())){ val2("nothing")}
  })

  observeEvent(val(), {
    if(length(input$table_rows_selected) > 0){
      val2(val())
      o(c(o(), "\n", "You chose :", val2()))
    } else{
      val2("nothing")
      o(c("\n", "You chose :", val2()))
    }
    output$output <- renderText({ o() })
  })
}

shinyApp(ui = ui, server = server)

已更新

library(shiny)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  DT::dataTableOutput("table"),
  verbatimTextOutput("output", placeholder = TRUE),
  actionButton("updateTable", "Show data table")
)

server <- function(input, output) {

  #Data table
  dt <- data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10))

  output$table <- DT::renderDataTable({
    DT::datatable(dt, selection = list(target = 'row'))
  })

  shinyjs::hide("table")


  #Button
  observeEvent(input$updateTable, {
    shinyjs::show("table")
    shinyjs::show("output")
  })


  #Value Box
  o <- reactiveVal()

  val <- reactive({
    tail(
      as.character(dt[input$table_rows_selected, 2]), 
      n = 1
    )
  })

  observeEvent(val(), {
      if(length(input$table_rows_selected) > 0){
        o(c(o(), "\n", "You chose :", val()))
      } else{
        req(o())
        o(c(o(), "\n", "You chose : nothing"))
      }
  })

  output$output <- renderText({ o() })
  shinyjs::hide("output")
}

shinyApp(ui = ui, server = server)

Answer 2

您的方法太复杂了。这是一种简化的方法-

library(shiny)

ui <- fluidPage(
  DT::dataTableOutput("table"),
  verbatimTextOutput("output", placeholder = TRUE),
  actionButton("updateTable", "Show data table")
)

server <- function(input, output) {

  val <- reactiveVal()

  dt <- eventReactive(input$updateTable, {
    # the datatable
    data.frame("a" = paste("a", 1:10), "b" = paste("b", 1:10))
  })

  output$table <- DT::renderDataTable({
      DT::datatable(dt(), selection = list(target = 'row'))
  })

  observe({
    val(c(isolate(val()), as.character(dt()[input$table_rows_selected, 2])))
  })

  output$output <- renderText({ paste0("\n You chose :", unique(val())) })
}

shinyApp(ui = ui, server = server)

避免在启动应用程序时多次启动ObserveEvent

2 个答案: