I'm trying to use a modal dialog box for user inputs since the fields of inputs are extensive in the full App. I almost have it working, but I'm not able to show the default table in the main panel when first invoking the App. I would like the default table (60 rows of 2 columns, 1st column labeled 1-60 and 2nd columns with values of 0.20) to appear when first invoking the App. Instead in the main panel I get the error message shown in the first image below. However, when I click the "Input Liabilities" action button which pulls up the modal dialog box with user input matrix grid, then the default table in the main panel correctly appears (whether or not the user has input into the grid) as shown in the second image, at the very bottom.
How do I correct this so the default table appears in the main panel when invoking the App?
Btw I just moved the user input matrix grid from a sidebar panel to modal dialog, and the default table correctly appeared in the main panel when first invoking the App when user input grid was in the sidebar panel. Now that I moved the user input matrix grid into the modal dialog (per the MWE code below), the default table no longer correctly renders until the modal dialog is invoked. So the problem must lie in my use of modal dialog.
Below is the MWE code:
library(shiny)
library(shinyMatrix)
library(shinyjs)
button2 <- function(x,y){actionButton(x,y,style="width:90px;margin-bottom:5px;font-size:80%")}
matrix1Input <- function(x){
matrixInput(x,
value = matrix(c(0.2), 4, 1,dimnames=list(c("A","B","C","D"),NULL)),
rows = list(extend=FALSE,names=TRUE),
cols = list(extend=FALSE,names=FALSE,editableNames=FALSE),
class = "numeric")}
pct <- function(x){paste(format(round(x*100,digits=1),nsmall=1),"%",sep="")} # convert to percentage
vectorBase <- function(x,y){
a <- rep(y,x)
b <- seq(1:x)
c <- data.frame(x = b, y = a)
return(c)}
vectorPlot <- function(w,x,y,z){plot(w,main=x,xlab=y,ylab=z,type="b",col="blue",pch=19,cex=1.25)}
ui <-
pageWithSidebar(
headerPanel("Model..."),
sidebarPanel(
fluidRow(helpText(h5(strong("Base Input Panel")),align="center",
style="margin-top:-15px;margin-bottom:5px")),
# Panels rendered with uiOuput & renderUI in server to stop flashing at invocation
uiOutput("Panels")
), # close sidebar panel
mainPanel(
tabsetPanel(
tabPanel("By balances", value=2),
tabPanel("By accounts", value=3),
tabPanel("Liabilities module", value=4,
fluidRow(h5(strong(helpText("Select model output to view:")))),
fluidRow(
button2('showVectorValueBtn','Vector values'),
button2('showVectorPlotBtn','Vector plots'),
), # close fluid row
div(style = "margin-top: 5px"),
# Shows outputs on each page of main panel
uiOutput('showResults')),
id = "tabselected"
) # close tabset panel
) # close main panel
) # close page with sidebar
server <- function(input,output,session)({
base_input <- reactive(input$base_input)
showResults <- reactiveValues()
yield <- function(){vectorBase(60,input$base_input[1,1])} # Must remain in server section
# --- Conditional panels rendered here rather than in UI to eliminate invocation flashing ------------>
output$Panels <- renderUI({
tagList(
conditionalPanel(
condition="input.tabselected==4",
actionButton('showLiabilityGrid','Input Liabilities',style='width:100%;background-color:LightGrey'),
setShadow(id='showLiabilityGrid'),
div(style = "margin-bottom: 10px"),
), # close conditional panel
conditionalPanel(condition="input.tabselected==3"),
conditionalPanel(condition="input.tabselected==4")
) # close tagList
}) # close renderUI
# --- Below produces vector values as default view when first invoking App --------------------------->
vectorsAll <- reactive({cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))}) # Produces vector values
output$table1 <- renderTable({vectorsAll()})
# --- Below produces vector values after clicking "Vector Values" button; see above for pre-click ---->
observeEvent(input$showVectorValueBtn,
{showResults$showme <-
tagList(tableOutput("table1"))
},ignoreNULL = FALSE)
# --- Below produces vector plots -------------------------------------------------------------------->
output$graph1 <-renderPlot(vectorPlot(yield(),"A Variable","Period","Rate"))
observeEvent(input$showVectorPlotBtn,{showResults$showme <- plotOutput("graph1")})
# --- Below sends both vector plots and vector values to UI section above ---------------------------->
output$showResults <- renderUI({showResults$showme})
# --- Below for modal dialog inputs ------------------------------------------------------------------>
observeEvent(input$showLiabilityGrid,
{showModal(modalDialog(
matrix1Input("base_input"),
div(style = "margin-top: 0px"),
useShinyjs(),
) # close modalDialog
) # close showModal
} # close showModal function
) # close observeEvent
}) # close server
shinyApp(ui, server)
Your vectorsAll
object is not defined before you click on the actionButton
"Input Liabilities". Therefore, you should try
vectorsAll <- reactive({
if (is.null(input$showLiabilityGrid ) ) {
df <- NULL
}else {
if (input$showLiabilityGrid < 1) {
df <- cbind(Period = 1:60,Yld_Rate = pct(0.2)) ## define what you want to display by default
}else {
req(yield())
df <- cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))
}
}
df
})
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.