这是我 6 月 30 日帖子的后续内容，我在调用应用程序时消除了conditionalPanel闪烁。sidebarPanel解决方案是将那些侧边栏条件面板移到renderUI中，消除闪烁。但是，后来我发现renderUI以这种方式使用会导致其他限制。有什么方法可以在不使用的情况下消除调用闪烁renderUI？
我包括以下 3 组代码：
- 非常短的 MWE 代码，说明了闪烁问题，由 ismirsehregal 提供
- 冗长而复杂的代码非常清楚地说明了所有条件面板在调用时如何在侧面板中闪烁，当侧边栏条件面板在 UI 中呈现时（侧边栏面板中没有
renderUI条件面板，如下面的#3 解决了这个问题，尽管它引入了其他这篇文章中没有解释的问题）。 - 上面 #2 的改编 where
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)
No. 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)
No. 3 Long code resloving #2 with renderUI，并且没有侧边栏调用闪烁（省略自定义函数，因为它们与上面的代码相同）：
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)