Shiny reactive values based on different reactive values
Question
I have a reasonably complex shiny app I'd like to break into modules. There are two dataframes ( a and b ) created in two separate modules. A third module is used to create a large dataframe with many new variables ( new_data ) based on dataframes a and b . The new_data dataframe is then used by another two modules to further wrangle new_data and output two dataframes c and d .
The code runs, but instead of getting two dataframes for c and d , I get an error: "data" must be 2-dimensional (eg a data frame or matrix) . If I change new_data into a reactiveValue the code crashes. Is this possible and good a good use of reactivity?
### 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 answers
solution1
2 ACCPTED 2019-11-19 07:39:51
Your example is a little complicated, and I think you're potentially running into several issues. With this particular code, the modularization seems more like a hindrance than a help, since it would be more straightforward to just call everything directly in the server code, but I understand that this is theoretically a reduced example (albeit still complex).
I'll start off by addressing your basic question: "Is this possible and a good use of reactivity?"
In Shiny, all code that's executed (directly or indirectly) by the server portion MUST be reactive. So the question is not really "should I or should I not use reactive code", but "which type of reactive code is most appropriate?"
The simplest form of reactivity is a call to reactive() , like so:
x <- reactive({
some code
})
The value of x depends on whatever code is present within x, including other reactive values. However, x does NOT behave like a normal non-reactive r variable; it is more akin to a function (or a "closure"). To source it in other code, you must follow it with parentheses , like so:
x2 <- reactive({
x() ^ 2
})
Thus, by correcting your syntax (adding parens) you can accomplish what you're trying to accomplish with reactive() alone.
reactiveValues() , meanwhile, is generally not preferred over reactive() , but it does have some advantages. The best use is in defining side effects. In other words, reactive() , like a typical function, can only return a single value (though that value can be a list or other complex data type). But, if you need a function to change the value of a side-effect variable before returning its final value, you can use reactiveValues() , like so:
statuses <- reactiveValues()
x <- reactive({
if (someval > 1) {
statuses$square <- TRUE
xval <- z ^ 2
} else {
statuses$square <- FALSE
xval <- z
}
}
So that all said, I went ahead and "fixed" your code to change your reactive variables to reactive() and to reference them properly with parentheses. Now, all of your tables are displayed properly. That said, there are still some other non-trivial issues with your code, such that it is not actually "doing" what it's supposed to do (tables c and d do not update with changes to a and b, and the "reset" buttons don't work). I haven't addressed these issues, but here is at least some revised code to get the tables to work.
### 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)
solution2
1 2019-11-19 06:22:56
If you convert (as you had) the mod_new_data to a reactive:
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)
}
then, in your code data_in and data_out in modules C and D are reactives, so you need to call them as that. Instead of data_in$data is data_in() , and instead of data_out is data_out() . The latter is the reason you have the "data" must be 2-dimensional (eg a data frame or matrix) error, as you were trying to call datatable on a reactive, not on the reactive result. After that everything works:
### 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)
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.
Related Question
If Statement in Shiny based on values in reactive
Updating reactive values in Shiny
shiny reactive values update order
Add values to a reactive table in shiny
displaying 'reactive values' in r shiny
How to save reactive values in Shiny?
Modify Values of a Reactive Dataframe in Shiny
using reactive values within r shiny modules
Shiny: uiOutput vs plugging reactive values to selectInput
R Shiny DT - edit values in table with reactive
Related Tags