R/app_styling.R

In Certara.DarwinReporter: Data Visualization Utilities for 'pyDarwin' Machine Learning Pharmacometric Model Development

#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;
  }

  .overview-cards {
    background: #ffffff;  /* fallback for old browsers */
    background: -webkit-linear-gradient(to right, #f2f2f2, #ffffff);  /* Chrome 10-25, Safari 5.1-6 */
    background: linear-gradient(to right, #f2f2f2, #ffffff); /* W3C, IE 10+/ Edge, Firefox 16+, Chrome 26+, Opera 12+, Safari 7+ */
  }

  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-output-error {
    color: red;
  }

  .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;
  }

  .navbar {
    height: 0px;
    padding: 0px;
    visibility: hidden;
  }

  .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;
  }

  #diagnostics-page-plot .bslib-full-screen-enter {
    bottom: var(--bslib-full-screen-enter-bottom);
    top: var(--bslib-full-screen-enter-top, 0.2rem);
  }
"


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("&nbsp;&nbsp;"),
             tags$a(href = 'https://www.certara.com/', target = '_blank', 'Home'),
             HTML("&nbsp;&nbsp;"),
             tags$a(href = url, target = '_blank', 'Help'),
             HTML("&nbsp;&nbsp;"),
             tags$a(href = 'https://certara.service-now.com/csm', target = '_blank', 'Support'),
             HTML("&nbsp;&nbsp;"),
             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("&#169; 2011-2024 Certara USA, Inc., All rights reserved. Version: 2.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 <- 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.select_material_sidenav_tab = function(tab_id){
#   $('.shiny-material-side-nav-tab-content').hide();
#   $('.shiny-material-side-nav-tab-content').trigger('hide');
#   $('.shiny-material-side-nav-tab-content').trigger('hidden');
#   $('.shiny-material-side-nav-tab').removeClass('active');
#   $('#' + tab_id).show();
#   $('#' + tab_id).trigger('show');
#   $('#' + tab_id).trigger('shown');
#   $('#' + tab_id + '_tab_id').addClass('active');
#   $('#side_nav_tabs_click_info').trigger('click');
#   // Reset scroll position to top after switching windows
#   window.scrollTo(0, 0);
#   }
#
#   shinyjs.hide_tab = function(){
#       $('li.tab a[href$=\"#tab_randomeffects\"]').hide();
#       $('li.tab a[href$=\"#tab2\"]').trigger('hide');
#       $('li.tab a[href$=\"#tab2\"]').trigger('hidden');
#   }
#
#   shinyjs.show_tab = function(){
#       $('li.tab a[href$=\"#tab_randomeffects\"]').show();
#   }
#
#   shinyjs.closewindow = function() { window.close(); }"

jsFunctions2 <- "shinyjs.select_sidenav_tab = function(tab_id) {

  $('[data-value]').removeClass('active');

  $('[data-value=' + tab_id + ']').addClass('active');

  $('[data-value=' + \"tab_preview\" + ']').addClass('active');
  $('[data-value=' + \"style\" + ']').addClass('active');

  $('.card-body').each(function() {
    this.scrollTop = 0;
  });

  }

  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")
}


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
  )
}

search_overview_cards <- function(search_overview) {
  # Remove best models
  if (is.null(search_overview)) {
    return(tagList())
  }
  search_overview <- search_overview[-1]
  titles <- c("# Models in Search Space",
              "# Models Considered",
              "# Models Run in Search",
              "# Models to Best Model",
              "Time to Best Model",
              "Total Elapsed Time"
  )
  stopifnot(length(titles) == length(search_overview))

  titles <- toupper(titles)
  cards <- tagList()
  for(i in 1:length(search_overview)){

    value <- search_overview[[i]]
    title <- titles[i]

    #this_data.i <- prettyNum(this_data.i, big.mark = ",")

    # this_color.i <- ifelse(this_data.i < 0, "#212121", "#212121")
    #
    # this_sym.i <- ifelse(this_data.i < 0, "- ", "+ ")
    #
    # this_data.i <- ifelse(this_data.i < 0, gsub("-", "", this_data.i), this_data.i)

    card <-
      bslib::card(
          class = "overview-cards",
          HTML(
            paste0(
              "<span style='font-size:12px; font-weight:bold;'>", title, "</span>"
            )
          ),
          HTML(
            paste0(
              "<div class='text-right'><span style='font-size:28px'>",
              value,
            "</span></div>")
          )
        )
    cards[[i]] <- card
  }

  return(cards)

}
#need to generate different tree if type = NLME versus type = NONMEM
resultsTreeListNLME <- list(
  `Darwin Search` = list(`Fitness vs Iteration` = "",
                         `Penalties vs Iteration` = "",
                         `Key Models` = ""),
  `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(
  `Darwin Search` = list(`Fitness vs Iteration` = "",
                         `Penalties vs Iteration` = "",
                         `Key Models` = ""),
  `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_trees <- c("Darwin Search", "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", "Key Models", "Theta", "Omega", "Sigma", "Secondary")

darwin_trees <- c("Fitness vs Iteration", "Penalties vs Iteration", "Key Models")

#' Write code to R script from tagged diagnostics
#'
#' Use this function to write code to R script from diagnostics tagged in Certara's Darwin Reporter Shiny Application
#'
#' @param tagged List of tagged objects from returned from \code{darwinReportUI()}
#' @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 <- darwinReportUI(ddb)
#'
#' write_code(tagged_diagnostics, "tagged_results.R")
#'
#' }
#'
#' @noRd

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)
  }
}