基于不同无功值的闪亮无功值
Shiny reactive values based on different reactive values
我有一个相当复杂的闪亮应用程序，我想分成多个模块。
在两个单独的模块中创建了两个数据帧（a 和 b）。第三个模块用于基于数据帧 a 和 b 创建具有许多新变量 (new_data) 的大型数据帧。然后，new_data 数据帧被另外两个模块用来进一步处理 new_data 并输出两个数据帧 c 和 d.
代码运行，但我没有得到 c 和 d 的两个数据帧，而是收到错误："data" must be 2-dimensional (e.g. a data frame or matrix)。如果我将 new_data 更改为 reactiveValue，代码就会崩溃。这是否可能并且很好地利用了反应性？
### 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_new_data <- function(input,output,session,tbl_a,tbl_b){
v <- reactiveValues(
data = data.frame(id=seq(from=1,to=10)) %>%
left_join(tbl_a$data,by="id") %>%
left_join(tbl_b$data,by="id") %>%
mutate(
y_1=x_1+x_6,
y_2=x_2+x_5
)
)
#
# v <- reactive({
# data.frame(id=seq(from=1,to=10)) %>%
# left_join(tbl_a$data,by="id") %>%
# left_join(tbl_b$data,by="id") %>%
# mutate(
# y_1=x_1+x_6,
# y_2=x_2+x_5
# )
# })
return(v)
}
mod_table_c <- function(input, output, session, data_in) {
data_out <- reactive({
data_in$data %>%
select(x_1,x_2,y_1)
})
# render table
output$table_c <- DT::renderDataTable({
DT::datatable(
data=data_out,
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
)
)
})
}
mod_table_d <- function(input, output, session, data_in) {
data_out <- reactive({
data_in$data %>%
select(x_4,x_6,y_2)
})
# render table
output$table_d <- DT::renderDataTable({
DT::datatable(
data=data_out,
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(5,
modFunctionUI("table_c")
)
),
fluidRow(
br(),
br(),
column(1,
br(),
actionButton(inputId = "reset_b", "Reset b")),
column(6,
modFunctionUI("table_b")
),
column(5,
modFunctionUI("table_d")
)
),
#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)
)
#new data
new_data <- callModule(module=mod_new_data,
id="new_data",
tbl_a = tbl_a_proxy,
tbl_b = tbl_b_proxy
)
#table c
callModule(module=mod_table_c,
id="table_c",
data_in=new_data
)
#table d
callModule(module=mod_table_d,
id="table_d",
data_in=new_data
)
}
#app----------------------------------
shinyApp(ui, server)
如果您将 mod_new_data 转换（如您所用）为反应式：
mod_new_data <- function(input,output,session,tbl_a,tbl_b){
# v <- reactiveValues(
# data = data.frame(id=seq(from=1,to=10)) %>%
# left_join(tbl_a$data,by="id") %>%
# left_join(tbl_b$data,by="id") %>%
# mutate(
# y_1=x_1+x_6,
# y_2=x_2+x_5
# )
# )
#
v <- reactive({
# browser()
data.frame(id=seq(from=1,to=10)) %>%
left_join(tbl_a$data,by="id") %>%
left_join(tbl_b$data,by="id") %>%
mutate(
y_1=x_1+x_6,
y_2=x_2+x_5
)
})
return(v)
}
然后，在您的代码中，模块中的 data_in 和 data_out C 和 D 是反应式的，因此您需要这样称呼它们。
代替 data_in$data 的是 data_in()，代替 data_out 的是 data_out()。后者是您出现 "data" must be 2-dimensional (e.g. a data frame or matrix) 错误的原因，因为您试图在反应性而非反应性结果上调用数据表。
之后一切正常：
### 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({
# browser()
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({
# browser()
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_new_data <- function(input,output,session,tbl_a,tbl_b){
# v <- reactiveValues(
# data = data.frame(id=seq(from=1,to=10)) %>%
# left_join(tbl_a$data,by="id") %>%
# left_join(tbl_b$data,by="id") %>%
# mutate(
# y_1=x_1+x_6,
# y_2=x_2+x_5
# )
# )
#
v <- reactive({
# browser()
data.frame(id=seq(from=1,to=10)) %>%
left_join(tbl_a$data,by="id") %>%
left_join(tbl_b$data,by="id") %>%
mutate(
y_1=x_1+x_6,
y_2=x_2+x_5
)
})
return(v)
}
mod_table_c <- function(input, output, session, data_in) {
data_out <- reactive({
data_in() %>%
select(x_1,x_2,y_1)
})
# render table
output$table_c <- DT::renderDataTable({
# browser()
DT::datatable(
data=data_out(),
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
)
)
})
}
mod_table_d <- function(input, output, session, data_in) {
data_out <- reactive({
data_in() %>%
select(x_4,x_6,y_2)
})
# render table
output$table_d <- DT::renderDataTable({
DT::datatable(
data=data_out(),
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(5,
modFunctionUI("table_c")
)
),
fluidRow(
br(),
br(),
column(1,
br(),
actionButton(inputId = "reset_b", "Reset b")),
column(6,
modFunctionUI("table_b")
),
column(5,
modFunctionUI("table_d")
)
),
#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)
)
#new data
new_data <- callModule(module=mod_new_data,
id="new_data",
tbl_a = tbl_a_proxy,
tbl_b = tbl_b_proxy
)
#table c
callModule(module=mod_table_c,
id="table_c",
data_in=new_data
)
#table d
callModule(module=mod_table_d,
id="table_d",
data_in=new_data
)
}
#app----------------------------------
shinyApp(ui, server)
您的示例有点复杂，我认为您可能 运行 遇到了几个问题。对于这个特定的代码，模块化似乎更像是一种障碍而不是帮助，因为直接在服务器代码中调用所有内容会更直接，但我知道这在理论上是一个简化的示例（尽管仍然很复杂）。
我将从回答您的基本问题开始：
"Is this possible and a good use of reactivity?"
在 Shiny 中，服务器部分（直接或间接）执行的所有代码都必须是反应性的。所以问题其实不是"should I or should I not use reactive code"，而是"which type of reactive code is most appropriate?"
最简单的反应形式是调用 reactive()，如下所示：
x <- reactive({
some code
})
x 的值取决于 x 中存在的任何代码，包括其他反应值。但是，x 的行为并不像普通的非反应性 r 变量；它更类似于函数（或 "closure"）。 要在其他代码中获取它，您必须在它后面加上括号，如下所示：
x2 <- reactive({
x() ^ 2
})
因此，通过更正您的语法（添加括号），您可以单独使用 reactive() 完成您想要完成的工作。
同时，reactiveValues() 通常不优于 reactive()，但它确实有一些优势。最好的用途是定义副作用。换句话说，reactive()，就像一个典型的函数，只能 return 一个单一的值（尽管那个值可以是一个列表或其他复杂的数据类型）。但是，如果您需要一个函数在 return 最终值之前更改副作用变量的值，您可以使用 reactiveValues()，如下所示：
statuses <- reactiveValues()
x <- reactive({
if (someval > 1) {
statuses$square <- TRUE
xval <- z ^ 2
} else {
statuses$square <- FALSE
xval <- z
}
}
综上所述，我继续 "fixed" 你的代码，将你的反应变量更改为 reactive() 并用括号正确引用它们。现在，您的所有表格都已正确显示。也就是说，您的代码仍然存在其他一些不重要的问题，因此它实际上并不是 "doing" 它应该做的（表 c 和 d 不会随着 a 和 b 的更改而更新，并且 "reset" 按钮不起作用）。我还没有解决这些问题，但这里至少有一些修改过的代码可以让表格正常工作。
### 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 <- reactive(data_in)
proxy = dataTableProxy("table_a")
#set var 2
observeEvent(reset_a(), {
v()[,"x_2"] <- round(rnorm(n=10,mean=0,sd=10),3)
replaceData(proxy(), v(), resetPaging = FALSE)
})
# render table
output$table_a <- 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
)
)
})
return(v)
}
mod_table_b <- function(input, output, session, data_in,reset_b) {
v <- reactive(data_in)
proxy = dataTableProxy("table_b")
#reset var
observeEvent(reset_b(), {
v()[,"x_6"] <- round(rnorm(n=10,mean=0,sd=10),3)
replaceData(proxy(), v(), resetPaging = FALSE) # replaces data displayed by the updated table
})
# render table
output$table_b <- 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
)
)
})
return(v)
}
mod_new_data <- function(input,output,session,tbl_a,tbl_b){
v <- reactive(
data.frame(id=seq(from=1,to=10)) %>%
left_join(tbl_a,by="id") %>%
left_join(tbl_b,by="id") %>%
mutate(
y_1=x_1+x_6,
y_2=x_2+x_5
)
)
#
# v <- reactive({
# data.frame(id=seq(from=1,to=10)) %>%
# left_join(tbl_a$data,by="id") %>%
# left_join(tbl_b$data,by="id") %>%
# mutate(
# y_1=x_1+x_6,
# y_2=x_2+x_5
# )
# })
return(v)
}
mod_table_c <- function(input, output, session, data_in) {
data_out <- reactive({
data_in %>%
select(x_1,x_2,y_1)
})
# render table
output$table_c <- DT::renderDataTable({
DT::datatable(
data=data_out(),
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
)
)
})
}
mod_table_d <- function(input, output, session, data_in) {
data_out <- reactive({
data_in %>%
select(x_4,x_6,y_2)
})
# render table
output$table_d <- DT::renderDataTable({
DT::datatable(
data=data_out(),
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(5,
modFunctionUI("table_c")
)
),
fluidRow(
br(),
br(),
column(1,
br(),
actionButton(inputId = "reset_b", "Reset b")),
column(6,
modFunctionUI("table_b")
),
column(5,
modFunctionUI("table_d")
)
),
#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)
)
#new data
new_data <- callModule(module=mod_new_data,
id="new_data",
tbl_a = tbl_a_proxy(),
tbl_b = tbl_b_proxy()
)
#table c
callModule(module=mod_table_c,
id="table_c",
data_in=new_data()
)
#table d
callModule(module=mod_table_d,
id="table_d",
data_in=new_data()
)
}
#app----------------------------------
shinyApp(ui, server)
我有一个相当复杂的闪亮应用程序，我想分成多个模块。
在两个单独的模块中创建了两个数据帧（a 和 b）。第三个模块用于基于数据帧 a 和 b 创建具有许多新变量 (new_data) 的大型数据帧。然后，new_data 数据帧被另外两个模块用来进一步处理 new_data 并输出两个数据帧 c 和 d.
代码运行，但我没有得到 c 和 d 的两个数据帧，而是收到错误："data" must be 2-dimensional (e.g. a data frame or matrix)。如果我将 new_data 更改为 reactiveValue，代码就会崩溃。这是否可能并且很好地利用了反应性？
### 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_new_data <- function(input,output,session,tbl_a,tbl_b){
v <- reactiveValues(
data = data.frame(id=seq(from=1,to=10)) %>%
left_join(tbl_a$data,by="id") %>%
left_join(tbl_b$data,by="id") %>%
mutate(
y_1=x_1+x_6,
y_2=x_2+x_5
)
)
#
# v <- reactive({
# data.frame(id=seq(from=1,to=10)) %>%
# left_join(tbl_a$data,by="id") %>%
# left_join(tbl_b$data,by="id") %>%
# mutate(
# y_1=x_1+x_6,
# y_2=x_2+x_5
# )
# })
return(v)
}
mod_table_c <- function(input, output, session, data_in) {
data_out <- reactive({
data_in$data %>%
select(x_1,x_2,y_1)
})
# render table
output$table_c <- DT::renderDataTable({
DT::datatable(
data=data_out,
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
)
)
})
}
mod_table_d <- function(input, output, session, data_in) {
data_out <- reactive({
data_in$data %>%
select(x_4,x_6,y_2)
})
# render table
output$table_d <- DT::renderDataTable({
DT::datatable(
data=data_out,
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(5,
modFunctionUI("table_c")
)
),
fluidRow(
br(),
br(),
column(1,
br(),
actionButton(inputId = "reset_b", "Reset b")),
column(6,
modFunctionUI("table_b")
),
column(5,
modFunctionUI("table_d")
)
),
#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)
)
#new data
new_data <- callModule(module=mod_new_data,
id="new_data",
tbl_a = tbl_a_proxy,
tbl_b = tbl_b_proxy
)
#table c
callModule(module=mod_table_c,
id="table_c",
data_in=new_data
)
#table d
callModule(module=mod_table_d,
id="table_d",
data_in=new_data
)
}
#app----------------------------------
shinyApp(ui, server)
如果您将 mod_new_data 转换（如您所用）为反应式：
mod_new_data <- function(input,output,session,tbl_a,tbl_b){
# v <- reactiveValues(
# data = data.frame(id=seq(from=1,to=10)) %>%
# left_join(tbl_a$data,by="id") %>%
# left_join(tbl_b$data,by="id") %>%
# mutate(
# y_1=x_1+x_6,
# y_2=x_2+x_5
# )
# )
#
v <- reactive({
# browser()
data.frame(id=seq(from=1,to=10)) %>%
left_join(tbl_a$data,by="id") %>%
left_join(tbl_b$data,by="id") %>%
mutate(
y_1=x_1+x_6,
y_2=x_2+x_5
)
})
return(v)
}
然后，在您的代码中，模块中的 data_in 和 data_out C 和 D 是反应式的，因此您需要这样称呼它们。
代替 data_in$data 的是 data_in()，代替 data_out 的是 data_out()。后者是您出现 "data" must be 2-dimensional (e.g. a data frame or matrix) 错误的原因，因为您试图在反应性而非反应性结果上调用数据表。
之后一切正常：
### 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({
# browser()
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({
# browser()
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_new_data <- function(input,output,session,tbl_a,tbl_b){
# v <- reactiveValues(
# data = data.frame(id=seq(from=1,to=10)) %>%
# left_join(tbl_a$data,by="id") %>%
# left_join(tbl_b$data,by="id") %>%
# mutate(
# y_1=x_1+x_6,
# y_2=x_2+x_5
# )
# )
#
v <- reactive({
# browser()
data.frame(id=seq(from=1,to=10)) %>%
left_join(tbl_a$data,by="id") %>%
left_join(tbl_b$data,by="id") %>%
mutate(
y_1=x_1+x_6,
y_2=x_2+x_5
)
})
return(v)
}
mod_table_c <- function(input, output, session, data_in) {
data_out <- reactive({
data_in() %>%
select(x_1,x_2,y_1)
})
# render table
output$table_c <- DT::renderDataTable({
# browser()
DT::datatable(
data=data_out(),
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
)
)
})
}
mod_table_d <- function(input, output, session, data_in) {
data_out <- reactive({
data_in() %>%
select(x_4,x_6,y_2)
})
# render table
output$table_d <- DT::renderDataTable({
DT::datatable(
data=data_out(),
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(5,
modFunctionUI("table_c")
)
),
fluidRow(
br(),
br(),
column(1,
br(),
actionButton(inputId = "reset_b", "Reset b")),
column(6,
modFunctionUI("table_b")
),
column(5,
modFunctionUI("table_d")
)
),
#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)
)
#new data
new_data <- callModule(module=mod_new_data,
id="new_data",
tbl_a = tbl_a_proxy,
tbl_b = tbl_b_proxy
)
#table c
callModule(module=mod_table_c,
id="table_c",
data_in=new_data
)
#table d
callModule(module=mod_table_d,
id="table_d",
data_in=new_data
)
}
#app----------------------------------
shinyApp(ui, server)
您的示例有点复杂，我认为您可能 运行 遇到了几个问题。对于这个特定的代码，模块化似乎更像是一种障碍而不是帮助，因为直接在服务器代码中调用所有内容会更直接，但我知道这在理论上是一个简化的示例（尽管仍然很复杂）。
我将从回答您的基本问题开始： "Is this possible and a good use of reactivity?"
在 Shiny 中，服务器部分（直接或间接）执行的所有代码都必须是反应性的。所以问题其实不是"should I or should I not use reactive code"，而是"which type of reactive code is most appropriate?"
最简单的反应形式是调用 reactive()，如下所示：
x <- reactive({
some code
})
x 的值取决于 x 中存在的任何代码，包括其他反应值。但是，x 的行为并不像普通的非反应性 r 变量；它更类似于函数（或 "closure"）。 要在其他代码中获取它，您必须在它后面加上括号，如下所示：
x2 <- reactive({
x() ^ 2
})
因此，通过更正您的语法（添加括号），您可以单独使用 reactive() 完成您想要完成的工作。
reactiveValues() 通常不优于 reactive()，但它确实有一些优势。最好的用途是定义副作用。换句话说，reactive()，就像一个典型的函数，只能 return 一个单一的值（尽管那个值可以是一个列表或其他复杂的数据类型）。但是，如果您需要一个函数在 return 最终值之前更改副作用变量的值，您可以使用 reactiveValues()，如下所示：
statuses <- reactiveValues()
x <- reactive({
if (someval > 1) {
statuses$square <- TRUE
xval <- z ^ 2
} else {
statuses$square <- FALSE
xval <- z
}
}
综上所述，我继续 "fixed" 你的代码，将你的反应变量更改为 reactive() 并用括号正确引用它们。现在，您的所有表格都已正确显示。也就是说，您的代码仍然存在其他一些不重要的问题，因此它实际上并不是 "doing" 它应该做的（表 c 和 d 不会随着 a 和 b 的更改而更新，并且 "reset" 按钮不起作用）。我还没有解决这些问题，但这里至少有一些修改过的代码可以让表格正常工作。
### 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 <- reactive(data_in)
proxy = dataTableProxy("table_a")
#set var 2
observeEvent(reset_a(), {
v()[,"x_2"] <- round(rnorm(n=10,mean=0,sd=10),3)
replaceData(proxy(), v(), resetPaging = FALSE)
})
# render table
output$table_a <- 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
)
)
})
return(v)
}
mod_table_b <- function(input, output, session, data_in,reset_b) {
v <- reactive(data_in)
proxy = dataTableProxy("table_b")
#reset var
observeEvent(reset_b(), {
v()[,"x_6"] <- round(rnorm(n=10,mean=0,sd=10),3)
replaceData(proxy(), v(), resetPaging = FALSE) # replaces data displayed by the updated table
})
# render table
output$table_b <- 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
)
)
})
return(v)
}
mod_new_data <- function(input,output,session,tbl_a,tbl_b){
v <- reactive(
data.frame(id=seq(from=1,to=10)) %>%
left_join(tbl_a,by="id") %>%
left_join(tbl_b,by="id") %>%
mutate(
y_1=x_1+x_6,
y_2=x_2+x_5
)
)
#
# v <- reactive({
# data.frame(id=seq(from=1,to=10)) %>%
# left_join(tbl_a$data,by="id") %>%
# left_join(tbl_b$data,by="id") %>%
# mutate(
# y_1=x_1+x_6,
# y_2=x_2+x_5
# )
# })
return(v)
}
mod_table_c <- function(input, output, session, data_in) {
data_out <- reactive({
data_in %>%
select(x_1,x_2,y_1)
})
# render table
output$table_c <- DT::renderDataTable({
DT::datatable(
data=data_out(),
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
)
)
})
}
mod_table_d <- function(input, output, session, data_in) {
data_out <- reactive({
data_in %>%
select(x_4,x_6,y_2)
})
# render table
output$table_d <- DT::renderDataTable({
DT::datatable(
data=data_out(),
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(5,
modFunctionUI("table_c")
)
),
fluidRow(
br(),
br(),
column(1,
br(),
actionButton(inputId = "reset_b", "Reset b")),
column(6,
modFunctionUI("table_b")
),
column(5,
modFunctionUI("table_d")
)
),
#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)
)
#new data
new_data <- callModule(module=mod_new_data,
id="new_data",
tbl_a = tbl_a_proxy(),
tbl_b = tbl_b_proxy()
)
#table c
callModule(module=mod_table_c,
id="table_c",
data_in=new_data()
)
#table d
callModule(module=mod_table_d,
id="table_d",
data_in=new_data()
)
}
#app----------------------------------
shinyApp(ui, server)