Shiny 无功值基于不同的无功值
[英]Shiny reactive values based on different reactive values
问题描述
我有一个相当复杂的 shiny 应用程序，我想分成模块。 在两个单独的模块中创建了两个数据框（ a和b ）。 第三个模块用于创建一个大型 dataframe，其中包含许多基于数据帧a和b的新变量 ( new_data )。 然后 new_data dataframe 被另外两个模块用来进一步争论new_data和 output 两个数据帧c和d 。
代码运行，但我没有得到c和d的两个数据帧，而是得到一个错误： "data" must be 2-dimensional (eg 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)
2 个解决方案
解决方案1
2 已采纳 2019-11-19 07:39:51
您的示例有点复杂，我认为您可能会遇到几个问题。 使用这个特定的代码，模块化似乎更像是一个障碍而不是一个帮助，因为直接在服务器代码中调用所有东西会更直接，但我知道这在理论上是一个简化的例子（尽管仍然很复杂）。
我将首先解决您的基本问题： “这是否可能并且可以很好地利用反应性？”
在 Shiny 中，服务器部分（直接或间接）执行的所有代码都必须是响应式的。 所以问题不是“我应该还是不应该使用响应式代码”，而是“哪种类型的响应式代码最合适？”
最简单的反应形式是调用reactive() ，如下所示：
x <- reactive({
some code
})
x 的值取决于 x 中存在的任何代码，包括其他反应值。 但是，x 的行为不像正常的非反应性 r 变量； 它更类似于 function（或“闭包”）。 要在其他代码中获取它，您必须在它后面加上括号，如下所示：
x2 <- reactive({
x() ^ 2
})
因此，通过更正您的语法（添加括号），您可以单独使用reactive()来完成您想要完成的事情。
与此同时， reactiveValues()通常并不优于reactive() ，但它确实有一些优势。 最好的用途是定义副作用。 换句话说， reactive() ，就像典型的 function 一样，只能返回单个值（尽管该值可以是列表或其他复杂数据类型）。 但是，如果您需要 function 在返回最终值之前更改副作用变量的值，则可以使用reactiveValues() ，如下所示：
statuses <- reactiveValues()
x <- reactive({
if (someval > 1) {
statuses$square <- TRUE
xval <- z ^ 2
} else {
statuses$square <- FALSE
xval <- z
}
}
综上所述，我继续“修复”您的代码以将您的反应变量更改为reactive()并用括号正确引用它们。 现在，您的所有表格都已正确显示。 也就是说，您的代码仍然存在一些其他重要的问题，例如它实际上并没有“做”它应该做的事情（表 c 和 d 不会随着对 a 和 b 的更改而更新，并且“重置”按钮不起作用）。 我还没有解决这些问题，但这里至少有一些修改后的代码可以让表格正常工作。
### 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)
解决方案2
1 2019-11-19 06:22:56
如果您将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)
}
然后，在您的代码中，模块C和D中的代码data_in和data_out是反应式，所以您需要这样称呼它们。 代替data_in$data的是data_in() ，而不是data_out是data_out() 。 后者是您有"data" must be 2-dimensional (eg 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)
如果基于反应中的值的Shiny语句
声明:本站的技术帖子网页，遵循CC BY-SA 4.0协议，如果您需要转载，请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.