使用 R6 和调用模块在观察事件上动态连接闪亮页面
Dynamic connection of shiny pages on observe event using R6 and call modules
我想连接两个用单独的 R6 类 编码的闪亮页面。我真的很困惑如何去做这件事。下面是一个简单的工作示例。当Page1中的private$..counter == 4时，我想隐藏Page1中的所有内容并激活Page2。我知道一个简单的 showModal，模态对话框可以说“谢谢”。我只是用了一个简单的例子。实际上，这个新页面还会显示更复杂的内容，例如 Page1。有什么方法可以使用 shinyjs 实现我想要的吗？还是其他方式？
第 1 页
library(R6)
library(stringi)
library(shiny)
df <- data.frame(dp = c("dp1", "dp2", "dp3"), desc = c("problem 1", "problem 2", "problem 3"))
page1 <- R6::R6Class(classname = "Page1",
private = list(
#unique string id
..id = stringi::stri_rand_strings(1, 18),
#the data to be iterated through
..df = df,
#counter to uqpdate text
..counter = 1,
#initiating the dp and desc
..dp = NA,
..desc = NA,
#the underlying server, to be created like a normal server
.server = function(input, output, session){
output$text <- renderText({
self$desc$text
})
observeEvent(input$button, {
private$..counter <- private$..counter + 1
self$update_private()
self$desc$text <- private$..desc
#check the private content since the print is not updating
print(private$..counter)
print(private$..dp)
print(private$..desc)
})
}
),
active = list(
.counter = function(value){
if(missing(value)){
private$..counter
}else{
private$..counter <- value
}
}
),
public = list(
#create names for ui elements
button = NULL,
text = NULL,
#Need this to update the text***************
desc = reactiveValues(text = NA),
initialize = function(counter = self$.counter){
self$.counter <- counter
self$button <- self$get_id("button")
self$text <- self$get_id("text")
self$update_private()
self$desc$text <- private$..desc
},
#gives ui outputs unique names tied to the user's id
get_id = function(name, ns = NS(NULL)){
ns <- NS(ns(private$..id))
id <- ns(name)
return(id)
},
#automatically updates the private field based on the counter
update_private = function(){
if(private$..counter == 1){
private$..dp <- "dp1"
} else if(private$..counter == 2){
private$..dp <- "dp2"
} else{
private$..dp <- "dp3"
}
private$..desc <- private$..df[private$..df$dp == private$..dp, "desc"]
},
ui = function(){
fluidPage(
h1("An Example"),
mainPanel(
textOutput(self$text)),
sidebarPanel(
shiny::actionButton(inputId = self$button,
label = 'Update!',
width = '100%'
))
)
},#end ui
server = function(input, output, session){
counter <- reactiveVal(private$..counter)
callModule(module = private$.server, id = private$..id)
}
)
)
第 2 页
page2 <- R6::R6Class(classname = "Page2",
private = list(
..init = NULL,
#unique string id
..id = NULL,
#the underlying server, to be created like a normal server
.server = function(input, output, session){
}
),
active = list(
.init = function(value){
if(missing(value)){
message("init class object required")
}else{
private$..init <- value
}
}
),
public = list(
initialize = function(init = self$.init){
self$.init <- init
private$..id <- private$..init$id
},
#gives ui outputs unique names tied to the user's id
get_id = function(name, ns = NS(NULL)){
ns <- NS(ns(private$..id))
id <- ns(name)
return(id)
},
ui = function(){
fluidPage(
h1("An Example Connection"),
mainPanel(
"Thanks for participating!")
)
},#end ui
server = function(input, output, session){
callModule(module = private$.server, id = private$..id)
}
)
)
应用程序
app1 <- page1$new()
app2 <- page2$new(init = app1)
#*******HELP************
ui <- app1$ui()
server <- function(input, output, session) {
app1$server()
app2$server()
}
shinyApp(ui = ui, server = server)
这里是这个问题的答案，以防其他人遇到这些问题。本质上，使用 id 和 ns 你可以用 div 保存 ui 元素，当满足条件时，div 会反应性地显示和隐藏。
library(R6)
library(stringi)
library(shiny)
library(shinyjs)
df <- data.frame(dp = c("dp1", "dp2", "dp3"), desc = c("problem 1", "problem 2", "problem 3"))
page1 <- R6::R6Class(classname = "Page1",
private = list(
#unique string id
..id = NULL,
#the data to be iterated through
..df = df,
#counter to uqpdate text
..counter = 1,
#initiating the dp and desc
..dp = NA,
..desc = NA,
#the underlying server, to be created like a normal server
.server = function(input, output, session){
output$text <- renderText({
self$desc$text
})
observeEvent(input$button, {
private$..counter <- private$..counter + 1
if (private$..counter == 4){
print('here')
shinyjs::hide(id = 'uip1')
shinyjs::show(id = 'uip2')
}
self$update_private()
self$desc$text <- private$..desc
#check the private content since the print is not updating
print(private$..counter)
print(private$..dp)
print(private$..desc)
})
}
),
active = list(
.id = function(value){
if(missing(value)){
private$..id
}else{
private$..id <- value
}
},
.counter = function(value){
if(missing(value)){
private$..counter
}else{
private$..counter <- value
}
}
),
public = list(
#create names for ui elements
button = NULL,
text = NULL,
#Need this to update the text***************
desc = reactiveValues(text = NA),
initialize = function(
id = self$.id,
counter = self$.counter){
self$.id <- id
self$.counter <- counter
self$button <- self$get_id("button")
self$text <- self$get_id("text")
self$update_private()
self$desc$text <- private$..desc
},
#gives ui outputs unique names tied to the user's id
get_id = function(name, ns = NS(NULL)){
ns <- NS(ns(private$..id))
id <- ns(name)
return(id)
},
#automatically updates the private field based on the counter
update_private = function(){
if(private$..counter == 1){
private$..dp <- "dp1"
} else if(private$..counter == 2){
private$..dp <- "dp2"
} else{
private$..dp <- "dp3"
}
private$..desc <- private$..df[private$..df$dp == private$..dp, "desc"]
},
ui = function(){
fluidPage(
h1("An Example"),
mainPanel(
textOutput(self$text)),
sidebarPanel(
shiny::actionButton(inputId = self$button,
label = 'Update!',
width = '100%'
))
)
},#end ui
server = function(input, output, session){
callModule(module = private$.server, id = private$..id)
}
)
)
#page 2 - thank you
page2 <- R6::R6Class(classname = "Page2",
private = list(
#unique string id
..id = NULL,
#the underlying server, to be created like a normal server
.server = function(input, output, session){
}
),
active = list(
.id = function(value){
if(missing(value)){
private$..id
}else{
private$..id <- value
}
}
),
public = list(
initialize = function(id = self$.id){
self$.id <- id
},
#gives ui outputs unique names tied to the user's id
get_id = function(name, ns = NS(NULL)){
ns <- NS(ns(private$..id))
id <- ns(name)
return(id)
},
ui = function(){
fluidPage(
h1("An Example Connection"),
mainPanel(
"Thanks for participating!")
)
},#end ui
server = function(input, output, session){
callModule(module = private$.server, id = private$..id)
}
)
)
get_id <- function(name, id, ns = NS(NULL)){
ns <- NS(ns(id))
id <- ns(name)
return(id)
}
id <- stringi::stri_rand_strings(1, 18)
app1 <- page1$new(id = id)
app2 <- page2$new(id = id)
#NEED: without this, the elements won't react
uip1 <- get_id("uip1", id)
uip2 <- get_id("uip2", id)
ui <- shiny::tagList(
shinyjs::useShinyjs(),
div(id = uip1,
style = "display:show;",
app1$ui()
),
div(id = uip2,
style = "display:none;",
app2$ui()
)
)
server <- function(input, output, session) {
app1$server()
app2$server()
}
shinyApp(ui = ui, server = server)
我想连接两个用单独的 R6 类 编码的闪亮页面。我真的很困惑如何去做这件事。下面是一个简单的工作示例。当Page1中的private$..counter == 4时，我想隐藏Page1中的所有内容并激活Page2。我知道一个简单的 showModal，模态对话框可以说“谢谢”。我只是用了一个简单的例子。实际上，这个新页面还会显示更复杂的内容，例如 Page1。有什么方法可以使用 shinyjs 实现我想要的吗？还是其他方式？
第 1 页
library(R6)
library(stringi)
library(shiny)
df <- data.frame(dp = c("dp1", "dp2", "dp3"), desc = c("problem 1", "problem 2", "problem 3"))
page1 <- R6::R6Class(classname = "Page1",
private = list(
#unique string id
..id = stringi::stri_rand_strings(1, 18),
#the data to be iterated through
..df = df,
#counter to uqpdate text
..counter = 1,
#initiating the dp and desc
..dp = NA,
..desc = NA,
#the underlying server, to be created like a normal server
.server = function(input, output, session){
output$text <- renderText({
self$desc$text
})
observeEvent(input$button, {
private$..counter <- private$..counter + 1
self$update_private()
self$desc$text <- private$..desc
#check the private content since the print is not updating
print(private$..counter)
print(private$..dp)
print(private$..desc)
})
}
),
active = list(
.counter = function(value){
if(missing(value)){
private$..counter
}else{
private$..counter <- value
}
}
),
public = list(
#create names for ui elements
button = NULL,
text = NULL,
#Need this to update the text***************
desc = reactiveValues(text = NA),
initialize = function(counter = self$.counter){
self$.counter <- counter
self$button <- self$get_id("button")
self$text <- self$get_id("text")
self$update_private()
self$desc$text <- private$..desc
},
#gives ui outputs unique names tied to the user's id
get_id = function(name, ns = NS(NULL)){
ns <- NS(ns(private$..id))
id <- ns(name)
return(id)
},
#automatically updates the private field based on the counter
update_private = function(){
if(private$..counter == 1){
private$..dp <- "dp1"
} else if(private$..counter == 2){
private$..dp <- "dp2"
} else{
private$..dp <- "dp3"
}
private$..desc <- private$..df[private$..df$dp == private$..dp, "desc"]
},
ui = function(){
fluidPage(
h1("An Example"),
mainPanel(
textOutput(self$text)),
sidebarPanel(
shiny::actionButton(inputId = self$button,
label = 'Update!',
width = '100%'
))
)
},#end ui
server = function(input, output, session){
counter <- reactiveVal(private$..counter)
callModule(module = private$.server, id = private$..id)
}
)
)
第 2 页
page2 <- R6::R6Class(classname = "Page2",
private = list(
..init = NULL,
#unique string id
..id = NULL,
#the underlying server, to be created like a normal server
.server = function(input, output, session){
}
),
active = list(
.init = function(value){
if(missing(value)){
message("init class object required")
}else{
private$..init <- value
}
}
),
public = list(
initialize = function(init = self$.init){
self$.init <- init
private$..id <- private$..init$id
},
#gives ui outputs unique names tied to the user's id
get_id = function(name, ns = NS(NULL)){
ns <- NS(ns(private$..id))
id <- ns(name)
return(id)
},
ui = function(){
fluidPage(
h1("An Example Connection"),
mainPanel(
"Thanks for participating!")
)
},#end ui
server = function(input, output, session){
callModule(module = private$.server, id = private$..id)
}
)
)
应用程序
app1 <- page1$new()
app2 <- page2$new(init = app1)
#*******HELP************
ui <- app1$ui()
server <- function(input, output, session) {
app1$server()
app2$server()
}
shinyApp(ui = ui, server = server)
这里是这个问题的答案，以防其他人遇到这些问题。本质上，使用 id 和 ns 你可以用 div 保存 ui 元素，当满足条件时，div 会反应性地显示和隐藏。
library(R6)
library(stringi)
library(shiny)
library(shinyjs)
df <- data.frame(dp = c("dp1", "dp2", "dp3"), desc = c("problem 1", "problem 2", "problem 3"))
page1 <- R6::R6Class(classname = "Page1",
private = list(
#unique string id
..id = NULL,
#the data to be iterated through
..df = df,
#counter to uqpdate text
..counter = 1,
#initiating the dp and desc
..dp = NA,
..desc = NA,
#the underlying server, to be created like a normal server
.server = function(input, output, session){
output$text <- renderText({
self$desc$text
})
observeEvent(input$button, {
private$..counter <- private$..counter + 1
if (private$..counter == 4){
print('here')
shinyjs::hide(id = 'uip1')
shinyjs::show(id = 'uip2')
}
self$update_private()
self$desc$text <- private$..desc
#check the private content since the print is not updating
print(private$..counter)
print(private$..dp)
print(private$..desc)
})
}
),
active = list(
.id = function(value){
if(missing(value)){
private$..id
}else{
private$..id <- value
}
},
.counter = function(value){
if(missing(value)){
private$..counter
}else{
private$..counter <- value
}
}
),
public = list(
#create names for ui elements
button = NULL,
text = NULL,
#Need this to update the text***************
desc = reactiveValues(text = NA),
initialize = function(
id = self$.id,
counter = self$.counter){
self$.id <- id
self$.counter <- counter
self$button <- self$get_id("button")
self$text <- self$get_id("text")
self$update_private()
self$desc$text <- private$..desc
},
#gives ui outputs unique names tied to the user's id
get_id = function(name, ns = NS(NULL)){
ns <- NS(ns(private$..id))
id <- ns(name)
return(id)
},
#automatically updates the private field based on the counter
update_private = function(){
if(private$..counter == 1){
private$..dp <- "dp1"
} else if(private$..counter == 2){
private$..dp <- "dp2"
} else{
private$..dp <- "dp3"
}
private$..desc <- private$..df[private$..df$dp == private$..dp, "desc"]
},
ui = function(){
fluidPage(
h1("An Example"),
mainPanel(
textOutput(self$text)),
sidebarPanel(
shiny::actionButton(inputId = self$button,
label = 'Update!',
width = '100%'
))
)
},#end ui
server = function(input, output, session){
callModule(module = private$.server, id = private$..id)
}
)
)
#page 2 - thank you
page2 <- R6::R6Class(classname = "Page2",
private = list(
#unique string id
..id = NULL,
#the underlying server, to be created like a normal server
.server = function(input, output, session){
}
),
active = list(
.id = function(value){
if(missing(value)){
private$..id
}else{
private$..id <- value
}
}
),
public = list(
initialize = function(id = self$.id){
self$.id <- id
},
#gives ui outputs unique names tied to the user's id
get_id = function(name, ns = NS(NULL)){
ns <- NS(ns(private$..id))
id <- ns(name)
return(id)
},
ui = function(){
fluidPage(
h1("An Example Connection"),
mainPanel(
"Thanks for participating!")
)
},#end ui
server = function(input, output, session){
callModule(module = private$.server, id = private$..id)
}
)
)
get_id <- function(name, id, ns = NS(NULL)){
ns <- NS(ns(id))
id <- ns(name)
return(id)
}
id <- stringi::stri_rand_strings(1, 18)
app1 <- page1$new(id = id)
app2 <- page2$new(id = id)
#NEED: without this, the elements won't react
uip1 <- get_id("uip1", id)
uip2 <- get_id("uip2", id)
ui <- shiny::tagList(
shinyjs::useShinyjs(),
div(id = uip1,
style = "display:show;",
app1$ui()
),
div(id = uip2,
style = "display:none;",
app2$ui()
)
)
server <- function(input, output, session) {
app1$server()
app2$server()
}
shinyApp(ui = ui, server = server)