Как обновить данные по нажатию кнопки actionButton? - PullRequest
0 голосов
/ 26 февраля 2019

Итак, у меня есть дата в Shiny, которую я хочу обновлять, только когда пользователь меняет входные параметры и нажимает кнопку.Ниже приведен минимальный воспроизводимый пример этого:

library(dplyr)
library(DT)
library(shiny)

ui <- fluidPage(
  fluidRow(
    column(3, numericInput("num1", "Limiter1", value = 0)),
    column(3, numericInput("num2", "Limiter2", value = 0))
  ),
  fluidRow(
    column(3,actionButton("button1", "Apply filters1")),
    column(3,actionButton("button2", "Apply filters2"))
  ),
  fluidRow(
    column(6,dataTableOutput("testtable1")),
    column(6,dataTableOutput("testtable2"))
  )
)

server <- function(input, output, session) {
  filteredData1 <- reactive({
    req(input$num1)
    iris %>%
      filter(Petal.Length >= input$num1)
  })

  observeEvent(input$button1, {
    updateNumericInput(session, "num2", value = input$num1)

    output$testtable1 <- renderDataTable(datatable(filteredData1()))
  })

  filteredData2 <- reactive({
    req(input$num2)
    iris %>%
      filter(Petal.Length >= input$num2)
  })

  observeEvent(input$button2, {
    output$testtable2 <- renderDataTable(datatable(filteredData2()))
  })
}

shinyApp(ui, server)

К сожалению, в этом случае таблица данных сначала загружается, когда пользователь нажимает кнопку, но после этого автоматически обновляется каждый раз, когда input$num1 изменяется независимо от того, button1 нажата.Есть ли способ обновить таблицу новыми параметрами только при нажатии button1?

Ответы [ 2 ]

0 голосов
/ 26 февраля 2019

С реактивным значением:

library(dplyr)
library(DT)
library(shiny)

ui <- fluidPage(
  fluidRow(
    numericInput("num1", "Limiter", value = 0)
  ),
  fluidRow(
    actionButton("button1", "Apply filters")
  ),
  fluidRow(
    dataTableOutput("testtable")
  )
)

server <- function(input, output, session) {

  filteredData <- reactiveVal(iris)
  observeEvent(input$button1, {
    filteredData(iris %>% filter(Petal.Length >= input$num1))
  })

  output$testtable <- renderDataTable(datatable(filteredData()))
}

shinyApp(ui, server)
0 голосов
/ 26 февраля 2019

Если приложение настолько простое, вы можете просто изменить actionButton на submitButton

library(dplyr)
library(DT)
library(shiny)

ui <- fluidPage(
  fluidRow(
    numericInput("num1", "Limiter", value = 0)
    ),
  fluidRow(
    submitButton("button1", "Apply filters")
    ),
  fluidRow(
    dataTableOutput("testtable")
    )
)

server <- function(input, output, session) {
  filteredData <- reactive({
    req(input$num1)
    iris %>%
      filter(Petal.Length >= input$num1)
  })

  output$testtable <- renderDataTable(datatable(filteredData()))
}

shinyApp(ui, server)
...