Как сделать таблицу оперативно обновляемой

Question

Я пытаюсь создать приложение, которое отображает реактивно обновляемую таблицу. Он состоит из двух частей: 1. Форма для ввода и сохранения пользовательских данных (работает). 2. Таблица, которая реактивно обновляет данные с MySQL каждый раз, когда пользователь добавляет новую строку.

Это упрощенная версия моего приложения:

library(shiny)
library(shinyWidgets)

con <- dbConnect(RMySQL::MySQL(), dbname = "test", username = "root", password = "123456", host = "127.0.0.1", port = 3306)


ui <- fluidPage(
  textInput("name", "name"),
  numericInput("age", "age", value = 1),
  actionButton("ok", "ok"),
  titlePanel(h2("My burnmarks")),
  br(),
  DT::dataTableOutput("table")
)

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

  observeEvent(input$ok, {
    query <- paste("INSERT INTO test (name, age) VALUES ('", 
                   input$name , "', '",input$age, "');", sep = "")
    dbExecute(con, query)
  })


  sqlOutput <- reactive({
    sqlInput <- "SELECT * from test"
    dbGetQuery(con, sqlInput)
  })


  output$table <- DT::renderDataTable(sqlOutput(),
                                      server = TRUE, rownames = FALSE,
                                      options = list(
                                        pageLength = 10,
                                        scrollX = TRUE,
                                        fixedColumns = TRUE),
                                      extensions = 'Responsive'
  )

  }
shinyApp(ui, server)

Answer 1

Используйте eventReactive вместо reactive, как показано ниже.

library(shiny)
library(shinyWidgets)
library(DBI)
library(pool)
pool <- dbPool(drv = RMySQL::MySQL(),dbname = "test",host = "host",username = "root",password = "pwd", port = 3306, unix.sock = "/var/run/mysqld/mysqld.sock")

ui <- fluidPage(
  textInput("name", "name"),
  numericInput("age", "age", value = 1),
  actionButton("ok", "ok"),
  titlePanel(h2("My burnmarks")),
  br(),
  DT::dataTableOutput("table")
)

server <- function(input, output, session) {
  observeEvent(input$ok, {
    dbGetQuery(pool, paste0("INSERT INTO test (name, age) VALUES ('", input$name , "', '",input$age, "');", sep = ""))
  })

sqlOutput <- eventReactive(input$ok, {
    op <- dbGetQuery(pool, "SELECT * FROM test;")
})

output$table <- DT::renderDataTable(sqlOutput(),
                                      server = TRUE, rownames = FALSE,
                                      options = list(
                                        pageLength = 10,
                                        scrollX = TRUE,
                                        fixedColumns = TRUE),
                                      extensions = 'Responsive'
  )

}
shinyApp(ui, server)

Также reactiveValues - еще одна функция для достижения того же.

server <- function(input, output, session) {
  values <- reactiveValues(df_data = NULL)
  observeEvent(input$ok, {
    dbGetQuery(pool, paste0("INSERT INTO test (name, age) VALUES ('", input$name , "', '",input$age, "');", sep = ""))
    values$df_data <- dbGetQuery(pool, "SELECT * FROM test;")
  })

  output$table <- DT::renderDataTable(values$df_data,
                                      server = TRUE, rownames = FALSE,
                                      options = list(
                                        pageLength = 10,
                                        scrollX = TRUE,
                                        fixedColumns = TRUE),
                                      extensions = 'Responsive'
  )
}