在R SHINY中，在不使用renderUI的情况下首次调用App时，如何消除侧边栏中所有条件面板的闪烁？ [英] In R shiny, how to eliminate flashing of all conditional panels in sidebar when first invoking the App without using renderUI?
本文介绍了在R SHINY中，在不使用renderUI的情况下首次调用App时，如何消除侧边栏中所有条件面板的闪烁？的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
这是我6月30日发布的帖子的后续内容，在那篇帖子中，我在调用App时消除了conditionalPanel闪烁。解决方案是将这些侧边栏条件面板移到renderUI中，消除闪烁。然而，我后来发现，以这种方式使用renderUI会导致其他限制。是否有办法在不使用renderUI的情况下消除调用闪烁？
我包括以下3组代码：
- 说明闪烁问题的非常简短的MWE代码，由ismirsehregal提供
- 冗长而复杂的代码非常清楚地说明了当侧栏条件面板在UI中呈现时，所有条件面板如何在调用时在侧面板中闪过(像下面的#3中那样，侧栏面板中没有
renderUI来解决这个问题，尽管它引入了本文中没有解释的其他问题)。 - 改编上面的#2，其中使用了
renderUI，并且没有调用闪烁。
我不想完全剥离第2项和第3项中的代码，以使侧栏面板足够大，从而使调用闪烁更明显。此外，当我对此代码进行一些剥离时，我确实丢失了一些功能，如"；Reset"；，这些功能在任何情况下都与手头的问题无关。
尽管#2和#3中的代码可能非常长且复杂，但将条件面板移到renderUI中是简单的。
第一短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号长代码解析#2，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)
推荐答案
现在我收到了一些feedback on GitHub。
设置style = "display: none;"可避免闪烁。
在用户界面中解决此问题，而不是使用基于服务器的解决方法(@EliBerkow的答案)，可以更快地加载用户界面。
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)
这篇关于在R SHINY中，在不使用renderUI的情况下首次调用App时，如何消除侧边栏中所有条件面板的闪烁？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
