来自rhandsontable数据库的反应性闪亮对象

来自rhandsontable数据库的反应性闪亮对象

问题描述:

我有一个数据库中的大量数据,我可以使用shiny中的反应函数调用。 我想用rhandsontable显示选定的数据,根据需要进行更新并将数据发送回数据库。来自rhandsontable数据库的反应性闪亮对象

我在尝试选择另一个反应性对象内的反应性对象时遇到了困难。 我知道如何根据this example对内存中的数据做到这一点,但正如我所说,我有很多数据不适合内存。

见重复的例子,下面,我只是想选择不同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())}) 

}) 
) 

任何帮助,这将不胜感激!

非常感谢

+0

当我运行您的代码时,我得到了该警告(警告:eventReactiveHandler中的错误:无法找到函数“dbExecute”);加载DBI后,它似乎工作。它在控制台中打印表格 – MLavoie

+0

谢谢MLavoie,我已经将DBI添加到了包中:) – anniemaggs

+0

MLavoie,它将rhandsontable的输出作为我嵌入的调试的一部分进行打印,但是您当选择不同的选项时,将看到它不会改变“选择”。代码不会出错,但它不会执行我想要的操作,如果这样做有道理。 – anniemaggs

使用反应性对象,select_dat()在单独observe({})功能回答我的问题。使用与以前相同的输入:

## 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())}) 

    }) 
)