在运行下面的 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)