反应性闪亮模块共享数据 [英] Reactive shiny modules sharing data
本文介绍了反应性闪亮模块共享数据的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我正在尝试使用模块创建一个闪亮的应用程序.两个数据框(表 a 和 b)是反应式的，可以修改，第三个数据框(表 c)也是反应式的，基于表 a 和 b.
I'm trying to create a shiny app using modules. Two dataframes (tables a and b) are reactive and can be modified, a third dataframe (table c) is also reactive and is based on tables a and b.
我尝试关注这个问题 对文本输入而不是数据帧执行相同的操作，但是我的代码不起作用 - 我得到一个 类型的闭包对象不是子集错误.
I tried following this question which does the same with text input and not dataframes, but my code isn't working - I get an object of type closure is not subsettable error.
感谢您的帮助.
### Libraries
library(shiny)
library(tidyverse)
library(DT)
### Data----------------------------------------
table_a <- data.frame(
id=seq(from=1,to=10),
x_1=rnorm(n=10,mean=0,sd=10),
x_2=rnorm(n=10,mean=0,sd=10),
x_3=rnorm(n=10,mean=0,sd=10),
x_4=rnorm(n=10,mean=0,sd=10)
) %>%
mutate_all(round,3)
table_b <- data.frame(
id=seq(from=1,to=10),
x_5=rnorm(n=10,mean=0,sd=10),
x_6=rnorm(n=10,mean=0,sd=10),
x_7=rnorm(n=10,mean=0,sd=10),
x_8=rnorm(n=10,mean=0,sd=10)
)%>%
mutate_all(round,3)
### Modules------------------------------------
mod_table_a <- function(input, output, session, data_in,reset_a) {
v <- reactiveValues(data = data_in)
proxy = dataTableProxy("table_a")
#set var 2
observeEvent(reset_a(), {
v$data[,"x_2"] <- round(rnorm(n=10,mean=0,sd=10),3)
replaceData(proxy, v$data, resetPaging = FALSE)
})
# render table
output$table_a <- DT::renderDataTable({
DT::datatable(
data=v$data,
editable = TRUE,
rownames = FALSE,
class="compact cell-border",
selection = list(mode = "single",
target = "row"
),
options = list(
dom="t",
autoWidth=TRUE,
scrollX = TRUE,
ordering=FALSE,
bLengthChange= FALSE,
searching=FALSE
)
)
})
return(v)
}
mod_table_b <- function(input, output, session, data_in,reset_b) {
v <- reactiveValues(data = data_in)
proxy = dataTableProxy("table_b")
#reset var
observeEvent(reset_b(), {
v$data[,"x_6"] <- round(rnorm(n=10,mean=0,sd=10),3)
replaceData(proxy, v$data, resetPaging = FALSE) # replaces data displayed by the updated table
})
# render table
output$table_b <- DT::renderDataTable({
DT::datatable(
data=v$data,
editable = TRUE,
rownames = FALSE,
class="compact cell-border",
selection = list(mode = "single",
target = "row"
),
options = list(
dom="t",
autoWidth=TRUE,
scrollX = TRUE,
ordering=FALSE,
bLengthChange= FALSE,
searching=FALSE
)
)
})
return(v)
}
mod_table_c <- function(input, output, session, tbl_a_proxy,tbl_b_proxy) {
v <- reactive({
table_c <- data.frame(id=seq(from=1,to=10)) %>%
left_join(tbl_a_proxy$data,by="id") %>%
left_join(tbl_b_proxy$data,by="id") %>%
mutate(y_1=x_1+x_6)%>%
select(x_2,x_6,y_1)
})
# render table
output$table_c <- DT::renderDataTable({
DT::datatable(
data=v$table_c,
editable = TRUE,
rownames = FALSE,
class="compact cell-border",
selection = list(mode = "single",
target = "row"
),
options = list(
dom="t",
autoWidth=TRUE,
scrollX = TRUE,
ordering=FALSE,
bLengthChange= FALSE,
searching=FALSE
)
)
})
}
modFunctionUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns(id))
}
### Shiny App---------
#ui----------------------------------
ui <- fluidPage(
fluidRow(
br(),
column(1,
br(),
actionButton(inputId = "reset_a", "Reset a")
),
column(6,
modFunctionUI("table_a")
),
column(1),
column(4)
),
fluidRow(
br(),
br(),
column(1,
br(),
actionButton(inputId = "reset_b", "Reset b")),
column(6,
modFunctionUI("table_b")
),
column(5,
modFunctionUI("table_c")
)
),
#set font size of tables
useShinyjs(),
inlineCSS(list("table" = "font-size: 10px"))
)
#server--------------
server <- function(input, output) {
#table a
tbl_a_proxy <- callModule(module=mod_table_a,
id="table_a",
data_in=table_a,
reset_a = reactive(input$reset_a)
)
#table b
tbl_b_proxy <- callModule(module=mod_table_b,
id="table_b",
data_in=table_b,
reset_b = reactive(input$reset_b)
)
#table c
callModule(module=mod_table_c,
id="table_c",
tbl_a_proxy,
tbl_b_proxy
)
}
shinyApp(ui, server)
推荐答案
你的问题是在 mod_table_c 中，data=v$table_c 没有任何意义，因为 v 是反应式的，并且已经对应于您想要显示的(反应式)table_c.因此，您需要将其替换为 data=v()(因为响应式表达式在使用时需要在其名称后使用 ()).
Your problem is that in mod_table_c, data=v$table_c does not mean anything because v is reactive and already corresponds to the (reactive) table_c you want to display. Therefore, you need to replace it by data=v() (because reactive expressions need () after their name when you use it).
这是您更正后的示例:
### Libraries
library(shiny)
library(tidyverse)
library(DT)
library(shinyjs)
### Data----------------------------------------
table_a <- data.frame(
id=seq(from=1,to=10),
x_1=rnorm(n=10,mean=0,sd=10),
x_2=rnorm(n=10,mean=0,sd=10),
x_3=rnorm(n=10,mean=0,sd=10),
x_4=rnorm(n=10,mean=0,sd=10)
) %>%
mutate_all(round,3)
table_b <- data.frame(
id=seq(from=1,to=10),
x_5=rnorm(n=10,mean=0,sd=10),
x_6=rnorm(n=10,mean=0,sd=10),
x_7=rnorm(n=10,mean=0,sd=10),
x_8=rnorm(n=10,mean=0,sd=10)
)%>%
mutate_all(round,3)
### Modules------------------------------------
mod_table_a <- function(input, output, session, data_in,reset_a) {
v <- reactiveValues(data = data_in)
proxy = dataTableProxy("table_a")
#set var 2
observeEvent(reset_a(), {
v$data[,"x_2"] <- round(rnorm(n=10,mean=0,sd=10),3)
replaceData(proxy, v$data, resetPaging = FALSE)
})
# render table
output$table_a <- DT::renderDataTable({
DT::datatable(
data=v$data,
editable = TRUE,
rownames = FALSE,
class="compact cell-border",
selection = list(mode = "single",
target = "row"
),
options = list(
dom="t",
autoWidth=TRUE,
scrollX = TRUE,
ordering=FALSE,
bLengthChange= FALSE,
searching=FALSE
)
)
})
return(v)
}
mod_table_b <- function(input, output, session, data_in,reset_b) {
v <- reactiveValues(data = data_in)
proxy = dataTableProxy("table_b")
#reset var
observeEvent(reset_b(), {
v$data[,"x_6"] <- round(rnorm(n=10,mean=0,sd=10),3)
replaceData(proxy, v$data, resetPaging = FALSE) # replaces data displayed by the updated table
})
# render table
output$table_b <- DT::renderDataTable({
DT::datatable(
data=v$data,
editable = TRUE,
rownames = FALSE,
class="compact cell-border",
selection = list(mode = "single",
target = "row"
),
options = list(
dom="t",
autoWidth=TRUE,
scrollX = TRUE,
ordering=FALSE,
bLengthChange= FALSE,
searching=FALSE
)
)
})
return(v)
}
mod_table_c <- function(input, output, session, tbl_a_proxy,tbl_b_proxy) {
v <- reactive({
table_c <- data.frame(id=seq(from=1,to=10)) %>%
left_join(tbl_a_proxy$data,by="id") %>%
left_join(tbl_b_proxy$data,by="id") %>%
mutate(y_1=x_1+x_6)%>%
select(x_2,x_6,y_1)
})
# render table
output$table_c <- DT::renderDataTable({
DT::datatable(
data=v(),
editable = TRUE,
rownames = FALSE,
class="compact cell-border",
selection = list(mode = "single",
target = "row"
),
options = list(
dom="t",
autoWidth=TRUE,
scrollX = TRUE,
ordering=FALSE,
bLengthChange= FALSE,
searching=FALSE
)
)
})
}
modFunctionUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns(id))
}
### Shiny App---------
#ui----------------------------------
ui <- fluidPage(
fluidRow(
br(),
column(1,
br(),
actionButton(inputId = "reset_a", "Reset a")
),
column(6,
modFunctionUI("table_a")
),
column(1),
column(4)
),
fluidRow(
br(),
br(),
column(1,
br(),
actionButton(inputId = "reset_b", "Reset b")),
column(6,
modFunctionUI("table_b")
),
column(5,
modFunctionUI("table_c")
)
),
#set font size of tables
useShinyjs(),
inlineCSS(list("table" = "font-size: 10px"))
)
#server--------------
server <- function(input, output) {
#table a
tbl_a_proxy <- callModule(module=mod_table_a,
id="table_a",
data_in=table_a,
reset_a = reactive(input$reset_a)
)
#table b
tbl_b_proxy <- callModule(module=mod_table_b,
id="table_b",
data_in=table_b,
reset_b = reactive(input$reset_b)
)
#table c
callModule(module=mod_table_c,
id="table_c",
tbl_a_proxy,
tbl_b_proxy
)
}
shinyApp(ui, server)
这篇关于反应性闪亮模块共享数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
