This is similar to a post of mine from 3-Sep-2021, except that the prior post addressed a situation where conditional panels were rendered in server
section using renderUI
. To simplify, I'm moving all conditional panels to UI
section and in certain instances what worked for renderUI
isn't working for UI
. So here goes...
The problem: when running the below MWE code, if the user is in the “Liabilities module” tab (default tab when first invoking) and is (1) currently viewing the Rates values table (table4
) in the main panel (after having clicked on "Rates values" radio button on top of main panel), then (2) clicks on the "Mod Liaby" action button in the sidebar panel, and then (3) dismisses/resets the modal dialogue, then (4) the Rates values table remains in the main panel.
Similarly, if user is in “Liabilities module" tab and is (1) currently viewing the liabilities structure table (table3)
in the main panel, then (2) clicks on the "Mod Rate" action button in the sidebar panel, and then (3) dismisses/resets the modal dialogue, then (4) the liabilities structure table remains in the main panel.
I'd like a click of "Mod Liaby" action button to immediately cause the liabilities table ("table3") to be rendered in the main panel (behind the modal dialogue), regardless of what was previously in the main panel. Similarly, I'd like a click of "Mod Rate" action button to immediately cause the rates table ("table4") to be rendered in the main panel (behind the modal dialogue), regardless of what was previously in the main panel.
Essentially, I need to trigger some sort of "Go to" function for main panel table rendering after clicking one of the side bar action buttons. I don't know how to do this.
My attempt to do this is flagged below with # ???
. My guess is this is a very simple fix but my working knowledge is still limited!! The functions at the top, above UI
, can be safely ignored! Also functions like vectorLiabStruct
and vectorRates
can be ignored, as the issue lies with conditonal panels in UI
section and table rendering.
MWE code:
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)
Once again I'm not entirely sure if I understood your problem correctly, but please check the following code and see the updateRadioButtons
calls:
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)
Edit: moved useShinyjs()
to the UI - see ?useShinyjs()
:
This function must be called from a Shiny app's UI in order for all other shinyjs functions to work.