[英]reactive shiny objects from database in rhandsontable
I have a large amount of data in a database that I can call using reactive functions in shiny
. 我在数据库中有大量数据,我可以使用
shiny
反应函数调用。 I would like to present the selected data using rhandsontable
, update as necessary and send the data back to the database. 我想使用
rhandsontable
呈现所选数据,根据需要进行更新并将数据发送回数据库。
I am running into difficulty when trying to select a reactive object inside another reactive object. 当我试图在另一个反应对象中选择一个反应对象时,我遇到了困难。 I know how to do this with data in memory, as per this example , but as I said, I have a lot of data that would not fit in memory.
我知道如何与数据在内存中做到这一点,按照这个例子 ,但正如我所说,我有很多是不适合在内存中的数据。
See reproducible example below, I would just like to select the different choice
options and set the t4
values to F
, but the table does not update when I select new reactive data from the drop down menu. 见重复的例子,下面,我只是想选择不同
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())})
})
)
Any help with this would be greatly appreciated! 任何有关这方面的帮助将不胜感激!
Many thanks 非常感谢
Answered my question using separate observe({})
functions on the reactive object, select_dat()
. 在反应对象
select_dat()
上使用单独的observe({})
函数回答了我的问题。 Using the same inputs as before: 使用与以前相同的输入:
## 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())})
})
)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.