在 R shiny 中，如何在单击操作按钮后触发 UI 中呈现的条件面板的更改？
In R shiny, how to trigger change in a conditional panel rendered in UI after clicking an action button?
这类似于我的 post 从 2021 年 9 月 3 日开始，除了之前的 post 解决了条件面板在 server 部分使用 renderUI。为简化起见，我将所有条件面板移至 UI 部分，在某些情况下，适用于 renderUI 的内容不适用于 UI。所以这里...
问题：当 运行 下面的 MWE 代码时，如果用户位于“负债模块”选项卡（首次调用时的默认选项卡）并且 (1) 当前正在查看利率值 table (table4) 在主面板中（单击主面板顶部的“Rates values”单选按钮后），然后 (2) 单击“Mod Liaby”操作按钮侧边栏面板，然后 (3) dismisses/resets 模态对话框，然后 (4) 费率值 table 保留在主面板中。
同样，如果用户在“负债模块”选项卡中并且 (1) 当前正在查看主面板中的负债结构 table (table3)，则 (2) 单击“Mod 边栏面板中的“评级”操作按钮，然后 (3) dismisses/resets 模式对话，然后 (4) 负债结构 table 保留在主面板中。
我想点击“Mod Liaby”操作按钮立即导致负债 table（“table3”）在主面板中呈现（在模态对话的后面），不管主面板之前是什么。同样，我希望单击“Mod Rate”操作按钮立即导致在主面板（在模式后面）中呈现 table（“table4”）对话），不管主面板之前是什么。
基本上，我需要在单击其中一个侧边栏操作按钮后触发主面板 table 呈现的某种“转到”功能。我不知道该怎么做。
下面用 # ??? 标记了我这样做的尝试。我的猜测是这是一个非常简单的修复，但我的工作知识仍然有限！！ UI 上方的函数可以安全地忽略！ vectorLiabStruct 和 vectorRates 等函数也可以忽略，因为问题在于 UI 部分中的条件面板和 table 渲染。
MWE 代码：
library(shiny);library(shinyMatrix);library(shinyjs)
mainPanelBtns <- function(x,y,z){radioButtons(inputId=x,label="Model view:",choices= y,selected=z,inline=TRUE)}
matrix3Default <- matrix(c(1,24,0,100), 4, 1,dimnames=list(c('A','B','C','D')))
matrix3Input <- function(x, matrix3Default){matrixInput(x,label='Input:',value=matrix3Default,class= 'numeric')}
matrix3RowHeaders <- function(){c('A','B','C','D')}
matrix4Default <- matrix(c(0.2), 4, 1,dimnames=list(c("A","B","C","D"),NULL))
matrix4Input <- function(x,matrix4Input){matrixInput(x,value = matrix4Input,class = "numeric")}
vectorBaseRate <- function(x,y){
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)}
ui <-
pageWithSidebar(
headerPanel("Model..."),
sidebarPanel(
fluidRow("Base Input Panel"),
conditionalPanel(condition="input.tabselected==4",actionButton('modLiab','Mod Liaby')),
conditionalPanel(condition="input.tabselected==4||input.tabselected==5",actionButton('modRates','Mod Rate'))
), # close sidebar panel
mainPanel(
tabsetPanel(
tabPanel("Liabilities module", value=4,
mainPanelBtns('mainPanelBtnTab4',c('Liabilities','Rates values'),'Liabilities'),
conditionalPanel(condition = "input.mainPanelBtnTab4 == 'Liabilities'", tableOutput("table3")),
conditionalPanel(condition = "input.mainPanelBtnTab4 == 'Rates values'", tableOutput("table4"))
), # close tab panel
tabPanel("Interest rates", value=5,
mainPanelBtns('mainPanelBtnTab5',c('Rates values'),'Rates values'),
conditionalPanel(condition = "input.mainPanelBtnTab5 == 'Rates values'", tableOutput("table5"))
), # close tab panel
id = "tabselected"
))) # close tabset panel, main panel, and page with sidebar
server <- function(input,output,session)({
rv3 <- reactiveValues( # << rv3 used for matrix 3 (liability structure) inputs
mat3 = matrix3Input('matrix3',matrix3Default),
input = matrix3Default
) # close reactive values
matrix4 <- reactive(input$matrix4)
baseRate <- function(){vectorBaseRate(60,input$matrix4[1,1])}
vectorLiabStruct <- reactive({
if(!isTruthy(input$modLiab)){
df <- matrix3Default
rownames(df) <- matrix3RowHeaders()}
else{
req(input$matrix3)
rv3$mat3 <- matrix3Input('matrix3',input$matrix3)
df <- input$matrix3
rownames(df) <- matrix3RowHeaders()
rv3$input <- df
} # close else
df})
output$table3 <- renderTable({
if(!isTruthy(input$modLiab)){
df <- matrix3Default
rownames(df) <- matrix3RowHeaders()}
else{
req(input$matrix3)
rv3$mat3 <- matrix3Input('matrix3',input$matrix3)
df <- input$matrix3
rownames(df) <- matrix3RowHeaders()
rv3$input <- df
} # close else
df},rownames=TRUE, colnames=TRUE)
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})
observeEvent(input$modLiab,{
showModal(modalDialog(rv3$mat3,footer=tagList(actionButton("resetLiab","Reset"),modalButton("Close"))))
tableOutput("table3") # ???
})
observeEvent(input$resetLiab, {updateMatrixInput(session,'matrix3', matrix3Default)})
observeEvent(input$resetRates, {updateMatrixInput(session,'matrix4', matrix4Default)})
output$table5<-output$table4<-renderTable({vectorRates()})
observeEvent(input$modRates,
{showModal(modalDialog(
matrix4Input("matrix4",if(is.null(input$matrix4)) matrix4Default else input$matrix4),
useShinyjs(),
footer = tagList(actionButton("resetRates","Reset"),modalButton("Close"))))
} # close modalDialog
) # close observeEvent
}) # close server
shinyApp(ui, server)
再一次，我不确定我是否正确理解了您的问题，但请检查以下代码并查看 updateRadioButtons 调用：
library(shiny)
library(shinyMatrix)
library(shinyjs)
mainPanelBtns <- function(x, y, z) {
radioButtons(
inputId = x,
label = "Model view:",
choices = y,
selected = z,
inline = TRUE
)
}
matrix3Default <- matrix(c(1, 24, 0, 100), 4, 1, dimnames = list(c('A', 'B', 'C', 'D')))
matrix3Input <- function(x, matrix3Default) {
matrixInput(x,
label = 'Input:',
value = matrix3Default,
class = 'numeric')
}
matrix3RowHeaders <- function() {
c('A', 'B', 'C', 'D')
}
matrix4Default <- matrix(c(0.2), 4, 1, dimnames = list(c("A", "B", "C", "D"), NULL))
matrix4Input <- function(x, matrix4Input) {
matrixInput(x, value = matrix4Input, class = "numeric")
}
vectorBaseRate <- function(x, y) {
a <- rep(y, x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)
}
ui <- pageWithSidebar(
headerPanel("Model..."),
sidebarPanel(
fluidRow("Base Input Panel"),
conditionalPanel(condition = "input.tabselected==4", actionButton('modLiab', 'Mod Liaby')),
conditionalPanel(condition = "input.tabselected==4||input.tabselected==5", actionButton('modRates', 'Mod Rate'))
), # close sidebar panel
mainPanel(
useShinyjs(),
tabsetPanel(
tabPanel(
"Liabilities module",
value = 4,
mainPanelBtns(
'mainPanelBtnTab4',
c('Liabilities', 'Rates values'),
'Liabilities'
),
conditionalPanel(condition = "input.mainPanelBtnTab4 == 'Liabilities'", tableOutput("table3")),
conditionalPanel(condition = "input.mainPanelBtnTab4 == 'Rates values'", tableOutput("table4"))
), # close tab panel
tabPanel(
"Interest rates",
value = 5,
mainPanelBtns('mainPanelBtnTab5', c('Rates values'), 'Rates values'),
conditionalPanel(condition = "input.mainPanelBtnTab5 == 'Rates values'", tableOutput("table5"))
), # close tab panel
id = "tabselected"
))
) # close tabset panel, main panel, and page with sidebar
server <- function(input, output, session){
rv3 <- reactiveValues(
# << rv3 used for matrix 3 (liability structure) inputs
mat3 = matrix3Input('matrix3', matrix3Default),
input = matrix3Default
) # close reactive values
matrix4 <- reactive(input$matrix4)
baseRate <- function() {
vectorBaseRate(60, input$matrix4[1, 1])
}
vectorLiabStruct <- reactive({
if (!isTruthy(input$modLiab)) {
df <- matrix3Default
rownames(df) <- matrix3RowHeaders()
} else{
req(input$matrix3)
rv3$mat3 <- matrix3Input('matrix3', input$matrix3)
df <- input$matrix3
rownames(df) <- matrix3RowHeaders()
rv3$input <- df
} # close else
df
})
output$table3 <- renderTable({
if (!isTruthy(input$modLiab)) {
df <- matrix3Default
rownames(df) <- matrix3RowHeaders()
} else{
req(input$matrix3)
rv3$mat3 <- matrix3Input('matrix3', input$matrix3)
df <- input$matrix3
rownames(df) <- matrix3RowHeaders()
rv3$input <- df
} # close else
df
}, rownames = TRUE, colnames = TRUE)
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
})
observeEvent(input$modLiab, {
updateRadioButtons(inputId = "mainPanelBtnTab4", selected = "Liabilities")
updateRadioButtons(inputId = "mainPanelBtnTab5", selected = "Liabilities")
showModal(modalDialog(rv3$mat3, footer = tagList(
actionButton("resetLiab", "Reset"), modalButton("Close")
)))
})
observeEvent(input$resetLiab, {
updateMatrixInput(session, 'matrix3', matrix3Default)
})
observeEvent(input$resetRates, {
updateMatrixInput(session, 'matrix4', matrix4Default)
})
output$table5 <- output$table4 <- renderTable({
vectorRates()
})
observeEvent(input$modRates, {
updateRadioButtons(inputId = "mainPanelBtnTab4", selected = "Rates values")
updateRadioButtons(inputId = "mainPanelBtnTab5", selected = "Rates values")
showModal(modalDialog(
matrix4Input("matrix4",
if (is.null(input$matrix4)){
matrix4Default
} else {
input$matrix4
}),
footer = tagList(
actionButton("resetRates", "Reset"),
modalButton("Close")
)
))
} # close modalDialog
) # close observeEvent
} # close server
shinyApp(ui, server)
编辑：将 useShinyjs() 移至 UI - 参见 ?useShinyjs():
This function must be called from a Shiny app's UI in order for all
other shinyjs functions to work.
这类似于我的 post 从 2021 年 9 月 3 日开始，除了之前的 post 解决了条件面板在 server 部分使用 renderUI。为简化起见，我将所有条件面板移至 UI 部分，在某些情况下，适用于 renderUI 的内容不适用于 UI。所以这里...
问题：当 运行 下面的 MWE 代码时，如果用户位于“负债模块”选项卡（首次调用时的默认选项卡）并且 (1) 当前正在查看利率值 table (table4) 在主面板中（单击主面板顶部的“Rates values”单选按钮后），然后 (2) 单击“Mod Liaby”操作按钮侧边栏面板，然后 (3) dismisses/resets 模态对话框，然后 (4) 费率值 table 保留在主面板中。
同样，如果用户在“负债模块”选项卡中并且 (1) 当前正在查看主面板中的负债结构 table (table3)，则 (2) 单击“Mod 边栏面板中的“评级”操作按钮，然后 (3) dismisses/resets 模式对话，然后 (4) 负债结构 table 保留在主面板中。
我想点击“Mod Liaby”操作按钮立即导致负债 table（“table3”）在主面板中呈现（在模态对话的后面），不管主面板之前是什么。同样，我希望单击“Mod Rate”操作按钮立即导致在主面板（在模式后面）中呈现 table（“table4”）对话），不管主面板之前是什么。
基本上，我需要在单击其中一个侧边栏操作按钮后触发主面板 table 呈现的某种“转到”功能。我不知道该怎么做。
下面用 # ??? 标记了我这样做的尝试。我的猜测是这是一个非常简单的修复，但我的工作知识仍然有限！！ UI 上方的函数可以安全地忽略！ vectorLiabStruct 和 vectorRates 等函数也可以忽略，因为问题在于 UI 部分中的条件面板和 table 渲染。
MWE 代码：
library(shiny);library(shinyMatrix);library(shinyjs)
mainPanelBtns <- function(x,y,z){radioButtons(inputId=x,label="Model view:",choices= y,selected=z,inline=TRUE)}
matrix3Default <- matrix(c(1,24,0,100), 4, 1,dimnames=list(c('A','B','C','D')))
matrix3Input <- function(x, matrix3Default){matrixInput(x,label='Input:',value=matrix3Default,class= 'numeric')}
matrix3RowHeaders <- function(){c('A','B','C','D')}
matrix4Default <- matrix(c(0.2), 4, 1,dimnames=list(c("A","B","C","D"),NULL))
matrix4Input <- function(x,matrix4Input){matrixInput(x,value = matrix4Input,class = "numeric")}
vectorBaseRate <- function(x,y){
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)}
ui <-
pageWithSidebar(
headerPanel("Model..."),
sidebarPanel(
fluidRow("Base Input Panel"),
conditionalPanel(condition="input.tabselected==4",actionButton('modLiab','Mod Liaby')),
conditionalPanel(condition="input.tabselected==4||input.tabselected==5",actionButton('modRates','Mod Rate'))
), # close sidebar panel
mainPanel(
tabsetPanel(
tabPanel("Liabilities module", value=4,
mainPanelBtns('mainPanelBtnTab4',c('Liabilities','Rates values'),'Liabilities'),
conditionalPanel(condition = "input.mainPanelBtnTab4 == 'Liabilities'", tableOutput("table3")),
conditionalPanel(condition = "input.mainPanelBtnTab4 == 'Rates values'", tableOutput("table4"))
), # close tab panel
tabPanel("Interest rates", value=5,
mainPanelBtns('mainPanelBtnTab5',c('Rates values'),'Rates values'),
conditionalPanel(condition = "input.mainPanelBtnTab5 == 'Rates values'", tableOutput("table5"))
), # close tab panel
id = "tabselected"
))) # close tabset panel, main panel, and page with sidebar
server <- function(input,output,session)({
rv3 <- reactiveValues( # << rv3 used for matrix 3 (liability structure) inputs
mat3 = matrix3Input('matrix3',matrix3Default),
input = matrix3Default
) # close reactive values
matrix4 <- reactive(input$matrix4)
baseRate <- function(){vectorBaseRate(60,input$matrix4[1,1])}
vectorLiabStruct <- reactive({
if(!isTruthy(input$modLiab)){
df <- matrix3Default
rownames(df) <- matrix3RowHeaders()}
else{
req(input$matrix3)
rv3$mat3 <- matrix3Input('matrix3',input$matrix3)
df <- input$matrix3
rownames(df) <- matrix3RowHeaders()
rv3$input <- df
} # close else
df})
output$table3 <- renderTable({
if(!isTruthy(input$modLiab)){
df <- matrix3Default
rownames(df) <- matrix3RowHeaders()}
else{
req(input$matrix3)
rv3$mat3 <- matrix3Input('matrix3',input$matrix3)
df <- input$matrix3
rownames(df) <- matrix3RowHeaders()
rv3$input <- df
} # close else
df},rownames=TRUE, colnames=TRUE)
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})
observeEvent(input$modLiab,{
showModal(modalDialog(rv3$mat3,footer=tagList(actionButton("resetLiab","Reset"),modalButton("Close"))))
tableOutput("table3") # ???
})
observeEvent(input$resetLiab, {updateMatrixInput(session,'matrix3', matrix3Default)})
observeEvent(input$resetRates, {updateMatrixInput(session,'matrix4', matrix4Default)})
output$table5<-output$table4<-renderTable({vectorRates()})
observeEvent(input$modRates,
{showModal(modalDialog(
matrix4Input("matrix4",if(is.null(input$matrix4)) matrix4Default else input$matrix4),
useShinyjs(),
footer = tagList(actionButton("resetRates","Reset"),modalButton("Close"))))
} # close modalDialog
) # close observeEvent
}) # close server
shinyApp(ui, server)
再一次，我不确定我是否正确理解了您的问题，但请检查以下代码并查看 updateRadioButtons 调用：
library(shiny)
library(shinyMatrix)
library(shinyjs)
mainPanelBtns <- function(x, y, z) {
radioButtons(
inputId = x,
label = "Model view:",
choices = y,
selected = z,
inline = TRUE
)
}
matrix3Default <- matrix(c(1, 24, 0, 100), 4, 1, dimnames = list(c('A', 'B', 'C', 'D')))
matrix3Input <- function(x, matrix3Default) {
matrixInput(x,
label = 'Input:',
value = matrix3Default,
class = 'numeric')
}
matrix3RowHeaders <- function() {
c('A', 'B', 'C', 'D')
}
matrix4Default <- matrix(c(0.2), 4, 1, dimnames = list(c("A", "B", "C", "D"), NULL))
matrix4Input <- function(x, matrix4Input) {
matrixInput(x, value = matrix4Input, class = "numeric")
}
vectorBaseRate <- function(x, y) {
a <- rep(y, x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)
}
ui <- pageWithSidebar(
headerPanel("Model..."),
sidebarPanel(
fluidRow("Base Input Panel"),
conditionalPanel(condition = "input.tabselected==4", actionButton('modLiab', 'Mod Liaby')),
conditionalPanel(condition = "input.tabselected==4||input.tabselected==5", actionButton('modRates', 'Mod Rate'))
), # close sidebar panel
mainPanel(
useShinyjs(),
tabsetPanel(
tabPanel(
"Liabilities module",
value = 4,
mainPanelBtns(
'mainPanelBtnTab4',
c('Liabilities', 'Rates values'),
'Liabilities'
),
conditionalPanel(condition = "input.mainPanelBtnTab4 == 'Liabilities'", tableOutput("table3")),
conditionalPanel(condition = "input.mainPanelBtnTab4 == 'Rates values'", tableOutput("table4"))
), # close tab panel
tabPanel(
"Interest rates",
value = 5,
mainPanelBtns('mainPanelBtnTab5', c('Rates values'), 'Rates values'),
conditionalPanel(condition = "input.mainPanelBtnTab5 == 'Rates values'", tableOutput("table5"))
), # close tab panel
id = "tabselected"
))
) # close tabset panel, main panel, and page with sidebar
server <- function(input, output, session){
rv3 <- reactiveValues(
# << rv3 used for matrix 3 (liability structure) inputs
mat3 = matrix3Input('matrix3', matrix3Default),
input = matrix3Default
) # close reactive values
matrix4 <- reactive(input$matrix4)
baseRate <- function() {
vectorBaseRate(60, input$matrix4[1, 1])
}
vectorLiabStruct <- reactive({
if (!isTruthy(input$modLiab)) {
df <- matrix3Default
rownames(df) <- matrix3RowHeaders()
} else{
req(input$matrix3)
rv3$mat3 <- matrix3Input('matrix3', input$matrix3)
df <- input$matrix3
rownames(df) <- matrix3RowHeaders()
rv3$input <- df
} # close else
df
})
output$table3 <- renderTable({
if (!isTruthy(input$modLiab)) {
df <- matrix3Default
rownames(df) <- matrix3RowHeaders()
} else{
req(input$matrix3)
rv3$mat3 <- matrix3Input('matrix3', input$matrix3)
df <- input$matrix3
rownames(df) <- matrix3RowHeaders()
rv3$input <- df
} # close else
df
}, rownames = TRUE, colnames = TRUE)
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
})
observeEvent(input$modLiab, {
updateRadioButtons(inputId = "mainPanelBtnTab4", selected = "Liabilities")
updateRadioButtons(inputId = "mainPanelBtnTab5", selected = "Liabilities")
showModal(modalDialog(rv3$mat3, footer = tagList(
actionButton("resetLiab", "Reset"), modalButton("Close")
)))
})
observeEvent(input$resetLiab, {
updateMatrixInput(session, 'matrix3', matrix3Default)
})
observeEvent(input$resetRates, {
updateMatrixInput(session, 'matrix4', matrix4Default)
})
output$table5 <- output$table4 <- renderTable({
vectorRates()
})
observeEvent(input$modRates, {
updateRadioButtons(inputId = "mainPanelBtnTab4", selected = "Rates values")
updateRadioButtons(inputId = "mainPanelBtnTab5", selected = "Rates values")
showModal(modalDialog(
matrix4Input("matrix4",
if (is.null(input$matrix4)){
matrix4Default
} else {
input$matrix4
}),
footer = tagList(
actionButton("resetRates", "Reset"),
modalButton("Close")
)
))
} # close modalDialog
) # close observeEvent
} # close server
shinyApp(ui, server)
编辑：将 useShinyjs() 移至 UI - 参见 ?useShinyjs():
This function must be called from a Shiny app's UI in order for all other shinyjs functions to work.