在 R Shiny 中，如何将用户输入从侧边栏面板移动到模式对话框中？
In R Shiny, how to move user inputs from sidebar panel into a modal dialogue box?
在下面的 MWE 代码中，用户将值输入到“负债模块”选项卡侧边栏面板中的矩阵中。工作正常。但我想将矩阵输入网格 从 侧边栏面板和 移动到 模态对话框。那要怎么做呢？
该矩阵输入网格将不再出现在边栏面板中。相反，它只会出现在模态对话框中。
主面板中的模型输出（链接到标有“A”的第一个矩阵行）将继续链接到重新定位的矩阵输入网格。
在 observeEvent(input$showLiabilityGrid...
中，您会在 MWE 的底部看到我尝试创建模态对话框的骨架
在最底部，我还附上了一张图片来解释我正在尝试做的事情。
MWE 代码：
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"),
matrix1Input("base_input"),
div(style = "margin-top: 0px"),
useShinyjs(),
), # 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(
# ???
) # close modalDialog
) # close showModal
} # close showModal function
) # close observeEvent
}) # close server
shinyApp(ui, server)
我不知道您希望输入模块处于什么位置。但是，这确实可以移动它并且可以正常工作。
我不得不添加一个库，除此之外我已经注释掉了我会从您的原始代码中删除的代码。
因为边栏现在是空白的，所以它是 navbarPage()
您将在 tabPanel('Liabilities module'...
中看到一个新的 fluidrow()
library(shiny)
library(shinyMatrix)
library(shinyjs)
library(shinyWidgets) # added for the function setShadow
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(
navbarPage(
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,
# added - taken from sidebar coding
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"),
# end add
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"),
matrix1Input("base_input"),
div(style = "margin-top: 0px"),
useShinyjs(),
), # 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(
# ???
) # close modalDialog
) # close showModal
} # close showModal function
) # close observeEvent
}) # close server
shinyApp(ui, server)
这是它的样子：
在 YBS 在另一个 Stack Overflow post 中进一步挖掘和帮助后，下面的完整 MWE 现在可以工作并解决了原始查询。用户输入模态对话框，结果显示在主面板中。以这种方式使用模态对话框，用户界面更加清晰。
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 ---------------------------------------------------------------------->
# Below now defines the vectorsAll object before user clicks on actionButton "Input Liabilities".
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(input$base_input)
df <- cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))
} # close 2nd else
} # close 1st else
df
}) # close reactive
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)
在下面的 MWE 代码中，用户将值输入到“负债模块”选项卡侧边栏面板中的矩阵中。工作正常。但我想将矩阵输入网格 从 侧边栏面板和 移动到 模态对话框。那要怎么做呢？
该矩阵输入网格将不再出现在边栏面板中。相反，它只会出现在模态对话框中。
主面板中的模型输出（链接到标有“A”的第一个矩阵行）将继续链接到重新定位的矩阵输入网格。
在 observeEvent(input$showLiabilityGrid...
在最底部，我还附上了一张图片来解释我正在尝试做的事情。
MWE 代码：
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"),
matrix1Input("base_input"),
div(style = "margin-top: 0px"),
useShinyjs(),
), # 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(
# ???
) # close modalDialog
) # close showModal
} # close showModal function
) # close observeEvent
}) # close server
shinyApp(ui, server)
我不知道您希望输入模块处于什么位置。但是，这确实可以移动它并且可以正常工作。
我不得不添加一个库，除此之外我已经注释掉了我会从您的原始代码中删除的代码。
因为边栏现在是空白的，所以它是 navbarPage()
您将在 tabPanel('Liabilities module'...
fluidrow()
library(shiny)
library(shinyMatrix)
library(shinyjs)
library(shinyWidgets) # added for the function setShadow
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(
navbarPage(
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,
# added - taken from sidebar coding
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"),
# end add
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"),
matrix1Input("base_input"),
div(style = "margin-top: 0px"),
useShinyjs(),
), # 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(
# ???
) # close modalDialog
) # close showModal
} # close showModal function
) # close observeEvent
}) # close server
shinyApp(ui, server)
这是它的样子：
在 YBS 在另一个 Stack Overflow post 中进一步挖掘和帮助后，下面的完整 MWE 现在可以工作并解决了原始查询。用户输入模态对话框，结果显示在主面板中。以这种方式使用模态对话框，用户界面更加清晰。
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 ---------------------------------------------------------------------->
# Below now defines the vectorsAll object before user clicks on actionButton "Input Liabilities".
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(input$base_input)
df <- cbind(Period = 1:60,Yld_Rate = pct(yield()[,2]))
} # close 2nd else
} # close 1st else
df
}) # close reactive
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)