可以在 R shiny 中嵌套 outputUI 和 renderUI 吗？
Possible to nest outputUI and renderUI in R shiny?
我试图通过将条件面板包装在 renderUI 函数中，将条件面板从 ui 部分移动到 server 部分。我这样做是为了消除在设置条件面板之前调用应用程序时其他项目的闪烁。我在一个更简单的应用程序上尝试过这个，这就是这个技巧。但是，当我在此处发布的 MWE 代码上尝试它时，我收到一条错误消息。这个 MWE 更复杂的是，我要移动到 renderUI 的条件面板之一已经调用了另一个 renderUI。我假设可以嵌套 outputUI/renderUI。有什么办法可以做到这一点吗？
下面是 2 个代码示例。第一个 MWE 正常工作（除了在设置条件面板之前闪烁其他内容 - 移动到 renderUI 应该解决）。下面的第二组代码反映了我尝试使用 renderUI.
将条件面板从 ui 移动到 server
工作 MWE：
library(shiny)
library(shinyMatrix)
library(shinyjs)
matrix1.input <- function(x){
matrixInput(
x,
value = matrix(c(0.2), 4, 1, dimnames = list(c("A","B","C","D"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
vector.base <- function(x,y){
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)}
ui <-
pageWithSidebar(
headerPanel("Model"),
sidebarPanel(
conditionalPanel(condition="input.tabselected==1"),
conditionalPanel(
condition="input.tabselected==2",
sliderInput('periods','Input periods:',min=1,max=120,value=60),
matrix1.input("base_input"),
useShinyjs(),
actionButton('showPerfVectorBtn','Show'),
actionButton('hidePerfVectorBtn','Hide'),
actionButton('resetPerfVectorBtn','Reset'),
hidden(uiOutput("Vectors"))
) # close conditional panel
), # close sidebar panel
mainPanel(
tabsetPanel(
tabPanel("About",value=1),
tabPanel("Dynamic",value=2,plotOutput("graph1")),
id = "tabselected"
) # close tabset panel
) # close main panel
) # close page with sidebar
server <- function(input,output,session)({
periods <- reactive(input$periods)
base_input <- reactive(input$base_input)
vector_input <- reactive(input$vector_input)
observeEvent(input$periods|input$base_input,{
updateMatrixInput(session,"vector_input",
value=matrix(c(input$periods,input$base_input[1,1]),1,2))})
output$Vectors <- renderUI({
input$resetPerfVectorBtn
tagList(matrix1.input("Plot"))
}) # close render UI
observeEvent(input$showPerfVectorBtn, {shinyjs::show("Vectors")})
observeEvent(input$hidePerfVectorBtn, {shinyjs::hide("Vectors")})
output$graph1 <- renderPlot(
if(input$showPerfVectorBtn == 0)
plot(vector.base(periods(),input$base_input[1,1]))
else plot(vector.base(periods(),input$base_input[1,1])))
}) # close server
shinyApp(ui, server)
崩溃代码，我尝试使用 renderUI 将条件面板从 ui 移动到 server（定义的函数 matrix1.input 和 vector.base 未在下面显示为简洁起见，它们显示在上面的 MWE 代码中）：
ui <-
pageWithSidebar(
headerPanel("Model"),
sidebarPanel(
uiOutput("Panels")
), # close sidebar panel
mainPanel(
tabsetPanel(
tabPanel("About",value=1),
tabPanel("Dynamic",value=2,plotOutput("graph1")),
id = "tabselected"
) # close tabset panel
) # close main panel
) # close page with sidebar
server <- function(input,output,session)({
periods <- reactive(input$periods)
base_input <- reactive(input$base_input)
vector_input <- reactive(input$vector_input)
observeEvent(input$periods|input$base_input,{
updateMatrixInput(session,"vector_input",
value=matrix(c(input$periods,input$base_input[1,1]),1,2))})
output$Panels <- renderUI({
conditionalPanel(condition="input.tabselected==1")
conditionalPanel(
condition="input.tabselected==2",
sliderInput('periods','Input periods:',min=1,max=120,value=60),
matrix1.input("base_input"),
useShinyjs(),
actionButton('showPerfVectorBtn','Show'),
actionButton('hidePerfVectorBtn','Hide'),
actionButton('resetPerfVectorBtn','Reset'),
hidden(uiOutput("Vectors"))
) # close seconds conditional panel
})
output$Vectors <- renderUI({
input$resetPerfVectorBtn
tagList(matrix1.input("Plot"))
}) # close render UI
observeEvent(input$showPerfVectorBtn, {shinyjs::show("Vectors")})
observeEvent(input$hidePerfVectorBtn, {shinyjs::hide("Vectors")})
output$graph1 <- renderPlot(
if(input$showPerfVectorBtn == 0)
plot(vector.base(periods(),input$base_input[1,1]))
else plot(vector.base(periods(),input$base_input[1,1])))
}) # close server
shinyApp(ui, server)
是的，可以在 R shiny 中嵌套 outputUI/renderUI。下面已解决的代码执行此操作。查看 output$Vectors 如何嵌套在 output$Panels 中，两者都在 server 部分使用 renderUI。
所有这些代码移动的 objective 是为了消除首次调用应用程序时所有 ui 项目的快速闪烁，使其显得草率、错误、不专业。使用代码 ui 部分中的 outputUI 和 server 部分中的 renderUI 将条件面板从 ui 移动到 server 部分部分，消除了首次调用应用程序时所有 ui 项的闪烁。
下面是最终解析的代码。上面的“崩溃代码”不起作用，因为 server 下的 renderUI 部分中的条件面板需要包含在 tagList 中，如下所示。一个意外的遗漏。此外，上面的崩溃代码也崩溃了，因为 updateMatrixInput 的 observeEvent 也需要包装在 renderUI 中（关于最后一项，我不确定为什么会这样 - 我它是通过反复试验和直觉得出的。我希望这不会导致未来的另一个问题——通常当我实施一个我不是 100% 理解的“修复”时会发生什么。
library(shiny)
library(shinyMatrix)
library(shinyjs)
matrix1.input <- function(x){
matrixInput(
x,
value = matrix(c(0.2), 4, 1, dimnames = list(c("A","B","C","D"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
vector.base <- function(x,y){
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)}
ui <-
pageWithSidebar(
headerPanel("Model"),
sidebarPanel(
uiOutput("Panels")
), # close sidebar panel
mainPanel(
tabsetPanel(
tabPanel("About",value=1),
tabPanel("Dynamic",value=2,plotOutput("graph1")),
id = "tabselected"
) # close tabset panel
) # close main panel
) # close page with sidebar
server <- function(input,output,session)({
periods <- reactive(input$periods)
base_input <- reactive(input$base_input)
vector_input <- reactive(input$vector_input)
output$Panels <- renderUI({
tagList(
conditionalPanel(condition="input.tabselected==1"),
conditionalPanel(
condition="input.tabselected==2",
sliderInput('periods','Input periods:',min=1,max=120,value=60),
matrix1.input("base_input"),
useShinyjs(),
actionButton('showPerfVectorBtn','Show'),
actionButton('hidePerfVectorBtn','Hide'),
actionButton('resetPerfVectorBtn','Reset'),
hidden(uiOutput("Vectors")),
) # close conditional panel
) # close tagList
}) # close renderUI
output$Vectors <- renderUI({
input$resetPerfVectorBtn
tagList(matrix1.input("Plot"))
}) # close render UI
# run observeEvent in renderUI
renderUI({
observeEvent(input$periods|input$base_input,{
updateMatrixInput(session,"vector_input",
value=matrix(c(input$periods,input$base_input[1,1]),1,2))})
}) # close renderUI
observeEvent(input$showPerfVectorBtn, {shinyjs::show("Vectors")})
observeEvent(input$hidePerfVectorBtn, {shinyjs::hide("Vectors")})
output$graph1 <- renderPlot(
if(input$showPerfVectorBtn == 0)
plot(vector.base(periods(),input$base_input[1,1]))
else plot(vector.base(periods(),input$base_input[1,1])))
}) # close server
shinyApp(ui, server)
我试图通过将条件面板包装在 renderUI 函数中，将条件面板从 ui 部分移动到 server 部分。我这样做是为了消除在设置条件面板之前调用应用程序时其他项目的闪烁。我在一个更简单的应用程序上尝试过这个，这就是这个技巧。但是，当我在此处发布的 MWE 代码上尝试它时，我收到一条错误消息。这个 MWE 更复杂的是，我要移动到 renderUI 的条件面板之一已经调用了另一个 renderUI。我假设可以嵌套 outputUI/renderUI。有什么办法可以做到这一点吗？
下面是 2 个代码示例。第一个 MWE 正常工作（除了在设置条件面板之前闪烁其他内容 - 移动到 renderUI 应该解决）。下面的第二组代码反映了我尝试使用 renderUI.
ui 移动到 server
工作 MWE：
library(shiny)
library(shinyMatrix)
library(shinyjs)
matrix1.input <- function(x){
matrixInput(
x,
value = matrix(c(0.2), 4, 1, dimnames = list(c("A","B","C","D"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
vector.base <- function(x,y){
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)}
ui <-
pageWithSidebar(
headerPanel("Model"),
sidebarPanel(
conditionalPanel(condition="input.tabselected==1"),
conditionalPanel(
condition="input.tabselected==2",
sliderInput('periods','Input periods:',min=1,max=120,value=60),
matrix1.input("base_input"),
useShinyjs(),
actionButton('showPerfVectorBtn','Show'),
actionButton('hidePerfVectorBtn','Hide'),
actionButton('resetPerfVectorBtn','Reset'),
hidden(uiOutput("Vectors"))
) # close conditional panel
), # close sidebar panel
mainPanel(
tabsetPanel(
tabPanel("About",value=1),
tabPanel("Dynamic",value=2,plotOutput("graph1")),
id = "tabselected"
) # close tabset panel
) # close main panel
) # close page with sidebar
server <- function(input,output,session)({
periods <- reactive(input$periods)
base_input <- reactive(input$base_input)
vector_input <- reactive(input$vector_input)
observeEvent(input$periods|input$base_input,{
updateMatrixInput(session,"vector_input",
value=matrix(c(input$periods,input$base_input[1,1]),1,2))})
output$Vectors <- renderUI({
input$resetPerfVectorBtn
tagList(matrix1.input("Plot"))
}) # close render UI
observeEvent(input$showPerfVectorBtn, {shinyjs::show("Vectors")})
observeEvent(input$hidePerfVectorBtn, {shinyjs::hide("Vectors")})
output$graph1 <- renderPlot(
if(input$showPerfVectorBtn == 0)
plot(vector.base(periods(),input$base_input[1,1]))
else plot(vector.base(periods(),input$base_input[1,1])))
}) # close server
shinyApp(ui, server)
崩溃代码，我尝试使用 renderUI 将条件面板从 ui 移动到 server（定义的函数 matrix1.input 和 vector.base 未在下面显示为简洁起见，它们显示在上面的 MWE 代码中）：
ui <-
pageWithSidebar(
headerPanel("Model"),
sidebarPanel(
uiOutput("Panels")
), # close sidebar panel
mainPanel(
tabsetPanel(
tabPanel("About",value=1),
tabPanel("Dynamic",value=2,plotOutput("graph1")),
id = "tabselected"
) # close tabset panel
) # close main panel
) # close page with sidebar
server <- function(input,output,session)({
periods <- reactive(input$periods)
base_input <- reactive(input$base_input)
vector_input <- reactive(input$vector_input)
observeEvent(input$periods|input$base_input,{
updateMatrixInput(session,"vector_input",
value=matrix(c(input$periods,input$base_input[1,1]),1,2))})
output$Panels <- renderUI({
conditionalPanel(condition="input.tabselected==1")
conditionalPanel(
condition="input.tabselected==2",
sliderInput('periods','Input periods:',min=1,max=120,value=60),
matrix1.input("base_input"),
useShinyjs(),
actionButton('showPerfVectorBtn','Show'),
actionButton('hidePerfVectorBtn','Hide'),
actionButton('resetPerfVectorBtn','Reset'),
hidden(uiOutput("Vectors"))
) # close seconds conditional panel
})
output$Vectors <- renderUI({
input$resetPerfVectorBtn
tagList(matrix1.input("Plot"))
}) # close render UI
observeEvent(input$showPerfVectorBtn, {shinyjs::show("Vectors")})
observeEvent(input$hidePerfVectorBtn, {shinyjs::hide("Vectors")})
output$graph1 <- renderPlot(
if(input$showPerfVectorBtn == 0)
plot(vector.base(periods(),input$base_input[1,1]))
else plot(vector.base(periods(),input$base_input[1,1])))
}) # close server
shinyApp(ui, server)
是的，可以在 R shiny 中嵌套 outputUI/renderUI。下面已解决的代码执行此操作。查看 output$Vectors 如何嵌套在 output$Panels 中，两者都在 server 部分使用 renderUI。
所有这些代码移动的 objective 是为了消除首次调用应用程序时所有 ui 项目的快速闪烁，使其显得草率、错误、不专业。使用代码 ui 部分中的 outputUI 和 server 部分中的 renderUI 将条件面板从 ui 移动到 server 部分部分，消除了首次调用应用程序时所有 ui 项的闪烁。
下面是最终解析的代码。上面的“崩溃代码”不起作用，因为 server 下的 renderUI 部分中的条件面板需要包含在 tagList 中，如下所示。一个意外的遗漏。此外，上面的崩溃代码也崩溃了，因为 updateMatrixInput 的 observeEvent 也需要包装在 renderUI 中（关于最后一项，我不确定为什么会这样 - 我它是通过反复试验和直觉得出的。我希望这不会导致未来的另一个问题——通常当我实施一个我不是 100% 理解的“修复”时会发生什么。
library(shiny)
library(shinyMatrix)
library(shinyjs)
matrix1.input <- function(x){
matrixInput(
x,
value = matrix(c(0.2), 4, 1, dimnames = list(c("A","B","C","D"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
vector.base <- function(x,y){
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)}
ui <-
pageWithSidebar(
headerPanel("Model"),
sidebarPanel(
uiOutput("Panels")
), # close sidebar panel
mainPanel(
tabsetPanel(
tabPanel("About",value=1),
tabPanel("Dynamic",value=2,plotOutput("graph1")),
id = "tabselected"
) # close tabset panel
) # close main panel
) # close page with sidebar
server <- function(input,output,session)({
periods <- reactive(input$periods)
base_input <- reactive(input$base_input)
vector_input <- reactive(input$vector_input)
output$Panels <- renderUI({
tagList(
conditionalPanel(condition="input.tabselected==1"),
conditionalPanel(
condition="input.tabselected==2",
sliderInput('periods','Input periods:',min=1,max=120,value=60),
matrix1.input("base_input"),
useShinyjs(),
actionButton('showPerfVectorBtn','Show'),
actionButton('hidePerfVectorBtn','Hide'),
actionButton('resetPerfVectorBtn','Reset'),
hidden(uiOutput("Vectors")),
) # close conditional panel
) # close tagList
}) # close renderUI
output$Vectors <- renderUI({
input$resetPerfVectorBtn
tagList(matrix1.input("Plot"))
}) # close render UI
# run observeEvent in renderUI
renderUI({
observeEvent(input$periods|input$base_input,{
updateMatrixInput(session,"vector_input",
value=matrix(c(input$periods,input$base_input[1,1]),1,2))})
}) # close renderUI
observeEvent(input$showPerfVectorBtn, {shinyjs::show("Vectors")})
observeEvent(input$hidePerfVectorBtn, {shinyjs::hide("Vectors")})
output$graph1 <- renderPlot(
if(input$showPerfVectorBtn == 0)
plot(vector.base(periods(),input$base_input[1,1]))
else plot(vector.base(periods(),input$base_input[1,1])))
}) # close server
shinyApp(ui, server)