Nothing
R/app_styling.R
In Certara.ModelResults: Generate Diagnostics for Pharmacometric Models Using 'shiny'
Defines functions
toggleVisibility
hasCovariates
write_code
change_outlier_shape
change_point_shape
material_tabs
create_id
material_collapsible_item
add_gg_line_break
remove_rlang
material_collapsible
material_collapsible_item
hideTab
certara_footer
certara_header
Documented in
write_code
#app_styling
styleCSS <-
"body, .container-fluid {
background-color: #616161;
margin: 0;
padding: 0;
}
.sidebar {
margin-bottom: -1.5rem;
}
.bslib-sidebar-layout .sidebar .sidebar-content {
padding-top: 20px;
gap: 0px;
}
.sidebar-card .card-body.bslib-gap-spacing {
gap: 2px;
}
.certara-header {
display: flex;
justify-content: space-between;
align-items: center;
padding: 0px 20px;
background-color: #d3d3d3;
border-bottom: 2px solid #CC0000;
}
.logo-title {
display: flex;
align-items: center;
}
.logo-title img {
margin-right: 10px;
}
.certara-footer {
display: flex;
justify-content: space-between;
align-items: center;
left: 0;
bottom: 0;
width: 100%;
height: 35px;
background-color: #d3d3d3;
border-top: 1px solid #CC0000;
color: #000;
text-align: left;
z-index: 12;
}
.preview-tab {
gap: 0px;
}
.style-subtab {
padding-left: 50px;
padding-right: 50px;
display: flex;
gap: 0px;
}
.style-column {
margin-left: 0.5rem;
margin-right: 0.5rem;
}
.layout-subtab {
display: flex;
padding-left: 50px;
padding-right: 50px;
gap: 0px;
}
.display-subtab {
padding-left: 50px;
padding-right: 50px;
gap: 0px;
}
.multi-input-with-checkbox {
display: flex;
align-items: baseline;
}
.multi-input-with-checkbox .col-sm-1,
.multi-input-with-checkbox .col-sm-2,
.multi-input-with-checkbox .col-sm-3 {
align-self: flex-start;
}
.multi-input-with-checkbox .col-checkbox {
align-self: flex-start;
margin-bottom: 5px;
padding-top: 2.2rem;
}
h4 {
color:black;
font-size: 22px;
font-family: Segoe UI Light, Arial, sans-serif;
}
h5 {
color:black;
font-size: 16px;
font-family: Segoe UI Light, Arial, sans-serif;
}
h6 {
color: #9e9e9e;
font-size: 0.9rem;
line-height: 9%;
}
.shiny-output-error-validation {
padding-top: 10px;
color: #FF0000;
}
.shiny-input-container label {
color: #9e9e9e;
font-size: 0.7rem;
line-height: 9%;
margin: 0.366667rem 0 -0.54rem 0;
}
.shiny-input-container .control-label {
line-height: initial;
}
.shiny-input-container .checkbox label {
color: initial;
font-size: initial;
line-height: initial;
margin: initial;
}
.form-group.shiny-input-container[data-shiny-input-type=colour] {
padding-bottom: 4.5px;
}
.save_btn,
.shiny-download-link,
#generateReportPirana {
color: black;
text-decoration: none;
cursor: pointer;
}
.save_btn:hover
.shiny-download-link:hover,
#generateReportPirana {
color: black;
text-decoration: none;
}
.btn {
color: #fff;
background-color: #1d7eba;
text-decoration: none;
text-align: center;
letter-spacing: .5px;
-webkit-transition: background-color .2s ease-out;
transition: background-color .2s ease-out;
cursor: pointer;
}
.btn:hover {
background-color: #008CBA;
color: #fff;
}
#cancelRemoveTagged, #exitCancel {
background-color: grey;
}
.colourpicker-input-container {
background-image: none;
height: 2rem;
margin-top: 0px;
}
.nav-item {
flex: 1;
text-align: center;
}
/* width */
::-webkit-scrollbar {
width: 5px;
}
/* Track */
::-webkit-scrollbar-track {
background: #f1f1f1;
}
/* Handle */
::-webkit-scrollbar-thumb {
background: #888;
}
/* Handle on hover */
::-webkit-scrollbar-thumb:hover {
background: #555;
}
#open_savePlotModal {
position: fixed;
bottom: 60px;
right: 25px;
height: 60px;
width: 60px;
border-radius: 50%;
display: flex;
align-items: center;
justify-content: center;
}
#selectedModel + .selectize-control {
word-break: break-word;
}
#selectedPlotName,
#selectedPlotDesc {
font-size: 0.8rem
}
#selected_plot_type {
visibility: hidden;
height: 0px;
}
.fa-tag {
font-size: 40px;
padding-top: 3px;
}
.bslib-sidebar-layout .sidebar {
background-color: #fff;
}
#treeModelDiagnostics-search-input {
width: -webkit-fill-available;
margin-right: 0.5rem;
}
.bslib-full-screen-enter {
bottom: var(--bslib-full-screen-enter-bottom);
top: var(--bslib-full-screen-enter-top, 0.2rem);
}
"
styleInput <- "input:not([type]), input[type=text]:not(.browser-default), input[type=password]:not(.browser-default), input[type=email]:not(.browser-default), input[type=url]:not(.browser-default), input[type=time]:not(.browser-default), input[type=date]:not(.browser-default), input[type=datetime]:not(.browser-default), input[type=datetime-local]:not(.browser-default), input[type=tel]:not(.browser-default), input[type=number]:not(.browser-default), input[type=search]:not(.browser-default), textarea.materialize-textarea {
background-color: transparent;
border: none;
border-bottom: 1px solid #9e9e9e;
border-radius: 0;
outline: none;
height: 1.75rem;
width: 100%;
font-size: 14px;
margin: 0 0 8px 0;
padding: 0;
-webkit-box-shadow: none;
box-shadow: none;
-webkit-box-sizing: content-box;
box-sizing: content-box;
-webkit-transition: border .3s, -webkit-box-shadow .3s;
transition: border .3s, -webkit-box-shadow .3s;
transition: box-shadow .3s, border .3s;
transition: box-shadow .3s, border .3s, -webkit-box-shadow .3s;
}"
certara_header <- function(header_title) {
div(class = "certara-header",
div(class = "logo-title",
tags$a(
href = "https://www.certara.com",
target = "_blank",
class = "brand-logo",
tags$img(src = "https://cdn.shortpixel.ai/spai/w_133+q_lossless+ret_img+to_webp/https://www.certara.com/app/uploads/2023/05/certara-logo-2023.png")
),
h4(class = "header_title", header_title, style = "margin-top: 20px; font-family: Segoe UI !important")
),
shiny::actionLink(inputId = "exitShiny",
label = "Save & Exit",
icon = icon("save"),
class = "save_btn"
)
)
}
certara_footer <- function(url) {
div(class = "certara-footer",
tags$p(style = 'margin: 0; padding-right: 5px; font-size:small',
HTML(" "),
tags$a(href = 'https://www.certara.com/', target = '_blank', 'Home'),
HTML(" "),
tags$a(href = url, target = '_blank', 'Help'),
HTML(" "),
tags$a(href = 'https://certara.service-now.com/csm', target = '_blank', 'Support'),
HTML(" "),
tags$a(href = 'https://www.certara.com/legal/privacy-center/', target = '_blank', 'Privacy Policy')
),
tags$p(style = 'margin: 0; padding-right: 5px; font-size:small; text-align: right;',
HTML("© 2011-2024 Certara USA, Inc., All rights reserved. Version: 3.0.1")
)
)
}
hideTab <- function(inputId, target,
session = getDefaultReactiveDomain()) {
force(target)
inputId <- session$ns(inputId)
callback <- function() {
session$sendChangeTabVisibility(
inputId = inputId,
target = target,
type = "hide"
)
}
session$onFlush(callback, once = TRUE)
}
material_collapsible_item <- function(label, ..., icon = NULL, active = FALSE) {
tags$li(
tags$div(
class = paste("collapsible-header", if (active) "active"),
if (!is.null(icon))
tags$i(class = "material-icons", icon),
label
),
tags$div(
class = "collapsible-body",
tags$span(
...
)
)
)
}
material_collapsible <- function(..., depth = NULL, color = NULL, type = NULL, active = TRUE){
tags$ul(
class = paste(
"collapsible",
if (active) "active",
if (!is.null(type)) type,
if (!is.null(depth)) paste0("z-depth-", depth),
if (!is.null(color)) color),
...
)
}
jsFunctions <- "shinyjs.closewindow = function() { window.close(); }"
# $('li.tab a[href$=\"#tab2\"]').trigger('hide');
# $('li.tab a[href$=\"#tab2\"]').trigger('hidden');
# remove_rlang <- function(code){
# gsub("!!rlang::sym\\(\"(\\S+)\"\\)", "\\1", code)
# } #alternative approach
remove_rlang <- function(code){
gsub("!!rlang::sym\\(\"([\\w\\W]*?)\"\\)", "\\1", code, perl=TRUE)
}
add_gg_line_break <- function(code){
code <- gsub("as.symbol\\(\"xpobj\"\\)", "xpobj", code)
code <- gsub("\\+", "+ \n", code)
code <- c(code, "\n")
}
# --------------------------------------------------------------------------------
# !!rlang::sym '!!rlang::sym'
# --------------------------------------------------------------------------------
# \( '('
# --------------------------------------------------------------------------------
# \" '"'
# --------------------------------------------------------------------------------
# ( group and capture to \1:
# --------------------------------------------------------------------------------
# [\w\W]*? any character of: word characters (a-z,
# A-Z, 0-9, _), non-word characters (all
# but a-z, A-Z, 0-9, _) (0 or more times
# (matching the least amount possible))
# --------------------------------------------------------------------------------
# ) end of \1
# --------------------------------------------------------------------------------
# " '"'
# --------------------------------------------------------------------------------
# \) ')'
material_collapsible_item <- function(label, ..., icon = NULL, active = FALSE) {
tags$li(
tags$div(
class = paste("collapsible-header", if (active) "active"),
if (!is.null(icon))
tags$i(class = "material-icons", icon),
label
),
tags$div(
class = "collapsible-body",
tags$span(
...
)
)
)
}
create_id <- function() {
paste(format(as.hexmode(sample(256, 8, replace = TRUE) -
1), width = 2), collapse = "")
}
material_tabs <- function(tabs, color = NULL, icon = NULL){
material_tabs <- shiny::tagList()
this_id <- paste0('tabs-id-', create_id())
for(i in 1:length(tabs)){
material_tabs[[i]] <-
shiny::tags$li(
class = "tab",
# shiny::tags$div(
# if (!is.null(icon[[i]]))
# tags$i(class = "material-icons", icon[[i]])
# ),
shiny::tags$a(
class =
paste0(
ifelse(
is.null(color),
"",
paste0(" ", color, "-text")
)
),
href = paste0("#", tabs[[i]]),
tags$i(class = "material-icons", icon[[i]]),
names(tabs)[[i]]
)
)
}
if(!is.null(color)){
tabs_style <-
shiny::tagList(
shiny::tags$head(
shiny::tags$style(
paste0(
"
#", this_id, " .indicator {
position: absolute;
bottom: 0;
height: 2px;
background-color: ", color, " !important;
will-change: left, right;
}
#", this_id, " .tab a:focus, #", this_id, " .tab a:focus.active {
background-color: ", paste0('rgba(', paste0(as.character(grDevices::col2rgb(color)[,1]), collapse = ', '), ', 0.2)'), ";
outline: none;
}
"
)
)
)
)
} else {
tabs_style <- shiny::tags$div()
}
shiny::tagList(
shiny::tags$ul(
id = this_id,
class = "tabs tabs-fixed-width",
material_tabs
),
tabs_style
)
}
#need to generate different tree if type = NLME versus type = NONMEM
resultsTreeListNLME <- list(
`Basic GOF` = list(`|IWRES| vs IPRED` = "",
`|IWRES| vs IVAR` = "",
`|IWRES| vs TAD` = "",
`IWRES vs IPRED` = "",
`IWRES vs IVAR` = "",
`IWRES vs TAD` = "",
`CWRES vs PRED` = "",
`CWRES vs IVAR` = "",
`CWRES vs TAD` = "",
`PCWRES vs PPRED` = "",
`PCWRES vs IVAR` = "",
`PCWRES vs TAD` = "",
`WRES vs PRED` = "",
`WRES vs IVAR` = "",
`WRES vs TAD` = "",
`NPD vs PPRED` = "",
`NPD vs IVAR` = "",
`NPD vs TAD` = "",
`NPDE vs PPRED` = "",
`NPDE vs IVAR` = "",
`NPDE vs TAD` = "",
`Individual Plots (IVAR)` = "",
`Individual Plots (TAD)` = "",
`DV vs IVAR` = "",
`DV vs IPRED` = "",
`DV vs PRED` = "",
`DV PREDS vs IVAR` = "",
`PRED vs IVAR` = ""
),
`Covariate Model` = list(`ETA vs Covariate` = "",
`Structural Parameter vs Covariate` = "",
`CWRES vs Covariate` = "",
`PCWRES vs Covariate` = "",
`WRES vs Covariate` = "",
`IWRES vs Covariate` = "",
`NPD vs Covariate` = "",
`NPDE vs Covariate` = ""
),
`Distribution Plots` = list(`Covariate Distribution` = "",
`ETA Distribution` = "",
`Structural Parameter Distribution` = "",
`CWRES Distribution` = "",
`PCWRES Distribution` = "",
`WRES Distribution` = "",
`IWRES Distribution` = "",
`NPD Distribution` = "",
`NPDE Distribution` = ""
),
#`Minimization Diagnostics` = list(`PRM vs Iteration` = ""),
`QQ Plots` = list(`Covariate QQ` = "",
`ETA QQ` = "",
`Structural Parameter QQ` = "",
`CWRES QQ` = "",
`PCWRES QQ` = "",
`WRES QQ` = "",
`IWRES QQ` = "",
`NPD QQ` = "",
`NPDE QQ` = ""),
`Tables` = list(`Overall` = "",
`Theta` = "",
`Secondary` = "",
`Omega` = "",
`Sigma` = "")
)
resultsTreeListNONMEM <- list(
`Basic GOF` = list(`|IWRES| vs IPRED` = "",
`|IWRES| vs IVAR` = "",
`|IWRES| vs TAD` = "",
`IWRES vs IPRED` = "",
`IWRES vs IVAR` = "",
`IWRES vs TAD` = "",
`CWRES vs PRED` = "",
`CWRES vs IVAR` = "",
`CWRES vs TAD` = "",
`ECWRES vs PRED` = "",
`ECWRES vs IVAR` = "",
`ECWRES vs TAD` = "",
`EWRES vs PRED` = "",
`EWRES vs IVAR` = "",
`EWRES vs TAD` = "",
`NPD vs PRED` = "",
`NPD vs IVAR` = "",
`NPD vs TAD` = "",
`NPDE vs PRED` = "",
`NPDE vs IVAR` = "",
`NPDE vs TAD` = "",
`WRES vs PRED` = "",
`WRES vs IVAR` = "",
`WRES vs TAD` = "",
`Individual Plots (IVAR)` = "",
`Individual Plots (TAD)` = "",
`DV vs IVAR` = "",
`DV vs IPRED` = "",
`DV vs PRED` = "",
`DV PREDS vs IVAR` = "",
`PRED vs IVAR` = ""
),
`Covariate Model` = list(`ETA vs Covariate` = "",
`Structural Parameter vs Covariate` = "",
`CWRES vs Covariate` = "",
`ECWRES vs Covariate` = "",
`EWRES vs Covariate` = "",
`NPD vs Covariate` = "",
`NPDE vs Covariate` = "",
`WRES vs Covariate` = "",
`IWRES vs Covariate` = ""
),
`Distribution Plots` = list(`Covariate Distribution` = "",
`ETA Distribution` = "",
`Structural Parameter Distribution` = "",
`CWRES Distribution` = "",
`ECWRES Distribution` = "",
`EWRES Distribution` = "",
`NPD Distribution` = "",
`NPDE Distribution` = "",
`WRES Distribution` = "",
`IWRES Distribution` = ""),
`QQ Plots` = list(`Covariate QQ` = "",
`ETA QQ` = "",
`Structural Parameter QQ` = "",
`CWRES QQ` = "",
`ECWRES QQ` = "",
`EWRES QQ` = "",
`NPD QQ` = "",
`NPDE QQ` = "",
`WRES QQ` = "",
`IWRES QQ` = ""),
`Tables` = list(`Overall` = "",
`Theta` = "",
`Omega` = "",
`Sigma` = "")
)
templates_titles_df <- data.frame(
Tag = c("@condn",
"@covtime",
"@data",
"@descr",
"@dir",
"@epsshk",
"@errors",
"@esampleseed",
"@etashk",
"@file",
"@label",
"@method",
"@nesample",
"@nind",
"@nobs",
"@nsig",
"@ofv",
"@page and @lastpage",
"@probn",
"@plotfun",
"@ref",
"@run",
"@runtime",
"@software",
"@simseed",
"@subroutine",
"@timestart",
"@timestop",
"@timeplot",
"@term",
"@version",
"@warnings",
"@x @y"),
Description = c("Condition number",
"Covariance matrix runtime",
"Model input data used",
"Model description",
"Model directory",
"Epsilon shrinkage",
"Run errors (e.g termination error)",
"ESAMPLE seed number (used in NPDE)",
"Eta shrinkage",
"Model file name",
"Model label",
"Estimation method or sim",
"Number of ESAMPLE (used in NPDE)",
"Number of individuals",
"Number of observations",
"Number of significant digits",
"Objective function value",
"Are respectively the page number and the number of the last page when faceting on multiple pages",
"Problem number",
"Name of the plot function",
"Reference model",
"Model run name",
"Estimation/Sim runtime",
"Software used (e.g. NLME/NONMEM)",
"Simulation seed",
"Differential equation solver",
"Run start time",
"Run stop time",
"Time of the plot rendering",
"Termination message",
"Software version (e.g. 7.3)",
"Run warnings (e.g. boundary)",
"Name of any ggplot2 variable used for mapping in an aes() type function"))
table_glossary_df <- data.frame(
Name = c("OFV",
"LL",
"-2LL",
"RetCode",
"Condition",
"AIC",
"BIC",
"nParm",
"nObs",
"nSub",
"SE",
"RSE"),
Description = c("Objective function value",
"Log-likelihood",
"Twice the negative log-likelihood",
"Return code indicating the success of convergence",
"Condition number",
"Akaike information criterion",
"Bayesian information criterion",
"Number of parameters",
"Number of observations",
"Number of subjects",
"Standard error",
"Relative standard error, also called coefficient of variation (CV)"))
# # Update Model Results Theme ----
# updateThemeMR <- function(input){
#
# theme_model_results <- list(
# arrange.ncol = input$arrangeColNum,
# arrange.nrow = input$arrangeRowNum,
# axis.color = input$colorAxis,
# axis.face = input$faceAxis,
# axis.font = input$fontAxis,
# axis.scale = input$selectedAxisScale,
# axis.size = input$sizeAxis,
# axis.x.label = input$xlab,
# axis.y.label = input$ylab,
# background.border = input$isShowBorder,
# background.color = input$colorBackground,
# background.gridlines = input$isShowGridLines,
# boxplot.alpha = input$alphaBoxPlot/100,
# boxplot.line.color = input$colorBoxPlot,
# boxplot.fill.color = input$fillBoxPlot,
# axis.log.type = set_log_type(input$isLogX, input$isLogY),
# caption.color = input$colorCaption,
# caption.face = input$faceCaption,
# caption.font = input$fontCaption,
# caption.size = input$sizeCaption,
# caption.text = input$textCaption,
# density.alpha = input$alphaDensity/100,
# density.line.color = input$colorDensity,
# density.fill.color = input$fillDensity,
# density.line.type = input$typeLineDensity,
# density.size = input$sizeDensity,
# facet.ncol = input$arrangeColNum,
# facet.nrow = input$arrangeRowNum,
# guide.line.alpha = input$alphaLineGuide/100,
# guide.line.color = input$colorLineGuide,
# guide.line.size = input$sizeLineGuide,
# guide.line.type = input$typeLineGuide,
# guide.line.extra.y1 = input$hLine1,
# guide.line.extra.y2 = input$hLine2,
# hist.alpha = input$alphaHistogram/100,
# hist.line.color = input$colorHistogram,
# hist.fill.color = input$fillHistogram,
# hist.line.type = input$typeLineHistogram,
# hist.nbins = input$nbinsHistogram,
# hist.size = input$sizeHistogram,
# indplots.legend.position = input$legendPosition,
# indplots.line.color.IPRED = input$colorLineIPRED,
# indplots.line.color.PRED = input$colorLinePRED,
# indplots.line.type.IPRED = input$typeLineIPRED,
# indplots.line.type.PRED = input$typeLinePRED,
# indplots.point.alpha.DV = input$alphaPointDV / 100,
# indplots.point.color.DV = input$colorPointDV,
# indplots.point.size.DV = input$sizePointDV,
# indplots.point.shape.DV = change_point_shape(input$shapePointDV),
# line.alpha = input$alphaLine/100,
# line.color = input$colorLine,
# line.size = input$sizeLine,
# line.type = input$typeLine,
# outlier.alpha = input$alphaOutlier/100,
# outlier.color = input$colorOutlier,
# outlier.shape = change_outlier_shape(input$shapeOutlier, input$displayOutliers),
# outlier.size = input$sizeOutlier,
# plot.distribution.type = set_plot_distribution_type(input$displayHistogram, input$displayDensity, input$displayRug),
# plot.scatter.guide = input$displayRefLine,
# plot.scatter.smoothing = input$smoothingType,
# plot.scatter.type = set_plot_scatter_type(input$displayPoints, input$displayLines, input$displaySmoothing, input$displayText),
# point.alpha = input$alphaPoint/100,
# point.color = input$colorPoint,
# point.shape = change_point_shape(input$shapePoint),
# point.size = input$sizePoint,
# rug.color = input$colorRug,
# rug.line.size = input$sizeLineRug,
# rug.sides = set_rug_type(input$positionRug),
# smooth.line.alpha = input$alphaLineSmooth/100,
# smooth.line.color = input$colorLineSmooth,
# smooth.line.size = input$sizeLineSmooth,
# smooth.line.type = input$typeLineSmooth,
# smooth.span = input$spanSmooth,
# subtitle.color = input$colorSubtitle,
# subtitle.face = input$faceSubtitle,
# subtitle.font = input$fontSubtitle,
# subtitle.size = input$sizeSubtitle,
# subtitle.text = input$textSubtitle,
# title.color = input$colorTitle,
# title.face = input$faceTitle,
# title.font = input$fontTitle,
# title.size = input$sizeTitle,
# title.text = input$textTitle
# )
#
# theme_model_results
# }
change_point_shape <- function(shape){
if(shape == "circle"){
shape <- 1
} else if(shape == "circle-fill"){
shape <- 16
} else if(shape == "square"){
shape <- 0
} else if(shape == "square-fill"){
shape <- 15
} else if(shape == "triangle"){
shape <- 2
} else {
shape <- 17
}
}
change_outlier_shape <- function(shape, display){
if(shape == "circle"){
shape <- 1
} else if(shape == "circle-fill"){
shape <- 16
} else if(shape == "square"){
shape <- 0
} else if(shape == "square-fill"){
shape <- 15
} else if(shape == "triangle"){
shape <- 2
} else {
shape <- 17
}
if(!display) shape <- NA
shape
}
# Define Tree Lookups ----
branches <- c("Basic GOF", "Covariate Model", "Distribution Plots", "QQ Plots", "Tables")
covariate_trees <- c("CWRES vs Covariate" ,"ECWRES vs Covariate" ,"EWRES vs Covariate" ,"ETA vs Covariate" ,"IWRES vs Covariate" ,
"NPD vs Covariate" ,"NPDE vs Covariate" ,"Structural Parameter vs Covariate" ,"WRES vs Covariate","PCWRES vs Covariate",
"Covariate Distribution")
no_refline_trees <- c("|IWRES| vs IPRED", "|IWRES| vs IVAR", "|IWRES| vs TAD", "Structural Parameter vs Covariate", "DV vs IVAR", "DV PREDS vs IVAR","PRED vs IVAR" )
distribution_trees <- c("Covariate Distribution", "PCWRES Distribution", "ECWRES Distribution", "EWRES Distribution",
"NPD Distribution", "NPDE Distribution", "CWRES Distribution", "ETA Distribution", "IWRES Distribution", "Structural Parameter Distribution", "WRES Distribution")
qq_trees <- c("Covariate QQ", "NPD QQ", "NPDE QQ", "CWRES QQ", "ETA QQ", "IWRES QQ", "Structural Parameter QQ", "WRES QQ", "PCWRES QQ")
table_trees <- c("Overall", "Theta", "Omega", "Sigma", "Secondary")
#' Write code to R script from tagged diagnostics
#'
#' Use this function to write code to R script from diagnostics tagged in Certara's Model Results Shiny Application.
#'
#' @param tagged List of tagged objects from returned from \code{resultsUI()}.
#' @param file Character specifying path of output file. If missing, it will be saved as \code{code.R} in working directory.
#'
#' @examples
#' if (interactive()) {
#' tagged_diagnostics <- resultsUI(xpdb = xpdb_NLME)
#'
#' write_code(tagged_diagnostics, "tagged_results.R")
#'
#' }
#'
#' @return Returns \code{NULL} after writing to \code{file}.
#' @export
write_code <- function(tagged, file){
if(missing(file)){
stop("Missing \"file\" argument.")
}
lines <- vector(mode = "list", length = length(tagged))
for(i in seq_along(tagged)){
lines[[i]] <- paste0(tagged[[i]]$code)
}
writeLines(unlist(lines), con = file)
}
# check if xpdb contains covariates
hasCovariates <- function(xpdb){
index <- xpdb$data$index[[1]]
catcovColNames <- index %>%
dplyr::filter(.data$type == "catcov") %>%
dplyr::select(col) %>%
unlist(use.names = FALSE)
contcovColNames <- index %>%
dplyr::filter(.data$type == "contcov") %>%
dplyr::select(col) %>%
unlist(use.names = FALSE)
if(length(c(catcovColNames, contcovColNames)) > 0){
hascov <- TRUE
} else {
hascov <- FALSE
}
return(hascov)
}
toggleVisibility <- function(selector, condition){
if(condition){
shinyjs::show(selector = selector)
} else {
shinyjs::hide(selector = selector)
}
}
Try the Certara.ModelResults package in your browser
Any scripts or data that you put into this service are public.
Certara.ModelResults documentation built on April 4, 2025, 2:43 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions toggleVisibility hasCovariates write_code change_outlier_shape change_point_shape material_tabs create_id material_collapsible_item add_gg_line_break remove_rlang material_collapsible material_collapsible_item hideTab certara_footer certara_header
Documented in write_code
#app_styling
styleCSS <-
"body, .container-fluid {
background-color: #616161;
margin: 0;
padding: 0;
}
.sidebar {
margin-bottom: -1.5rem;
}
.bslib-sidebar-layout .sidebar .sidebar-content {
padding-top: 20px;
gap: 0px;
}
.sidebar-card .card-body.bslib-gap-spacing {
gap: 2px;
}
.certara-header {
display: flex;
justify-content: space-between;
align-items: center;
padding: 0px 20px;
background-color: #d3d3d3;
border-bottom: 2px solid #CC0000;
}
.logo-title {
display: flex;
align-items: center;
}
.logo-title img {
margin-right: 10px;
}
.certara-footer {
display: flex;
justify-content: space-between;
align-items: center;
left: 0;
bottom: 0;
width: 100%;
height: 35px;
background-color: #d3d3d3;
border-top: 1px solid #CC0000;
color: #000;
text-align: left;
z-index: 12;
}
.preview-tab {
gap: 0px;
}
.style-subtab {
padding-left: 50px;
padding-right: 50px;
display: flex;
gap: 0px;
}
.style-column {
margin-left: 0.5rem;
margin-right: 0.5rem;
}
.layout-subtab {
display: flex;
padding-left: 50px;
padding-right: 50px;
gap: 0px;
}
.display-subtab {
padding-left: 50px;
padding-right: 50px;
gap: 0px;
}
.multi-input-with-checkbox {
display: flex;
align-items: baseline;
}
.multi-input-with-checkbox .col-sm-1,
.multi-input-with-checkbox .col-sm-2,
.multi-input-with-checkbox .col-sm-3 {
align-self: flex-start;
}
.multi-input-with-checkbox .col-checkbox {
align-self: flex-start;
margin-bottom: 5px;
padding-top: 2.2rem;
}
h4 {
color:black;
font-size: 22px;
font-family: Segoe UI Light, Arial, sans-serif;
}
h5 {
color:black;
font-size: 16px;
font-family: Segoe UI Light, Arial, sans-serif;
}
h6 {
color: #9e9e9e;
font-size: 0.9rem;
line-height: 9%;
}
.shiny-output-error-validation {
padding-top: 10px;
color: #FF0000;
}
.shiny-input-container label {
color: #9e9e9e;
font-size: 0.7rem;
line-height: 9%;
margin: 0.366667rem 0 -0.54rem 0;
}
.shiny-input-container .control-label {
line-height: initial;
}
.shiny-input-container .checkbox label {
color: initial;
font-size: initial;
line-height: initial;
margin: initial;
}
.form-group.shiny-input-container[data-shiny-input-type=colour] {
padding-bottom: 4.5px;
}
.save_btn,
.shiny-download-link,
#generateReportPirana {
color: black;
text-decoration: none;
cursor: pointer;
}
.save_btn:hover
.shiny-download-link:hover,
#generateReportPirana {
color: black;
text-decoration: none;
}
.btn {
color: #fff;
background-color: #1d7eba;
text-decoration: none;
text-align: center;
letter-spacing: .5px;
-webkit-transition: background-color .2s ease-out;
transition: background-color .2s ease-out;
cursor: pointer;
}
.btn:hover {
background-color: #008CBA;
color: #fff;
}
#cancelRemoveTagged, #exitCancel {
background-color: grey;
}
.colourpicker-input-container {
background-image: none;
height: 2rem;
margin-top: 0px;
}
.nav-item {
flex: 1;
text-align: center;
}
/* width */
::-webkit-scrollbar {
width: 5px;
}
/* Track */
::-webkit-scrollbar-track {
background: #f1f1f1;
}
/* Handle */
::-webkit-scrollbar-thumb {
background: #888;
}
/* Handle on hover */
::-webkit-scrollbar-thumb:hover {
background: #555;
}
#open_savePlotModal {
position: fixed;
bottom: 60px;
right: 25px;
height: 60px;
width: 60px;
border-radius: 50%;
display: flex;
align-items: center;
justify-content: center;
}
#selectedModel + .selectize-control {
word-break: break-word;
}
#selectedPlotName,
#selectedPlotDesc {
font-size: 0.8rem
}
#selected_plot_type {
visibility: hidden;
height: 0px;
}
.fa-tag {
font-size: 40px;
padding-top: 3px;
}
.bslib-sidebar-layout .sidebar {
background-color: #fff;
}
#treeModelDiagnostics-search-input {
width: -webkit-fill-available;
margin-right: 0.5rem;
}
.bslib-full-screen-enter {
bottom: var(--bslib-full-screen-enter-bottom);
top: var(--bslib-full-screen-enter-top, 0.2rem);
}
"
styleInput <- "input:not([type]), input[type=text]:not(.browser-default), input[type=password]:not(.browser-default), input[type=email]:not(.browser-default), input[type=url]:not(.browser-default), input[type=time]:not(.browser-default), input[type=date]:not(.browser-default), input[type=datetime]:not(.browser-default), input[type=datetime-local]:not(.browser-default), input[type=tel]:not(.browser-default), input[type=number]:not(.browser-default), input[type=search]:not(.browser-default), textarea.materialize-textarea {
background-color: transparent;
border: none;
border-bottom: 1px solid #9e9e9e;
border-radius: 0;
outline: none;
height: 1.75rem;
width: 100%;
font-size: 14px;
margin: 0 0 8px 0;
padding: 0;
-webkit-box-shadow: none;
box-shadow: none;
-webkit-box-sizing: content-box;
box-sizing: content-box;
-webkit-transition: border .3s, -webkit-box-shadow .3s;
transition: border .3s, -webkit-box-shadow .3s;
transition: box-shadow .3s, border .3s;
transition: box-shadow .3s, border .3s, -webkit-box-shadow .3s;
}"
certara_header <- function(header_title) {
div(class = "certara-header",
div(class = "logo-title",
tags$a(
href = "https://www.certara.com",
target = "_blank",
class = "brand-logo",
tags$img(src = "https://cdn.shortpixel.ai/spai/w_133+q_lossless+ret_img+to_webp/https://www.certara.com/app/uploads/2023/05/certara-logo-2023.png")
),
h4(class = "header_title", header_title, style = "margin-top: 20px; font-family: Segoe UI !important")
),
shiny::actionLink(inputId = "exitShiny",
label = "Save & Exit",
icon = icon("save"),
class = "save_btn"
)
)
}
certara_footer <- function(url) {
div(class = "certara-footer",
tags$p(style = 'margin: 0; padding-right: 5px; font-size:small',
HTML(" "),
tags$a(href = 'https://www.certara.com/', target = '_blank', 'Home'),
HTML(" "),
tags$a(href = url, target = '_blank', 'Help'),
HTML(" "),
tags$a(href = 'https://certara.service-now.com/csm', target = '_blank', 'Support'),
HTML(" "),
tags$a(href = 'https://www.certara.com/legal/privacy-center/', target = '_blank', 'Privacy Policy')
),
tags$p(style = 'margin: 0; padding-right: 5px; font-size:small; text-align: right;',
HTML("© 2011-2024 Certara USA, Inc., All rights reserved. Version: 3.0.1")
)
)
}
hideTab <- function(inputId, target,
session = getDefaultReactiveDomain()) {
force(target)
inputId <- session$ns(inputId)
callback <- function() {
session$sendChangeTabVisibility(
inputId = inputId,
target = target,
type = "hide"
)
}
session$onFlush(callback, once = TRUE)
}
material_collapsible_item <- function(label, ..., icon = NULL, active = FALSE) {
tags$li(
tags$div(
class = paste("collapsible-header", if (active) "active"),
if (!is.null(icon))
tags$i(class = "material-icons", icon),
label
),
tags$div(
class = "collapsible-body",
tags$span(
...
)
)
)
}
material_collapsible <- function(..., depth = NULL, color = NULL, type = NULL, active = TRUE){
tags$ul(
class = paste(
"collapsible",
if (active) "active",
if (!is.null(type)) type,
if (!is.null(depth)) paste0("z-depth-", depth),
if (!is.null(color)) color),
...
)
}
jsFunctions <- "shinyjs.closewindow = function() { window.close(); }"
# $('li.tab a[href$=\"#tab2\"]').trigger('hide');
# $('li.tab a[href$=\"#tab2\"]').trigger('hidden');
# remove_rlang <- function(code){
# gsub("!!rlang::sym\\(\"(\\S+)\"\\)", "\\1", code)
# } #alternative approach
remove_rlang <- function(code){
gsub("!!rlang::sym\\(\"([\\w\\W]*?)\"\\)", "\\1", code, perl=TRUE)
}
add_gg_line_break <- function(code){
code <- gsub("as.symbol\\(\"xpobj\"\\)", "xpobj", code)
code <- gsub("\\+", "+ \n", code)
code <- c(code, "\n")
}
# --------------------------------------------------------------------------------
# !!rlang::sym '!!rlang::sym'
# --------------------------------------------------------------------------------
# \( '('
# --------------------------------------------------------------------------------
# \" '"'
# --------------------------------------------------------------------------------
# ( group and capture to \1:
# --------------------------------------------------------------------------------
# [\w\W]*? any character of: word characters (a-z,
# A-Z, 0-9, _), non-word characters (all
# but a-z, A-Z, 0-9, _) (0 or more times
# (matching the least amount possible))
# --------------------------------------------------------------------------------
# ) end of \1
# --------------------------------------------------------------------------------
# " '"'
# --------------------------------------------------------------------------------
# \) ')'
material_collapsible_item <- function(label, ..., icon = NULL, active = FALSE) {
tags$li(
tags$div(
class = paste("collapsible-header", if (active) "active"),
if (!is.null(icon))
tags$i(class = "material-icons", icon),
label
),
tags$div(
class = "collapsible-body",
tags$span(
...
)
)
)
}
create_id <- function() {
paste(format(as.hexmode(sample(256, 8, replace = TRUE) -
1), width = 2), collapse = "")
}
material_tabs <- function(tabs, color = NULL, icon = NULL){
material_tabs <- shiny::tagList()
this_id <- paste0('tabs-id-', create_id())
for(i in 1:length(tabs)){
material_tabs[[i]] <-
shiny::tags$li(
class = "tab",
# shiny::tags$div(
# if (!is.null(icon[[i]]))
# tags$i(class = "material-icons", icon[[i]])
# ),
shiny::tags$a(
class =
paste0(
ifelse(
is.null(color),
"",
paste0(" ", color, "-text")
)
),
href = paste0("#", tabs[[i]]),
tags$i(class = "material-icons", icon[[i]]),
names(tabs)[[i]]
)
)
}
if(!is.null(color)){
tabs_style <-
shiny::tagList(
shiny::tags$head(
shiny::tags$style(
paste0(
"
#", this_id, " .indicator {
position: absolute;
bottom: 0;
height: 2px;
background-color: ", color, " !important;
will-change: left, right;
}
#", this_id, " .tab a:focus, #", this_id, " .tab a:focus.active {
background-color: ", paste0('rgba(', paste0(as.character(grDevices::col2rgb(color)[,1]), collapse = ', '), ', 0.2)'), ";
outline: none;
}
"
)
)
)
)
} else {
tabs_style <- shiny::tags$div()
}
shiny::tagList(
shiny::tags$ul(
id = this_id,
class = "tabs tabs-fixed-width",
material_tabs
),
tabs_style
)
}
#need to generate different tree if type = NLME versus type = NONMEM
resultsTreeListNLME <- list(
`Basic GOF` = list(`|IWRES| vs IPRED` = "",
`|IWRES| vs IVAR` = "",
`|IWRES| vs TAD` = "",
`IWRES vs IPRED` = "",
`IWRES vs IVAR` = "",
`IWRES vs TAD` = "",
`CWRES vs PRED` = "",
`CWRES vs IVAR` = "",
`CWRES vs TAD` = "",
`PCWRES vs PPRED` = "",
`PCWRES vs IVAR` = "",
`PCWRES vs TAD` = "",
`WRES vs PRED` = "",
`WRES vs IVAR` = "",
`WRES vs TAD` = "",
`NPD vs PPRED` = "",
`NPD vs IVAR` = "",
`NPD vs TAD` = "",
`NPDE vs PPRED` = "",
`NPDE vs IVAR` = "",
`NPDE vs TAD` = "",
`Individual Plots (IVAR)` = "",
`Individual Plots (TAD)` = "",
`DV vs IVAR` = "",
`DV vs IPRED` = "",
`DV vs PRED` = "",
`DV PREDS vs IVAR` = "",
`PRED vs IVAR` = ""
),
`Covariate Model` = list(`ETA vs Covariate` = "",
`Structural Parameter vs Covariate` = "",
`CWRES vs Covariate` = "",
`PCWRES vs Covariate` = "",
`WRES vs Covariate` = "",
`IWRES vs Covariate` = "",
`NPD vs Covariate` = "",
`NPDE vs Covariate` = ""
),
`Distribution Plots` = list(`Covariate Distribution` = "",
`ETA Distribution` = "",
`Structural Parameter Distribution` = "",
`CWRES Distribution` = "",
`PCWRES Distribution` = "",
`WRES Distribution` = "",
`IWRES Distribution` = "",
`NPD Distribution` = "",
`NPDE Distribution` = ""
),
#`Minimization Diagnostics` = list(`PRM vs Iteration` = ""),
`QQ Plots` = list(`Covariate QQ` = "",
`ETA QQ` = "",
`Structural Parameter QQ` = "",
`CWRES QQ` = "",
`PCWRES QQ` = "",
`WRES QQ` = "",
`IWRES QQ` = "",
`NPD QQ` = "",
`NPDE QQ` = ""),
`Tables` = list(`Overall` = "",
`Theta` = "",
`Secondary` = "",
`Omega` = "",
`Sigma` = "")
)
resultsTreeListNONMEM <- list(
`Basic GOF` = list(`|IWRES| vs IPRED` = "",
`|IWRES| vs IVAR` = "",
`|IWRES| vs TAD` = "",
`IWRES vs IPRED` = "",
`IWRES vs IVAR` = "",
`IWRES vs TAD` = "",
`CWRES vs PRED` = "",
`CWRES vs IVAR` = "",
`CWRES vs TAD` = "",
`ECWRES vs PRED` = "",
`ECWRES vs IVAR` = "",
`ECWRES vs TAD` = "",
`EWRES vs PRED` = "",
`EWRES vs IVAR` = "",
`EWRES vs TAD` = "",
`NPD vs PRED` = "",
`NPD vs IVAR` = "",
`NPD vs TAD` = "",
`NPDE vs PRED` = "",
`NPDE vs IVAR` = "",
`NPDE vs TAD` = "",
`WRES vs PRED` = "",
`WRES vs IVAR` = "",
`WRES vs TAD` = "",
`Individual Plots (IVAR)` = "",
`Individual Plots (TAD)` = "",
`DV vs IVAR` = "",
`DV vs IPRED` = "",
`DV vs PRED` = "",
`DV PREDS vs IVAR` = "",
`PRED vs IVAR` = ""
),
`Covariate Model` = list(`ETA vs Covariate` = "",
`Structural Parameter vs Covariate` = "",
`CWRES vs Covariate` = "",
`ECWRES vs Covariate` = "",
`EWRES vs Covariate` = "",
`NPD vs Covariate` = "",
`NPDE vs Covariate` = "",
`WRES vs Covariate` = "",
`IWRES vs Covariate` = ""
),
`Distribution Plots` = list(`Covariate Distribution` = "",
`ETA Distribution` = "",
`Structural Parameter Distribution` = "",
`CWRES Distribution` = "",
`ECWRES Distribution` = "",
`EWRES Distribution` = "",
`NPD Distribution` = "",
`NPDE Distribution` = "",
`WRES Distribution` = "",
`IWRES Distribution` = ""),
`QQ Plots` = list(`Covariate QQ` = "",
`ETA QQ` = "",
`Structural Parameter QQ` = "",
`CWRES QQ` = "",
`ECWRES QQ` = "",
`EWRES QQ` = "",
`NPD QQ` = "",
`NPDE QQ` = "",
`WRES QQ` = "",
`IWRES QQ` = ""),
`Tables` = list(`Overall` = "",
`Theta` = "",
`Omega` = "",
`Sigma` = "")
)
templates_titles_df <- data.frame(
Tag = c("@condn",
"@covtime",
"@data",
"@descr",
"@dir",
"@epsshk",
"@errors",
"@esampleseed",
"@etashk",
"@file",
"@label",
"@method",
"@nesample",
"@nind",
"@nobs",
"@nsig",
"@ofv",
"@page and @lastpage",
"@probn",
"@plotfun",
"@ref",
"@run",
"@runtime",
"@software",
"@simseed",
"@subroutine",
"@timestart",
"@timestop",
"@timeplot",
"@term",
"@version",
"@warnings",
"@x @y"),
Description = c("Condition number",
"Covariance matrix runtime",
"Model input data used",
"Model description",
"Model directory",
"Epsilon shrinkage",
"Run errors (e.g termination error)",
"ESAMPLE seed number (used in NPDE)",
"Eta shrinkage",
"Model file name",
"Model label",
"Estimation method or sim",
"Number of ESAMPLE (used in NPDE)",
"Number of individuals",
"Number of observations",
"Number of significant digits",
"Objective function value",
"Are respectively the page number and the number of the last page when faceting on multiple pages",
"Problem number",
"Name of the plot function",
"Reference model",
"Model run name",
"Estimation/Sim runtime",
"Software used (e.g. NLME/NONMEM)",
"Simulation seed",
"Differential equation solver",
"Run start time",
"Run stop time",
"Time of the plot rendering",
"Termination message",
"Software version (e.g. 7.3)",
"Run warnings (e.g. boundary)",
"Name of any ggplot2 variable used for mapping in an aes() type function"))
table_glossary_df <- data.frame(
Name = c("OFV",
"LL",
"-2LL",
"RetCode",
"Condition",
"AIC",
"BIC",
"nParm",
"nObs",
"nSub",
"SE",
"RSE"),
Description = c("Objective function value",
"Log-likelihood",
"Twice the negative log-likelihood",
"Return code indicating the success of convergence",
"Condition number",
"Akaike information criterion",
"Bayesian information criterion",
"Number of parameters",
"Number of observations",
"Number of subjects",
"Standard error",
"Relative standard error, also called coefficient of variation (CV)"))
# # Update Model Results Theme ----
# updateThemeMR <- function(input){
#
# theme_model_results <- list(
# arrange.ncol = input$arrangeColNum,
# arrange.nrow = input$arrangeRowNum,
# axis.color = input$colorAxis,
# axis.face = input$faceAxis,
# axis.font = input$fontAxis,
# axis.scale = input$selectedAxisScale,
# axis.size = input$sizeAxis,
# axis.x.label = input$xlab,
# axis.y.label = input$ylab,
# background.border = input$isShowBorder,
# background.color = input$colorBackground,
# background.gridlines = input$isShowGridLines,
# boxplot.alpha = input$alphaBoxPlot/100,
# boxplot.line.color = input$colorBoxPlot,
# boxplot.fill.color = input$fillBoxPlot,
# axis.log.type = set_log_type(input$isLogX, input$isLogY),
# caption.color = input$colorCaption,
# caption.face = input$faceCaption,
# caption.font = input$fontCaption,
# caption.size = input$sizeCaption,
# caption.text = input$textCaption,
# density.alpha = input$alphaDensity/100,
# density.line.color = input$colorDensity,
# density.fill.color = input$fillDensity,
# density.line.type = input$typeLineDensity,
# density.size = input$sizeDensity,
# facet.ncol = input$arrangeColNum,
# facet.nrow = input$arrangeRowNum,
# guide.line.alpha = input$alphaLineGuide/100,
# guide.line.color = input$colorLineGuide,
# guide.line.size = input$sizeLineGuide,
# guide.line.type = input$typeLineGuide,
# guide.line.extra.y1 = input$hLine1,
# guide.line.extra.y2 = input$hLine2,
# hist.alpha = input$alphaHistogram/100,
# hist.line.color = input$colorHistogram,
# hist.fill.color = input$fillHistogram,
# hist.line.type = input$typeLineHistogram,
# hist.nbins = input$nbinsHistogram,
# hist.size = input$sizeHistogram,
# indplots.legend.position = input$legendPosition,
# indplots.line.color.IPRED = input$colorLineIPRED,
# indplots.line.color.PRED = input$colorLinePRED,
# indplots.line.type.IPRED = input$typeLineIPRED,
# indplots.line.type.PRED = input$typeLinePRED,
# indplots.point.alpha.DV = input$alphaPointDV / 100,
# indplots.point.color.DV = input$colorPointDV,
# indplots.point.size.DV = input$sizePointDV,
# indplots.point.shape.DV = change_point_shape(input$shapePointDV),
# line.alpha = input$alphaLine/100,
# line.color = input$colorLine,
# line.size = input$sizeLine,
# line.type = input$typeLine,
# outlier.alpha = input$alphaOutlier/100,
# outlier.color = input$colorOutlier,
# outlier.shape = change_outlier_shape(input$shapeOutlier, input$displayOutliers),
# outlier.size = input$sizeOutlier,
# plot.distribution.type = set_plot_distribution_type(input$displayHistogram, input$displayDensity, input$displayRug),
# plot.scatter.guide = input$displayRefLine,
# plot.scatter.smoothing = input$smoothingType,
# plot.scatter.type = set_plot_scatter_type(input$displayPoints, input$displayLines, input$displaySmoothing, input$displayText),
# point.alpha = input$alphaPoint/100,
# point.color = input$colorPoint,
# point.shape = change_point_shape(input$shapePoint),
# point.size = input$sizePoint,
# rug.color = input$colorRug,
# rug.line.size = input$sizeLineRug,
# rug.sides = set_rug_type(input$positionRug),
# smooth.line.alpha = input$alphaLineSmooth/100,
# smooth.line.color = input$colorLineSmooth,
# smooth.line.size = input$sizeLineSmooth,
# smooth.line.type = input$typeLineSmooth,
# smooth.span = input$spanSmooth,
# subtitle.color = input$colorSubtitle,
# subtitle.face = input$faceSubtitle,
# subtitle.font = input$fontSubtitle,
# subtitle.size = input$sizeSubtitle,
# subtitle.text = input$textSubtitle,
# title.color = input$colorTitle,
# title.face = input$faceTitle,
# title.font = input$fontTitle,
# title.size = input$sizeTitle,
# title.text = input$textTitle
# )
#
# theme_model_results
# }
change_point_shape <- function(shape){
if(shape == "circle"){
shape <- 1
} else if(shape == "circle-fill"){
shape <- 16
} else if(shape == "square"){
shape <- 0
} else if(shape == "square-fill"){
shape <- 15
} else if(shape == "triangle"){
shape <- 2
} else {
shape <- 17
}
}
change_outlier_shape <- function(shape, display){
if(shape == "circle"){
shape <- 1
} else if(shape == "circle-fill"){
shape <- 16
} else if(shape == "square"){
shape <- 0
} else if(shape == "square-fill"){
shape <- 15
} else if(shape == "triangle"){
shape <- 2
} else {
shape <- 17
}
if(!display) shape <- NA
shape
}
# Define Tree Lookups ----
branches <- c("Basic GOF", "Covariate Model", "Distribution Plots", "QQ Plots", "Tables")
covariate_trees <- c("CWRES vs Covariate" ,"ECWRES vs Covariate" ,"EWRES vs Covariate" ,"ETA vs Covariate" ,"IWRES vs Covariate" ,
"NPD vs Covariate" ,"NPDE vs Covariate" ,"Structural Parameter vs Covariate" ,"WRES vs Covariate","PCWRES vs Covariate",
"Covariate Distribution")
no_refline_trees <- c("|IWRES| vs IPRED", "|IWRES| vs IVAR", "|IWRES| vs TAD", "Structural Parameter vs Covariate", "DV vs IVAR", "DV PREDS vs IVAR","PRED vs IVAR" )
distribution_trees <- c("Covariate Distribution", "PCWRES Distribution", "ECWRES Distribution", "EWRES Distribution",
"NPD Distribution", "NPDE Distribution", "CWRES Distribution", "ETA Distribution", "IWRES Distribution", "Structural Parameter Distribution", "WRES Distribution")
qq_trees <- c("Covariate QQ", "NPD QQ", "NPDE QQ", "CWRES QQ", "ETA QQ", "IWRES QQ", "Structural Parameter QQ", "WRES QQ", "PCWRES QQ")
table_trees <- c("Overall", "Theta", "Omega", "Sigma", "Secondary")
#' Write code to R script from tagged diagnostics
#'
#' Use this function to write code to R script from diagnostics tagged in Certara's Model Results Shiny Application.
#'
#' @param tagged List of tagged objects from returned from \code{resultsUI()}.
#' @param file Character specifying path of output file. If missing, it will be saved as \code{code.R} in working directory.
#'
#' @examples
#' if (interactive()) {
#' tagged_diagnostics <- resultsUI(xpdb = xpdb_NLME)
#'
#' write_code(tagged_diagnostics, "tagged_results.R")
#'
#' }
#'
#' @return Returns \code{NULL} after writing to \code{file}.
#' @export
write_code <- function(tagged, file){
if(missing(file)){
stop("Missing \"file\" argument.")
}
lines <- vector(mode = "list", length = length(tagged))
for(i in seq_along(tagged)){
lines[[i]] <- paste0(tagged[[i]]$code)
}
writeLines(unlist(lines), con = file)
}
# check if xpdb contains covariates
hasCovariates <- function(xpdb){
index <- xpdb$data$index[[1]]
catcovColNames <- index %>%
dplyr::filter(.data$type == "catcov") %>%
dplyr::select(col) %>%
unlist(use.names = FALSE)
contcovColNames <- index %>%
dplyr::filter(.data$type == "contcov") %>%
dplyr::select(col) %>%
unlist(use.names = FALSE)
if(length(c(catcovColNames, contcovColNames)) > 0){
hascov <- TRUE
} else {
hascov <- FALSE
}
return(hascov)
}
toggleVisibility <- function(selector, condition){
if(condition){
shinyjs::show(selector = selector)
} else {
shinyjs::hide(selector = selector)
}
}
Try the Certara.ModelResults package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.