R/settings.R

In Certara.ModelResults: Generate Diagnostics for Pharmacometric Models Using 'shiny'

initialize_settings <- list(
  arrange.ncol = 3,
  arrange.nrow = 2,
  axis.color = "#000000",
  axis.face = "plain",
  axis.font = "Arial",
  axis.scale = "free",
  axis.size = 12,
  background.border = FALSE,
  background.color = "#EDEDED",
  background.gridlines = FALSE,
  boxplot.alpha = 50,
  boxplot.line.color = "#BEBEBE",
  boxplot.fill.color = "#A4AEC4",
  axis.log.type = NULL,
  caption.color = "#000000",
  caption.face = "plain",
  caption.font = "Arial",
  caption.size = 10,
  certara.theme = TRUE,
  density.alpha = 50,
  density.line.color = "#BEBEBE",
  density.fill.color = "#A4AEC4",
  density.line.type = "blank",
  density.size = 1,
  facet.ncol = 3,
  facet.nrow = 2,
  guide.line.alpha = 50,
  guide.line.color = "#000000",
  guide.line.size = 1,
  guide.line.type = "dashed",
  guide.line.extra.y1 = 2,
  guide.line.extra.y2 = -2,
  hist.alpha = 50,
  hist.line.color = "#BEBEBE",
  hist.fill.color = "#A4AEC4",
  hist.line.type = "blank",
  hist.nbins = 8,
  hist.size = 1,
  indplots.legend.position = "bottom",
  indplots.line.color.IPRED = "#1B3152",
  indplots.line.color.PRED = "#DB4C1C",
  indplots.line.type.IPRED = "solid",
  indplots.line.type.PRED = "dashed",
  indplots.point.alpha.DV = 75,
  indplots.point.color.DV = "#A4AEC4",
  indplots.point.size.DV = 3,
  indplots.point.shape.DV = 16,
  line.alpha = 50,
  line.color = "#000000",
  line.size = 1,
  line.type = "solid",
  outlier.alpha = 50,
  outlier.color = "#FF0000",
  outlier.shape = 1,
  outlier.size = 1,
  plot.distribution.type = "hr",
  plot.scatter.guide = TRUE,
  plot.scatter.smoothing = "loess",
  plot.scatter.type = "ps",
  point.alpha = 50,
  point.color = "#757D8F",
  point.shape = 16,
  point.size = 3,
  rug.color = "#BEBEBE",
  rug.line.size = 1,
  rug.sides = "bottom",
  smooth.line.alpha = 50,
  smooth.line.color = "#D63636",
  smooth.line.size = 1.2,
  smooth.line.type = "solid",
  smooth.span = 0.75,
  subtitle.color = "#000000",
  subtitle.face = "plain",
  subtitle.font = "Arial",
  subtitle.size = 14,
  text.default = TRUE,
  title.color = "#000000",
  title.face = "bold",
  title.font = "Arial",
  title.size = 18,
  vpc.axis.scale = "free",
  vpc.facet.category = TRUE,
  vpc.facet.quantile = FALSE,
  vpc.legend.position = "top",
  vpc.line.type.lo = "dashed",
  vpc.line.type.med = "solid",
  vpc.line.type.hi = "dashed",
  vpc.line.color.lo = "#D63636",
  vpc.line.color.med = "#3648D6",
  vpc.line.color.hi = "#D63636",
  vpc.line.type.prob0 = "dashed",
  vpc.line.type.prob1 = "solid",
  vpc.line.type.prob2 = "dashed",
  vpc.line.type.prob3 = "dotted",
  vpc.line.type.prob4 = "solid",
  vpc.line.color.prob0 = "#6DDA00",
  vpc.line.color.prob1 = "#3648D6",
  vpc.line.color.prob2 = "#D63636",
  vpc.line.color.prob3 = "#3648D6",
  vpc.line.color.prob4 = "#D63636",
  vpc.pi.alpha.fill = 0.1,
  vpc.point.alpha = 0.5,
  vpc.point.color = "#757D8F",
  vpc.point.shape = "circle-fill",
  vpc.point.size = 3,
  vpc.show.binning = FALSE,
  vpc.show.boundaries = TRUE,
  vpc.quantile.type = "Type 6"
)


update_settings <- function(settings, input) {
  settings$arrange.ncol <- input$arrangeColNum
  settings$arrange.nrow <- input$arrangeRowNum
  settings$axis.color <- input$colorAxis
  settings$axis.face <- input$faceAxis
  settings$axis.font <- input$fontAxis
  settings$axis.scale <- input$selectedAxisScale
  settings$axis.size <- input$sizeAxis
  settings$background.border <- input$isShowBorder
  settings$background.color <- input$colorBackground
  settings$background.gridlines <- input$isShowGridLines
  settings$boxplot.alpha <- input$alphaBoxPlot
  settings$boxplot.line.color <- input$colorBoxPlot
  settings$boxplot.fill.color <- input$fillBoxPlot
  settings$caption.color <- input$colorCaption
  settings$caption.face <- input$faceCaption
  settings$caption.font <- input$fontCaption
  settings$caption.size <- input$sizeCaption
  settings$certara.theme <- input$isCertaraTheme
  settings$density.alpha <- input$alphaDensity
  settings$density.line.color <- input$colorDensity
  settings$density.fill.color <- input$fillDensity
  settings$density.line.type <- input$typeLineDensity
  settings$density.size <- input$sizeDensity
  settings$guide.line.alpha <- input$alphaLineGuide
  settings$guide.line.color <- input$colorLineGuide
  settings$guide.line.size <- input$sizeLineGuide
  settings$guide.line.type <- input$typeLineGuide
  settings$guide.line.extra.y1 <- input$hLine1
  settings$guide.line.extra.y2 <- input$hLine2
  settings$hist.alpha <- input$alphaHistogram
  settings$hist.line.color <- input$colorHistogram
  settings$hist.fill.color <- input$fillHistogram
  settings$hist.line.type <- input$typeLineHistogram
  settings$hist.nbins <- input$nbinsHistogram
  settings$hist.size <- input$sizeHistogram
  settings$indplots.legend.position <- input$legendPosition
  settings$indplots.line.color.IPRED <- input$colorLineIPRED
  settings$indplots.line.color.PRED <- input$colorLinePRED
  settings$indplots.line.type.IPRED <- input$typeLineIPRED
  settings$indplots.line.type.PRED <- input$typeLinePRED
  settings$indplots.point.alpha.DV <- input$alphaPointDV
  settings$indplots.point.color.DV <- input$colorPointDV
  settings$indplots.point.size.DV <- input$sizePointDV
  settings$indplots.point.shape.DV <- input$shapePointDV
  settings$line.alpha <- input$alphaLine
  settings$line.color <- input$colorLine
  settings$line.size <- input$sizeLine
  settings$line.type <- input$typeLine
  settings$outlier.alpha <- input$alphaOutlier
  settings$outlier.color <- input$colorOutlier
  settings$outlier.shape <- input$shapeOutlier
  settings$outlier.size <- input$sizeOutlier
  settings$plot.scatter.smoothing <- input$smoothingType
  settings$point.alpha <- input$alphaPoint
  settings$point.color <- input$colorPoint
  settings$point.shape <- input$shapePoint
  settings$point.size <- input$sizePoint
  settings$rug.color <- input$colorRug
  settings$rug.line.size <- input$sizeLineRug
  settings$rug.sides <- input$positionRug
  settings$smooth.line.color <- input$colorLineSmooth
  settings$smooth.line.size <- input$sizeLineSmooth
  settings$smooth.line.type <- input$typeLineSmooth
  settings$subtitle.color <- input$colorSubtitle
  settings$subtitle.face <- input$faceSubtitle
  settings$subtitle.font <- input$fontSubtitle
  settings$subtitle.size <- input$sizeSubtitle
  settings$title.color <- input$colorTitle
  settings$title.face <- input$faceTitle
  settings$title.font <- input$fontTitle
  settings$title.size <- input$sizeTitle
  return(settings)
}



#' A ggplot2 theme for Certara.
#'
#' @inheritParams ggplot2::theme_grey
#' @inheritParams ggplot2::continuous_scale
#' @param grid Which grid lines should appear? Horizontal only, both horizontal and vertical, or none (default).
#' \code{\link[ggplot2]{continuous_scale}()}.
#' @details There are 3 variants of the theme: no grid
#' \code{theme_certara()}, full grid \code{theme_certara(grid = "both")}, and
#' horizontal grid lines only \code{theme_certara(grid = "horizontal")}.
#' @return An object of class \code{\link[ggplot2]{theme}()}.
#' @export


theme_certara <- function(base_size = 11,
                          base_family = "",
                          base_line_size = base_size / 22,
                          base_rect_size = base_size / 22,
                          grid = c("none", "horizontal", "both")) {

  grid <- match.arg(grid)

  half_line <- base_size / 2

  theme_c <- theme(
    line = element_line(
      colour = "black",
      size = base_line_size,
      linetype = 1,
      lineend = "butt"
    ),

    rect = element_rect(
      fill = "white",
      colour = "black",
      size = base_rect_size,
      linetype = 1
    ),

    text = element_text(
      family = base_family,
      face = "plain",
      colour = "black",
      size = base_size,
      lineheight = 0.9,
      hjust = 0.5,
      vjust = 0.5,
      angle = 0,
      margin = margin(),
      debug = FALSE
    ),

    axis.line = element_blank(),
    axis.line.x = NULL,
    axis.line.y = NULL,

    axis.text = element_text(
      size = rel(0.9),
      colour = "grey40"
    ),

    axis.text.x = element_text(
      margin = margin(t = 0.8 * half_line / 2),
      vjust = 1
    ),

    axis.text.x.top = element_text(
      margin = margin(b = 0.8 * half_line / 2),
      vjust = 0
    ),

    axis.text.y = element_text(
      # angle=90,
      margin = margin(r = 0.8 * half_line / 2),
      hjust = 0.5
    ),

    axis.text.y.right = element_text(
      angle = -90,
      margin = margin(l = 0.8 * half_line / 2),
      hjust = 0.5
    ),

    axis.ticks = element_line(colour = "grey40", size = 0.3),

    axis.ticks.length = unit(half_line, "pt"),
    axis.ticks.length.x = unit(half_line, "pt"),
    axis.ticks.length.x.top = unit(half_line, "pt"),
    axis.ticks.length.x.bottom = unit(half_line, "pt"),
    axis.ticks.length.y = unit(half_line, "pt"),
    axis.ticks.length.y.left = unit(half_line, "pt"),
    axis.ticks.length.y.right = unit(half_line, "pt"),

    axis.title = element_text(colour = "grey40"),

    axis.title.x = element_text(
      margin = margin(t = half_line / 2),
      vjust = 1
    ),

    axis.title.x.top = element_text(
      margin = margin(b = half_line / 2),
      vjust = 0
    ),

    axis.title.y = element_text(
      angle = 90,
      margin = margin(r = half_line / 2),
      vjust = 1
    ),

    axis.title.y.right = element_text(
      angle = -90,
      margin = margin(l = half_line / 2),
      vjust = 0
    ),

    legend.background = element_rect(colour = NA),

    legend.spacing = unit(2 * half_line, "pt"),
    legend.spacing.x = unit(half_line, "pt"),
    legend.spacing.y = NULL,

    legend.margin = margin(half_line, half_line, half_line, half_line),

    legend.key = element_rect(
      fill = "white", colour = "NA"
    ),

    legend.key.size = unit(1.2, "lines"),
    legend.key.height = NULL,
    legend.key.width = NULL,

    legend.text = element_text(
      size = rel(0.9),
      margin = margin(r = 2 * half_line, unit = "pt")
    ),

    legend.text.align = NULL,

    legend.title = element_text(
      size = rel(0.9),
      hjust = 0
    ),

    legend.title.align = NULL,

    legend.position = "bottom",
    legend.direction = "horizontal",
    legend.justification = "left",

    legend.box = NULL,
    legend.box.margin = margin(0, 0, 0, 0, "cm"),
    legend.box.background = element_blank(),
    legend.box.spacing = unit(2 * half_line, "pt"),

    panel.background = element_rect(
      fill = "white",
      colour = NA
    ),

    panel.border = element_rect(
      fill = NA,
      colour = "grey60",
      size = 0.3
    ),

    panel.grid = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),

    panel.spacing = unit(half_line, "pt"),
    panel.spacing.x = NULL,
    panel.spacing.y = NULL,

    panel.ontop = FALSE,

    strip.background = element_rect(
      fill = "grey90", colour = "grey20"
    ),

    strip.text = element_text(
      colour = "grey30",
      size = rel(0.8),
      margin = margin(0.3 * half_line, 0.3 * half_line, 0.5 * half_line, 0.3 * half_line)
    ),

    strip.text.x = NULL,
    strip.text.y = element_text(angle = -90),

    strip.placement = "inside",
    strip.placement.x = NULL,
    strip.placement.y = NULL,

    strip.switch.pad.grid = unit(half_line / 2, "pt"),
    strip.switch.pad.wrap = unit(half_line / 2, "pt"),

    plot.background = element_rect(colour = "white"),

    plot.title = element_text(
      size = rel(1.2),
      hjust = 0,
      vjust = 1,
      margin = margin(b = half_line)
    ),

    plot.subtitle = element_text(
      hjust = 0,
      vjust = 1,
      margin = margin(b = half_line)
    ),

    plot.caption = element_text(
      size = rel(0.8),
      hjust = 1,
      vjust = 1,
      margin = margin(t = half_line)
    ),

    plot.tag = element_text(
      size = rel(1.2),
      hjust = 0.5,
      vjust = 0.5
    ),

    plot.tag.position = "topleft",

    plot.margin = margin(half_line, half_line, half_line, half_line),

    complete = TRUE
  )

  if (grid == "horizontal") {
    theme_c <- theme_c %+replace% theme(
      panel.grid.major.y = element_line(colour = "grey90", size = 0.3),
      panel.grid.minor.y = element_line(colour = "grey90", size = 0.3)
    )
  } else if (grid == "both") {
    theme_c <- theme_c %+replace% theme(
      panel.grid.major = element_line(colour = "grey90", size = 0.3),
      panel.grid.minor = element_line(colour = "grey90", size = 0.3)
    )
  }

  theme_c
}



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
}