Nothing
source("utils.R", local = T)
#' Creates an SST Test results page layout.
#'
#' @param ... Lists generated by \code{shiny::fluidRow} functions.
#'
#' @return A \code{shiny::fluidPage} containing all items passed
#' in \code{...} that can be used in a \code{shinydashboard::tabItems} function.
#'
sstTestResults.pageLayout <- function(...) {
fluidPage(
id = "sstTestResults",
fluidRow(
column(
width = 12,
tags$h2("Simulations results")
)
),
actionButton("introJsResults", label = "Interactive help", onclick = "resultsIntro()"),
...
)
}
#' Creates an SST Test modular \code{shiny::fluidRow} to display plots
#' and SST simulation results.
#'
#' @param simpleOutputs A list of 2 simplified output containing the values
#' from \code{sstModel::sstOutput} without the simulations, with or without
#' scenario.
#'
#' @param baseCurrency The base currency used for the simulation.
#'
#' @param plotParams A list of 3 logical values indicating which plots
#' shall be displayed.
#'
#' @return A \code{shiny::fluidRow} containing either one or two
#' \code{resultColumn} depending on the parameters.
#'
sstTestResults.resultColumns <- function(simpleOutputs,
baseCurrency,
plotParams) {
if(plotParams$scenario) {
res <- list(
sstTestResults.resultColumn(simpleOutput = simpleOutputs$noScenario,
baseCurrency = baseCurrency,
plotParams = plotParams,
isScenario = FALSE,
width = 6
),
sstTestResults.resultColumn(simpleOutput = simpleOutputs$scenario,
baseCurrency = baseCurrency,
plotParams = plotParams,
isScenario = TRUE,
width = 6
)
)
} else {
res <- sstTestResults.resultColumn(simpleOutput = simpleOutputs$noScenario,
baseCurrency = baseCurrency,
plotParams = plotParams
)
}
fluidRow(res)
}
#' Creates an SST Test modular \code{shiny::column} to display plots
#' and SST simulation results. Scenario columns contains the drbc
#' and scenario risk plot. Normal columns contains the drbc (without scenario),
#' insurance and market risks plot.
#'
#' @param simpleOutput A implified output containing the values
#' from \code{sstModel::sstOutput} without the simulations, with or without
#' scenario.
#'
#' @param baseCurrency The base currency used for the simulation.
#'
#' @param plotParams A list of 3 logical values indicating which plots
#' shall be displayed.
#'
#' @param isScenario A logical value indicating whether to build
#' a scenario column or normal column.
#'
#' @param width The width of the column generated, defaults to 12 (full width)
#'
#' @return A \code{shiny::column}.
#'
sstTestResults.resultColumn <- function(simpleOutput,
baseCurrency,
plotParams,
isScenario = FALSE,
width = 12) {
sstRatio <- round(simpleOutput$sstRatio * 100)
sstRatioColor <- sstRatioColorHelper(sstRatio)
id <- if(isScenario) "scenario" else "noScenario"
# Defines tabBox depending on plotParams and isScenario
plotBox <- if(isScenario) {
sstTestResults.tabBox(
isScenario,
tabPanel("\U0394RBC", plotOutput("insMarScePlot")),
tabPanel("Scenario Risk", plotOutput("scePlot"))
)
} else if (plotParams$insurance && plotParams$marketRisk) {
sstTestResults.tabBox(
isScenario,
tabPanel("\U0394RBC", plotOutput("insMarPlot")),
tabPanel("Insurance Risk", plotOutput("insPlot")),
tabPanel("Market Risk", plotOutput("marPlot"))
)
} else if (!plotParams$insurance) {
sstTestResults.tabBox(
isScenario,
tabPanel("\U0394RBC", plotOutput("insMarPlot")),
tabPanel("Market Risk", plotOutput("marPlot"))
)
} else {
sstTestResults.tabBox(
isScenario,
tabPanel("\U0394RBC", plotOutput("insMarPlot")),
tabPanel("Insurance Risk", plotOutput("insPlot"))
)
}
column(
id = id,
width = width,
plotBox,
fluidRow(
id = if(isScenario) NULL else "highlightBoxes",
sstTestResults.moneyBox("Risk bearing capital", simpleOutput$rtkg, baseCurrency, icon("line-chart"), "blue"),
sstTestResults.moneyBox("One-year risk capital", simpleOutput$riskCapital, baseCurrency, icon("line-chart"), "blue"),
sstTestResults.moneyBox("MVM", simpleOutput$mvm, baseCurrency, icon("pie-chart"), "blue"),
sstTestResults.percentBox("SST ratio", sstRatio, icon("percent"), sstRatioColor)
)
)
}
#' Creates an \code{shinydashboard::tabBox} container for plot results.
#'
#' @param isScenario A logical indicating whether the box is used to
#' display with or without scenario results.
#'
#' @param ... Additional \code{shinydashboard::tabPanel} parameters to
#' include in the \code{shinydashboard::tabBox}.
#'
#' @return A \code{shiny::fluidRow}.
#'
sstTestResults.tabBox <- function(isScenario, ...) {
fluidRow(
id = if(isScenario) NULL else "plotBox",
tags$h3(if(isScenario) "With scenario" else "Without scenario"),
shinydashboard::tabBox(
width = 12,
...
)
)
}
#' Creates an \code{shinydashboard::infoBox} container to display to
#' display percent values.
#'
#' @param title The title of the box
#'
#' @param val The value of the box (should be a percentage)
#'
#' @param icon The icon for the box, generated by \code{shiny::icon}
#'
#' @param color The color of the box.
#'
#' @return A \code{shinydashboard::infoBox}.
#'
sstTestResults.percentBox <- function(title,
val,
icon,
color) {
div(
# Manually added boostrap classes to the div for better
# responsiveness. Prevents the colored boxes of solvency figures
# from being unreadable when the window is too small.
class = "col-lg-6 col-md-12",
fluidRow(
shinydashboard::infoBox(
value = paste0(val, " %"),
title = title,
icon = icon,
width = 12,
color = color,
fill = TRUE
)
)
)
}
#' Creates an \code{shinydashboard::infoBox} container to display to
#' display financial values.
#'
#' @param title The title of the box
#'
#' @param val The value of the box (should be a financial value)
#'
#' @param currency A string representing a currency that will be appended
#' to the value of the box.
#'
#' @param icon The icon for the box, generated by \code{shiny::icon}
#'
#' @param color The color of the box.
#'
#' @return A \code{shinydashboard::infoBox}.
#'
sstTestResults.moneyBox <- function(title,
val,
currency,
icon,
color) {
div(
# Manually added boostrap classes to the div for better
# responsiveness. Prevents the colored boxes of solvency figures
# from being unreadable when the window is too small.
class = "col-lg-6 col-md-12",
fluidRow(
shinydashboard::infoBox(
value = paste0(
"Mio. ",
currency,
" ",
prettyNum(round(abs(val)), big.mark = "'", scientific = FALSE)
),
title = title,
icon = icon,
width = 12,
color = color,
fill = TRUE
)
)
)
}
#' Creates an SST Test modular \code{shiny::fluidRow} to display a table
#' of standalones.
#'
#' @param summary The summary of the sstOuput, generarted by
#' \code{sstModel::summary(sstOutput)}
#'
#' @return A \code{shiny::fluidRow} containing different \code{shinydashboard::box}
#'
sstTestResults.standalonesTables <- function(summary) {
# Computes the names of the a list type datastructure,
# names(x) would return colnames for data.frame otherwise.
xnames <- function(x) {
if(is.data.frame(x)) {
rownames(x)
} else {
names(x)
}
}
lengths <- summaryLengths(summary)
fluidRow(lapply(names(lengths), function(x) sstTestResults.standalonesTable(x, lengths[[x]], xnames(summary[[x]]))))
}
#' Creates an SST Test modular \code{shiny::fluidRow} to display a table
#' of standalones.
#'
#' @param title A character string that will be used as title for the box
#' and to compute ids for the tables.
#'
#' @param ntables THe number of tables in the box.
#'
#' @param names A character vector containing the names of each table.
#'
#' @return A \code{shinydashboard::box} containing a \code{shiny::dataTableOutput}
#'
sstTestResults.standalonesTable <- function(title, ntables, names) {
# If ntables > 0 it means that tables to render may have different titles
# than title, therefore we would manually add the subtitle for the table.
list <- if(ntables > 0) {
lapply(seq(to = ntables), function(x) {
list(
tags$h4(names[x]),
uiOutput(formatTableId(title, x), width = "100%")
)
})
# Otherwise it means the box can only contain one table, so no
# subtitles are needed.
} else {
uiOutput(title, width = "100%")
}
shinydashboard::box(
title = title,
solidHeader = TRUE,
status = "primary",
width = 12,
class = "tableBox",
style="overflow: auto;",
list
)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.