在 R Shiny 中，如何从不同的条件面板控制同一个对象？
In R Shiny, how to control the same object from different conditional panels?
在我的应用程序中，我希望允许用户从两个不同的条件面板对同一对象进行更改。 （相信我 - 从用户的角度来看，这将有助于 运行 复杂的模型。我知道这听起来很奇怪）。
此对象的共同点是 table4 派生自 matrix4.... 用户应该能够从以下 MWE 代码中的两个条件面板之一查看和更改此 table4 ，来自 condition="input.tabselected==4"（“负债模块”）或来自 condition="input.tabselected==5"（“利率”）。
从“负债模块”（选项卡 = 4）对 table4 的更改也应在从“利率”模块（选项卡 = 5）访问 table4（或等效项）时反应性地反映出来), 反之亦然。
有没有干净简单的方法来做到这一点？
以我有限的经验，我的冲动是在选项卡 4 和 5 中复制 table4/matrix4... 进程的 2 个版本，然后 link 这两个版本。但这似乎是重复和麻烦的，我敢打赌有更多经验的人知道如何更容易地做到这一点。
如果解决方案附有解释，那肯定会有所帮助，因为我需要在 MWE 派生的完整代码中实现它。
下面是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(h5(strong(helpText("Select model output to view:")))),
fluidRow(
actionButton('showRatesValueBtn','Rates values'),
actionButton('showRatesPlotBtn','Rates plots')), # close fluid row
uiOutput('showTab4Results')
), # close tab panel
tabPanel("Interest rates", value=5,
fluidRow(h5(strong(helpText("Select model output to view:")))),
fluidRow(
actionButton('showRatesValueBtn','Rates values'),
actionButton('showRatesPlotBtn','Rates plots')), # close fluid row
uiOutput('showTab5Results')
), # close tab panel
id = "tabselected"
))) # close tabset panel, main panel, page with sidebar
server <- function(input,output,session)({
showTab4Results <- reactiveValues()
showTab5Results <- reactiveValues()
matrix4 <- reactive(input$matrix4)
baseRate <- function(){vectorBaseRate(60,input$matrix4[1,1])} # Must remain in server section
output$Panels <- renderUI({
tagList(
conditionalPanel(condition="input.tabselected==4",actionButton('modRates','Modify Rates')),
conditionalPanel(condition="input.tabselected==5",actionButton('modRates','Modify Rates'))
) # close tagList
}) # 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
output$table4 <- renderTable({vectorRates()})
observeEvent(input$resetRatesStruct, {updateMatrixInput(session,'matrix4', matrix4Default)})
observeEvent(input$showRatesValueBtn,
{showTab4Results$showme <- tagList(
fluidRow(h5(strong(helpText("You are viewing Rates values:")))),
tableOutput("table4"))
},ignoreNULL = FALSE)
output$graph4 <-renderPlot(vectorBaseRatePlot(vectorRates(),"A Variable","Period","Rate"))
observeEvent(input$showRatesPlotBtn,{showTab4Results$showme <- tagList(
fluidRow(h5(strong(helpText("You are viewing Rates plots:")))),
plotOutput("graph4"))})
output$showTab4Results <- renderUI({showTab4Results$showme})
output$showTab5Results <- renderUI({showTab5Results$showme})
observeEvent(input$modRates,
{showModal(modalDialog(
matrix4Input("matrix4",if(is.null(input$matrix4)) matrix4Default else input$matrix4),
useShinyjs(),
footer = tagList(
actionButton("resetRatesStruct","Reset"),
modalButton("Close")
)))
showTab4Results$showme <- tagList(tableOutput("table4"))
} # close modalDialog, showModal, and showModal function
) # close observeEvent
}) # close server
shinyApp(ui, server)
我不是 100% 确定我是否理解正确，但我猜你只需要 or 在 conditionalPanel:
的 javascript 条件下
condition="input.tabselected==4 || input.tabselected==5"
请检查以下内容：
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(h5(strong(helpText("Select model output to view:")))),
fluidRow(
actionButton('showRatesValueBtnA','Rates values'),
actionButton('showRatesPlotBtnA','Rates plots')), # close fluid row
uiOutput('showTab4Results')
), # close tab panel
tabPanel("Interest rates", value=5,
fluidRow(h5(strong(helpText("Select model output to view:")))),
fluidRow(
actionButton('showRatesValueBtnB','Rates values'),
actionButton('showRatesPlotBtnB','Rates plots')), # close fluid row
uiOutput('showTab5Results')
), # close tab panel
id = "tabselected"
))) # close tabset panel, main panel, page with sidebar
server <- function(input,output,session)({
showTab4Results <- reactiveValues()
showTab5Results <- reactiveValues()
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'))
}) # 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
output$table5 <- output$table4 <- renderTable({vectorRates()})
observeEvent(input$resetRatesStruct, {updateMatrixInput(session,'matrix4', matrix4Default)})
observeEvent(input$showRatesValueBtnA,
{showTab4Results$showme <- tagList(
fluidRow(h5(strong(helpText("You are viewing Rates values:")))),
tableOutput("table4"))
},ignoreNULL = FALSE)
observeEvent(input$showRatesValueBtnB,
{showTab5Results$showme <- tagList(
fluidRow(h5(strong(helpText("You are viewing Rates values:")))),
tableOutput("table5"))
},ignoreNULL = FALSE)
output$graph5 <- output$graph4 <- renderPlot(vectorBaseRatePlot(vectorRates(),"A Variable","Period","Rate"))
observeEvent(input$showRatesPlotBtnA,{showTab4Results$showme <- tagList(
fluidRow(h5(strong(helpText("You are viewing Rates plots:")))),
plotOutput("graph4"))})
observeEvent(input$showRatesPlotBtnB,{showTab5Results$showme <- tagList(
fluidRow(h5(strong(helpText("You are viewing Rates plots:")))),
plotOutput("graph5"))})
output$showTab4Results <- renderUI({showTab4Results$showme})
output$showTab5Results <- renderUI({showTab5Results$showme})
observeEvent(input$modRates,
{showModal(modalDialog(
matrix4Input("matrix4",if(is.null(input$matrix4)) matrix4Default else input$matrix4),
useShinyjs(),
footer = tagList(
actionButton("resetRatesStruct","Reset"),
modalButton("Close")
)))
showTab4Results$showme <- tagList(tableOutput("table4"))
} # close modalDialog, showModal, and showModal function
) # close observeEvent
}) # close server
shinyApp(ui, server)
这是一个简化版本，避免了 reactiveValues:
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(
"Liabilities module",
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'))
}) # 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') {
tagList(fluidRow(h5(strong(
helpText("You are viewing Rates values:")
))),
tableOutput("table4"))
} else {
tagList(fluidRow(h5(strong(
helpText("You are viewing Rates plots:")
))),
plotOutput("graph4"))
}
})
output$showTab5Results <- renderUI({
if (input$showRates5 == 'Rates values') {
tagList(fluidRow(h5(strong(
helpText("You are viewing Rates values:")
))),
tableOutput("table5"))
} else {
tagList(fluidRow(h5(strong(
helpText("You are viewing Rates plots:")
))),
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)
另一个解决方案是嵌套条件面板。为了解决这个问题，我使用了以下内容：
output$Panels <- renderUI({
conditionalPanel(
condition = "input.tabselected==4 || input.tabselected==5", actionButton('modRates', 'Modify Rates'),
conditionalPanel(
condition = "input.tabselected==4", actionButton('test', 'Test'),
) # close 2nd conditional panel
) # close 1st conditional panel
}) # close renderUI
代替原始 MWE 代码发布中使用的以下内容：
output$Panels <- renderUI({
conditionalPanel(condition="input.tabselected==4 || input.tabselected==5",actionButton('modRates','Modify Rates'))
}) # close renderUI
在我的应用程序中，我希望允许用户从两个不同的条件面板对同一对象进行更改。 （相信我 - 从用户的角度来看，这将有助于 运行 复杂的模型。我知道这听起来很奇怪）。
此对象的共同点是 table4 派生自 matrix4.... 用户应该能够从以下 MWE 代码中的两个条件面板之一查看和更改此 table4 ，来自 condition="input.tabselected==4"（“负债模块”）或来自 condition="input.tabselected==5"（“利率”）。
从“负债模块”（选项卡 = 4）对 table4 的更改也应在从“利率”模块（选项卡 = 5）访问 table4（或等效项）时反应性地反映出来), 反之亦然。
有没有干净简单的方法来做到这一点？
以我有限的经验，我的冲动是在选项卡 4 和 5 中复制 table4/matrix4... 进程的 2 个版本，然后 link 这两个版本。但这似乎是重复和麻烦的，我敢打赌有更多经验的人知道如何更容易地做到这一点。
如果解决方案附有解释，那肯定会有所帮助，因为我需要在 MWE 派生的完整代码中实现它。
下面是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(h5(strong(helpText("Select model output to view:")))),
fluidRow(
actionButton('showRatesValueBtn','Rates values'),
actionButton('showRatesPlotBtn','Rates plots')), # close fluid row
uiOutput('showTab4Results')
), # close tab panel
tabPanel("Interest rates", value=5,
fluidRow(h5(strong(helpText("Select model output to view:")))),
fluidRow(
actionButton('showRatesValueBtn','Rates values'),
actionButton('showRatesPlotBtn','Rates plots')), # close fluid row
uiOutput('showTab5Results')
), # close tab panel
id = "tabselected"
))) # close tabset panel, main panel, page with sidebar
server <- function(input,output,session)({
showTab4Results <- reactiveValues()
showTab5Results <- reactiveValues()
matrix4 <- reactive(input$matrix4)
baseRate <- function(){vectorBaseRate(60,input$matrix4[1,1])} # Must remain in server section
output$Panels <- renderUI({
tagList(
conditionalPanel(condition="input.tabselected==4",actionButton('modRates','Modify Rates')),
conditionalPanel(condition="input.tabselected==5",actionButton('modRates','Modify Rates'))
) # close tagList
}) # 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
output$table4 <- renderTable({vectorRates()})
observeEvent(input$resetRatesStruct, {updateMatrixInput(session,'matrix4', matrix4Default)})
observeEvent(input$showRatesValueBtn,
{showTab4Results$showme <- tagList(
fluidRow(h5(strong(helpText("You are viewing Rates values:")))),
tableOutput("table4"))
},ignoreNULL = FALSE)
output$graph4 <-renderPlot(vectorBaseRatePlot(vectorRates(),"A Variable","Period","Rate"))
observeEvent(input$showRatesPlotBtn,{showTab4Results$showme <- tagList(
fluidRow(h5(strong(helpText("You are viewing Rates plots:")))),
plotOutput("graph4"))})
output$showTab4Results <- renderUI({showTab4Results$showme})
output$showTab5Results <- renderUI({showTab5Results$showme})
observeEvent(input$modRates,
{showModal(modalDialog(
matrix4Input("matrix4",if(is.null(input$matrix4)) matrix4Default else input$matrix4),
useShinyjs(),
footer = tagList(
actionButton("resetRatesStruct","Reset"),
modalButton("Close")
)))
showTab4Results$showme <- tagList(tableOutput("table4"))
} # close modalDialog, showModal, and showModal function
) # close observeEvent
}) # close server
shinyApp(ui, server)
我不是 100% 确定我是否理解正确，但我猜你只需要 or 在 conditionalPanel:
condition="input.tabselected==4 || input.tabselected==5"
请检查以下内容：
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(h5(strong(helpText("Select model output to view:")))),
fluidRow(
actionButton('showRatesValueBtnA','Rates values'),
actionButton('showRatesPlotBtnA','Rates plots')), # close fluid row
uiOutput('showTab4Results')
), # close tab panel
tabPanel("Interest rates", value=5,
fluidRow(h5(strong(helpText("Select model output to view:")))),
fluidRow(
actionButton('showRatesValueBtnB','Rates values'),
actionButton('showRatesPlotBtnB','Rates plots')), # close fluid row
uiOutput('showTab5Results')
), # close tab panel
id = "tabselected"
))) # close tabset panel, main panel, page with sidebar
server <- function(input,output,session)({
showTab4Results <- reactiveValues()
showTab5Results <- reactiveValues()
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'))
}) # 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
output$table5 <- output$table4 <- renderTable({vectorRates()})
observeEvent(input$resetRatesStruct, {updateMatrixInput(session,'matrix4', matrix4Default)})
observeEvent(input$showRatesValueBtnA,
{showTab4Results$showme <- tagList(
fluidRow(h5(strong(helpText("You are viewing Rates values:")))),
tableOutput("table4"))
},ignoreNULL = FALSE)
observeEvent(input$showRatesValueBtnB,
{showTab5Results$showme <- tagList(
fluidRow(h5(strong(helpText("You are viewing Rates values:")))),
tableOutput("table5"))
},ignoreNULL = FALSE)
output$graph5 <- output$graph4 <- renderPlot(vectorBaseRatePlot(vectorRates(),"A Variable","Period","Rate"))
observeEvent(input$showRatesPlotBtnA,{showTab4Results$showme <- tagList(
fluidRow(h5(strong(helpText("You are viewing Rates plots:")))),
plotOutput("graph4"))})
observeEvent(input$showRatesPlotBtnB,{showTab5Results$showme <- tagList(
fluidRow(h5(strong(helpText("You are viewing Rates plots:")))),
plotOutput("graph5"))})
output$showTab4Results <- renderUI({showTab4Results$showme})
output$showTab5Results <- renderUI({showTab5Results$showme})
observeEvent(input$modRates,
{showModal(modalDialog(
matrix4Input("matrix4",if(is.null(input$matrix4)) matrix4Default else input$matrix4),
useShinyjs(),
footer = tagList(
actionButton("resetRatesStruct","Reset"),
modalButton("Close")
)))
showTab4Results$showme <- tagList(tableOutput("table4"))
} # close modalDialog, showModal, and showModal function
) # close observeEvent
}) # close server
shinyApp(ui, server)
这是一个简化版本，避免了 reactiveValues:
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(
"Liabilities module",
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'))
}) # 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') {
tagList(fluidRow(h5(strong(
helpText("You are viewing Rates values:")
))),
tableOutput("table4"))
} else {
tagList(fluidRow(h5(strong(
helpText("You are viewing Rates plots:")
))),
plotOutput("graph4"))
}
})
output$showTab5Results <- renderUI({
if (input$showRates5 == 'Rates values') {
tagList(fluidRow(h5(strong(
helpText("You are viewing Rates values:")
))),
tableOutput("table5"))
} else {
tagList(fluidRow(h5(strong(
helpText("You are viewing Rates plots:")
))),
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)
另一个解决方案是嵌套条件面板。为了解决这个问题，我使用了以下内容：
output$Panels <- renderUI({
conditionalPanel(
condition = "input.tabselected==4 || input.tabselected==5", actionButton('modRates', 'Modify Rates'),
conditionalPanel(
condition = "input.tabselected==4", actionButton('test', 'Test'),
) # close 2nd conditional panel
) # close 1st conditional panel
}) # close renderUI
代替原始 MWE 代码发布中使用的以下内容：
output$Panels <- renderUI({
conditionalPanel(condition="input.tabselected==4 || input.tabselected==5",actionButton('modRates','Modify Rates'))
}) # close renderUI