在 R Shiny 中，如何更改主面板中的默认视图？
In R Shiny, how to change default view in main panel?
以下几乎是 MWE 的代码工作正常，除了下面第一张图片中显示的 table 是单击“负债模块”选项卡时主面板中默认显示的内容。相反，我想让 table 显示在下面的第二张图片中，当用户单击同一“负债模块”选项卡中主面板顶部的“负债”按钮时，会出现在首次调用应用程序（并转到“负债模块”）时默认情况下的主面板。
我的问题是：
- 以下代码中当前设置该负债模块中的默认视图（费率 table、
table4）的是什么？
- 如何更改以下代码，以便负债结构 table (
table3) 在打开“负债模块”选项卡时显示为默认视图？
快速使用注意事项：单击“负债”模块侧边栏面板中的“修改...”操作按钮会弹出模式对话框，供用户输入 table3 和 table4。这些输入反应性地（立即）反映在 table3 和 table4 输出中。
几乎 MWE 代码：
library(shiny);library(shinyMatrix);library(shinyjs);library(shinyWidgets)
colnames(matrix3Default) <- paste0("Series ",1:ncol(matrix3Default))
matrix3Default <- matrix(c(1,24,0,100),4,1,dimnames=list(matrix3Headers(), NULL))
matrix3Headers <- function(){c('A','B','C','D')}
matrix3Input <- function(x, matrix3Default){
matrixInput(x,
label = 'Input series terms into below grid:',
value = matrix3Default,
rows = list(extend=FALSE,names=TRUE),
cols = list(extend=TRUE,names=TRUE,editableNames=FALSE,delete=TRUE),
class = 'numeric'
) # close matrix input
} # close function
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")}
pct <- function(x){paste(format(round(x*100,digits=1),nsmall=1),"%",sep="")} # convert to percentage
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,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")),
uiOutput("Panels")
),
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(
actionButton('showLiabStructBtn','Liabilities'),
actionButton('showRatesValueBtn','Rates values'),
actionButton('showRatesPlotBtn','Rates plots'),
), # close fluid row
div(style = "margin-top: 5px"),
uiOutput('showResults')),
id = "tabselected"
) # close tabset panel
) # close main panel
) # close page with sidebar
server <- function(input,output,session)({
rates_input <- reactive(input$rates_input)
showResults <- reactiveValues()
baseRate <- function(){vectorBaseRate(60,input$rates_input[1,1])} # Must remain in server section
rv <- reactiveValues(
mat3=matrix3Input('matrix3',matrix3Default),
input=matrix3Default,
colHeader = colnames(input)
) # close reactive values
output$Panels <- renderUI({
tagList(
conditionalPanel(
condition="input.tabselected==4",
actionButton('modLiabStruct','Modify Liabilities Structure',
style='width:100%;background-color:LightGrey'
),
div(style = "margin-bottom: 10px"),
actionButton('modRates','Modify Rates and Coupons',
style='width:100%;background-color:LightGrey'
),
div(style = "margin-bottom: 10px"),
setShadow(id='modLiabStruct'),
setShadow(id='modRates')
), # close conditional panel
conditionalPanel(condition="input.tabselected==3"),
conditionalPanel(condition="input.tabselected==4")
) # close tagList
}) # close renderUI
vectorRates <- reactive({
if (is.null(input$modRates)){df <- NULL}
else {
if(input$modRates < 1){df <- cbind(Period = 1:60,BaseRate = pct(0.2))}
else {
req(input$rates_input)
df <- cbind(Period = 1:60,BaseRate = pct(baseRate()[,2]))
} # close 2nd else
} # close 1st else
df
}) # close reactive
output$table4 <- renderTable({vectorRates()})
vectorLiabStruct <- reactive({
if(!isTruthy(input$modLiabStruct)){ # << Generates default table when first invoking the App
df <- matrix3Default
df
n <- dim(df)[2]
colnames(df) <- paste("Series", 1:n)
rownames(df) <- matrix3Headers()
}
else{
req(input$matrix3)
rv$mat3 <- matrix3Input('matrix3',input$matrix3)
df <- input$matrix3
n <- dim(df)[2]
colnames(df) <- paste("Series", 1:n)
rownames(df) <- matrix3Headers()
rv$input <- df
} # close else
df
})
output$table3 <- renderTable({vectorLiabStruct()})
output$table3 <- renderTable({
if(!isTruthy(input$modLiabStruct)){ # << Generates default table when first invoking the App
df <- matrix3Default
df
n <- dim(df)[2]
colnames(df) <- paste("Series", 1:n)
rownames(df) <- matrix3Headers()
}
else{
req(input$matrix3)
rv$mat3 <- matrix3Input('matrix3',input$matrix3) # << Any live modifications to the matrix in the modal box are reflected in table3 thanks to the reactivity, and stored in the rv$mat3 reactiveValues() (with the rv$mat3 <- matrix3Input('matrix3',input$matrix3) line)
df <- input$matrix3
n <- dim(df)[2]
colnames(df) <- paste("Series", 1:n)
rownames(df) <- matrix3Headers()
rv$input <- df
} # close else
df
},rownames=TRUE, colnames=TRUE) # close output$table3
observeEvent(input$modLiabStruct,{
showModal(modalDialog(
rv$mat3
)) # close shown modal and modal dialog
}) # close observe event
observeEvent(input$showLiabStructBtn,
{showResults$showme <- tagList(tableOutput("table3"))},ignoreNULL = FALSE)
observeEvent(input$showRatesValueBtn,
{showResults$showme <- tagList(tableOutput("table4"))},ignoreNULL = FALSE)
output$graph1 <-renderPlot(vectorBaseRatePlot(vectorRates(),"A Variable","Period","Rate"))
observeEvent(input$showRatesPlotBtn,{showResults$showme <- plotOutput("graph1")})
output$showResults <- renderUI({showResults$showme})
observeEvent(input$modRates,
{showModal(modalDialog(
matrix4Input("rates_input",if(is.null(input$rates_input)) matrix4Default else input$rates_input),
div(style = "margin-top: 0px"),
useShinyjs(),
))}
) # close observeEvent
}) # close server
shinyApp(ui, server)
以下应该有效。
observeEvent(input$showLiabStructBtn,
{showResults$showme <- tagList(tableOutput("table3"))},ignoreNULL = FALSE)
observeEvent(input$showRatesValueBtn,
{showResults$showme <- tagList(tableOutput("table4"))},ignoreNULL = TRUE)
以下几乎是 MWE 的代码工作正常，除了下面第一张图片中显示的 table 是单击“负债模块”选项卡时主面板中默认显示的内容。相反，我想让 table 显示在下面的第二张图片中，当用户单击同一“负债模块”选项卡中主面板顶部的“负债”按钮时，会出现在首次调用应用程序（并转到“负债模块”）时默认情况下的主面板。
我的问题是：
- 以下代码中当前设置该负债模块中的默认视图（费率 table、
table4）的是什么？ - 如何更改以下代码，以便负债结构 table (
table3) 在打开“负债模块”选项卡时显示为默认视图？
快速使用注意事项：单击“负债”模块侧边栏面板中的“修改...”操作按钮会弹出模式对话框，供用户输入 table3 和 table4。这些输入反应性地（立即）反映在 table3 和 table4 输出中。
几乎 MWE 代码：
library(shiny);library(shinyMatrix);library(shinyjs);library(shinyWidgets)
colnames(matrix3Default) <- paste0("Series ",1:ncol(matrix3Default))
matrix3Default <- matrix(c(1,24,0,100),4,1,dimnames=list(matrix3Headers(), NULL))
matrix3Headers <- function(){c('A','B','C','D')}
matrix3Input <- function(x, matrix3Default){
matrixInput(x,
label = 'Input series terms into below grid:',
value = matrix3Default,
rows = list(extend=FALSE,names=TRUE),
cols = list(extend=TRUE,names=TRUE,editableNames=FALSE,delete=TRUE),
class = 'numeric'
) # close matrix input
} # close function
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")}
pct <- function(x){paste(format(round(x*100,digits=1),nsmall=1),"%",sep="")} # convert to percentage
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,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")),
uiOutput("Panels")
),
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(
actionButton('showLiabStructBtn','Liabilities'),
actionButton('showRatesValueBtn','Rates values'),
actionButton('showRatesPlotBtn','Rates plots'),
), # close fluid row
div(style = "margin-top: 5px"),
uiOutput('showResults')),
id = "tabselected"
) # close tabset panel
) # close main panel
) # close page with sidebar
server <- function(input,output,session)({
rates_input <- reactive(input$rates_input)
showResults <- reactiveValues()
baseRate <- function(){vectorBaseRate(60,input$rates_input[1,1])} # Must remain in server section
rv <- reactiveValues(
mat3=matrix3Input('matrix3',matrix3Default),
input=matrix3Default,
colHeader = colnames(input)
) # close reactive values
output$Panels <- renderUI({
tagList(
conditionalPanel(
condition="input.tabselected==4",
actionButton('modLiabStruct','Modify Liabilities Structure',
style='width:100%;background-color:LightGrey'
),
div(style = "margin-bottom: 10px"),
actionButton('modRates','Modify Rates and Coupons',
style='width:100%;background-color:LightGrey'
),
div(style = "margin-bottom: 10px"),
setShadow(id='modLiabStruct'),
setShadow(id='modRates')
), # close conditional panel
conditionalPanel(condition="input.tabselected==3"),
conditionalPanel(condition="input.tabselected==4")
) # close tagList
}) # close renderUI
vectorRates <- reactive({
if (is.null(input$modRates)){df <- NULL}
else {
if(input$modRates < 1){df <- cbind(Period = 1:60,BaseRate = pct(0.2))}
else {
req(input$rates_input)
df <- cbind(Period = 1:60,BaseRate = pct(baseRate()[,2]))
} # close 2nd else
} # close 1st else
df
}) # close reactive
output$table4 <- renderTable({vectorRates()})
vectorLiabStruct <- reactive({
if(!isTruthy(input$modLiabStruct)){ # << Generates default table when first invoking the App
df <- matrix3Default
df
n <- dim(df)[2]
colnames(df) <- paste("Series", 1:n)
rownames(df) <- matrix3Headers()
}
else{
req(input$matrix3)
rv$mat3 <- matrix3Input('matrix3',input$matrix3)
df <- input$matrix3
n <- dim(df)[2]
colnames(df) <- paste("Series", 1:n)
rownames(df) <- matrix3Headers()
rv$input <- df
} # close else
df
})
output$table3 <- renderTable({vectorLiabStruct()})
output$table3 <- renderTable({
if(!isTruthy(input$modLiabStruct)){ # << Generates default table when first invoking the App
df <- matrix3Default
df
n <- dim(df)[2]
colnames(df) <- paste("Series", 1:n)
rownames(df) <- matrix3Headers()
}
else{
req(input$matrix3)
rv$mat3 <- matrix3Input('matrix3',input$matrix3) # << Any live modifications to the matrix in the modal box are reflected in table3 thanks to the reactivity, and stored in the rv$mat3 reactiveValues() (with the rv$mat3 <- matrix3Input('matrix3',input$matrix3) line)
df <- input$matrix3
n <- dim(df)[2]
colnames(df) <- paste("Series", 1:n)
rownames(df) <- matrix3Headers()
rv$input <- df
} # close else
df
},rownames=TRUE, colnames=TRUE) # close output$table3
observeEvent(input$modLiabStruct,{
showModal(modalDialog(
rv$mat3
)) # close shown modal and modal dialog
}) # close observe event
observeEvent(input$showLiabStructBtn,
{showResults$showme <- tagList(tableOutput("table3"))},ignoreNULL = FALSE)
observeEvent(input$showRatesValueBtn,
{showResults$showme <- tagList(tableOutput("table4"))},ignoreNULL = FALSE)
output$graph1 <-renderPlot(vectorBaseRatePlot(vectorRates(),"A Variable","Period","Rate"))
observeEvent(input$showRatesPlotBtn,{showResults$showme <- plotOutput("graph1")})
output$showResults <- renderUI({showResults$showme})
observeEvent(input$modRates,
{showModal(modalDialog(
matrix4Input("rates_input",if(is.null(input$rates_input)) matrix4Default else input$rates_input),
div(style = "margin-top: 0px"),
useShinyjs(),
))}
) # close observeEvent
}) # close server
shinyApp(ui, server)
以下应该有效。
observeEvent(input$showLiabStructBtn,
{showResults$showme <- tagList(tableOutput("table3"))},ignoreNULL = FALSE)
observeEvent(input$showRatesValueBtn,
{showResults$showme <- tagList(tableOutput("table4"))},ignoreNULL = TRUE)