当调用使用条件面板的R Shiny应用程序时,如何防止所有面板在进入第一个面板之前闪烁



下面几乎是MWE代码。问题是当打开和调用应用程序时,其他条件面板(选项卡(在设置在标记为";关于";。这很好(应该先显示"关于"选项卡(,但所有先显示的内容都很草率。我该如何防止一切都一闪而过?

从我的研究来看,有一些粗略的解决方案,比如";将所有内容置于renderUI下";我不知道该怎么做。

以下是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)

使用ouputUIrenderUI将条件面板从ui部分移动到server部分,确实消除了调用应用程序时其他项目的闪烁,使应用程序看起来更专业。下面是解析的代码,我在其中获取上面的MWE代码并将条件面板项移动到renderUI。请注意server下方底部的注释部分,标记为">在renderUI中运行observeEvent";。我最初在没有将其包装在renderUI中的情况下,以及当将条件面板移动到renderUI而没有将observeEvent包装在renderUI中时,应用程序会崩溃。将observeEvent封装在renderUI中解决了问题。将其链接到renderUI也是有意义的,但这是通过尝试/错误得出的解决方案,我不完全理解它为什么有效。我希望这以后不会引起问题!!

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)

相关内容

最新更新