Question

我在数据库中有大量数据，我可以使用shiny中的反应函数调用。我想使用rhandsontable呈现所选数据，根据需要进行更新并将数据发送回数据库。

尝试在另一个反应对象中选择反应对象时遇到困难。根据{{3}}，我知道如何使用内存中的数据执行此操作，但正如我所说，我有很多数据不适合内存。

请参阅下面的可重复示例，我只想选择不同的choice选项并将t4值设置为F，但是当我选择新的反应数据时，表格不会更新从下拉菜单中。

library(shiny)
library(rhandsontable)
library(dplyr)
library(magrittr)
library(RSQLite)
library(DBI)


## create data :
dat <- data.frame("id" = 1:10,
              "choice" = rep(c("option 1", "option 2"), each = 5),
              "t1" = sample(1:100, 10),
              "t2" = sample(1:100, 10),
              "t3" = sample(1:100, 10),
              "t4" = rep("T", 10))

## define database
test_db <- src_sqlite("test_db.sqlite3", create = T)

## copy to database:
test_sqlite <- copy_to(test_db, dat, temporary = FALSE, indexes = list(
  c("choice"),"t1", "t2", "t3", "t4"))

## test data is loaded:
dbGetQuery(test_db$con, paste0("SELECT * FROM dat"))


## build shiny app:

shinyApp(
  shinyUI(
    fluidRow(
  selectInput("select", label = h3("Select box"), 
              choices = list("option 1", "option 2"), 
              selected = "option 1"),
  rHandsontableOutput("hot"),
  actionButton("to_db", label = "Send to Database"),
  verbatimTextOutput("to_db_text")
)),

shinyServer(function(input, output, session) {


## define data to select 
select_dat <- eventReactive(input$select, {
  dbGetQuery(test_db$con, paste0("SELECT * FROM dat WHERE choice = '", input$select, "'"))
  })

# debugging
observe({print(input$select)})  
observe({print(select_dat())})  

values = reactiveValues()

data = reactive({
  if (!is.null(input$hot)) {
    DF = hot_to_r(input$hot)
  } else {
    if (is.null(values[["DF"]]))
        DF = select_dat()
    else
      DF = values[["DF"]]
  }
  values[["DF"]] = DF
  DF
})

output$hot <- renderRHandsontable({
  DF = data()
  if (!is.null(DF))
  rhandsontable(DF, stretchH = "all", selectCallback = TRUE,  readOnly = T) %>%
    hot_col("t4", readOnly = F, type = "dropdown", source = c("T","F"))
})

##    debugging    
observe({print(data())})   

ntext <- eventReactive(input$to_db, {
  ids <- data() %>% filter(t4 == "F") %>% dplyr::select(id) %>% extract2(1)
   sql_str <- paste0("UPDATE dat SET t4 = 'F' WHERE id IN (", paste(ids, collapse=","),")")
   dbExecute(test_db$con, sql_str)

})

observe({print(ntext())})

})
)

非常感谢任何帮助！

非常感谢

Answer 1

使用反应对象observe({})上的单独select_dat()函数回答了我的问题。使用与以前相同的输入：

## build shiny app:

shinyApp(
  shinyUI(
    fluidRow(
      selectInput("select", label = h3("Select box"), 
                  choices = list("option 1", "option 2"), 
                  selected = "option 1"),
      rHandsontableOutput("hot"),
      actionButton("to_db", label = "Send to Database"),
      verbatimTextOutput("to_db_text")
    )),

  shinyServer(function(input, output, session) {


    ## define data to select 
    select_dat <- eventReactive(input$select, {
      dbGetQuery(test_db$con, paste0("SELECT * FROM dat WHERE choice = '", input$select, "'"))
    })

    # debugging
#     observe({print(input$select)})  
#     observe({print(select_dat())})  

    ## define data to be updated in rhandsontable:
    values = reactiveValues(data=NULL)

    observe({
      input$select
      values$data <- select_dat()
    })

    observe({
      if(!is.null(input$hot))
        values$data <- hot_to_r(input$hot)
    })


    output$hot <- renderRHandsontable({
      rhandsontable(values$data)
    })

##    debugging    
     observe(print(values$data))   

## send data to database     
     ntext <- eventReactive(input$to_db, {
       ids <- values$data %>% filter(t4 == "F") %>% dplyr::select(id) %>% extract2(1)
       sql_str <- paste0("UPDATE dat SET t4 = 'F' WHERE id IN (", paste(ids, collapse=","),")")
       dbExecute(test_db$con, sql_str)

     })

     observe({print(ntext())})

  })
)

rhandsontable

1 个答案: