【发布时间】：2021-11-05 08:12:34
【问题描述】：
在下面的 MWE 代码中，运行代码生成的两个选项卡“负债模块”和“利率”是相同的。它们旨在作为当前通过运行代码生成的同一数据表和绘图（显示速率）的两条不同路径。
但是这两个选项卡需要随着它们的进一步发展而分道扬镳，就侧边栏面板中的其他操作按钮而言，以及出现在每个相应选项卡的主面板顶部的操作按钮而言。举个简单的例子，我想在“负债模块”而不是“利率”模块中添加一个“测试”操作按钮。
如何将多个条件添加到条件面板，因此在这种情况下，“测试”操作按钮会出现在“负债模块”中，但不会出现在“利率”标签中？如下图所示。
我的谦虚尝试在下面的 MWE 中标记为 # ATTEMPT #；当然，它不起作用，所以我不得不将其注释掉。
MWE 代码：
library(shiny)
library(shinyMatrix)
library(shinyjs)
matrix4Default <- matrix(c(0.2), 4, 1, dimnames = list(c("A", "B", "C", "D"), NULL))
matrix4Input <- function(x, matrix4Input) {
matrixInput(
x,
value = matrix4Input,
rows = list(extend = FALSE, names = TRUE),
cols = list(
extend = FALSE,
names = FALSE,
editableNames = FALSE
),
class = "numeric"
)
}
vectorBaseRate <- function(x, y) {
a <- rep(y, x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)
}
vectorBaseRatePlot <- function(w, x, y, z) {
plot(
w[, 1],
sapply(w[, 2], function(x)
gsub("%", "", x)),
main = x,
xlab = y,
ylab = z
)
}
ui <- pageWithSidebar(
headerPanel("Model..."),
sidebarPanel(fluidRow(helpText(h5(
strong("Base Input Panel")
))), uiOutput("Panels")),
mainPanel(tabsetPanel(
tabPanel(
"Liabilities module",
value = 4,
fluidRow(
radioButtons(
inputId = "showRates4",
label = h5(strong(helpText(
"Select model output to view:"
))),
choices = c('Rates values', 'Rates plots'),
selected = 'Rates values',
inline = TRUE
),
uiOutput('showTab4Results')
)
),
# close tab panel
tabPanel(
"Interest rates",
value = 5,
fluidRow(
radioButtons(
inputId = "showRates5",
label = h5(strong(helpText(
"Select model output to view:"
))),
choices = c('Rates values', 'Rates plots'),
selected = 'Rates values',
inline = TRUE
),
uiOutput('showTab5Results')
)
),
# close tab panel
id = "tabselected"
))
) # close tabset panel, main panel, page with sidebar
server <- function(input, output, session) {
matrix4 <- reactive(input$matrix4)
baseRate <-
function() {
vectorBaseRate(60, input$matrix4[1, 1])
} # Must remain in server section
output$Panels <- renderUI({
conditionalPanel(
condition = "input.tabselected==4 || input.tabselected==5", actionButton('modRates', 'Modify Rates'),
# ATTEMPT # condition = "input.tabselected==4", actionButton('test','Test')
) # close conditional panel
}) # close renderUI
vectorRates <- reactive({
if (is.null(input$modRates)){DF <- NULL}
else {
if (input$modRates < 1) {DF <- cbind(Period = 1:60, BaseRate = 0.2)}
else {
req(input$matrix4)
DF <- cbind(Period = 1:60, BaseRate = baseRate()[, 2])
} # close 2nd else
} # close 1st else
DF
}) # close reactive
observeEvent(input$resetRatesStruct, {updateMatrixInput(session, 'matrix4', matrix4Default)})
output$table5 <- output$table4 <- renderTable({vectorRates()})
output$graph5 <- output$graph4 <- renderPlot({
vectorBaseRatePlot(vectorRates(), "A Variable", "Period", "Rate")
})
output$showTab4Results <- renderUI({
if (input$showRates4 == 'Rates values'){tableOutput("table4")}
else {plotOutput("graph4")}
})
output$showTab5Results <- renderUI({
if (input$showRates5 == 'Rates values'){tableOutput("table5")}
else {plotOutput("graph5")}
})
observeEvent(input$modRates,
{
showModal(modalDialog(
matrix4Input("matrix4", if (is.null(input$matrix4))
matrix4Default
else
input$matrix4),
useShinyjs(),
footer = tagList(
actionButton("resetRatesStruct", "Reset"),
modalButton("Close")
)
))
} # close modalDialog, showModal, and showModal function
) # close observeEvent
} # close server
shinyApp(ui, server)
【问题讨论】：
标签： r shiny shiny-reactivity