下面几乎是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)
使用ouputUI
和renderUI
将条件面板从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)