在R闪亮中，如何在不使用renderUI的情况下首次调用应用程序时消除侧边栏中所有条件面板的闪烁？

关键词：

【中文标题】在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 闪亮中绘制情节？

...:40:42【问题描述】：请查看带有圆圈文字的图片。我使用renderUI来显示我的情节，但使用它我无法添加像这张图片这样的文字。有人可以帮帮我吗？enterimagedescriptionhere【问题讨论】：您能否提供问题所需的ui和server 查看详情

闪亮的 renderUI selectInput 返回 NULL

】闪亮的renderUIselectInput返回NULL【英文标题】：ShinyrenderUIselectInputreturnedNULL【发布时间】：2015-08-0309:23:09【问题描述】：我正在尝试使用一个反应模型，其中一个输入会影响多个输出，如闪亮的备忘单中所述。我需要使用renderUI... 查看详情

闪亮的 R 渲染图

...tInput()$n_plot？我很感激任何建议！此时，我可以通过调用renderUI来创 查看详情

在闪亮的 server.R 中更新数据框而不重新启动应用程序

】在闪亮的server.R中更新数据框而不重新启动应用程序【英文标题】：Updateadataframeinshinyserver.RwithoutrestartingtheApp【发布时间】：2013-01-3120:52:47【问题描述】：关于如何在不停止和重新启动应用程序的情况下更新闪亮正在使用的数... 查看详情

R Shiny - 将tabPanel动态添加到tabsetPanel（使用renderUI）

】RShiny-将tabPanel动态添加到tabsetPanel（使用renderUI）【英文标题】：RShiny-addtabPaneltotabsetPaneldynamically(withtheuseofrenderUI)【发布时间】：2013-10-2812:33:00【问题描述】：我正在开发一个闪亮的应用程序，我在其中使用tabsetPanel，它是在... 查看详情

shinyjs 不会隐藏使用 renderUI 创建的按钮

】shinyjs不会隐藏使用renderUI创建的按钮【英文标题】：shinyjswon\'thidebuttoncreatedwithrenderUI【发布时间】：2021-06-2616:14:02【问题描述】：我有一个使用shinyproxy制作的闪亮应用程序。在server.R上，我使用renderUI创建了一些UI元素，如下... 查看详情

如何在 R 闪亮中使用 plotly

】如何在R闪亮中使用plotly【英文标题】：HowtouseplotlyinRshiny【发布时间】：2020-06-0306:00:42【问题描述】：我正在尝试为我使用闪亮生成的输出添加图表。我在生成图形时遇到错误。有人可以看看并提供帮助。条形图参数是计算生... 查看详情

如何在闪亮的 R 应用程序中使用传单添加控制输入？

】如何在闪亮的R应用程序中使用传单添加控制输入？【英文标题】：HowcaniusetheleafletaddcontrolinputsintheshinyRapp?【发布时间】：2022-01-1613:43:04【问题描述】：我想在地图内使用带有checkboxGroupInput的闪亮传单制作地图，并使用checkboxGro... 查看详情

如何在 R Shiny 中的 renderUI 中显示表格中的输入框？

】如何在RShiny中的renderUI中显示表格中的输入框？【英文标题】：HowtodisplayinputboxesinatablefromrenderUIinRShiny?【发布时间】：2021-05-0216:36:01【问题描述】：现在所有来自uiOutput("prefs")的数字输入框都显示在彼此下方。我想让它们显示... 查看详情

如何在不改变绘图宽度的情况下使用 ggplot2 在 R 中添加可变大小的 y 轴标签？

】如何在不改变绘图宽度的情况下使用ggplot2在R中添加可变大小的y轴标签？【英文标题】：HowcanIaddvariablesizey-axislabelsinRwithggplot2withoutchangingtheplotwidth?【发布时间】：2014-04-0816:31:41【问题描述】：我在R中使用ggplot2制作了一个绘图... 查看详情

在闪亮的 R 中自动调整 textAreaInput 的大小

】在闪亮的R中自动调整textAreaInput的大小【英文标题】：auto-resizetextAreaInputinshinyR【发布时间】：2021-05-3101:15:22【问题描述】：我正在尝试调整thisSOanswer关于如何通过javascript为闪亮R自动调整textarea输入的大小。理想情况下，我想... 查看详情

闪亮的模块和 renderUI 传递 javascript 代码

】闪亮的模块和renderUI传递javascript代码【英文标题】：ShinymodulesandrenderUIpassingjavascriptcode【发布时间】：2019-02-2419:05:57【问题描述】：我一直在尝试让我的renderUI代码响应@StéphaneLaurent共享的slick.js实现。基本上我有创建表的模块... 查看详情

如何使用 `renderUI` 响应式更新 Shiny 应用程序中的活动菜单项？

】如何使用`renderUI`响应式更新Shiny应用程序中的活动菜单项？【英文标题】：HowcanIreactivelyupdatetheactivemenuIteminaShinyappusing`renderUI`?【发布时间】：2021-03-2119:16:17【问题描述】：我正在构建一个闪亮的应用程序，它可以从数据框中... 查看详情

如何在ui中使用使用反应函数作为输入的结果？ -r 闪亮

】如何在ui中使用使用反应函数作为输入的结果？-r闪亮【英文标题】：Howtousetheresultofusingreactivefunctionasinputinui?-rshiny【发布时间】：2021-04-1901:49:19【问题描述】：我在服务器上使用了一个响应式函数来创建一个数据框。并且我想... 查看详情

在 perl 中如何在不使用 XS 的情况下写入调用者的变量？

】在perl中如何在不使用XS的情况下写入调用者的变量？【英文标题】：inperlhowtowritetocaller\'svariablewithoutusingXS?【发布时间】：2017-04-0616:55:46【问题描述】：我正在围绕一些旧代码编写单元测试，并发现需要围绕Apache2::Request的read()... 查看详情

PHP Regex：如何在不使用 [\r\n] 的情况下匹配 \r 和 \n？

】PHPRegex：如何在不使用[\\\\r\\\\n]的情况下匹配\\\\r和\\\\n？【英文标题】：PHPRegex:Howtomatch\\rand\\nwithoutusing[\\r\\n]?PHPRegex：如何在不使用[\\r\\n]的情况下匹配\\r和\\n？【发布时间】：2013-09-3001:52:21【问题描述】：我已经测试了\\v（... 查看详情

我们可以在不重新加载页面的情况下重置 r 中的页面或对象吗

...】：2020-04-0614:14:45【问题描述】：问题1：我创建了一个闪亮的应用程序，当用户将任何记录提交到数据库时，整个页面都会重新加载，我不希望我只想在没有完整的情况下重置/刷新我的R闪亮对象页面重新加载。是否有任何替代... 查看详情

如何在不重新启动 R 的情况下禁用软件包？ [复制]

】如何在不重新启动R的情况下禁用软件包？[复制]【英文标题】：HowtodisablepackagewithoutrestartingR?[duplicate]【发布时间】：2012-12-1801:13:03【问题描述】：可能重复：HowtounloadapackagewithoutrestartingR?要将包加载到R中，我们可以使用library(... 查看详情