在R闪亮中，如何在不使用renderUI的情况下首次调用应用程序时消除侧边栏中所有条件面板的闪烁？
Posted
技术标签:
【中文标题】在R闪亮中，如何在不使用renderUI的情况下首次调用应用程序时消除侧边栏中所有条件面板的闪烁？【英文标题】：In R shiny, how to eliminate flashing of all conditional panels in sidebar when first invoking the App without using renderUI? 【发布时间】：2021-11-08 17:09:18 【问题描述】：这是我 6 月 30 日帖子的后续内容，我在调用应用程序时消除了sidebarPanel 中闪烁的conditionalPanel。解决方案是将这些侧边栏条件面板移动到renderUI，消除闪烁。但是，后来我发现以这种方式使用renderUI 会导致其他限制。有什么方法可以在不使用renderUI的情况下消除调用闪烁？
我包含以下 3 组代码：
-
很短的 MWE 代码说明了闪烁问题，由 ismirsehregal 提供
长而复杂的代码非常清楚地说明了所有条件面板在调用时如何在侧面板中闪烁，当侧边栏条件面板在 UI 中呈现时（没有
renderUI 用于侧边栏面板中的条件面板，如下面的#3解决了这个问题，尽管它引入了本文未解释的其他问题）。
上述#2 的改编，其中使用了renderUI，并且没有调用闪烁。
我不想完全剥离第 2 项和第 3 项中的代码，以便侧边栏面板足够大，从而使调用闪烁更加明显。此外，当我对这段代码进行一些剥离时，我确实失去了一些功能，例如“重置”，无论如何这与手头的问题无关。
尽管 #2 和 #3 中的代码可能非常冗长且复杂，但将条件面板移动到 renderUI 是很简单的。
没有。 1 个短 MWE 代码：
library(shiny)
ui <- fluidPage(
radioButtons("yourChoice", "Display button?", choices = c("Yes", "No"), selected = "No",),
conditionalPanel("input.yourChoice == 'Yes'", actionButton("test", "test"))
# not working: ------------------------------------------------------------
# conditionalPanel("typeof input.yourChoice !== 'undefined' && input.yourChoice == 'Yes'", actionButton("test", "test"))
# conditionalPanel("typeof input !== 'undefined' && input.yourChoice == 'Yes'", actionButton("test", "test"))
)
server <- function(input, output, session)
shinyApp(ui, server)
没有。 2 没有renderUI的长代码，边栏调用闪烁：
library(shiny)
library(shinyMatrix)
library(shinyjs)
library(DT)
matrix1Input <- 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")
matrix2Input <- function(x,y,z)
matrixInput(x,
value = matrix(c(y,z),1,2,dimnames=list(NULL,c("Y","Z"))),
rows = list(extend = TRUE, names = FALSE),
cols = list(extend = FALSE, names = TRUE, editableNames = FALSE),
class = "numeric")
matrixLink <- function(x,y)
observeEvent(input$periods|input$base_input,
updateMatrixInput(session,x,value=matrix(c(input$periods,y),1,2,dimnames=list(NULL, c("y","z"))))
)
matrixValidate <- function(x,y)
a <- y
a[,1][a[,1]>x] <- x
b <- diff(a[,1,drop=FALSE])
b[b<=0] <- NA
b <- c(1,b)
a <- cbind(a,b)
a <- na.omit(a)
a <- a[,-c(3),drop=FALSE]
return(a)
vectorBase <- function(x,y)
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)
vectorMulti <- function(x,y,z)
a <- rep(NA, x)
a[y] <- z
a[seq_len(min(y)-1)] <- a[min(y)]
if(max(y) < x)a[seq(max(y)+1, x, 1)] <- 0
a <- approx(seq_along(a)[!is.na(a)],a[!is.na(a)],seq_along(a))$y
b <- seq(1:x)
c <- data.frame(x=b,z=a)
return(c)
vectorMultiFinal <- function(x,y)vectorMulti(x,matrixValidate(x,y)[,1],matrixValidate(x,y)[,2])
vectorPlot <- function(w,x,y,z)plot(w,main=x,xlab=y,ylab=z,type="b",col="blue",pch=19,cex=1.25)
ui <-
pageWithSidebar(
headerPanel("Model"),
sidebarPanel(
useShinyjs(),
fluidRow(helpText(h4("Base Input Panel"))),
conditionalPanel(condition="input.tabselected==1",h4("Select:")),
conditionalPanel(
condition="input.tabselected==2",
sliderInput('periods','',min=1,max=120,value=60),
matrix1Input("base_input"),
actionButton('showVectorBtn','Show'),
actionButton('hideVectorBtn','Hide'),
actionButton('resetVectorBtn','Reset'),
hidden(uiOutput("Vectors"))
), # close conditional panel
), # close sidebar panel
mainPanel(
useShinyjs(),
tabsetPanel(
tabPanel("About model", value=1, helpText("Model")),
tabPanel("By balances", value=2,
fluidRow(
radioButtons(
inputId = 'mainPanelBtnTab2',
label = h5(helpText("Asset outputs:")),
choices = c('Vector plots','Vector values','Downloads'),
selected = 'Vector plots',
inline = TRUE
) # close radio buttons
), # close fluid row
conditionalPanel(condition="input.mainPanelBtnTab2=='Vector plots'",plotOutput("graph1")),
conditionalPanel(condition="input.mainPanelBtnTab2=='Vector values'",DTOutput("table1")),
), # close tab panel
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)
yield_vector_input <- reactive(input$yield_vector_input)
chargeoff_vector_input <- reactive(input$chargeoff_vector_input)
npr_vector_input <- reactive(input$npr_vector_input)
mpr_vector_input <- reactive(input$mpr_vector_input)
chargeoff <- reactiveValues()
npr <- reactiveValues()
mpr <- reactiveValues()
vectorVariable <- function(x,y)
if(input$showVectorBtn == 0) vectorBase(input$periods,x)
else vectorMultiFinal(input$periods,matrixValidate(input$periods,y))
yield <- function()vectorVariable(input$base_input[1,1],yield_vector_input())
chargeoffs <- function()vectorVariable(input$base_input[2,1],chargeoff_vector_input())
npr <- function()vectorVariable(input$base_input[3,1],npr_vector_input())
mpr <- function()vectorVariable(input$base_input[4,1],mpr_vector_input())
renderUI(
matrixLink("yield_vector_input",input$base_input[1,1])
matrixLink("chargeoff_vector_input",input$base_input[2,1])
matrixLink("npr_vector_input",input$base_input[3,1])
matrixLink("mpr_vector_input",input$base_input[4,1])
) # close renderUI
output$Vectors <- renderUI(
input$resetVectorBtn
tagList(
matrix2Input("yield_vector_input",input$periods,input$base_input[1,1]),
matrix2Input("chargeoff_vector_input",input$periods,input$base_input[2,1]),
matrix2Input("npr_vector_input",input$periods,input$base_input[3,1]),
matrix2Input("mpr_vector_input",input$periods,input$base_input[4,1])
) # close tag list
) # close render UI
observeEvent(input$showVectorBtn,shinyjs::show("Vectors"))
observeEvent(input$hideVectorBtn,shinyjs::hide("Vectors"))
vectorsAll <- reactive(
cbind(Period = 1:periods(),
Yld_Rate = yield()[,2],
Chg_Rate = chargeoffs()[,2],
Pur_Rate = npr()[,2],
Pmt_Rate = mpr()[,2]
) # close cbind
) # close reactive
output$graph1 <-renderPlot(vectorPlot(yield(),"Annual gross portfolio yield","Period","Rate"))
output$table1 <- renderDT(vectorsAll(),
options=list(columnDefs=list(list(className='dt-center',targets=0:4)))
) # close renderDT
output$balancePlot <- renderPlot(vectorPlot(bal(),"Asset bal","Period","Balances OS"))
output$download <- downloadHandler(
filename = function() paste("Yield","png",sep="."),
content = function(file)
png(file)
vectorPlot(yield(),"Annual yield","Period","Rate")
dev.off()
# close content function
) # close download handler
observeEvent(input$mainPanelBtnTab2,
req(input$mainPanelBtnTab2 == "Downloads")
showModal(
modalDialog(
selectInput("downloadItem","Selection:",c("Yield plot")),
downloadButton("download", "Download")
) # close modal dialog
) # close show modal
updateRadioButtons(inputId = "mainPanelBtnTab2", selected = "Vector plots")
) # close observeEvent
) # close server
shinyApp(ui, server)
没有。 3 用renderUI 重新处理#2 的长代码，并且没有侧边栏调用闪烁（省略自定义函数，因为它们与上面的代码相同）：
ui <-
pageWithSidebar(
headerPanel("Model"),
sidebarPanel(
useShinyjs(),
fluidRow(helpText(h4("Base Input Panel"))),
uiOutput("Panels")
), # close sidebar panel
mainPanel(
useShinyjs(),
tabsetPanel(
tabPanel("About model", value=1, helpText("Model")),
tabPanel("By balances", value=2,
fluidRow(
radioButtons(
inputId = 'mainPanelBtnTab2',
label = h5(helpText("Asset outputs:")),
choices = c('Vector plots','Vector values','Downloads'),
selected = 'Vector plots',
inline = TRUE
) # close radio buttons
), # close fluid row
conditionalPanel(condition="input.mainPanelBtnTab2=='Vector plots'",plotOutput("graph1")),
conditionalPanel(condition="input.mainPanelBtnTab2=='Vector values'",DTOutput("table1")),
), # close tab panel
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)
yield_vector_input <- reactive(input$yield_vector_input)
chargeoff_vector_input <- reactive(input$chargeoff_vector_input)
npr_vector_input <- reactive(input$npr_vector_input)
mpr_vector_input <- reactive(input$mpr_vector_input)
chargeoff <- reactiveValues()
npr <- reactiveValues()
mpr <- reactiveValues()
vectorVariable <- function(x,y)
if(input$showVectorBtn == 0) vectorBase(input$periods,x)
else vectorMultiFinal(input$periods,matrixValidate(input$periods,y))
yield <- function()vectorVariable(input$base_input[1,1],yield_vector_input())
chargeoffs <- function()vectorVariable(input$base_input[2,1],chargeoff_vector_input())
npr <- function()vectorVariable(input$base_input[3,1],npr_vector_input())
mpr <- function()vectorVariable(input$base_input[4,1],mpr_vector_input())
output$Panels <- renderUI(
tagList(
conditionalPanel(condition="input.tabselected==1",h4("Select:")),
conditionalPanel(
condition="input.tabselected==2",
sliderInput('periods','',min=1,max=120,value=60),
matrix1Input("base_input"),
actionButton('showVectorBtn','Show'),
actionButton('hideVectorBtn','Hide'),
actionButton('resetVectorBtn','Reset'),
hidden(uiOutput("Vectors"))
), # close conditional panel
) # close tag list
) # close renderUI
renderUI(
matrixLink("yield_vector_input",input$base_input[1,1])
matrixLink("chargeoff_vector_input",input$base_input[2,1])
matrixLink("npr_vector_input",input$base_input[3,1])
matrixLink("mpr_vector_input",input$base_input[4,1])
) # close renderUI
output$Vectors <- renderUI(
input$resetVectorBtn
tagList(
matrix2Input("yield_vector_input",input$periods,input$base_input[1,1]),
matrix2Input("chargeoff_vector_input",input$periods,input$base_input[2,1]),
matrix2Input("npr_vector_input",input$periods,input$base_input[3,1]),
matrix2Input("mpr_vector_input",input$periods,input$base_input[4,1])
) # close tag list
) # close render UI
observeEvent(input$showVectorBtn,shinyjs::show("Vectors"))
observeEvent(input$hideVectorBtn,shinyjs::hide("Vectors"))
vectorsAll <- reactive(
cbind(Period = 1:periods(),
Yld_Rate = yield()[,2],
Chg_Rate = chargeoffs()[,2],
Pur_Rate = npr()[,2],
Pmt_Rate = mpr()[,2]
) # close cbind
) # close reactive
output$graph1 <-renderPlot(vectorPlot(yield(),"Annual gross portfolio yield","Period","Rate"))
output$table1 <- renderDT(vectorsAll(),
options=list(columnDefs=list(list(className='dt-center',targets=0:4)))
) # close renderDT
output$balancePlot <- renderPlot(vectorPlot(bal(),"Asset bal","Period","Balances OS"))
output$download <- downloadHandler(
filename = function() paste("Yield","png",sep="."),
content = function(file)
png(file)
vectorPlot(yield(),"Annual yield","Period","Rate")
dev.off()
# close content function
) # close download handler
observeEvent(input$mainPanelBtnTab2,
req(input$mainPanelBtnTab2 == "Downloads")
showModal(
modalDialog(
selectInput("downloadItem","Selection:",c("Yield plot")),
downloadButton("download", "Download")
) # close modal dialog
) # close show modal
updateRadioButtons(inputId = "mainPanelBtnTab2", selected = "Vector plots")
) # close observeEvent
) # close server
shinyApp(ui, server)
【问题讨论】：
你为什么总是发布大容量的应用程序？一个最小的应用程序足以显示闪烁问题。 我曾在另一篇文章中就这个问题与某人合作过，他/她对代码很熟悉，所以我没有费心削减尽可能多的优化。这篇文章真的是为那个人准备的。但是我看到不熟悉此代码的人实际上解决了它。将来会确保减少到最低限度。 这很难。我能够重现这种行为并做了一些测试。除了使用来自library(shinyjs) 的hidden 之外，到目前为止，我还没有基于UI 的解决方案。我做了一个 MWE 并将其发布到here。如果您喜欢将其复制到 SO 以减少其他人调查问题的工作量。
现在我得到了一些feedback on GitHub。 Stéphane Laurent 和 Joe cheng 提供了一些基于 CSS 的解决方案。另请参阅下面的答案。
【参考方案1】：
现在我得到了一些feedback on GitHub。
设置style = "display: none;"可以避免闪烁。
在 UI 中解决这个问题，而不是使用基于服务器的解决方法（@EliBerkow 的回答）可以更快地加载 UI。
library(shiny)
ui <- fluidPage(
radioButtons("yourChoice", "Display button?", choices = c("Yes", "No"), selected = "No",),
conditionalPanel("input.yourChoice == 'Yes'", style = "display: none;", actionButton("test", "test"))
)
server <- function(input, output, session)
shinyApp(ui, server)
应用于@CuriousJorge-user9788072 的代码：
library(shiny)
library(shinyMatrix)
library(shinyjs)
library(DT)
matrix1Input <- 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")
matrix2Input <- function(x,y,z)
matrixInput(x,
value = matrix(c(y,z),1,2,dimnames=list(NULL,c("Y","Z"))),
rows = list(extend = TRUE, names = FALSE),
cols = list(extend = FALSE, names = TRUE, editableNames = FALSE),
class = "numeric")
matrixLink <- function(x,y)
observeEvent(input$periods|input$base_input,
updateMatrixInput(session,x,value=matrix(c(input$periods,y),1,2,dimnames=list(NULL, c("y","z"))))
)
matrixValidate <- function(x,y)
a <- y
a[,1][a[,1]>x] <- x
b <- diff(a[,1,drop=FALSE])
b[b<=0] <- NA
b <- c(1,b)
a <- cbind(a,b)
a <- na.omit(a)
a <- a[,-c(3),drop=FALSE]
return(a)
vectorBase <- function(x,y)
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)
vectorMulti <- function(x,y,z)
a <- rep(NA, x)
a[y] <- z
a[seq_len(min(y)-1)] <- a[min(y)]
if(max(y) < x)a[seq(max(y)+1, x, 1)] <- 0
a <- approx(seq_along(a)[!is.na(a)],a[!is.na(a)],seq_along(a))$y
b <- seq(1:x)
c <- data.frame(x=b,z=a)
return(c)
vectorMultiFinal <- function(x,y)vectorMulti(x,matrixValidate(x,y)[,1],matrixValidate(x,y)[,2])
vectorPlot <- function(w,x,y,z)plot(w,main=x,xlab=y,ylab=z,type="b",col="blue",pch=19,cex=1.25)
ui <-
pageWithSidebar(
headerPanel("Model"),
sidebarPanel(
useShinyjs(),
fluidRow(helpText(h4("Base Input Panel"))),
conditionalPanel(condition="input.tabselected==1",h4("Select:")),
conditionalPanel(
condition="input.tabselected==2",
sliderInput('periods','',min=1,max=120,value=60),
matrix1Input("base_input"),
actionButton('showVectorBtn','Show'),
actionButton('hideVectorBtn','Hide'),
actionButton('resetVectorBtn','Reset'),
hidden(uiOutput("Vectors")),
style = "display: none;"
), # close conditional panel
), # close sidebar panel
mainPanel(
useShinyjs(),
tabsetPanel(
tabPanel("About model", value=1, helpText("Model")),
tabPanel("By balances", value=2,
fluidRow(
radioButtons(
inputId = 'mainPanelBtnTab2',
label = h5(helpText("Asset outputs:")),
choices = c('Vector plots','Vector values','Downloads'),
selected = 'Vector plots',
inline = TRUE
) # close radio buttons
), # close fluid row
conditionalPanel(condition="input.mainPanelBtnTab2=='Vector plots'",plotOutput("graph1")),
conditionalPanel(condition="input.mainPanelBtnTab2=='Vector values'",DTOutput("table1")),
), # close tab panel
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)
yield_vector_input <- reactive(input$yield_vector_input)
chargeoff_vector_input <- reactive(input$chargeoff_vector_input)
npr_vector_input <- reactive(input$npr_vector_input)
mpr_vector_input <- reactive(input$mpr_vector_input)
chargeoff <- reactiveValues()
npr <- reactiveValues()
mpr <- reactiveValues()
vectorVariable <- function(x,y)
if(input$showVectorBtn == 0) vectorBase(input$periods,x)
else vectorMultiFinal(input$periods,matrixValidate(input$periods,y))
yield <- function()vectorVariable(input$base_input[1,1],yield_vector_input())
chargeoffs <- function()vectorVariable(input$base_input[2,1],chargeoff_vector_input())
npr <- function()vectorVariable(input$base_input[3,1],npr_vector_input())
mpr <- function()vectorVariable(input$base_input[4,1],mpr_vector_input())
renderUI(
matrixLink("yield_vector_input",input$base_input[1,1])
matrixLink("chargeoff_vector_input",input$base_input[2,1])
matrixLink("npr_vector_input",input$base_input[3,1])
matrixLink("mpr_vector_input",input$base_input[4,1])
) # close renderUI
output$Vectors <- renderUI(
input$resetVectorBtn
tagList(
matrix2Input("yield_vector_input",input$periods,input$base_input[1,1]),
matrix2Input("chargeoff_vector_input",input$periods,input$base_input[2,1]),
matrix2Input("npr_vector_input",input$periods,input$base_input[3,1]),
matrix2Input("mpr_vector_input",input$periods,input$base_input[4,1])
) # close tag list
) # close render UI
observeEvent(input$showVectorBtn,shinyjs::show("Vectors"))
observeEvent(input$hideVectorBtn,shinyjs::hide("Vectors"))
vectorsAll <- reactive(
cbind(Period = 1:periods(),
Yld_Rate = yield()[,2],
Chg_Rate = chargeoffs()[,2],
Pur_Rate = npr()[,2],
Pmt_Rate = mpr()[,2]
) # close cbind
) # close reactive
output$graph1 <-renderPlot(vectorPlot(yield(),"Annual gross portfolio yield","Period","Rate"))
output$table1 <- renderDT(vectorsAll(),
options=list(columnDefs=list(list(className='dt-center',targets=0:4)))
) # close renderDT
output$balancePlot <- renderPlot(vectorPlot(bal(),"Asset bal","Period","Balances OS"))
output$download <- downloadHandler(
filename = function() paste("Yield","png",sep="."),
content = function(file)
png(file)
vectorPlot(yield(),"Annual yield","Period","Rate")
dev.off()
# close content function
) # close download handler
observeEvent(input$mainPanelBtnTab2,
req(input$mainPanelBtnTab2 == "Downloads")
showModal(
modalDialog(
selectInput("downloadItem","Selection:",c("Yield plot")),
downloadButton("download", "Download")
) # close modal dialog
) # close show modal
updateRadioButtons(inputId = "mainPanelBtnTab2", selected = "Vector plots")
) # close observeEvent
) # close server
shinyApp(ui, server)
【讨论】：
【参考方案2】：在服务器中使用observeEvent 而不是在用户界面中使用conditionalPanel，如下所示（参见#Added Code）。我还需要向h4() 添加一个ID，并从前面的所有第二个标签边栏按钮hidden 开始。最后我将ignoreInit = TRUE 添加到observeEvent，因为它最初是不必要的：
library(shiny)
library(shinyMatrix)
library(shinyjs)
library(DT)
matrix1Input <- 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")
matrix2Input <- function(x,y,z)
matrixInput(x,
value = matrix(c(y,z),1,2,dimnames=list(NULL,c("Y","Z"))),
rows = list(extend = TRUE, names = FALSE),
cols = list(extend = FALSE, names = TRUE, editableNames = FALSE),
class = "numeric")
matrixLink <- function(x,y)
observeEvent(input$periods|input$base_input,
updateMatrixInput(session,x,value=matrix(c(input$periods,y),1,2,dimnames=list(NULL, c("y","z"))))
)
matrixValidate <- function(x,y)
a <- y
a[,1][a[,1]>x] <- x
b <- diff(a[,1,drop=FALSE])
b[b<=0] <- NA
b <- c(1,b)
a <- cbind(a,b)
a <- na.omit(a)
a <- a[,-c(3),drop=FALSE]
return(a)
vectorBase <- function(x,y)
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)
vectorMulti <- function(x,y,z)
a <- rep(NA, x)
a[y] <- z
a[seq_len(min(y)-1)] <- a[min(y)]
if(max(y) < x)a[seq(max(y)+1, x, 1)] <- 0
a <- approx(seq_along(a)[!is.na(a)],a[!is.na(a)],seq_along(a))$y
b <- seq(1:x)
c <- data.frame(x=b,z=a)
return(c)
vectorMultiFinal <- function(x,y)vectorMulti(x,matrixValidate(x,y)[,1],matrixValidate(x,y)[,2])
vectorPlot <- function(w,x,y,z)plot(w,main=x,xlab=y,ylab=z,type="b",col="blue",pch=19,cex=1.25)
ui <-
pageWithSidebar(
headerPanel("Model"),
sidebarPanel(
useShinyjs(),
fluidRow(helpText(h4("Base Input Panel"))),
h4(id = 'select', "Select:", ),
hidden(sliderInput('periods','',min=1,max=120,value=60)),
hidden(matrix1Input("base_input")),
hidden(actionButton('showVectorBtn','Show')),
hidden(actionButton('hideVectorBtn','Hide')),
hidden(actionButton('resetVectorBtn','Reset')),
hidden(uiOutput("Vectors"))
), # close sidebar panel
mainPanel(
useShinyjs(),
tabsetPanel(
tabPanel("About model", value=1, helpText("Model")),
tabPanel("By balances", value=2,
fluidRow(
radioButtons(
inputId = 'mainPanelBtnTab2',
label = h5(helpText("Asset outputs:")),
choices = c('Vector plots','Vector values','Downloads'),
selected = 'Vector plots',
inline = TRUE
) # close radio buttons
), # close fluid row
conditionalPanel(condition="input.mainPanelBtnTab2=='Vector plots'",plotOutput("graph1")),
conditionalPanel(condition="input.mainPanelBtnTab2=='Vector values'",DTOutput("table1")),
), # close tab panel
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)
yield_vector_input <- reactive(input$yield_vector_input)
chargeoff_vector_input <- reactive(input$chargeoff_vector_input)
npr_vector_input <- reactive(input$npr_vector_input)
mpr_vector_input <- reactive(input$mpr_vector_input)
chargeoff <- reactiveValues()
npr <- reactiveValues()
mpr <- reactiveValues()
vectorVariable <- function(x,y)
if(input$showVectorBtn == 0) vectorBase(input$periods,x)
else vectorMultiFinal(input$periods,matrixValidate(input$periods,y))
yield <- function()vectorVariable(input$base_input[1,1],yield_vector_input())
chargeoffs <- function()vectorVariable(input$base_input[2,1],chargeoff_vector_input())
npr <- function()vectorVariable(input$base_input[3,1],npr_vector_input())
mpr <- function()vectorVariable(input$base_input[4,1],mpr_vector_input())
renderUI(
matrixLink("yield_vector_input",input$base_input[1,1])
matrixLink("chargeoff_vector_input",input$base_input[2,1])
matrixLink("npr_vector_input",input$base_input[3,1])
matrixLink("mpr_vector_input",input$base_input[4,1])
) # close renderUI
output$Vectors <- renderUI(
input$resetVectorBtn
tagList(
matrix2Input("yield_vector_input",input$periods,input$base_input[1,1]),
matrix2Input("chargeoff_vector_input",input$periods,input$base_input[2,1]),
matrix2Input("npr_vector_input",input$periods,input$base_input[3,1]),
matrix2Input("mpr_vector_input",input$periods,input$base_input[4,1])
) # close tag list
) # close render UI
# Added Code
observeEvent(input$tabselected,
if (input$tabselected == 1)
show('select')
hide('periods')
hide("base_input")
hide('showVectorBtn')
hide('hideVectorBtn')
hide('resetVectorBtn')
else
hide('select')
show('periods')
show("base_input")
show('showVectorBtn')
show('hideVectorBtn')
show('resetVectorBtn')
, ignoreInit = TRUE)
observeEvent(input$showVectorBtn,shinyjs::show("Vectors"))
observeEvent(input$hideVectorBtn,shinyjs::hide("Vectors"))
vectorsAll <- reactive(
cbind(Period = 1:periods(),
Yld_Rate = yield()[,2],
Chg_Rate = chargeoffs()[,2],
Pur_Rate = npr()[,2],
Pmt_Rate = mpr()[,2]
) # close cbind
) # close reactive
output$graph1 <-renderPlot(vectorPlot(yield(),"Annual gross portfolio yield","Period","Rate"))
output$table1 <- renderDT(vectorsAll(),
options=list(columnDefs=list(list(className='dt-center',targets=0:4)))
) # close renderDT
output$balancePlot <- renderPlot(vectorPlot(bal(),"Asset bal","Period","Balances OS"))
output$download <- downloadHandler(
filename = function() paste("Yield","png",sep="."),
content = function(file)
png(file)
vectorPlot(yield(),"Annual yield","Period","Rate")
dev.off()
# close content function
) # close download handler
observeEvent(input$mainPanelBtnTab2,
req(input$mainPanelBtnTab2 == "Downloads")
showModal(
modalDialog(
selectInput("downloadItem","Selection:",c("Yield plot")),
downloadButton("download", "Download")
) # close modal dialog
) # close show modal
updateRadioButtons(inputId = "mainPanelBtnTab2", selected = "Vector plots")
) # close observeEvent
) # close server
shinyApp(ui, server)
【讨论】：
Eli 花了你相当多的时间和精力来解决。抱歉，代码太复杂了！您的解决方案在我测试的场景中运行良好，非常感谢！ 豪尔赫，没问题。其实还不错。我经常使用闪亮的东西，并且以前见过这些例子。我设法很容易地隔离了您所询问的代码。无论如何，很高兴能提供帮助。我确实同意 Stéphane Laurent 的观点，尽管你应该简化你的代码以解决未来的问题。 请注意，这在这个只有 2 个选项卡的示例中可以正常工作。但是，当一个应用程序有多个选项卡时，这个解决方案会变得非常麻烦，因为“observeEvent(input$tabselected...”部分中的显示/隐藏列表很长。 您可以做的是创建一个 div，其中包含每个选项卡的所有按钮/输入，这会稍微好一些。您可以使用其 id 来显示或隐藏所有内容。 实际上你最好的选择是预先设置一个 tabsetPanel，然后每个 tabPanel 都有自己的 pageWithSidebar。有点与你所拥有的相反。这将自动将每个侧边栏保留在其各自的 tabPanel 中，而无需额外的代码。以上是关于在R闪亮中，如何在不使用renderUI的情况下首次调用应用程序时消除侧边栏中所有条件面板的闪烁？的主要内容，如果未能解决你的问题，请参考以下文章
闪亮的 renderUI selectInput 返回 NULL