在 R Shiny 中扩展侧边栏长度时如何防止侧边栏宽度发生变化?

时间:2021-06-15 11:50:40

标签: r shiny

在运行下面的 MWE 代码时,请注意在“动态”选项卡中,当您单击“显示”按钮时,下方会弹出一个长矩阵输入网格,从而延长了侧边栏面板的长度。当您单击“隐藏”时,矩阵输入网格消失。这一切正常。但是当单击“显示”时,由于侧边栏面板延伸到屏幕下方,侧边栏面板的宽度会缩小,以便为右侧的默认垂直查看滑块腾出空间。当默认的垂直查看滑块出现在右侧时,有没有办法防止侧边栏面板的宽度发生变化?如果某些东西需要缩小以容纳该滑块,我宁愿将其作为主面板。

library(shiny) 
library(shinyMatrix)
library(shinyjs)

# --- Initial values for performance vectors input matrix
m2 <- function(x) {matrix(c(1:40), 20, 2)}

# --- MatrixInput function to use for performance vector
matrix2.input <- function(x) {matrixInput(
    x,
    value = {m2()},
    rows = list(extend = TRUE,  names = FALSE),
    cols = list(extend = FALSE, names = TRUE, editableNames = FALSE),
    class = "numeric")} 

ui <- 
pageWithSidebar(
  headerPanel("Model"),
  sidebarPanel(
    conditionalPanel(condition="input.tabselected==1",
                     numericInput("begin.bal","Beginning balance:",value=100000,step=1000),
                     sliderInput("periods", "Number of periods to model:",min=1,max=120,value=60),
                     h5(strong("Vectorize performance variable:")), 
                     
                     # Action buttons to conditionally show/hide performance vectors --->
                     useShinyjs(),
                     actionButton('showPerfVectorBtn', 'Show'), 
                     actionButton('hidePerfVectorBtn', 'Hide'), 
                     uiOutput("Vectors")),
    conditionalPanel(condition="input.tabselected==2",
                     selectInput("dataset", "select the desired dataset", 
                                 choices=ls('package:datasets'), 
                                 selected = "")), 
    conditionalPanel(condition="input.tabselected==3",uiOutput("varx"),uiOutput("vary"))
  ), # close sidebar panel
  
  mainPanel(
    tabsetPanel(
      tabPanel("Dynamic", value=1,
          helpText("Pending...")),
      tabPanel("Data", value=2, 
          conditionalPanel(condition="input.choice==1", verbatimTextOutput("dat")),
          conditionalPanel(condition="input.choice==2", verbatimTextOutput("struct")),
          conditionalPanel(condition="input.choice==3", verbatimTextOutput("summary"))),
      tabPanel("Plot", value=3, plotOutput("plot")), 
      
      id = "tabselected"
    ) # close tabset panel
  ) # close main panel
) # close page with sidebar

 server <- function(input,output)({

# --- Set reactive input variables 
 periods    <-  reactive(input$periods)
 yld_input  <-  reactive(input$yld_input)
 
# --- Action buttons to conditionally show/hide performance vector
 output$Vectors <- renderUI({
   req(input$showPerfVectorBtn)
    tagList(matrix2.input("yld_input")) # close tag list    
  }) # close render UI
   
observeEvent(input$showPerfVectorBtn, {shinyjs::show("Vectors")})
observeEvent(input$hidePerfVectorBtn, {shinyjs::hide("Vectors")})

}) # close server

shinyApp(ui, server)

0 个答案:

没有答案