【发布时间】：2020-03-14 13:16:01
【问题描述】：
我有一个相当复杂的闪亮应用程序，我想分解成模块。
在两个单独的模块中创建了两个数据框（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)
【问题讨论】：
-
data=data_out将替换为data=data_out()。
标签： r shiny reactive shiny-reactivity