R/ct_plot.R
In shirewoman2/Consultancy: Standardized tools for using R within the Simcyp Consultancy Team
Defines functions
ct_plot
Documented in
ct_plot
#' Concentration-time plots to match Consultancy template
#'
#' @description Using observed and simulated concentration-time data generated
#' from the function \code{\link{extractConcTime}}, make publication-quality
#' graphs that comply with the Simcyp Consultancy Team's standards. We've
#' tried to include a fair number of options here for flexibility, but many of
#' the function arguments are optional; most of the time, you'll get
#' decent-looking graphs while only setting a minimal number of arguments.
#'
#' For detailed instructions and examples, please see the SharePoint file
#' "Simcyp PBPKConsult R Files - Simcyp PBPKConsult R Files/SimcypConsultancy
#' function examples and instructions/Concentration-time plots 1 - one sim at
#' a time/Concentration-time-plot-examples-1.docx". (Sorry, we are unable to
#' include a link to it here.)
#'
#' \strong{A few notes:} \enumerate{\item{Not all substrate metabolites,
#' inhibitors, or inhibitor metabolites are available in all tissues. If it's
#' not present in your output, we can't graph it here.}
#'
#' \item{If you have observed concentration-time data to match your simulated data
#' but you don't see those observed data on your graph, please check the help
#' file for the function you used -- either \code{\link{extractConcTime}} or
#' \code{\link{extractConcTime_mult}} -- to extract your data. Something has
#' likely gone wrong in the data extraction.}
#'
#' \item{If you attempt to use data generated by
#' \code{\link{extractConcTime_mult}} here, you can get weird results if you're
#' not careful to include only one tissue and one compound. If you see
#' something odd, try including the legend with, e.g., \code{legend_position =
#' "right"} to help decipher what might have gone awry. It can also be
#' informative to use the function \code{\link{ct_plot_overlay}} to make a
#' draft version of your graph because that function will give you some messages
#' about what data are included.}
#'
#' \item{If you want to plot enzyme abundance data, please see
#' \code{\link{enz_plot}} or \code{\link{enz_plot_overlay}}.}}
#'
#' @param ct_dataframe the input concentration-time data generated by running
#' the function \code{\link{extractConcTime}}. Not quoted.
#' @param Tissue_subtype Certain types of models have additional subtypes of
#' tissues. Currently, the SimcypConsultancy package supports ADAM-model and
#' brain-compartment tissue subtypes. In these scenarios, it's not sufficient
#' to say "colon" or "brain" because those tissues have multiple subtypes.
#' This is where you can specify which you want. Default is "free compound in
#' lumen" but is ignored when ct_dataframe doesn't contain ADAM data.
#' @param figure_type type of figure to plot. Options are:
#'
#' \describe{
#'
#' \item{"percentiles"}{(default) plots an opaque line for the mean data,
#' lighter lines for the 5th and 95th percentiles of the simulated data, and
#' open circles for the observed data. If an effecter were present, the
#' default is dashed lines for the data in the presence of a perpetrator.}
#'
#' \item{"trial means"}{plots an opaque line for the mean data, lighter lines
#' for the mean of each trial of simulated data, and open circles for the
#' observed data. If a perpetrator were present, lighter dashed lines indicate
#' the mean of each trial of simulated data in the presence of the perpetrator.}
#'
#' \item{"percentile ribbon"}{plots an opaque line for the mean data,
#' transparent shading for the 5th to 95th percentiles of the simulated data,
#' and open circles for the observed data. If a perpetrator were present, the
#' default is to show the data without the perpetrator in blue and the data in
#' the presence of the perpetrator in red. \strong{NOTE: There is a known bug
#' within RStudio that causes filled semi-transparent areas like you get with
#' the "percentile ribbon" figure type to NOT get graphed for certain versions
#' of RStudio.} To get around this, within RStudio, go to Tools --> Global
#' Options --> General --> Graphics --> And then set "Graphics device:
#' backend" to "AGG". Honestly, this is a better option for higher-quality
#' graphics anyway!}
#'
#' \item{"means only"}{plots a black line for the mean data and, if an
#' perpetrator was modeled, a dashed line for the concentration-time data with
#' Inhibitor 1.}
#'
#' \item{"Freddy"}{Freddy's favorite style of plot with trial means in light
#' gray, the overall mean in thicker black, the 5th and 95th percentiles in
#' dashed lines, and the observed data in semi-transparent purple-blue. Graphs
#' with a perpetrator present lose the trial means, and the percentiles switch
#' to solid, gray lines. \strong{An editorial comment:} While this does not
#' align with the officially sanctioned template at this time, this looks
#' \emph{sharp}, makes it easy to see the defining characteristics of the
#' data, and I recommend checking it out, even just for your own purposes of
#' examining your data. If the color is too much for you but you like the
#' rest, try setting \code{obs_color = "black", obs_shape = c(1, 2)}. -LSh}
#'
#' \item{"compound summary"}{matches the concentration-time plots in Simcyp
#' compound summary files. These are similar to "Freddy" types of graphs in
#' that they show the mean as a dark line, the trial means as lighter lines,
#' dashed lines for the 5th and 95th percentiles, but then they additionally
#' color observed points by a column titled "Study" that you will need to add
#' to your data. (And yes, it \emph{must} be titled "Study" exactly.)
#' Everything else in these graphs will be gray or black, but
#' you can specify the color of the observed points with the argument
#' "obs_color" and the shape of the points with the argument "obs_shape".}}
#'
#' @param mean_type graph "arithmetic" (default) or "geometric" means or
#' "median" for median concentrations. If that option was not included in the
#' output, you'll get a warning and the graph will include one that was.
#' @param time_range time range to show relative to the start of the simulation.
#' Options: \describe{
#'
#' \item{NA}{(default) entire time range of data}
#'
#' \item{a start time and end time in hours}{only data in that time range,
#' e.g. \code{c(24, 48)}. Note that there are no quotes around numeric data.}
#'
#' \item{"first dose"}{only the time range of the first dose}
#'
#' \item{"last dose"}{only the time range of the last dose}
#'
#' \item{"penultimate dose"}{only the time range of the 2nd-to-last dose,
#' which can be useful for BID data where the end of the simulation extended
#' past the dosing interval or data when the substrate was dosed BID and the
#' perpetrator was dosed QD}
#'
#' \item{a specific dose number with "dose" or "doses" as the prefix}{the time
#' range encompassing the requested doses, e.g., \code{time_range = "dose 3"}
#' for the 3rd dose or \code{time_range = "doses 1 to 4"} for doses 1 to 4}
#'
#' \item{a specific day number with "day" or "days" as the prefix}{the time
#' range encompassing the requested days, e.g., \code{time_range = "day 2"}
#' for the 24-hour period starting on day 2, e.g., 24-48 hours, or
#' \code{time_range = "days 1 to 4"} for the 4-day period from 0 to 96 hours}
#'
#' \item{"all obs" or "all observed" if you feel like spelling it out}{Time
#' range will be limited to only times when observed data are present.}
#'
#' \item{"last dose to last observed" or "last obs" for short}{Time range will
#' be limited to the start of the last dose until the last observed data
#' point.}
#'
#' \item{"last dose to end" or "last to end" for short}{Time range will
#' be limited to the start of the last dose until the end of the simulation.}
#' }
#'
#' @param t0 What event should be used for time zero? Options are: "simulation
#' start" (default), "dose 1", "penultimate dose", or "last dose". \emph{This
#' does not change which data are included in the graph;} instead, this
#' determines whether the x axis numbers are offset so that, e.g., the last
#' dose is administered at time 0.
#'
#' @param adjust_obs_time TRUE or FALSE (default) for whether to adjust the time
#' listed in the observed data file to match the last dose administered. This
#' only applies to multiple-dosing regimens. If TRUE, the graph will show the
#' observed data overlaid with the simulated data such that the dose in the
#' observed data was administered at the same time as the last dose in the
#' simulated data. If FALSE, the observed data will start at whatever times
#' are listed in the Excel file.
#' @param pad_x_axis optionally add a smidge of padding to the the x axis
#' (default is TRUE, which includes some generally reasonable padding). If
#' changed to FALSE, the y axis will be placed right at the beginning of your
#' time range and all data will end \emph{exactly} at the end of the time
#' range specified. If you want a \emph{specific} amount of x-axis padding,
#' set this to a number; the default is \code{c(0.02, 0.04)}, which adds 2\%
#' more space to the left side and 4\% more to the right side of the x axis.
#' If you only specify one number, we'll assume that's the percent you want
#' added to the left side.
#' @param pad_y_axis optionally add a smidge of padding to the y axis (default
#' is TRUE, which includes some generally reasonable padding). As with
#' \code{pad_x_axis}, if changed to FALSE, the x axis will be placed right at
#' the bottom of your data, possibly cutting a point in half. If you want a
#' \emph{specific} amount of y-axis padding, set this to a number; the default
#' is \code{c(0.02, 0)}, which adds 2\% more space to the bottom and nothing
#' to the top of the y axis. If you only specify one number, we'll assume
#' that's the percent you want added to the bottom.
#' @param x_axis_interval optionally set the x-axis major tick-mark interval.
#' Acceptable input: any number or leave as NA to accept default values, which
#' are generally reasonable guesses as to aesthetically pleasing and
#' PK-relevant intervals.
#' @param x_axis_label optionally supply a character vector or an expression to
#' use for the x axis label
#' @param y_axis_limits_lin optionally set the Y axis limits for the linear
#' plot, e.g., \code{c(10, 1000)}. If left as the default NA, the Y axis
#' limits for the linear plot will be automatically selected. (Setting up
#' semi-log plot y axis intervals manually is a bit tricky and is not
#' currently supported.)
#' @param y_axis_limits_log optionally set the Y axis limits for the semi-log
#' plot, e.g., \code{c(10, 1000)}. Values will be rounded down and up,
#' respectively, to a round number. If left as the default NA, the Y axis
#' limits for the semi-log plot will be automatically selected.
#' @param y_axis_interval set the linear y-axis major tick-mark interval.
#' Acceptable input: any number or leave as NA to accept default values, which
#' are generally reasonable guesses as to aesthetically pleasing intervals.
#' @param y_axis_label optionally supply a character vector or an expression to
#' use for the y axis label
#' @param obs_color If you would like the observed data points to be in color,
#' either specify a color here or leave this as NA to get all black points for
#' most graph types or, if you set something for \code{line_color}, whatever
#' colors were used for that, semi-transparent blue-purple for a figure_type
#' of "Freddy", or a different color for each study (you must have a column
#' titled "Study" in ct_dataframe for this to work) for a figure_type of
#' "compound summary". Setting this to "none" will remove observed data from
#' the graph. Hex color codes are also ok to use. If you've got a figure_type
#' of "compound summary", then you can specify each color you want or you can
#' call on one of the possible color sets: Options: \describe{
#'
#' \item{"default"}{a set of colors from Cynthia Brewer et al. from Penn State
#' that are friendly to those with red-green colorblindness. The first three
#' colors are green, orange, and purple. This can also be referred to as
#' "Brewer set 2". If there are only two unique values in the colorBy_column,
#' then Brewer set 1 will be used since red and blue are still easily
#' distinguishable but also more aesthetically pleasing than green and
#' orange.}
#'
#' \item{"Brewer set 1"}{colors selected from the Brewer palette "set 1". The
#' first three colors are red, blue, and green.}
#'
#' \item{"ggplot2 default"}{the default set of colors used in ggplot2 graphs
#' (ggplot2 is an R package for graphing.)}
#'
#' \item{"rainbow"}{colors selected from a rainbow palette. The default
#' palette is limited to something like 6 colors, so if you have more than
#' that, that's when this palette is most useful. It's \emph{not} very useful
#' when you only need a couple of colors.}
#'
#' \item{"blue-green"}{a set of blues fading into greens. This palette can be
#' especially useful if you are comparing a systematic change in some
#' continuous variable -- for example, increasing dose or predicting how a
#' change in intrinsic solubility will affect concentration-time profiles --
#' because the direction of the trend will be clear.}
#'
#' \item{"blues"}{a set of blues fading from sky to navy. Like
#' "blue-green", this palette can be especially useful if you are comparing a
#' systematic change in some continuous variable.}
#'
#' \item{"greens"}{a set of greens fading from chartreuse to forest. Great for showing
#' systematic changes in a continuous variable.}
#'
#' \item{"purples"}{a set of purples fading from lavender to aubergine. Great for showing
#' systematic changes in a continuous variable.}
#'
#' \item{"reds"}{a set of reds from pink to brick. Great for showing
#' systematic changes in a continuous variable.}
#'
#' \item{"Tableau"}{uses the standard Tableau palette; requires the "ggthemes"
#' package}
#'
#' \item{"viridis"}{from the eponymous package by Simon Garnier and ranges
#' colors from purple to blue to green to yellow in a manner that is
#' "printer-friendly, perceptually uniform and easy to read by those with
#' colorblindness", according to the package author}
#'
#' \item{a character vector of colors}{If you'd prefer to set all the colors
#' yourself to \emph{exactly} the colors you want, you can specify those
#' colors here. An example of how the syntax should look: \code{color_set =
#' c("dodgerblue3", "purple", "#D8212D")} or, if you want to specify exactly
#' which item in \code{colorBy_column} gets which color, you can supply a
#' named vector. For example, if you're coloring the lines by the compound ID,
#' you could do this: \code{color_set = c("substrate" = "dodgerblue3",
#' "inhibitor 1" = "purple", "primary metabolite 1" = "#D8212D")}. If you'd
#' like help creating a specific gradation of colors, please talk to a member
#' of the R Working Group about how to do that using
#' \link{colorRampPalette}.}}
#'
#' @param obs_shape optionally specify what shapes are used to depict observed
#' data for 1. the substrate drug alone and 2. the substrate drug in the
#' presence of a perpetrator. Input should look like this, for example:
#' \code{c(1, 2)} to get an open circle and an open triangle. To see all the
#' possible shapes and what number corresponds to which shape, type
#' \code{ggpubr::show_point_shapes()} into the console. If left as NA,
#' substrate alone will be an open circle and substrate + inhibitor 1 will be
#' an open triangle.
#' @param obs_size optionally specify the size of the points to use for the
#' observed data. If left as NA, the size will be 2.
#' @param obs_fill_trans optionally specify the transparency for the fill of the
#' observed data points, which can be helpful when you have a lot of points
#' overlapping. This only applies when you have specified a value for
#' \code{obs_color} since, for most of the graph types, the observed data is
#' depicted as an open circle by default. Acceptable values are from 0 (fully
#' transparent, so no fill at all) to 1 (completely opaque or black). If left
#' as the default NA, the observed data points will be 50% transparent, so the
#' same as if this were set to 0.5.
#' @param obs_line_trans optionally specify the transparency for the outline of
#' the observed data points, which can be helpful when you have a lot of
#' points overlapping. Acceptable values are from 0 (fully transparent, so no
#' line at all) to 1 (completely opaque or black). If left as the default NA,
#' the observed data points will be opaque, so the same as if this were set to
#' 1.
#' @param connect_obs_points TRUE or FALSE (default) for whether to add
#' connecting lines between observed data points from the same individual
#' @param obs_on_top TRUE (default) or FALSE for whether to show the observed
#' data on top of the simulated data. If FALSE, the simulated data will be on
#' top.
#' @param include_errorbars TRUE or FALSE (default) for whether to include error
#' bars for observed data points. This ONLY applies when you have supplied
#' observed data from V22 or higher because those data files included a column
#' titled "SD/SE", which is what we'll use for determining the error bar
#' heights.
#' @param errorbar_width width of error bars to use in hours (or, if you've used
#' some other time unit, in whatever units are in your data). Default is 0.5.
#' @param showBLQ TRUE or FALSE (default) to display observed concentrations
#' that were clearly below the lower limit of quantitation, that is,
#' concentrations equal to 0 after time 0. The default (FALSE) removes these
#' values so that they will not show up on graphs.
#' @param line_transparency optionally specify the transparency for the trial
#' mean or percentile lines. Acceptable values are from 0 (fully transparent,
#' so no line at all) to 1 (completely opaque or black). If left as the
#' default NA, this value will be automatically determined.
#' @param line_type Optionally specify what types of lines are used to depict
#' \enumerate{\item{the substrate drug alone and} \item{the substrate drug in
#' the presence of a perpetrator (when applicable).}} Input should look like
#' this, for example: \code{c("solid", "dashed")} to get a solid line for the
#' substrate drug and a dashed line for inhibitor 1. \itemize{ \item{To see
#' all possible \code{line_type} options: \code{ggpubr::show_line_types()}}
#' \item{If left as NA, substrate alone will be a solid line and substrate +
#' inhibitor 1 will be a dashed line.} \item{If \code{figure_type} is "Freddy"
#' and there's no perpetrator present, which is a slightly different scenario
#' than the other graph types, the 1st line type specified will be for the
#' mean simulated concentration and the trial means, and the 2nd line type
#' specified will be for the 5th and 95th percentiles.}}
#' @param line_color optionally specify what colors to use for the lines.
#' Acceptable input for, e.g., the substrate alone to be blue and the
#' substrate + Inhibitor 1 to be red: \code{c("blue", "red")}. If left as the
#' default NA, lines will be black or gray. Hex color codes are also
#' acceptable to use.
#' @param line_width optionally specify how thick to make the lines. Acceptable
#' input is a number; the default is 1 for most lines and 0.8 for some, to
#' give you an idea of where to start.
#' @param hline_position numerical position(s) of any horizontal lines to add to
#' the graph. The default is NA to have no lines, and good syntax if you
#' \emph{do} want lines would be, for example, \code{hline_position = 10} to
#' have a horizontal line at 10 ng/mL (or whatever your concentration units
#' are) or \code{hline_position = c(10, 100, 1000)} to have horizontal lines
#' at each of those y values. Examples of where this might be useful would be
#' to indicate a toxicity threshold, a target Cmin, or the lower limit of
#' quantification for the assay used to generate the concentration-time data.
#' @param hline_style the line color and type to use for any horizontal lines
#' that you add to the graph with \code{hline_position}. Default is "red
#' dotted", but any combination of 1) a color in R and 2) a named linetype is
#' acceptable. Examples: "red dotted", "blue dashed", or "#FFBE33 longdash".
#' To see all the possible linetypes, type \code{ggpubr::show_line_types()}
#' into the console.
#' @param vline_position numerical position(s) of any vertical lines to add to
#' the graph. The default is NA to have no lines, and good syntax if you
#' \emph{do} want lines would be, for example, \code{vline_position = 12} to
#' have a vertical line at 12 h or \code{vline_position = seq(from = 0, to =
#' 168, by = 24)} to have horizontal lines every 24 hours for one week.
#' Examples of where this might be useful would be indicating dosing times or
#' the time at which some other drug was started or stopped.
#' @param vline_style the line color and type to use for any vertical lines that
#' you add to the graph with \code{vline_position}. Default is "red dotted",
#' but any combination of 1) a color in R and 2) a named linetype is
#' acceptable. Examples: "red dotted", "blue dashed", or "#FFBE33 longdash".
#' To see all the possible linetypes, type \code{ggpubr::show_line_types()}
#' into the console.
#' @param graph_labels TRUE or FALSE for whether to include labels (A, B, C,
#' etc.) for each of the small graphs. (Not applicable if only outputting
#' linear or only semi-log graphs.)
#' @param graph_title optionally specify a title that will be centered across
#' your graph or set of graphs
#' @param graph_title_size the font size for the graph title if it's included;
#' default is 14. This also determines the font size of the graph labels.
#' @param legend_label optionally indicate on the legend whether the perpetrator
#' is an inhibitor, inducer, activator, or suppressor. Input will be used as
#' the label in the legend for the line style and the shape. If left as the
#' default NA when a legend is included and a perpetrator is present, the
#' label in the legend will be "Inhibitor".
#' @param legend_orientation optionally specify how the legend entries should be
#' oriented. Options are "vertical" or "horizontal", and, if left as NA, the
#' legend entries will be "vertical" when the legend is on the left or right
#' and "horizontal" when it's on the top or bottom.
#' @param prettify_compound_names TRUE (default), FALSE or a character vector:
#' This is asking whether to make compound names prettier in legend entries
#' and in any Word output files. This was designed for simulations where the
#' substrate and any metabolites, perpetrators, or perpetrator metabolites are
#' among the standard options for the simulator, and leaving
#' \code{prettify_compound_names = TRUE} will make the name of those compounds
#' something more human readable. For example, "SV-Rifampicin-MD" will become
#' "rifampicin", and "Sim-Midazolam" will become "midazolam". Setting this to
#' FALSE will leave the compound names as is. For an approach with more
#' control over what the compound names will look like in legends and Word
#' output, set each compound to the exact name you want with a named
#' character vector where the names are "substrate" and, as applicable,
#' "perpetrator" and the values are the names you want, e.g.,
#' \code{prettify_compound_names = c("perpetrator" = "teeswiftavir",
#' "substrate" = "superstatin")}. Please note that "perpetrator" includes
#' \emph{all} the perpetrators and perpetrator metabolites present, so, if
#' you're setting the perpetrator name, you really should use something like
#' this if you're including perpetrator metabolites: \code{prettify_compound_names =
#' c("perpetrator" = "teeswiftavir and 1-OH-teeswiftavir", "substrate" =
#' "superstatin")}.
#' @param linear_or_log the type of graph to be returned. Options: \describe{
#' \item{"semi-log"}{y axis is log transformed}
#'
#' \item{"linear"}{no axis transformation}
#'
#' \item{"both vertical"}{(default) both the linear and the semi-log graphs
#' will be returned, and graphs are stacked vertically}
#'
#' \item{"both horizontal"}{both the linear and the semi-log graphs will be
#' returned, and graphs are side by side horizontally}
#'
#' \item{"horizontal and vertical"}{both the linear and the semi-log graphs
#' will be returned, and graphs are side by side horizontally (one graph; file
#' name will end in "- horizontal") and stacked vertically (second graph; file
#' name will end in "- vertical"). This option, which was designed to create
#' the vertically stacked version of a graph for a report and the horizontal,
#' side-by-side version for a presentation, is a bit different from the others
#' since it will return two separate files. In the RStudio "Plots" window,
#' you'll only see the vertically stacked version. Setting \code{fig_height}
#' and \code{fig_width} will adjust only the dimensions of the horizontal
#' figure; the default values will be used for the vertical one. If you
#' request Word output, only the vertical plot will be saved in Word format;
#' the horizontal plot will be saved as a png file.}}
#' @param legend_position specify where you want the legend to be. Options are
#' "left", "right", "bottom", "top", or "none" (default) if you don't want one
#' at all.
#' @param qc_graph TRUE or FALSE (default) on whether to create a second copy of
#' the graph where the left panel shows the original graph and the right panel
#' shows information about the simulation trial design. This works MUCH faster
#' when you have already used \code{\link{extractExpDetails_mult}} to get
#' information about how your simulation or simulations were set up and supply
#' that object to the argument \code{existing_exp_details}.
#' @param existing_exp_details output from \code{\link{extractExpDetails}} or
#' \code{\link{extractExpDetails_mult}} to be used for creating figure
#' headings and captions tailored to the specific simulation when saving to a
#' Word file or for use with \code{qc_graph}
#' @param return_caption TRUE or FALSE (default) for whether to return any
#' caption text to use with the graph. This works best if you supply something
#' for the argument \code{existing_exp_details}. If set to TRUE, you'll get as
#' output a list of the graph, the figure heading, and the figure caption.
#' @param save_graph optionally save the output graph by supplying a file name
#' in quotes here, e.g., "My conc time graph.png" or "My conc time
#' graph.docx". The nice thing about saving to Word is that the figure title
#' and caption text will be filled in automatically. If you leave off ".png"
#' or ".docx", the graph will be saved as a png file, but if you specify a
#' different graphical file extension, it will be saved as that file format.
#' Acceptable graphical file extensions are "eps", "ps", "jpeg", "jpg",
#' "tiff", "png", "bmp", or "svg". Do not include any slashes, dollar signs,
#' or periods in the file name. Leaving this as NA means the file will not be
#' saved to disk.
#' @param fig_height figure height in inches
#' @param fig_width figure width in inches
#' @param time_units_to_use time units to use for graphs. If left as NA, the
#' time units in the source data will be used. Options are "hours", "minutes",
#' "days", or "weeks".
#' @param conc_units_to_use concentration units to use for graphs. If left as
#' NA, the concentration units in the source data will be used. Acceptable
#' options are "mg/L", "mg/mL", "µg/L" (or "ug/L"), "µg/mL" (or "ug/mL"),
#' "ng/L", "ng/mL", "µM" (or "uM"), or "nM". If you want to use a molar
#' concentration and your source data were in mass per volume units or vice
#' versa, you'll need to provide something for the argument
#' \code{existing_exp_details}.
#' @param subsection_ADAM SOON TO BE DEPRECATED. We have now added
#' non-ADAM-model tissues to the subtypes of tissues you can extract from
#' Simulator output, so the old "subsection_ADAM" name we had used for which
#' subtype of tissue it was no longer works as well. Please use
#' "Tissue_subtype" instead going forward.
#' @param name_clinical_study optionally specify the name(s) of the clinical
#' study or studies for any observed data. This only affects the caption of
#' the graph. For example, specifying \code{name_clinical_study = "101, fed
#' cohort"} will result in a figure caption that reads in part "clinical study
#' 101, fed cohort". If you have more than one study, that's fine; we'll take
#' care of stringing them together appropriately. Just list them as a
#' character vector, e.g., \code{name_clinical_study = c("101",
#' "102", "103")} will become "clinical studies 101, 102, and 103."
#' @param study_design_matches_obs optionally specify whether the study design
#' for the simulated data matched that of any observed data. This only affects
#' the caption of the graph. If set to TRUE, this assumes that the number of
#' subjects in the clinical study matches the number of subjects per trial in
#' the simulated data.
#'
#' @return Output is a ggplot2 graph or two ggplot2 graphs arranged with
#' ggpubr::ggarrange()
#' @export
#'
#' @examples
#' # Load some concentration-time data to play with:
#' data(LMVct)
#'
#' ct_plot(ct_dataframe = LMVct)
#' ct_plot(ct_dataframe = LMVct, figure_type = "percentiles")
#' ct_plot(ct_dataframe = LMVct)
#' ct_plot(ct_dataframe = LMVct)
#'
#' # Perhaps you don't want to show *all* the data but instead want to
#' # limit the time interval that is graphed. Use `time_range` here:
#' ct_plot(ct_dataframe = LMVct, time_range = c(0, 24))
#'
#' # Or you can let it automatically calculate the time frame
#' # for a given set of doses
#' ct_plot(ct_dataframe = LMVct
#' time_range = "first dose")
#' ct_plot(ct_dataframe = LMVct,
#' time_range = "last dose")
#'
#' # The default graph may be too busy when Inhibitor 1 is present,
#' # so you may want to consider only plotting means as an alternative:
#' ct_plot(ct_dataframe = LMVct,
#' figure_type = "means only")
#'
#' # Add some further options for the look of your graph -- especially useful
#' # if the default settings are clipping your data.
#' ct_plot(ct_dataframe = LMVct,
#' obs_color = "red",
#' line_color = "blue",
#' y_axis_limits_log = c(50, 2000),
#' pad_x_axis = TRUE,
#' legend_label = "Inhibitor")
ct_plot <- function(ct_dataframe = NA,
figure_type = "percentiles",
Tissue_subtype = NA,
mean_type = "arithmetic",
time_range = NA,
x_axis_interval = NA,
x_axis_label = NA,
time_units_to_use = NA,
pad_x_axis = TRUE,
pad_y_axis = TRUE,
adjust_obs_time = FALSE,
t0 = "simulation start",
y_axis_limits_lin = NA,
y_axis_limits_log = NA,
y_axis_interval = NA,
y_axis_label = NA,
conc_units_to_use = NA,
obs_color = NA,
obs_shape = NA,
obs_size = NA,
obs_fill_trans = NA,
obs_line_trans = NA,
connect_obs_points = FALSE,
obs_on_top = TRUE,
include_errorbars = FALSE,
errorbar_width = 0.5,
showBLQ = FALSE,
line_type = NA,
line_transparency = NA,
line_color = NA,
line_width = NA,
hline_position = NA,
hline_style = "red dotted",
vline_position = NA,
vline_style = "red dotted",
legend_position = "none",
legend_orientation = NA,
legend_label = NA,
prettify_compound_names = TRUE,
linear_or_log = "both vertical",
graph_labels = TRUE,
graph_title = NA,
graph_title_size = 14,
qc_graph = FALSE,
existing_exp_details = NA,
return_caption = FALSE,
name_clinical_study = NA,
save_graph = NA,
fig_height = NA,
fig_width = NA,
subsection_ADAM = "deprecated"){
# Error catching ----------------------------------------------------------
# Check whether tidyverse is loaded
if("package:tidyverse" %in% search() == FALSE){
stop("The SimcypConsultancy R package requires the package tidyverse to be loaded, and it doesn't appear to be loaded yet. Please run\nlibrary(tidyverse)\n ...and then try again.",
call. = FALSE)
}
# Noting whether this is an enzyme-abundance plot b/c some options change
# then.
EnzPlot <- all(c("Enzyme", "Abundance") %in% names(ct_dataframe))
if(nrow(ct_dataframe) == 0){
stop(paste0("Please check your input. The data.frame you supplied for ",
ifelse(EnzPlot, "sim_enz_dataframe", "ct_dataframe"),
" doesn't have any rows."),
call. = FALSE)
}
if("character" %in% class(subsection_ADAM) == FALSE ||
all(subsection_ADAM == "deprecated") == FALSE){
warning(wrapn("The argument 'subsection_ADAM' is soon to be deprecated. We have now added non-ADAM-model tissues as subtypes of tissues availble, so the old 'subsection_ADAM' name we had used for which subtype of tissue it was no longer works as well. Please use 'Tissue_subtype' instead going forward."),
call. = FALSE)
}
if(length(sort(unique(ct_dataframe$File[ct_dataframe$Simulated == TRUE]))) > 1){
stop(paste0("The ct_plot function is for graphing only one simulator file at a time, but you have ",
length(sort(unique(ct_dataframe$File))),
" simulator files. Please use ct_plot_overlay or ct_plot_mult for making graphs with this data.frame."),
call. = FALSE)
}
# NB: Allowing more than one file for observed data here so that the user
# doesn't need to mess with it.
if(length(sort(unique(ct_dataframe$Tissue))) > 1){
stop(paste0("The ct_plot function is for graphing only one tissue at a time, but you have ",
length(sort(unique(ct_dataframe$Tissue))),
" tissues. Please use ct_plot_overlay or ct_plot_mult for making graphs with this data.frame."),
call. = FALSE)
}
# Checking for good input for prettify_compound_names.
if("character" %in% class(prettify_compound_names) &&
any(is.null(names(prettify_compound_names)))){
if(length(unique(ct_dataframe$CompoundID)) == 1){
names(prettify_compound_names) <- unique(ct_dataframe$CompoundID)
} else {
warning(wrapn("We're not sure what you wanted for the argument `prettify_compound_names` because we were expecting a TRUE or FALSE or a named character vector, and that's not what you have supplied. Please check the help file for appropriate values for `prettify_compound_names`. For now, we'll set this to TRUE, the default."),
call. = FALSE)
prettify_compounds_names <- TRUE
}
}
if("character" %in% class(prettify_compound_names)){
names(prettify_compound_names) <- tolower(names(prettify_compound_names))
names(prettify_compound_names)[str_detect(names(prettify_compound_names), "inhibitor")] <- "perpetrator"
names(prettify_compound_names)[str_detect(names(prettify_compound_names), "inhib")] <- "perpetrator"
if("perpetrator" %in% names(prettify_compound_names) == FALSE &
any(ct_dataframe$Inhibitor != "none")){
prettify_compound_names <-
c(prettify_compound_names,
"perpetrator" = prettify_compound_name(
unique(ct_dataframe$Inhibitor[ct_dataframe$Inhibitor != "none"])))
}
if(EnzPlot == FALSE &&
("substrate" %in% names(prettify_compound_names) == FALSE &
any(ct_dataframe$CompoundID == "substrate"))){
prettify_compound_names <-
c(prettify_compound_names,
"perpetrator" = prettify_compound_name(
unique(ct_dataframe$Inhibitor[ct_dataframe$Inhibitor != "none"])))
}
}
# Checking whether user tried to include obs data directly from simulator
# output for a simulation that included anything other than substrate in
# plasma.
if(EnzPlot == FALSE && any(unique(ct_dataframe$CompoundID) == "UNKNOWN")){
return(
ggplot(data.frame(Problem = 1, DataFail = 1),
aes(y = Problem, x = DataFail)) +
xlab("Please check the help file for extractConcTime") +
theme(axis.title.x = element_text(size = 14, color = "red",
face = "italic")) +
annotate(geom = "text", x = 1, y = 1, size = 8,
color = "red",
label = "You have extracted observed\ndata from a simulator output\nfile, but the simulator doesn't\ninclude information on\nwhat compound it is or\nwhether a perpetrator was present.\nWe cannot make your graph.")
)
}
if(EnzPlot == FALSE && length(sort(unique(ct_dataframe$CompoundID))) > 1){
stop(paste0("The ct_plot function is for graphing only one compound at a time, but you have ",
length(sort(unique(ct_dataframe$CompoundID))),
" compounds. Please use ct_plot_overlay or ct_plot_mult for making graphs with this data.frame."),
call. = FALSE)
}
# Check whether they've specified anything for Tissue_subtype or if data
# only contain 1 value for Tissue_subtype.
if(EnzPlot == FALSE){
if("Tissue_subtype" %in% names(ct_dataframe)){
if(any(complete.cases(ct_dataframe$Tissue_subtype)) &
complete.cases(Tissue_subtype)){
if(length(unique(ct_dataframe$Tissue_subtype)) == 1 &&
unique(ct_dataframe$Tissue_subtype) != Tissue_subtype){
warning(wrapn(paste0("You requested the Tissue_subtype tissue ",
Tissue_subtype,
", but what's in your data is ",
unique(ct_dataframe$Tissue_subtype),
", so we'll use that instead.")),
call. = FALSE)
Tissue_subtype <- unique(ct_dataframe$Tissue_subtype)
}
} else {
Tissue_subtype <- unique(ct_dataframe$Tissue_subtype)
}
} else {
ct_dataframe$Tissue_subtype <- NA
}
if(length(Tissue_subtype) > 1){
Tissue_subtype <- Tissue_subtype[1]
warning(wrapn(paste0("You requested more than one value for Tissue_subtype, but we can only plot one with the ct_plot function. We'll set it to the 1st value we find in your data: ",
Tissue_subtype, ".")),
call. = FALSE)
}
}
# If user wants feces, use the British spelling even if they entered the
# American spelling.
Tissue_subtype <- sub("feces", "faeces", Tissue_subtype)
if(length(obs_color) > 1 & figure_type != "compound summary"){
warning(wrapn("The argument `obs_color` can only take one color, and you've specified more than that. Only the first color will be used."),
call. = FALSE)
obs_color <- obs_color[1]
}
# Making most character arguments lower case to avoid case sensitivity
figure_type <- tolower(figure_type) # LOWER CASE ONLY FROM HERE DOWN.
mean_type <- tolower(mean_type)[1]
legend_position <- tolower(legend_position)[1]
linear_or_log <- tolower(linear_or_log)[1]
if(str_detect(linear_or_log, "horiz") & str_detect(linear_or_log, "vert")){
linear_or_log <- "horizontal and vertical"
}
if(length(figure_type) != 1 |
figure_type %in% c("trial means", "percentiles", "trial percentiles",
"freddy", "means only", "overlay",
"percentile ribbon", "percentile ribbons",
"ribbon", "compound summary") == FALSE){
warning(wrapn("The only acceptable options for figure_type are `trial means`, `percentiles`, `percentile ribbon`, `means only`, `Freddy`, or `compound summary`. We'll set your graph type to `percentiles` for now."),
call. = FALSE)
figure_type <- "percentiles"
}
# Setting figure type to be exactly what it should be
figure_type <- ifelse(str_detect(figure_type, "percentile") &
!str_detect(figure_type, "ribbon"),
"percentiles", figure_type)
figure_type <- ifelse(str_detect(figure_type, "ribbon"),
"percentile ribbon", figure_type)
# Checking that data include Study column if the figure_type is "compound
# summary" b/c otherwise won't know how to color obs points.
if(figure_type == "compound summary" &
"Study" %in% names(ct_dataframe) == FALSE){
warning(wrapn("You have requested a figure type of 'compound summary' but have not included a column named 'Study' in your source data. We need that column to determine how to color the observed data points, so we'll have to make all the observed data points the same color."),
call. = FALSE)
figure_type <- "freddy"
}
# Now that figure type is set, adjusting the number of observed data colors
# and shapes to 1 if the figure type is anything other than "compound
# summary".
if(figure_type != "compound summary"){
obs_color <- obs_color[1]
obs_shape <- obs_shape[1]
}
if(("Compound" %in% names(ct_dataframe) && length(unique(ct_dataframe$Compound)) > 1) |
("CompoundID" %in% names(ct_dataframe) && length(unique(ct_dataframe$CompoundID)) > 1)){
stop("It looks like you have more than one kind of data here because you have multiple compounds. Did you perhaps mean to use the function ct_plot_overlay instead? Because this function has been set up to deal with only one dataset at a time, no graph can be made. Please check your data and try this function with only one dataset at a time.")
}
if(length(unique(ct_dataframe$Inhibitor)) > 2){
stop("It looks like you have more than one kind of data here because you have multiple sets of inhibitors. Did you perhaps mean to use the function ct_plot_overlay instead? Because this function has been set up to deal with only one dataset at a time, no graph can be made. Please check your data and try this function with only one dataset at a time.")
}
# If user wanted hline or vline added, check that they have specified
# argument correctly and set up the character vector of preferences.
HLineAES <- str_split(hline_style, pattern = " ")[[1]]
if(length(HLineAES) < 2 & any(complete.cases(hline_position))){
warning(wrapn("You requested that a horizontal line be added to the graph, but you've supplied input that doesn't work for `hline_style`. We'll set this to `red dotted` for now, but please check the help file to get what you want."),
call. = FALSE)
HLineAES <- c("red", "dotted")
}
VLineAES <- str_split(vline_style, pattern = " ")[[1]]
if(length(VLineAES) < 2 & any(complete.cases(vline_position))){
warning(wrapn("You requested that a vertical line be added to the graph, but you've supplied input that doesn't work for `vline_style`. We'll set this to `red dotted` for now, but please check the help file to get what you want."),
call. = FALSE)
VLineAES <- c("red", "dotted")
}
# This doesn't check that they've specified legit colors or linetypes, but
# I'm hoping that ggplot2 errors will cover that.
# Getting experimental details if they didn't supply them and want to have a
# QC graph
if(qc_graph == TRUE | "logical" %in% class(existing_exp_details) == FALSE){
if("logical" %in% class(existing_exp_details)){
Deets <- tryCatch(
extractExpDetails(sim_data_file = unique(ct_dataframe$File),
exp_details = "Summary and Input")[["MainDetails"]],
error = function(x) "missing file")
} else {
Deets <- harmonize_details(existing_exp_details)[["MainDetails"]] %>%
filter(File %in% unique(ct_dataframe$File))
if(nrow(Deets) == 0){
Deets <- tryCatch(
extractExpDetails(sim_data_file = unique(ct_dataframe$File),
exp_details = "Summary and Input")[["MainDetails"]],
error = function(x) "missing file")
}
}
if(qc_graph == TRUE &
(class(Deets)[1] == "character" || nrow(Deets) == 0)){
warning(wrapn("We couldn't find the source Excel file for this graph, so we can't QC it."),
call. = FALSE)
qc_graph <- FALSE
}
}
if(any(complete.cases(time_units_to_use))){
time_units_to_use <- tolower(time_units_to_use[1])
if(time_units_to_use %in% c("hours", "minutes", "days", "weeks") == FALSE){
warning(wrapn(paste0("You requested that the graph have time units of `",
time_units_to_use,
"`, which is not among the acceptable options. We'll use hours instead.")),
call. = FALSE)
time_units_to_use <- "hours"
}
}
if(any(complete.cases(conc_units_to_use))){
conc_units_to_use <- conc_units_to_use[1]
if(conc_units_to_use %in% c("mg/L", "mg/mL", "µg/L", "ug/L", "µg/mL",
"ug/mL", "ng/L", "ng/mL", "µM", "uM",
"nM") == FALSE){
warning(wrapn(paste0("You requested that the graph have concentration units of `",
conc_units_to_use,
"`, which is not among the acceptable options. We'll use ng/mL instead.")),
call. = FALSE)
conc_units_to_use <- "ng/mL"
}
}
legend_position <- tolower(legend_position)[1]
if(complete.cases(legend_position) &&
legend_position %in% c("left", "right", "bottom", "top", "none") == FALSE){
warning(wrapn("You have specified something for the legend position that is not among the possible options. We'll set it to 'right'."),
call. = FALSE)
legend_position <- "right"
}
legend_orientation <- tolower(legend_orientation)[1]
if((complete.cases(legend_orientation) & legend_position != "none") &&
legend_orientation %in% c("horizontal", "vertical") == FALSE){
legend_orientation <- case_when(legend_position %in% c("left", "right", "none") ~ "vertical",
.default = "horizontal")
warning(wrapn(paste0("You have specified something for the legend orientation that is not among the possible options. Since you requested that the legend position be on the ",
legend_position, ", we will set the legend orientation to be ",
legend_orientation, ". ")),
call. = FALSE)
}
if(is.na(legend_orientation)){
legend_orientation <- case_when(legend_position %in% c("left", "right", "none") ~ "vertical",
.default = "horizontal")
}
# Main body of function --------------------------------------------------
# This will run orders of magnitude faster if we only include aggregate data.
# Removing individual data when possible using column IndivOrAgg, which will
# be NA for observed data and not exist for release- or dissolution-profile
# data. Dealing with that and harmonizing data.
# Adding info for IndivOrAgg for data that were extracted w/older version
# of package. Uncomment the if statement at some point?
# if("IndivOrAgg" %in% names(ct_dataframe) == FALSE){
ct_dataframe <- ct_dataframe %>%
mutate(IndivOrAgg = case_when(Simulated == FALSE ~ NA,
Simulated == TRUE & Trial %in%
c("mean", "median",
"geomean",
"per5", "per95", "per10", "per90",
"trial mean", "trial geomean",
"trial median") ~ "aggregate",
.default = "individual"))
# }
ct_dataframe <- ct_dataframe %>%
filter(Simulated == FALSE |
(Simulated == TRUE & IndivOrAgg == "aggregate"))
# Noting user's original preferences for a few things
obs_line_trans_user <- obs_line_trans
obs_fill_trans_user <- obs_fill_trans
obs_color_user <- obs_color
obs_shape_user <- obs_shape
# If user had already filtered ct_dataframe to include only the ADAM data
# they wanted, the Tissue_subtype column might not include the default
# value for Tissue_subtype. In that case, just switch to the subsection
# that *was* included and make the plot.
ADAMoptions <- c("dissolved compound", "undissolved compound",
"enterocyte concentration",
"free compound in lumen", "total compound in lumen",
"Heff", "absorption rate",
"unreleased compound in faeces",
"luminal CLint",
"dissolution rate of solid state",
"cumulative fraction of compound absorbed",
"cumulative fraction of compound dissolved")
if(EnzPlot == FALSE &&
(Tissue_subtype == "free compound in lumen" &
length(unique(ct_dataframe$Tissue_subtype)) == 1 &&
unique(ct_dataframe$Tissue_subtype) %in% ADAMoptions)){
Tissue_subtype <- unique(ct_dataframe$Tissue_subtype)
}
MyMeanType <- ct_dataframe %>%
filter(Trial %in% c("geomean", "mean", "median")) %>%
pull(Trial) %>% unique() %>%
factor(levels = c("mean", "geomean", "median")) %>%
sort()
if(switch(mean_type, "arithmetic" = "mean", "geometric" = "geomean",
"median" = "median") %in% ct_dataframe$Trial == FALSE){
warning(wrapn(paste0("You requested the ",
switch(mean_type, "arithmetic" = "arithmetic means",
"geometric" = "geometric means",
"median" = "medians"),
", but those are not included in your data. Instead, the ",
ifelse(MyMeanType[1] == "mean",
"arithmetic mean", MyMeanType[1]),
"s will be used.")),
call. = FALSE)
MyMeanType <- MyMeanType[1] %>% as.character()
} else {
MyMeanType <- switch(mean_type, "arithmetic" = "mean", "geometric" = "geomean",
"median" = "median")
}
Data <- ct_dataframe %>%
# Making sure we only have one summary aggregate measurement
filter(!Trial %in% setdiff(c("mean", "geomean", "median"),
MyMeanType))
# Set MyCompoundID to whatever compound was included.
MyCompoundID <- ifelse(EnzPlot, unique(Data$Enzyme),
unique(Data$CompoundID))
if(EnzPlot){
Data <- Data %>%
rename(Conc = Abundance) %>%
mutate(CompoundID = Enzyme,
Compound = Enzyme,
Conc_units = "ng/mL", # placeholder only
Tissue_subtype = NA, # This avoids some annoying warnings later, and it's easiest to just add it here.
# putting "conc" into decimal format b/c it works better with
# using percents on y axis labels
Conc = Conc / 100)
# Since the y axis is now scaled by 1/100, need to also scale y axis
# limits.
y_axis_limits_lin <- y_axis_limits_lin / 100
y_axis_limits_log <- y_axis_limits_log / 100
hline_position <- hline_position / 100
}
# We've discovered that, sometimes, an ADAM model can return negative
# concentrations, which causes this function to essentially freeze.
# Removing negative concs.
Data <- Data %>% filter(Conc >= 0)
# Noting whether the tissue was from an ADAM model
ADAM <- unique(Data$Tissue) %in% c("stomach", "duodenum", "jejunum I",
"jejunum II", "ileum I", "ileum II",
"ileum III", "ileum IV", "colon",
"faeces", "cumulative absorption",
"cumulative dissolution") &&
EnzPlot == FALSE
AdvBrainModel <- "Tissue_subtype" %in% names(Data) &&
unique(Data$Tissue == "brain") &
any(Data$Tissue_subtype %in%
c("intracranial", "brain ICF", "brain ISF", "spinal CSF", "cranial CSF",
"total brain", "Kp,uu,brain", "Kp,uu,ICF", "Kp,uu,ISF"))
# If the tissue was an ADAM tissue, only include the Tissue_subtype they requested.
if(any(ADAM)){
if(length(Tissue_subtype) > 1){
stop(paste0("You can only enter one option for the concentration type for ADAM-model tissues. Please set Tissue_subtype to one of ",
str_comma(paste0("`", ADAMoptions, "`"), conjunction = "or"),
"."),
call. = FALSE)
}
if(Tissue_subtype %in% ADAMoptions == FALSE){
stop(paste0("The concentration type you requested, `", Tissue_subtype,
"``, is not one of the options. Please set this value to one of ",
str_comma(paste0("`", ADAMoptions, "`"), conjunction = "or"),
"."),
call. = FALSE)
}
Data <- Data %>% filter(Tissue_subtype == {{Tissue_subtype}})
if(nrow(Data) == 0){
stop(paste0("You appear to have ADAM-model data, and you requested `",
Tissue_subtype,
"` for the Tissue_subtype argument, but that type is not present in ct_dataframe. The type(s) of ADAM data available in ct_dataframe is/are ",
str_comma(paste0("`", unique(ct_dataframe$Tissue_subtype), "`")),
". Please set the argument `Tissue_subtype` to one of these values."),
call. = FALSE)
}
}
# Error catching now that we've figured out which Tissue_subtype they want
if("Conc_units" %in% names(Data) && length(unique(Data$Conc_units)) > 1){
stop("It looks like you have more than one kind of data here because you have multiple concentration units. Maybe you've got more than one ADAM-model tissue included? Because this function has been set up to deal with only one dataset at a time, no graph can be made. Please check your data and try this function with only one dataset at a time.")
}
# Dealing with possible inhibitor 1 data ---------------------------------
# Adding a grouping variable to data and also making the inhibitor 1 name
# prettier for the graphs.
MyPerpetrator <- unique(Data$Inhibitor) %>% as.character()
MyPerpetrator <- MyPerpetrator[!MyPerpetrator == "none"]
if(length(MyPerpetrator) > 0 && complete.cases(MyPerpetrator)){
Data <- Data %>%
mutate(CompoundIsPerp = Compound == MyPerpetrator,
Inhibitor = as.character(ifelse(is.na(Inhibitor),
"none", Inhibitor)))
if(class(prettify_compound_names) == "logical" &&
prettify_compound_names){
MyPerpetrator <- prettify_compound_name(MyPerpetrator)
}
if(class(prettify_compound_names) == "character"){
MyPerpetrator <- prettify_compound_names["perpetrator"]
}
Data <-
Data %>%
mutate(Compound = ifelse(CompoundIsPerp, MyPerpetrator, Compound),
Inhibitor = ifelse(Inhibitor != "none", MyPerpetrator, Inhibitor)) %>%
unite(col = Group, remove = FALSE,
any_of(c("Compound", "Inhibitor", "Trial", "Individual"))) %>%
select(-CompoundIsPerp)
}
# Error catching for when user specifies linetype, color or shape and
# doesn't include enough values when perpetrator present
if(complete.cases(obs_shape[1]) && length(MyPerpetrator) > 0 &&
complete.cases(MyPerpetrator) &&
MyCompoundID != "inhibitor 1" &&
length(complete.cases(obs_shape)) < 2 &
figure_type != "compound summary"){
warning(wrapn("There is an inhibitor or perpetrator present, but you have specified only one shape for the observed data. The same shape will be used for both."),
call. = FALSE)
obs_shape <- rep(obs_shape, 2)
}
if(complete.cases(line_color[1]) && length(MyPerpetrator) > 0 &&
complete.cases(MyPerpetrator) &&
MyCompoundID != "inhibitor 1" &&
length(complete.cases(line_color)) < 2){
warning(wrapn("There is an inhibitor or perpetrator present, but you have specified only one line color. The same line color will be used for both."),
call. = FALSE)
line_color <- rep(line_color, 2)
}
if(complete.cases(line_type[1]) && length(MyPerpetrator) > 0 &&
complete.cases(MyPerpetrator) &&
MyCompoundID != "inhibitor 1" &&
length(complete.cases(line_type)) < 2){
warning(wrapn("There is an inhibitor or perpetrator present, but you have specified only one line type. The same line type will be used for both."),
call. = FALSE)
line_type <- rep(line_type, 2)
}
# Always want "none" to be the 1st item on the legend, and we need there
# to be some value present for "Inhibitor" for function to work correctly.
Data <- Data %>%
mutate(Inhibitor = ifelse(is.na(Inhibitor), "none", Inhibitor))
if(length(MyPerpetrator) > 0){
Data <- Data %>%
mutate(Inhibitor = factor(Inhibitor, levels = c("none", MyPerpetrator)))
}
# Setting up data.frames to graph ---------------------------------------
# Converting conc and time units if requested
if(any(complete.cases(conc_units_to_use))){
if("logical" %in% class(existing_exp_details) == FALSE){
MWs_1 <- AllCompounds %>%
mutate(Detail = paste0("MW", Suffix)) %>%
select(CompoundID, Detail) %>%
left_join(harmonize_details(existing_exp_details)[["MainDetails"]] %>%
filter(File %in% unique(ct_dataframe$File)) %>%
select(File, matches("MW_")) %>%
pivot_longer(cols = matches("MW_"),
names_to = "Detail",
values_to = "Value"),
by = "Detail")
MWs <- MWs_1$Value
names(MWs) <- MWs_1$CompoundID
} else {
MWs <- NA
}
Data <- convert_conc_units(Data, conc_units = conc_units_to_use,
MW = MWs)
}
if(any(complete.cases(time_units_to_use))){
Data <- convert_time_units(Data, time_units = time_units_to_use)
}
# Setting up the x axis using the subfunction ct_x_axis
XStuff <- ct_x_axis(Data = Data,
time_range = time_range,
t0 = t0,
pad_x_axis = pad_x_axis,
MyCompoundID = MyCompoundID,
EnzPlot = EnzPlot)
xlab <- XStuff$xlab
Data <- XStuff$Data # Is this necessary??
time_range <- XStuff$time_range
time_range_relative <- XStuff$time_range_relative
t0 <- XStuff$t0
TimeUnits <- XStuff$TimeUnits
# Checking whether there are data in the time range requested and warning if
# not.
if(any(Data$Time >= time_range_relative[1] &
Data$Time <= time_range_relative[2]) == FALSE){
warning(wrapn(paste0(
"You requested a time range of ",
time_range_relative[1], " to ", time_range_relative[2],
" h, but your data are in the range of ",
min(Data$Time), " to ", max(Data$Time), " h. ",
"Since none of your data are in the time range requested, the full time range will be returned.")),
call. = FALSE)
time_range <- c(min(Data$Time), max(Data$Time))
time_range_relative <- time_range
}
# Separating the data by type and calculating trial means
sim_data_trial <- Data %>%
filter(Simulated == TRUE &
Trial %in% switch(mean_type,
"arithmetic" = "trial mean",
"geometric" = "trial geomean",
"median" = "trial median")) %>%
ungroup() %>%
unite(col = Group, remove = FALSE,
any_of(c("Compound", "Inhibitor", "Individual", "Simulated")))
sim_data_mean <- Data %>%
filter(Simulated == TRUE &
Trial %in% c(MyMeanType, "per5", "per95")) %>%
unite(col = Group, remove = FALSE,
any_of(c("Compound", "Inhibitor", "Trial", "Individual")))
if(figure_type == "compound summary"){
# Hacking the Study column for the simulated data
sim_data_mean$Study <- "simulated"
}
# Setting up observed data per user input -------------------------------
obs_dataframe <- Data %>% filter(Simulated == FALSE) %>% droplevels() %>%
unite(col = Group, remove = FALSE,
any_of(c("Compound", "Inhibitor", "Trial", "Individual", "Study")))
# If the user set obs_color to "none", then they must not want to include
# observed data in the graph. Set nrow to 0 in that case.
if(all(complete.cases(obs_color)) && all(obs_color == "none")){
obs_dataframe <- obs_dataframe %>% filter(Trial == "mango") # hack to keep all the column names just in case
}
if(figure_type == "compound summary"){
if(all(is.na(obs_color_user))){
obs_color <- make_color_set(
color_set = "default",
num_colors = length(sort(unique(obs_dataframe$Study))))
} else if(length(obs_color) == 1){
obs_color <- make_color_set(
color_set = obs_color_user,
num_colors = length(sort(unique(obs_dataframe$Study))))
} else if(length(obs_color) < length(sort(unique(obs_dataframe$Study)))){
warning(wrapn(paste0("You have ", length(sort(unique(obs_dataframe$Study))),
" unique studies in your data but have only specified ",
length(obs_color), " color. You might want to specify more colors to distinguish between studies.")),
call. = FALSE)
obs_color <- rep(obs_color_user, length(sort(unique(obs_dataframe$Study))))
}
}
if(showBLQ == FALSE){
obs_dataframe <- obs_dataframe %>%
mutate(Conc = ifelse(Conc <= 0 & Time > 0,
NA, Conc)) %>%
filter(complete.cases(Conc))
}
# Checking whether there are multiple observations at each time point. If
# so, user should probably be using figure_type = "percentiles" and, if not,
# user should probably be using figure_type = "trial means", and Hannah
# would like user to get a warning about that.
suppressMessages(
check <- obs_dataframe %>%
group_by(across(.cols = any_of(c("CompoundID", "Inhibitor", "Time")))) %>%
summarize(N = n())
)
if(nrow(obs_dataframe) > 0 && any(check$N > 1) & figure_type %in% c("trial means")){
warning(wrapn(paste0("You have requested a figure type of '",
figure_type,
"', but you appear to be plotting individual observed data (N > 1 at each time point). You may want to switch to a figure type of 'percentiles' or 'percentile ribbon' to comply with the recommendations of the Simcyp Consultancy Team report template. Please see red text at the beginning of section 4 in the template.")),
call. = FALSE)
}
if(nrow(obs_dataframe) > 0 &&
all(check$N == 1) & figure_type %in% c("percentiles", "percentile",
"percentile ribbon", "ribbon")){
warning(wrapn(paste0("You have requested a figure type of '",
figure_type,
"', but you appear to be plotting mean observed data (N = 1 at each time point). You may want to switch to a figure type of 'trial means' or 'means only' to comply with the recommendations of the Simcyp Consultancy Team report template. Please see red text at the beginning of section 4 in the template.")),
call. = FALSE)
}
# If there are no observed data and they requested a figure type of "compound
# summary", then just set the figure type to "Freddy" b/c it's the same.
if(nrow(obs_dataframe) == 0 & figure_type == "compound summary"){
figure_type <- "freddy"
}
# Setting up the y axis using the subfunction ct_y_axis -------------------
# Setting Y axis limits for both linear and semi-log plots
Ylim_data <- switch(figure_type,
"trial means" = bind_rows(sim_data_trial, obs_dataframe),
"percentiles" = bind_rows(sim_data_trial, sim_data_mean, obs_dataframe),
"freddy" = bind_rows(sim_data_trial, sim_data_mean, obs_dataframe),
"compound summary" = bind_rows(sim_data_trial, sim_data_mean, obs_dataframe),
"percentile ribbon" = bind_rows(sim_data_trial, sim_data_mean, obs_dataframe),
"means only" = bind_rows(sim_data_mean, obs_dataframe) %>%
filter(as.character(Trial) == MyMeanType |
str_detect(as.character(Trial), "obs"))
)
if("SD_SE" %in% names(Ylim_data) &&
any(complete.cases(Ylim_data$SD_SE))){
Ylim_data <- Ylim_data %>%
mutate(MaxConc = Conc + ifelse(complete.cases(SD_SE), SD_SE, 0),
MinConc = Conc - ifelse(complete.cases(SD_SE), SD_SE, 0))
Ylim_data <- bind_rows(Ylim_data,
data.frame(Conc = c(
max(Ylim_data$MaxConc, na.rm = T),
min(Ylim_data$MinConc, na.rm = T))))
}
if(nrow(Ylim_data) == 0){
Ylim_data <- bind_rows(sim_data_trial, obs_dataframe, sim_data_mean)
}
YStuff <- ct_y_axis(ADAMorAdvBrain = any(ADAM, AdvBrainModel),
Tissue_subtype = Tissue_subtype,
EnzPlot = EnzPlot,
time_range_relative = time_range_relative,
Ylim_data = Ylim_data,
prettify_compound_names = prettify_compound_names,
pad_y_axis = pad_y_axis,
y_axis_limits_lin = y_axis_limits_lin,
time_range = time_range,
y_axis_limits_log = y_axis_limits_log,
y_axis_interval = y_axis_interval
)
ObsConcUnits <- YStuff$ObsConcUnits
ylab <- YStuff$ylab
YLabels <- YStuff$YLabels
YLogLabels <- YStuff$YLogLabels
YBreaks <- YStuff$YBreaks
YLogBreaks <- YStuff$YLogBreaks
Ylim_log <- YStuff$Ylim_log
YmaxRnd <- YStuff$YmaxRnd
pad_y_num <- YStuff$pad_y_num
pad_y_axis <- YStuff$pad_y_axis
# Figure types ---------------------------------------------------------
obs_line_trans_user <- obs_line_trans
obs_fill_trans_user <- obs_fill_trans
obs_color_user <- obs_color_user
AesthetStuff <- set_aesthet(line_type = line_type,
figure_type = figure_type,
MyPerpetrator = MyPerpetrator,
MyCompoundID = MyCompoundID,
obs_shape = obs_shape,
obs_color = obs_color,
obs_fill_trans = obs_fill_trans,
obs_line_trans = obs_line_trans,
line_color = line_color)
line_type <- AesthetStuff$line_type
line_color <- AesthetStuff$line_color
obs_shape <- AesthetStuff$obs_shape
obs_color <- AesthetStuff$obs_color
obs_fill_trans<- AesthetStuff$obs_fill_trans
obs_line_trans <- AesthetStuff$obs_line_trans
# Making sure there are enough shapes and colors for "compound summary"
# figures.
if(figure_type == "compound summary"){
obs_color <- rep(obs_color,
length(unique(obs_dataframe$Study)))
obs_shape <- rep(obs_shape,
length(unique(obs_dataframe$Study)))
}
# Warning for a figure type that's not recommended
# Is this a graph showing substrate +/- perpetrator?
Eff_plusminus <- length(MyPerpetrator) > 0 &&
complete.cases(MyPerpetrator[1]) &&
MyPerpetrator[1] != "none" &
MyCompoundID %in% c("inhibitor 1", "inhibitor 2",
"inhibitor 1 metabolite") == FALSE
if(Eff_plusminus & EnzPlot == FALSE & figure_type != "means only"){
# This is when there is a perpetrator present and the graph is of the
# substrate or a substrate metabolite
warning(wrapn("When there is a perpetrator present in the simulation, as is the case here, the Simcyp Consultancy report template recommends only showing the means. You may want to change figure_type to 'means only'."),
call. = FALSE)
}
## Setting up ggplot and aes bases for the graph -----------------------
if(figure_type == "percentile ribbon"){
RibbonDF <- sim_data_mean %>% select(-any_of(c("Group", "Individual"))) %>%
pivot_wider(names_from = Trial, values_from = Conc) %>%
rename("MyMean" = {MyMeanType})
}
A <- switch(figure_type,
"trial means" = ggplot(sim_data_trial,
aes(x = Time, y = Conc, group = Group,
linetype = Inhibitor, shape = Inhibitor,
color = Inhibitor, fill = Inhibitor)),
"percentiles" = ggplot(sim_data_mean %>%
filter(Trial %in% c("per5", "per95")) %>%
mutate(Group = paste(Group, Trial)),
aes(x = Time, y = Conc,
linetype = Inhibitor, shape = Inhibitor,
color = Inhibitor, fill = Inhibitor,
group = Group)),
"percentile ribbon" = ggplot(RibbonDF,
aes(x = Time, y = MyMean,
ymin = per5, ymax = per95,
linetype = Inhibitor, shape = Inhibitor,
color = Inhibitor, fill = Inhibitor)),
"freddy" =
switch(as.character(Eff_plusminus),
"TRUE" = ggplot(data = sim_data_mean %>%
filter(Trial == MyMeanType),
aes(x = Time, y = Conc, group = Group,
linetype = Inhibitor, shape = Inhibitor,
color = Inhibitor, fill = Inhibitor)),
"FALSE" = ggplot(sim_data_trial,
aes(x = Time, y = Conc, group = Group,
linetype = Inhibitor, shape = Inhibitor,
color = Inhibitor, fill = Inhibitor))
),
"compound summary" =
switch(as.character(Eff_plusminus),
"TRUE" = ggplot(data = sim_data_mean %>%
filter(Trial == MyMeanType),
aes(x = Time, y = Conc, group = Group,
linetype = Inhibitor, shape = Inhibitor)),
"FALSE" = ggplot(sim_data_trial,
aes(x = Time, y = Conc, group = Group))
),
"means only" = ggplot(sim_data_mean %>%
filter(Trial == MyMeanType),
aes(x = Time, y = Conc,
linetype = Inhibitor, shape = Inhibitor,
color = Inhibitor, fill = Inhibitor)))
# Adding optional horizontal line(s)
if(any(complete.cases(hline_position))){
A <- A + geom_hline(yintercept = hline_position,
color = HLineAES[1], linetype = HLineAES[2])
}
# Adding optional vertical line(s)
if(any(complete.cases(vline_position))){
A <- A + geom_vline(xintercept = vline_position,
color = VLineAES[1], linetype = VLineAES[2])
}
if(nrow(obs_dataframe) > 0 & obs_on_top == FALSE){
MapObsData <- all(is.na(obs_color_user)) & figure_type != "freddy"
A <- addObsPoints(obs_dataframe = obs_dataframe,
A = A,
# Needed the argument AES for ct_plot_overlay, but
# it's only ever going to be "linetype" for ct_plot.
AES = "linetype",
obs_shape = obs_shape,
obs_shape_user = obs_shape_user,
obs_size = obs_size,
obs_color = obs_color,
obs_color_user = obs_color_user,
obs_line_trans = obs_line_trans,
obs_line_trans_user = obs_line_trans_user,
obs_fill_trans = obs_fill_trans,
obs_fill_trans_user = obs_fill_trans_user,
connect_obs_points = connect_obs_points,
line_width = line_width,
figure_type = figure_type,
MapObsData = MapObsData,
LegCheck = TRUE)
}
## figure_type: trial means -----------------------------------------------------------
if(figure_type == "trial means"){
NumTrials <- length(unique(sim_data_trial$Trial))
AlphaToUse <- ifelse(complete.cases(line_transparency),
line_transparency,
ifelse(NumTrials > 10, 0.05, 0.2))
A <- A +
geom_line(alpha = AlphaToUse,
linewidth = ifelse(is.na(line_width), 1, line_width)) +
geom_line(data = sim_data_mean %>%
filter(Trial == MyMeanType),
linewidth = ifelse(is.na(line_width), 1, line_width))
}
## figure_type: percentiles ----------------------------------------------------------
if(figure_type == "percentiles"){
# graphs with 95th percentiles
AlphaToUse <- ifelse(complete.cases(line_transparency),
line_transparency, 0.25)
A <- A +
geom_line(alpha = AlphaToUse,
linewidth = ifelse(is.na(line_width), 0.8, line_width)) +
geom_line(data = sim_data_mean %>%
filter(Trial == MyMeanType),
linewidth = ifelse(is.na(line_width), 1, line_width))
}
## figure_type: percentile ribbon ----------------------------------------------------------
if(str_detect(figure_type, "ribbon")){
# graphs with 95th percentiles as transparent ribbons
AlphaToUse <- ifelse(complete.cases(line_transparency),
line_transparency, 0.25)
A <- A +
geom_ribbon(alpha = AlphaToUse, color = NA) +
geom_line(linewidth = ifelse(is.na(line_width), 1, line_width))
}
## figure_type: Freddy or compound summary ----------------------------------
if(figure_type %in% c("freddy", "compound summary")){
NumTrials <- length(unique(sim_data_trial$Individual))
AlphaToUse <- ifelse(complete.cases(line_transparency),
line_transparency,
ifelse(NumTrials > 10, 0.05, 0.25))
# This figure type does things differently based on whether the graph is
# of a compound alone or a compound +/- a perpetrator.
if(Eff_plusminus){
# This is when there is a perpetrator present and the graph is of the
# substrate or a substrate metabolite
## linear plot
A <- A +
geom_line(linewidth = ifelse(is.na(line_width), 0.5, line_width)) +
geom_line(data = sim_data_mean %>%
filter(Trial %in% c("per5", "per95")),
alpha = AlphaToUse,
linewidth = ifelse(is.na(line_width), 0.5, line_width))
} else {
# This is when there is no perpetrator present or the graph is of the
# perpetrator or a perpetrator metabolite.
## linear plot
if(figure_type == "freddy"){
A <- A +
geom_line(alpha = AlphaToUse,
linewidth = ifelse(is.na(line_width), 0.5, line_width)) +
geom_line(data = sim_data_mean %>%
filter(Trial == MyMeanType),
linewidth = ifelse(is.na(line_width), 0.5, line_width)) +
geom_line(data = sim_data_mean %>%
filter(Trial %in% c("per5", "per95")),
linetype = line_type[2],
alpha = 1,
color = line_color[2])
} else if(figure_type == "compound summary"){
A <- A +
geom_line(alpha = AlphaToUse,
linewidth = ifelse(is.na(line_width), 0.5, line_width),
linetype = line_type[1],
color = "black",
show.legend = FALSE) +
geom_line(data = sim_data_mean %>%
filter(Trial == MyMeanType),
color = "black", alpha = 1,
linewidth = ifelse(is.na(line_width), 0.5, line_width),
linetype = line_type[1],
show.legend = FALSE) +
geom_line(data = sim_data_mean %>%
filter(Trial %in% c("per5", "per95")),
linetype = line_type[2],
alpha = 1,
color = "black",
show.legend = FALSE)
}
}
}
## figure_type: means only -----------------------------------------------------------
if(figure_type == "means only"){
A <- A +
geom_line(linewidth = ifelse(is.na(line_width), 1, line_width))
}
# Setting colors, linetypes, etc. -------------------------------------
# Naming the linetypes, colors, fills, and shapes b/c otherwise having
# trouble with order changing between when lines are plotted and when
# observed data are added. I think this is a ggplot2 bug.
if(length(unique(Data$Inhibitor)) > 1){
names(line_type) <- levels(Data$Inhibitor)
names(line_color) <- levels(Data$Inhibitor)
} else if(figure_type == "compound summary"){
names(obs_color) <- unique(obs_dataframe$Study)
names(obs_shape) <- unique(obs_dataframe$Study)
} else {
names(line_type) <- unique(Data$Inhibitor)
names(line_color) <- unique(Data$Inhibitor)
}
if(figure_type != "compound summary"){
A <- A +
scale_linetype_manual(values = line_type) +
scale_color_manual(values = line_color) +
scale_fill_manual(values = line_color)
} else {
A <- A +
scale_color_manual(values = obs_color) +
scale_shape_manual(values = obs_shape) +
scale_fill_manual(values = obs_color)
}
# Observed data on top ------------------------------------------------------
if(nrow(obs_dataframe) > 0 & obs_on_top){
MapObsData <- all(is.na(obs_color_user)) &
figure_type %in% c("freddy") == FALSE
A <- addObsPoints(obs_dataframe = obs_dataframe,
A = A,
AES = switch(figure_type,
"percentiles" = "linetype",
"trial means" = "linetype",
"percentile ribbon" = "linetype",
"compound summary" = "color",
"freddy" = "linetype",
"means only" = "linetype"),
obs_shape = obs_shape,
obs_shape_user = obs_shape_user,
obs_size = obs_size,
obs_color = obs_color,
obs_color_user = obs_color_user,
obs_line_trans = obs_line_trans,
obs_line_trans_user = obs_line_trans_user,
obs_fill_trans = obs_fill_trans,
obs_fill_trans_user = obs_fill_trans_user,
connect_obs_points = connect_obs_points,
line_width = line_width,
figure_type = figure_type,
MapObsData = MapObsData,
LegCheck = TRUE)
}
# Applying aesthetics ------------------------------------------------
## Making linear graph -------------------------------------------------
if(nrow(obs_dataframe) == 0){
A <- A + guides(shape = "none")
} else {
if("SD_SE" %in% names(obs_dataframe) & include_errorbars){
if(figure_type == "percentile ribbon"){
A <- A + geom_errorbar(data = obs_dataframe %>% rename(MyMean = Conc),
aes(ymin = MyMean - SD_SE, ymax = MyMean + SD_SE),
width = errorbar_width)
} else {
A <- A + geom_errorbar(data = obs_dataframe,
aes(ymin = Conc - SD_SE, ymax = Conc + SD_SE),
width = errorbar_width)
}
}
}
if(str_detect(figure_type, "ribbon")){
# There's a known glitch w/ggplot2 with coord_cartesian and
# geom_ribbon. Hacking around that.
A <- A +
scale_x_time(time_range = time_range_relative,
x_axis_interval = x_axis_interval,
time_units = TimeUnits,
pad_x_axis = pad_x_axis)
if(EnzPlot){
A <- A +
scale_y_continuous(limits = c(ifelse(is.na(y_axis_limits_lin[1]),
0, y_axis_limits_lin[1]),
YmaxRnd),
labels = scales::percent,
expand = expansion(mult = pad_y_num))
} else {
A <- A +
scale_y_continuous(limits = c(ifelse(is.na(y_axis_limits_lin[1]),
0, y_axis_limits_lin[1]),
YmaxRnd),
breaks = YBreaks,
labels = YLabels,
expand = expansion(mult = pad_y_num))
}
} else {
A <- A +
coord_cartesian(xlim = time_range_relative,
ylim = c(ifelse(is.na(y_axis_limits_lin[1]),
0, y_axis_limits_lin[1]),
YmaxRnd)) +
scale_x_time(time_range = time_range_relative,
x_axis_interval = x_axis_interval,
time_units = TimeUnits,
pad_x_axis = pad_x_axis)
if(EnzPlot){
A <- A +
scale_y_continuous(labels = scales::percent,
expand = expansion(mult = pad_y_num))
} else {
A <- A +
scale_y_continuous(breaks = YBreaks,
labels = YLabels,
expand = expansion(mult = pad_y_num))
}
}
if((class(y_axis_label) == "character" && complete.cases(y_axis_label)) |
(class(y_axis_label) == "expression" && length(y_axis_label) > 0)){
ylab <- y_axis_label
} else if(EnzPlot){
ylab <- paste("Relative",
ifelse(unique(ct_dataframe$Tissue) == "liver",
"hepatic", unique(ct_dataframe$Tissue)),
unique(ct_dataframe$Enzyme),
"abundance")
}
if((class(x_axis_label) == "character" && complete.cases(x_axis_label)) |
(class(x_axis_label) == "expression" && length(x_axis_label) > 0)){
xlab <- x_axis_label
}
A <- A +
labs(x = xlab, y = ylab,
linetype = case_when(complete.cases(legend_label) ~ legend_label,
.default = "Inhibitor"),
shape = case_when(complete.cases(legend_label) ~ legend_label,
figure_type == "compound summary" ~ "Study",
.default = "Inhibitor"),
color = case_when(complete.cases(legend_label) ~ legend_label,
figure_type == "compound summary" ~ "Study",
.default = "Inhibitor"),
fill = case_when(complete.cases(legend_label) ~ legend_label,
figure_type == "compound summary" ~ "Study",
.default = "Inhibitor")) +
theme_consultancy()
# If the user didn't want the legend or if the graph is of a perpetrator,
# remove legend.
if(legend_position == "none" | MyCompoundID %in% c("inhibitor 1", "inhibitor 2",
"inhibitor 1 metabolite")){
A <- A + theme(legend.position = "none")
} else {
# Otherwise, make the legend a little wider to actually show any dashes
A <- A + theme(legend.position = legend_position,
legend.key.width = unit(2, "lines"),
legend.direction = legend_orientation)
}
# When the y label is an expression, it tends to be a little too small. Make
# it 1.25 * larger. If it's an expression, that also means that it can't be
# bold. Make the x axis title not bold as well in that case.
if("expression" %in% class(ylab)){
A <- A + theme(axis.title.y = element_text(size = A$theme$text$size * 1.25),
axis.title.x = element_text(face = "plain"))
}
## Making semi-log graph ------------------------------------------------
if(EnzPlot){
LowConc <- ct_dataframe %>% filter(Trial %in% c("mean", "per5", "per95") &
Time > 0 &
Abundance < Ylim_log[1]) %>%
pull(Abundance)
} else {
LowConc <- ct_dataframe %>% filter(Trial %in% c("mean", "per5", "per95") &
Time > 0 &
Conc < Ylim_log[1]) %>%
pull(Conc)
}
if(length(LowConc) > 0 & str_detect(figure_type, "ribbon") &
linear_or_log %in% c("both", "both vertical", "both horizontal", "semi-log", "log")){
warning(wrapn("When plotting a `percentile ribbon` graph with low concentrations, if the ribbon looks disjointed or even not present at all, please try setting the graphics backend to `AGG`. See the help file for details."),
call. = FALSE)
}
suppressWarnings(suppressMessages(
B <- A + coord_cartesian(xlim = time_range_relative,
ylim = Ylim_log)))
if(EnzPlot){
suppressWarnings(suppressMessages(
withCallingHandlers({
B <- B + scale_y_log10(labels = scales::percent,
expand = expansion(mult = pad_y_num))
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
} else {
suppressWarnings(suppressMessages(
withCallingHandlers({
B <- B + scale_y_log10(breaks = YLogBreaks,
labels = YLogLabels,
expand = expansion(mult = pad_y_num))
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
}
if(graph_labels){
labels <- "AUTO"
} else {
labels <- NULL
}
# both plots together, aligned vertically
if(MyCompoundID %in% c("inhibitor 1", "inhibitor 2",
"inhibitor 1 metabolite")){
suppressWarnings(suppressMessages(
withCallingHandlers({
AB <- ggpubr::ggarrange(A, B, ncol = 1,
labels = labels,
font.label = list(size = graph_title_size),
align = "v")
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
suppressWarnings(suppressMessages(
withCallingHandlers({
ABhoriz <- ggpubr::ggarrange(A, B, ncol = 2,
labels = labels,
font.label = list(size = graph_title_size),
align = "hv")
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
} else {
# If the user didn't want the legend or if the graph is of Inhibitor1,
# remove legend.
if(legend_position == "none" |
MyCompoundID %in% c("inhibitor 1", "inhibitor 2",
"inhibitor 1 metabolite")){
suppressWarnings(suppressMessages(
withCallingHandlers({
AB <- ggpubr::ggarrange(A, B, ncol = 1,
labels = labels,
font.label = list(size = graph_title_size),
legend = "none", align = "hv")
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
suppressWarnings(suppressMessages(
withCallingHandlers({
ABhoriz <- ggpubr::ggarrange(A, B, ncol = 2,
labels = labels,
font.label = list(size = graph_title_size),
legend = "none", align = "hv")
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
} else {
suppressWarnings(suppressMessages(
withCallingHandlers({
AB <- ggpubr::ggarrange(A, B, ncol = 1,
labels = labels,
font.label = list(size = graph_title_size),
common.legend = TRUE, legend = legend_position,
align = "hv")
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
suppressWarnings(suppressMessages(
withCallingHandlers({
ABhoriz <- ggpubr::ggarrange(A, B, ncol = 2,
labels = labels,
font.label = list(size = graph_title_size),
common.legend = TRUE, legend = legend_position,
align = "hv")
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
}
}
if(complete.cases(graph_title)){
A <- A + ggtitle(graph_title) +
theme(plot.title = element_text(hjust = 0.5, size = graph_title_size),
plot.title.position = "panel")
B <- B + ggtitle(graph_title) +
theme(plot.title = element_text(hjust = 0.5, size = graph_title_size),
plot.title.position = "panel")
AB <- ggpubr::annotate_figure(
AB, top = ggpubr::text_grob(graph_title, hjust = 0.5,
face = "bold", size = graph_title_size))
ABhoriz <- ggpubr::annotate_figure(
ABhoriz, top = ggpubr::text_grob(graph_title, hjust = 0.5,
face = "bold", size = graph_title_size))
}
Out <- list("graph" = switch(linear_or_log,
"linear" = A,
"semi-log" = B,
"log" = B,
"both" = AB,
"both vertical" = AB,
"both horizontal" = ABhoriz,
"horizontal and vertical" = AB))
if(qc_graph){
QCTable <- formatTable_Simcyp(
annotateDetails(Deets, detail_set = "Methods") %>%
select(-c(SimulatorSection, Sheet, Notes, CompoundID, Compound)),
shading_column = Detail)
# Out would have been just the graph or just the two arranged graphs at
# this point, so need to convert it to a list here.
Out[["QCgraph"]] <- ggpubr::ggarrange(
plotlist = list(Out, flextable::gen_grob(QCTable)),
font.label = list(size = graph_title_size))
}
# Setting up figure caption --------------------------------------------
PlotType <- case_when(EnzPlot == TRUE ~ "enzyme-abundance",
# ReleaseProfPlot == TRUE ~ "release-profile",
# DissolutionProfPlot == TRUE ~ "dissolution-profile",
TRUE ~ "concentration-time")
FigText <- make_ct_caption(ct_dataframe = Data,
single_or_multiple_profiles = "single",
existing_exp_details = existing_exp_details,
mean_type = mean_type,
linear_or_log = linear_or_log,
figure_type = figure_type,
plot_type = PlotType,
name_clinical_study = name_clinical_study,
prettify_compound_names = prettify_compound_names,
hline_position = hline_position,
vline_position = vline_position,
hline_style = hline_style,
vline_style = vline_style)
# Saving -----------------------------------------------------------------
if(complete.cases(save_graph)){
# Checking for NA for fig_height and width
if(is.na(fig_height)){
fig_height <- switch(linear_or_log,
"linear" = 4,
"log" = 4,
"semi-log" = 4,
"both" = 6,
"both vertical" = 6,
"both horizontal" = 3.5,
"horizontal and vertical" = 3.5)
}
if(is.na(fig_width)){
fig_width <- switch(linear_or_log,
"linear" = 4.75,
"log" = 4.75,
"semi-log" = 4.75,
"both" = 5,
"both vertical" = 5,
"both horizontal" = 8,
"horizontal and vertical" = 8)
}
FileName <- save_graph
if(str_detect(FileName, "\\.")){
# Making sure they've got a good extension
Ext <- sub("\\.", "", str_extract(FileName, "\\..*"))
FileName <- sub(paste0(".", Ext), "", FileName)
if(Ext %in% c("eps", "ps", "jpeg", "tiff",
"png", "bmp", "svg", "jpg", "docx") == FALSE){
warning(wrapn(paste0("You have requested the graph's file extension be `",
Ext, "`, but we haven't set up that option. We'll save your graph as a `png` file instead.")),
call. = FALSE)
}
Ext <- ifelse(Ext %in% c("eps", "ps", "jpeg", "tiff",
"png", "bmp", "svg", "jpg", "docx"),
Ext, "png")
FileName <- paste0(FileName, ".", Ext)
} else {
FileName <- paste0(FileName, ".png")
Ext <- "png"
}
if(qc_graph & Ext != "docx"){
ggsave(sub(paste0("\\.", Ext), " - QC.png", FileName),
height = fig_height, width = fig_width * 2, dpi = 600,
plot = ggpubr::ggarrange(plotlist = list(Out$QCgraph),
nrow = 1))
}
if(Ext == "docx"){
if(linear_or_log == "horizontal and vertical"){
# Saving the horizontal version as a png file and the vertical
# version as a Word file lower down in this section of the
# script.
ggsave(sub(paste0("\\.", Ext), " - horizontal.png", FileName),
plot = ABhoriz, height = fig_height, width = fig_width, dpi = 600)
}
# This is when they want a Word file as output
OutPath <- dirname(FileName)
if(OutPath == "."){
OutPath <- getwd()
}
FileName <- basename(FileName)
if(exists("Deets", inherits = FALSE) &&
"character" %in% class(Deets)){
rm(Deets)
}
if(EnzPlot){
rmarkdown::render(system.file("rmarkdown/templates/enzyme-abundance-plot/skeleton/skeleton.Rmd",
package="SimcypConsultancy"),
output_dir = OutPath,
output_file = FileName,
quiet = TRUE)
} else {
rmarkdown::render(system.file("rmarkdown/templates/concentration-time-plots/skeleton/skeleton.Rmd",
package="SimcypConsultancy"),
output_dir = OutPath,
output_file = FileName,
quiet = TRUE)
# Note: The "system.file" part of the call means "go to where the
# package is installed, search for the file listed, and return its
# full path.
}
} else {
# This is when they want any kind of graphical file format.
if(linear_or_log %in% c("both", "both vertical")){
ggsave(FileName, height = fig_height, width = fig_width, dpi = 600,
plot = AB)
} else if(linear_or_log == "both horizontal"){
ggsave(FileName, height = fig_height, width = fig_width, dpi = 600,
plot = ABhoriz)
} else if(linear_or_log == "linear"){
ggsave(FileName, height = fig_height, width = fig_width, dpi = 600,
plot = A)
} else if(str_detect(linear_or_log, "log")){
ggsave(FileName, height = fig_height, width = fig_width, dpi = 600,
plot = B)
} else if(linear_or_log == "horizontal and vertical"){
ggsave(sub(paste0("\\.", Ext), paste0(" - vertical.", Ext), FileName),
plot = AB, height = 6, width = 5, dpi = 600)
ggsave(sub(paste0("\\.", Ext), paste0(" - horizontal.", Ext), FileName),
plot = ABhoriz, height = fig_height, width = fig_width, dpi = 600)
}
}
}
if(return_caption){
Out[["figure_heading"]] <- FigText$heading
Out[["figure_caption"]] <- FigText$caption
}
if(length(Out) == 1){
Out <- Out[[1]]
}
return(Out)
}
shirewoman2/Consultancy documentation built on Feb. 18, 2025, 10 p.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 ct_plot
Documented in ct_plot
#' Concentration-time plots to match Consultancy template
#'
#' @description Using observed and simulated concentration-time data generated
#' from the function \code{\link{extractConcTime}}, make publication-quality
#' graphs that comply with the Simcyp Consultancy Team's standards. We've
#' tried to include a fair number of options here for flexibility, but many of
#' the function arguments are optional; most of the time, you'll get
#' decent-looking graphs while only setting a minimal number of arguments.
#'
#' For detailed instructions and examples, please see the SharePoint file
#' "Simcyp PBPKConsult R Files - Simcyp PBPKConsult R Files/SimcypConsultancy
#' function examples and instructions/Concentration-time plots 1 - one sim at
#' a time/Concentration-time-plot-examples-1.docx". (Sorry, we are unable to
#' include a link to it here.)
#'
#' \strong{A few notes:} \enumerate{\item{Not all substrate metabolites,
#' inhibitors, or inhibitor metabolites are available in all tissues. If it's
#' not present in your output, we can't graph it here.}
#'
#' \item{If you have observed concentration-time data to match your simulated data
#' but you don't see those observed data on your graph, please check the help
#' file for the function you used -- either \code{\link{extractConcTime}} or
#' \code{\link{extractConcTime_mult}} -- to extract your data. Something has
#' likely gone wrong in the data extraction.}
#'
#' \item{If you attempt to use data generated by
#' \code{\link{extractConcTime_mult}} here, you can get weird results if you're
#' not careful to include only one tissue and one compound. If you see
#' something odd, try including the legend with, e.g., \code{legend_position =
#' "right"} to help decipher what might have gone awry. It can also be
#' informative to use the function \code{\link{ct_plot_overlay}} to make a
#' draft version of your graph because that function will give you some messages
#' about what data are included.}
#'
#' \item{If you want to plot enzyme abundance data, please see
#' \code{\link{enz_plot}} or \code{\link{enz_plot_overlay}}.}}
#'
#' @param ct_dataframe the input concentration-time data generated by running
#' the function \code{\link{extractConcTime}}. Not quoted.
#' @param Tissue_subtype Certain types of models have additional subtypes of
#' tissues. Currently, the SimcypConsultancy package supports ADAM-model and
#' brain-compartment tissue subtypes. In these scenarios, it's not sufficient
#' to say "colon" or "brain" because those tissues have multiple subtypes.
#' This is where you can specify which you want. Default is "free compound in
#' lumen" but is ignored when ct_dataframe doesn't contain ADAM data.
#' @param figure_type type of figure to plot. Options are:
#'
#' \describe{
#'
#' \item{"percentiles"}{(default) plots an opaque line for the mean data,
#' lighter lines for the 5th and 95th percentiles of the simulated data, and
#' open circles for the observed data. If an effecter were present, the
#' default is dashed lines for the data in the presence of a perpetrator.}
#'
#' \item{"trial means"}{plots an opaque line for the mean data, lighter lines
#' for the mean of each trial of simulated data, and open circles for the
#' observed data. If a perpetrator were present, lighter dashed lines indicate
#' the mean of each trial of simulated data in the presence of the perpetrator.}
#'
#' \item{"percentile ribbon"}{plots an opaque line for the mean data,
#' transparent shading for the 5th to 95th percentiles of the simulated data,
#' and open circles for the observed data. If a perpetrator were present, the
#' default is to show the data without the perpetrator in blue and the data in
#' the presence of the perpetrator in red. \strong{NOTE: There is a known bug
#' within RStudio that causes filled semi-transparent areas like you get with
#' the "percentile ribbon" figure type to NOT get graphed for certain versions
#' of RStudio.} To get around this, within RStudio, go to Tools --> Global
#' Options --> General --> Graphics --> And then set "Graphics device:
#' backend" to "AGG". Honestly, this is a better option for higher-quality
#' graphics anyway!}
#'
#' \item{"means only"}{plots a black line for the mean data and, if an
#' perpetrator was modeled, a dashed line for the concentration-time data with
#' Inhibitor 1.}
#'
#' \item{"Freddy"}{Freddy's favorite style of plot with trial means in light
#' gray, the overall mean in thicker black, the 5th and 95th percentiles in
#' dashed lines, and the observed data in semi-transparent purple-blue. Graphs
#' with a perpetrator present lose the trial means, and the percentiles switch
#' to solid, gray lines. \strong{An editorial comment:} While this does not
#' align with the officially sanctioned template at this time, this looks
#' \emph{sharp}, makes it easy to see the defining characteristics of the
#' data, and I recommend checking it out, even just for your own purposes of
#' examining your data. If the color is too much for you but you like the
#' rest, try setting \code{obs_color = "black", obs_shape = c(1, 2)}. -LSh}
#'
#' \item{"compound summary"}{matches the concentration-time plots in Simcyp
#' compound summary files. These are similar to "Freddy" types of graphs in
#' that they show the mean as a dark line, the trial means as lighter lines,
#' dashed lines for the 5th and 95th percentiles, but then they additionally
#' color observed points by a column titled "Study" that you will need to add
#' to your data. (And yes, it \emph{must} be titled "Study" exactly.)
#' Everything else in these graphs will be gray or black, but
#' you can specify the color of the observed points with the argument
#' "obs_color" and the shape of the points with the argument "obs_shape".}}
#'
#' @param mean_type graph "arithmetic" (default) or "geometric" means or
#' "median" for median concentrations. If that option was not included in the
#' output, you'll get a warning and the graph will include one that was.
#' @param time_range time range to show relative to the start of the simulation.
#' Options: \describe{
#'
#' \item{NA}{(default) entire time range of data}
#'
#' \item{a start time and end time in hours}{only data in that time range,
#' e.g. \code{c(24, 48)}. Note that there are no quotes around numeric data.}
#'
#' \item{"first dose"}{only the time range of the first dose}
#'
#' \item{"last dose"}{only the time range of the last dose}
#'
#' \item{"penultimate dose"}{only the time range of the 2nd-to-last dose,
#' which can be useful for BID data where the end of the simulation extended
#' past the dosing interval or data when the substrate was dosed BID and the
#' perpetrator was dosed QD}
#'
#' \item{a specific dose number with "dose" or "doses" as the prefix}{the time
#' range encompassing the requested doses, e.g., \code{time_range = "dose 3"}
#' for the 3rd dose or \code{time_range = "doses 1 to 4"} for doses 1 to 4}
#'
#' \item{a specific day number with "day" or "days" as the prefix}{the time
#' range encompassing the requested days, e.g., \code{time_range = "day 2"}
#' for the 24-hour period starting on day 2, e.g., 24-48 hours, or
#' \code{time_range = "days 1 to 4"} for the 4-day period from 0 to 96 hours}
#'
#' \item{"all obs" or "all observed" if you feel like spelling it out}{Time
#' range will be limited to only times when observed data are present.}
#'
#' \item{"last dose to last observed" or "last obs" for short}{Time range will
#' be limited to the start of the last dose until the last observed data
#' point.}
#'
#' \item{"last dose to end" or "last to end" for short}{Time range will
#' be limited to the start of the last dose until the end of the simulation.}
#' }
#'
#' @param t0 What event should be used for time zero? Options are: "simulation
#' start" (default), "dose 1", "penultimate dose", or "last dose". \emph{This
#' does not change which data are included in the graph;} instead, this
#' determines whether the x axis numbers are offset so that, e.g., the last
#' dose is administered at time 0.
#'
#' @param adjust_obs_time TRUE or FALSE (default) for whether to adjust the time
#' listed in the observed data file to match the last dose administered. This
#' only applies to multiple-dosing regimens. If TRUE, the graph will show the
#' observed data overlaid with the simulated data such that the dose in the
#' observed data was administered at the same time as the last dose in the
#' simulated data. If FALSE, the observed data will start at whatever times
#' are listed in the Excel file.
#' @param pad_x_axis optionally add a smidge of padding to the the x axis
#' (default is TRUE, which includes some generally reasonable padding). If
#' changed to FALSE, the y axis will be placed right at the beginning of your
#' time range and all data will end \emph{exactly} at the end of the time
#' range specified. If you want a \emph{specific} amount of x-axis padding,
#' set this to a number; the default is \code{c(0.02, 0.04)}, which adds 2\%
#' more space to the left side and 4\% more to the right side of the x axis.
#' If you only specify one number, we'll assume that's the percent you want
#' added to the left side.
#' @param pad_y_axis optionally add a smidge of padding to the y axis (default
#' is TRUE, which includes some generally reasonable padding). As with
#' \code{pad_x_axis}, if changed to FALSE, the x axis will be placed right at
#' the bottom of your data, possibly cutting a point in half. If you want a
#' \emph{specific} amount of y-axis padding, set this to a number; the default
#' is \code{c(0.02, 0)}, which adds 2\% more space to the bottom and nothing
#' to the top of the y axis. If you only specify one number, we'll assume
#' that's the percent you want added to the bottom.
#' @param x_axis_interval optionally set the x-axis major tick-mark interval.
#' Acceptable input: any number or leave as NA to accept default values, which
#' are generally reasonable guesses as to aesthetically pleasing and
#' PK-relevant intervals.
#' @param x_axis_label optionally supply a character vector or an expression to
#' use for the x axis label
#' @param y_axis_limits_lin optionally set the Y axis limits for the linear
#' plot, e.g., \code{c(10, 1000)}. If left as the default NA, the Y axis
#' limits for the linear plot will be automatically selected. (Setting up
#' semi-log plot y axis intervals manually is a bit tricky and is not
#' currently supported.)
#' @param y_axis_limits_log optionally set the Y axis limits for the semi-log
#' plot, e.g., \code{c(10, 1000)}. Values will be rounded down and up,
#' respectively, to a round number. If left as the default NA, the Y axis
#' limits for the semi-log plot will be automatically selected.
#' @param y_axis_interval set the linear y-axis major tick-mark interval.
#' Acceptable input: any number or leave as NA to accept default values, which
#' are generally reasonable guesses as to aesthetically pleasing intervals.
#' @param y_axis_label optionally supply a character vector or an expression to
#' use for the y axis label
#' @param obs_color If you would like the observed data points to be in color,
#' either specify a color here or leave this as NA to get all black points for
#' most graph types or, if you set something for \code{line_color}, whatever
#' colors were used for that, semi-transparent blue-purple for a figure_type
#' of "Freddy", or a different color for each study (you must have a column
#' titled "Study" in ct_dataframe for this to work) for a figure_type of
#' "compound summary". Setting this to "none" will remove observed data from
#' the graph. Hex color codes are also ok to use. If you've got a figure_type
#' of "compound summary", then you can specify each color you want or you can
#' call on one of the possible color sets: Options: \describe{
#'
#' \item{"default"}{a set of colors from Cynthia Brewer et al. from Penn State
#' that are friendly to those with red-green colorblindness. The first three
#' colors are green, orange, and purple. This can also be referred to as
#' "Brewer set 2". If there are only two unique values in the colorBy_column,
#' then Brewer set 1 will be used since red and blue are still easily
#' distinguishable but also more aesthetically pleasing than green and
#' orange.}
#'
#' \item{"Brewer set 1"}{colors selected from the Brewer palette "set 1". The
#' first three colors are red, blue, and green.}
#'
#' \item{"ggplot2 default"}{the default set of colors used in ggplot2 graphs
#' (ggplot2 is an R package for graphing.)}
#'
#' \item{"rainbow"}{colors selected from a rainbow palette. The default
#' palette is limited to something like 6 colors, so if you have more than
#' that, that's when this palette is most useful. It's \emph{not} very useful
#' when you only need a couple of colors.}
#'
#' \item{"blue-green"}{a set of blues fading into greens. This palette can be
#' especially useful if you are comparing a systematic change in some
#' continuous variable -- for example, increasing dose or predicting how a
#' change in intrinsic solubility will affect concentration-time profiles --
#' because the direction of the trend will be clear.}
#'
#' \item{"blues"}{a set of blues fading from sky to navy. Like
#' "blue-green", this palette can be especially useful if you are comparing a
#' systematic change in some continuous variable.}
#'
#' \item{"greens"}{a set of greens fading from chartreuse to forest. Great for showing
#' systematic changes in a continuous variable.}
#'
#' \item{"purples"}{a set of purples fading from lavender to aubergine. Great for showing
#' systematic changes in a continuous variable.}
#'
#' \item{"reds"}{a set of reds from pink to brick. Great for showing
#' systematic changes in a continuous variable.}
#'
#' \item{"Tableau"}{uses the standard Tableau palette; requires the "ggthemes"
#' package}
#'
#' \item{"viridis"}{from the eponymous package by Simon Garnier and ranges
#' colors from purple to blue to green to yellow in a manner that is
#' "printer-friendly, perceptually uniform and easy to read by those with
#' colorblindness", according to the package author}
#'
#' \item{a character vector of colors}{If you'd prefer to set all the colors
#' yourself to \emph{exactly} the colors you want, you can specify those
#' colors here. An example of how the syntax should look: \code{color_set =
#' c("dodgerblue3", "purple", "#D8212D")} or, if you want to specify exactly
#' which item in \code{colorBy_column} gets which color, you can supply a
#' named vector. For example, if you're coloring the lines by the compound ID,
#' you could do this: \code{color_set = c("substrate" = "dodgerblue3",
#' "inhibitor 1" = "purple", "primary metabolite 1" = "#D8212D")}. If you'd
#' like help creating a specific gradation of colors, please talk to a member
#' of the R Working Group about how to do that using
#' \link{colorRampPalette}.}}
#'
#' @param obs_shape optionally specify what shapes are used to depict observed
#' data for 1. the substrate drug alone and 2. the substrate drug in the
#' presence of a perpetrator. Input should look like this, for example:
#' \code{c(1, 2)} to get an open circle and an open triangle. To see all the
#' possible shapes and what number corresponds to which shape, type
#' \code{ggpubr::show_point_shapes()} into the console. If left as NA,
#' substrate alone will be an open circle and substrate + inhibitor 1 will be
#' an open triangle.
#' @param obs_size optionally specify the size of the points to use for the
#' observed data. If left as NA, the size will be 2.
#' @param obs_fill_trans optionally specify the transparency for the fill of the
#' observed data points, which can be helpful when you have a lot of points
#' overlapping. This only applies when you have specified a value for
#' \code{obs_color} since, for most of the graph types, the observed data is
#' depicted as an open circle by default. Acceptable values are from 0 (fully
#' transparent, so no fill at all) to 1 (completely opaque or black). If left
#' as the default NA, the observed data points will be 50% transparent, so the
#' same as if this were set to 0.5.
#' @param obs_line_trans optionally specify the transparency for the outline of
#' the observed data points, which can be helpful when you have a lot of
#' points overlapping. Acceptable values are from 0 (fully transparent, so no
#' line at all) to 1 (completely opaque or black). If left as the default NA,
#' the observed data points will be opaque, so the same as if this were set to
#' 1.
#' @param connect_obs_points TRUE or FALSE (default) for whether to add
#' connecting lines between observed data points from the same individual
#' @param obs_on_top TRUE (default) or FALSE for whether to show the observed
#' data on top of the simulated data. If FALSE, the simulated data will be on
#' top.
#' @param include_errorbars TRUE or FALSE (default) for whether to include error
#' bars for observed data points. This ONLY applies when you have supplied
#' observed data from V22 or higher because those data files included a column
#' titled "SD/SE", which is what we'll use for determining the error bar
#' heights.
#' @param errorbar_width width of error bars to use in hours (or, if you've used
#' some other time unit, in whatever units are in your data). Default is 0.5.
#' @param showBLQ TRUE or FALSE (default) to display observed concentrations
#' that were clearly below the lower limit of quantitation, that is,
#' concentrations equal to 0 after time 0. The default (FALSE) removes these
#' values so that they will not show up on graphs.
#' @param line_transparency optionally specify the transparency for the trial
#' mean or percentile lines. Acceptable values are from 0 (fully transparent,
#' so no line at all) to 1 (completely opaque or black). If left as the
#' default NA, this value will be automatically determined.
#' @param line_type Optionally specify what types of lines are used to depict
#' \enumerate{\item{the substrate drug alone and} \item{the substrate drug in
#' the presence of a perpetrator (when applicable).}} Input should look like
#' this, for example: \code{c("solid", "dashed")} to get a solid line for the
#' substrate drug and a dashed line for inhibitor 1. \itemize{ \item{To see
#' all possible \code{line_type} options: \code{ggpubr::show_line_types()}}
#' \item{If left as NA, substrate alone will be a solid line and substrate +
#' inhibitor 1 will be a dashed line.} \item{If \code{figure_type} is "Freddy"
#' and there's no perpetrator present, which is a slightly different scenario
#' than the other graph types, the 1st line type specified will be for the
#' mean simulated concentration and the trial means, and the 2nd line type
#' specified will be for the 5th and 95th percentiles.}}
#' @param line_color optionally specify what colors to use for the lines.
#' Acceptable input for, e.g., the substrate alone to be blue and the
#' substrate + Inhibitor 1 to be red: \code{c("blue", "red")}. If left as the
#' default NA, lines will be black or gray. Hex color codes are also
#' acceptable to use.
#' @param line_width optionally specify how thick to make the lines. Acceptable
#' input is a number; the default is 1 for most lines and 0.8 for some, to
#' give you an idea of where to start.
#' @param hline_position numerical position(s) of any horizontal lines to add to
#' the graph. The default is NA to have no lines, and good syntax if you
#' \emph{do} want lines would be, for example, \code{hline_position = 10} to
#' have a horizontal line at 10 ng/mL (or whatever your concentration units
#' are) or \code{hline_position = c(10, 100, 1000)} to have horizontal lines
#' at each of those y values. Examples of where this might be useful would be
#' to indicate a toxicity threshold, a target Cmin, or the lower limit of
#' quantification for the assay used to generate the concentration-time data.
#' @param hline_style the line color and type to use for any horizontal lines
#' that you add to the graph with \code{hline_position}. Default is "red
#' dotted", but any combination of 1) a color in R and 2) a named linetype is
#' acceptable. Examples: "red dotted", "blue dashed", or "#FFBE33 longdash".
#' To see all the possible linetypes, type \code{ggpubr::show_line_types()}
#' into the console.
#' @param vline_position numerical position(s) of any vertical lines to add to
#' the graph. The default is NA to have no lines, and good syntax if you
#' \emph{do} want lines would be, for example, \code{vline_position = 12} to
#' have a vertical line at 12 h or \code{vline_position = seq(from = 0, to =
#' 168, by = 24)} to have horizontal lines every 24 hours for one week.
#' Examples of where this might be useful would be indicating dosing times or
#' the time at which some other drug was started or stopped.
#' @param vline_style the line color and type to use for any vertical lines that
#' you add to the graph with \code{vline_position}. Default is "red dotted",
#' but any combination of 1) a color in R and 2) a named linetype is
#' acceptable. Examples: "red dotted", "blue dashed", or "#FFBE33 longdash".
#' To see all the possible linetypes, type \code{ggpubr::show_line_types()}
#' into the console.
#' @param graph_labels TRUE or FALSE for whether to include labels (A, B, C,
#' etc.) for each of the small graphs. (Not applicable if only outputting
#' linear or only semi-log graphs.)
#' @param graph_title optionally specify a title that will be centered across
#' your graph or set of graphs
#' @param graph_title_size the font size for the graph title if it's included;
#' default is 14. This also determines the font size of the graph labels.
#' @param legend_label optionally indicate on the legend whether the perpetrator
#' is an inhibitor, inducer, activator, or suppressor. Input will be used as
#' the label in the legend for the line style and the shape. If left as the
#' default NA when a legend is included and a perpetrator is present, the
#' label in the legend will be "Inhibitor".
#' @param legend_orientation optionally specify how the legend entries should be
#' oriented. Options are "vertical" or "horizontal", and, if left as NA, the
#' legend entries will be "vertical" when the legend is on the left or right
#' and "horizontal" when it's on the top or bottom.
#' @param prettify_compound_names TRUE (default), FALSE or a character vector:
#' This is asking whether to make compound names prettier in legend entries
#' and in any Word output files. This was designed for simulations where the
#' substrate and any metabolites, perpetrators, or perpetrator metabolites are
#' among the standard options for the simulator, and leaving
#' \code{prettify_compound_names = TRUE} will make the name of those compounds
#' something more human readable. For example, "SV-Rifampicin-MD" will become
#' "rifampicin", and "Sim-Midazolam" will become "midazolam". Setting this to
#' FALSE will leave the compound names as is. For an approach with more
#' control over what the compound names will look like in legends and Word
#' output, set each compound to the exact name you want with a named
#' character vector where the names are "substrate" and, as applicable,
#' "perpetrator" and the values are the names you want, e.g.,
#' \code{prettify_compound_names = c("perpetrator" = "teeswiftavir",
#' "substrate" = "superstatin")}. Please note that "perpetrator" includes
#' \emph{all} the perpetrators and perpetrator metabolites present, so, if
#' you're setting the perpetrator name, you really should use something like
#' this if you're including perpetrator metabolites: \code{prettify_compound_names =
#' c("perpetrator" = "teeswiftavir and 1-OH-teeswiftavir", "substrate" =
#' "superstatin")}.
#' @param linear_or_log the type of graph to be returned. Options: \describe{
#' \item{"semi-log"}{y axis is log transformed}
#'
#' \item{"linear"}{no axis transformation}
#'
#' \item{"both vertical"}{(default) both the linear and the semi-log graphs
#' will be returned, and graphs are stacked vertically}
#'
#' \item{"both horizontal"}{both the linear and the semi-log graphs will be
#' returned, and graphs are side by side horizontally}
#'
#' \item{"horizontal and vertical"}{both the linear and the semi-log graphs
#' will be returned, and graphs are side by side horizontally (one graph; file
#' name will end in "- horizontal") and stacked vertically (second graph; file
#' name will end in "- vertical"). This option, which was designed to create
#' the vertically stacked version of a graph for a report and the horizontal,
#' side-by-side version for a presentation, is a bit different from the others
#' since it will return two separate files. In the RStudio "Plots" window,
#' you'll only see the vertically stacked version. Setting \code{fig_height}
#' and \code{fig_width} will adjust only the dimensions of the horizontal
#' figure; the default values will be used for the vertical one. If you
#' request Word output, only the vertical plot will be saved in Word format;
#' the horizontal plot will be saved as a png file.}}
#' @param legend_position specify where you want the legend to be. Options are
#' "left", "right", "bottom", "top", or "none" (default) if you don't want one
#' at all.
#' @param qc_graph TRUE or FALSE (default) on whether to create a second copy of
#' the graph where the left panel shows the original graph and the right panel
#' shows information about the simulation trial design. This works MUCH faster
#' when you have already used \code{\link{extractExpDetails_mult}} to get
#' information about how your simulation or simulations were set up and supply
#' that object to the argument \code{existing_exp_details}.
#' @param existing_exp_details output from \code{\link{extractExpDetails}} or
#' \code{\link{extractExpDetails_mult}} to be used for creating figure
#' headings and captions tailored to the specific simulation when saving to a
#' Word file or for use with \code{qc_graph}
#' @param return_caption TRUE or FALSE (default) for whether to return any
#' caption text to use with the graph. This works best if you supply something
#' for the argument \code{existing_exp_details}. If set to TRUE, you'll get as
#' output a list of the graph, the figure heading, and the figure caption.
#' @param save_graph optionally save the output graph by supplying a file name
#' in quotes here, e.g., "My conc time graph.png" or "My conc time
#' graph.docx". The nice thing about saving to Word is that the figure title
#' and caption text will be filled in automatically. If you leave off ".png"
#' or ".docx", the graph will be saved as a png file, but if you specify a
#' different graphical file extension, it will be saved as that file format.
#' Acceptable graphical file extensions are "eps", "ps", "jpeg", "jpg",
#' "tiff", "png", "bmp", or "svg". Do not include any slashes, dollar signs,
#' or periods in the file name. Leaving this as NA means the file will not be
#' saved to disk.
#' @param fig_height figure height in inches
#' @param fig_width figure width in inches
#' @param time_units_to_use time units to use for graphs. If left as NA, the
#' time units in the source data will be used. Options are "hours", "minutes",
#' "days", or "weeks".
#' @param conc_units_to_use concentration units to use for graphs. If left as
#' NA, the concentration units in the source data will be used. Acceptable
#' options are "mg/L", "mg/mL", "µg/L" (or "ug/L"), "µg/mL" (or "ug/mL"),
#' "ng/L", "ng/mL", "µM" (or "uM"), or "nM". If you want to use a molar
#' concentration and your source data were in mass per volume units or vice
#' versa, you'll need to provide something for the argument
#' \code{existing_exp_details}.
#' @param subsection_ADAM SOON TO BE DEPRECATED. We have now added
#' non-ADAM-model tissues to the subtypes of tissues you can extract from
#' Simulator output, so the old "subsection_ADAM" name we had used for which
#' subtype of tissue it was no longer works as well. Please use
#' "Tissue_subtype" instead going forward.
#' @param name_clinical_study optionally specify the name(s) of the clinical
#' study or studies for any observed data. This only affects the caption of
#' the graph. For example, specifying \code{name_clinical_study = "101, fed
#' cohort"} will result in a figure caption that reads in part "clinical study
#' 101, fed cohort". If you have more than one study, that's fine; we'll take
#' care of stringing them together appropriately. Just list them as a
#' character vector, e.g., \code{name_clinical_study = c("101",
#' "102", "103")} will become "clinical studies 101, 102, and 103."
#' @param study_design_matches_obs optionally specify whether the study design
#' for the simulated data matched that of any observed data. This only affects
#' the caption of the graph. If set to TRUE, this assumes that the number of
#' subjects in the clinical study matches the number of subjects per trial in
#' the simulated data.
#'
#' @return Output is a ggplot2 graph or two ggplot2 graphs arranged with
#' ggpubr::ggarrange()
#' @export
#'
#' @examples
#' # Load some concentration-time data to play with:
#' data(LMVct)
#'
#' ct_plot(ct_dataframe = LMVct)
#' ct_plot(ct_dataframe = LMVct, figure_type = "percentiles")
#' ct_plot(ct_dataframe = LMVct)
#' ct_plot(ct_dataframe = LMVct)
#'
#' # Perhaps you don't want to show *all* the data but instead want to
#' # limit the time interval that is graphed. Use `time_range` here:
#' ct_plot(ct_dataframe = LMVct, time_range = c(0, 24))
#'
#' # Or you can let it automatically calculate the time frame
#' # for a given set of doses
#' ct_plot(ct_dataframe = LMVct
#' time_range = "first dose")
#' ct_plot(ct_dataframe = LMVct,
#' time_range = "last dose")
#'
#' # The default graph may be too busy when Inhibitor 1 is present,
#' # so you may want to consider only plotting means as an alternative:
#' ct_plot(ct_dataframe = LMVct,
#' figure_type = "means only")
#'
#' # Add some further options for the look of your graph -- especially useful
#' # if the default settings are clipping your data.
#' ct_plot(ct_dataframe = LMVct,
#' obs_color = "red",
#' line_color = "blue",
#' y_axis_limits_log = c(50, 2000),
#' pad_x_axis = TRUE,
#' legend_label = "Inhibitor")
ct_plot <- function(ct_dataframe = NA,
figure_type = "percentiles",
Tissue_subtype = NA,
mean_type = "arithmetic",
time_range = NA,
x_axis_interval = NA,
x_axis_label = NA,
time_units_to_use = NA,
pad_x_axis = TRUE,
pad_y_axis = TRUE,
adjust_obs_time = FALSE,
t0 = "simulation start",
y_axis_limits_lin = NA,
y_axis_limits_log = NA,
y_axis_interval = NA,
y_axis_label = NA,
conc_units_to_use = NA,
obs_color = NA,
obs_shape = NA,
obs_size = NA,
obs_fill_trans = NA,
obs_line_trans = NA,
connect_obs_points = FALSE,
obs_on_top = TRUE,
include_errorbars = FALSE,
errorbar_width = 0.5,
showBLQ = FALSE,
line_type = NA,
line_transparency = NA,
line_color = NA,
line_width = NA,
hline_position = NA,
hline_style = "red dotted",
vline_position = NA,
vline_style = "red dotted",
legend_position = "none",
legend_orientation = NA,
legend_label = NA,
prettify_compound_names = TRUE,
linear_or_log = "both vertical",
graph_labels = TRUE,
graph_title = NA,
graph_title_size = 14,
qc_graph = FALSE,
existing_exp_details = NA,
return_caption = FALSE,
name_clinical_study = NA,
save_graph = NA,
fig_height = NA,
fig_width = NA,
subsection_ADAM = "deprecated"){
# Error catching ----------------------------------------------------------
# Check whether tidyverse is loaded
if("package:tidyverse" %in% search() == FALSE){
stop("The SimcypConsultancy R package requires the package tidyverse to be loaded, and it doesn't appear to be loaded yet. Please run\nlibrary(tidyverse)\n ...and then try again.",
call. = FALSE)
}
# Noting whether this is an enzyme-abundance plot b/c some options change
# then.
EnzPlot <- all(c("Enzyme", "Abundance") %in% names(ct_dataframe))
if(nrow(ct_dataframe) == 0){
stop(paste0("Please check your input. The data.frame you supplied for ",
ifelse(EnzPlot, "sim_enz_dataframe", "ct_dataframe"),
" doesn't have any rows."),
call. = FALSE)
}
if("character" %in% class(subsection_ADAM) == FALSE ||
all(subsection_ADAM == "deprecated") == FALSE){
warning(wrapn("The argument 'subsection_ADAM' is soon to be deprecated. We have now added non-ADAM-model tissues as subtypes of tissues availble, so the old 'subsection_ADAM' name we had used for which subtype of tissue it was no longer works as well. Please use 'Tissue_subtype' instead going forward."),
call. = FALSE)
}
if(length(sort(unique(ct_dataframe$File[ct_dataframe$Simulated == TRUE]))) > 1){
stop(paste0("The ct_plot function is for graphing only one simulator file at a time, but you have ",
length(sort(unique(ct_dataframe$File))),
" simulator files. Please use ct_plot_overlay or ct_plot_mult for making graphs with this data.frame."),
call. = FALSE)
}
# NB: Allowing more than one file for observed data here so that the user
# doesn't need to mess with it.
if(length(sort(unique(ct_dataframe$Tissue))) > 1){
stop(paste0("The ct_plot function is for graphing only one tissue at a time, but you have ",
length(sort(unique(ct_dataframe$Tissue))),
" tissues. Please use ct_plot_overlay or ct_plot_mult for making graphs with this data.frame."),
call. = FALSE)
}
# Checking for good input for prettify_compound_names.
if("character" %in% class(prettify_compound_names) &&
any(is.null(names(prettify_compound_names)))){
if(length(unique(ct_dataframe$CompoundID)) == 1){
names(prettify_compound_names) <- unique(ct_dataframe$CompoundID)
} else {
warning(wrapn("We're not sure what you wanted for the argument `prettify_compound_names` because we were expecting a TRUE or FALSE or a named character vector, and that's not what you have supplied. Please check the help file for appropriate values for `prettify_compound_names`. For now, we'll set this to TRUE, the default."),
call. = FALSE)
prettify_compounds_names <- TRUE
}
}
if("character" %in% class(prettify_compound_names)){
names(prettify_compound_names) <- tolower(names(prettify_compound_names))
names(prettify_compound_names)[str_detect(names(prettify_compound_names), "inhibitor")] <- "perpetrator"
names(prettify_compound_names)[str_detect(names(prettify_compound_names), "inhib")] <- "perpetrator"
if("perpetrator" %in% names(prettify_compound_names) == FALSE &
any(ct_dataframe$Inhibitor != "none")){
prettify_compound_names <-
c(prettify_compound_names,
"perpetrator" = prettify_compound_name(
unique(ct_dataframe$Inhibitor[ct_dataframe$Inhibitor != "none"])))
}
if(EnzPlot == FALSE &&
("substrate" %in% names(prettify_compound_names) == FALSE &
any(ct_dataframe$CompoundID == "substrate"))){
prettify_compound_names <-
c(prettify_compound_names,
"perpetrator" = prettify_compound_name(
unique(ct_dataframe$Inhibitor[ct_dataframe$Inhibitor != "none"])))
}
}
# Checking whether user tried to include obs data directly from simulator
# output for a simulation that included anything other than substrate in
# plasma.
if(EnzPlot == FALSE && any(unique(ct_dataframe$CompoundID) == "UNKNOWN")){
return(
ggplot(data.frame(Problem = 1, DataFail = 1),
aes(y = Problem, x = DataFail)) +
xlab("Please check the help file for extractConcTime") +
theme(axis.title.x = element_text(size = 14, color = "red",
face = "italic")) +
annotate(geom = "text", x = 1, y = 1, size = 8,
color = "red",
label = "You have extracted observed\ndata from a simulator output\nfile, but the simulator doesn't\ninclude information on\nwhat compound it is or\nwhether a perpetrator was present.\nWe cannot make your graph.")
)
}
if(EnzPlot == FALSE && length(sort(unique(ct_dataframe$CompoundID))) > 1){
stop(paste0("The ct_plot function is for graphing only one compound at a time, but you have ",
length(sort(unique(ct_dataframe$CompoundID))),
" compounds. Please use ct_plot_overlay or ct_plot_mult for making graphs with this data.frame."),
call. = FALSE)
}
# Check whether they've specified anything for Tissue_subtype or if data
# only contain 1 value for Tissue_subtype.
if(EnzPlot == FALSE){
if("Tissue_subtype" %in% names(ct_dataframe)){
if(any(complete.cases(ct_dataframe$Tissue_subtype)) &
complete.cases(Tissue_subtype)){
if(length(unique(ct_dataframe$Tissue_subtype)) == 1 &&
unique(ct_dataframe$Tissue_subtype) != Tissue_subtype){
warning(wrapn(paste0("You requested the Tissue_subtype tissue ",
Tissue_subtype,
", but what's in your data is ",
unique(ct_dataframe$Tissue_subtype),
", so we'll use that instead.")),
call. = FALSE)
Tissue_subtype <- unique(ct_dataframe$Tissue_subtype)
}
} else {
Tissue_subtype <- unique(ct_dataframe$Tissue_subtype)
}
} else {
ct_dataframe$Tissue_subtype <- NA
}
if(length(Tissue_subtype) > 1){
Tissue_subtype <- Tissue_subtype[1]
warning(wrapn(paste0("You requested more than one value for Tissue_subtype, but we can only plot one with the ct_plot function. We'll set it to the 1st value we find in your data: ",
Tissue_subtype, ".")),
call. = FALSE)
}
}
# If user wants feces, use the British spelling even if they entered the
# American spelling.
Tissue_subtype <- sub("feces", "faeces", Tissue_subtype)
if(length(obs_color) > 1 & figure_type != "compound summary"){
warning(wrapn("The argument `obs_color` can only take one color, and you've specified more than that. Only the first color will be used."),
call. = FALSE)
obs_color <- obs_color[1]
}
# Making most character arguments lower case to avoid case sensitivity
figure_type <- tolower(figure_type) # LOWER CASE ONLY FROM HERE DOWN.
mean_type <- tolower(mean_type)[1]
legend_position <- tolower(legend_position)[1]
linear_or_log <- tolower(linear_or_log)[1]
if(str_detect(linear_or_log, "horiz") & str_detect(linear_or_log, "vert")){
linear_or_log <- "horizontal and vertical"
}
if(length(figure_type) != 1 |
figure_type %in% c("trial means", "percentiles", "trial percentiles",
"freddy", "means only", "overlay",
"percentile ribbon", "percentile ribbons",
"ribbon", "compound summary") == FALSE){
warning(wrapn("The only acceptable options for figure_type are `trial means`, `percentiles`, `percentile ribbon`, `means only`, `Freddy`, or `compound summary`. We'll set your graph type to `percentiles` for now."),
call. = FALSE)
figure_type <- "percentiles"
}
# Setting figure type to be exactly what it should be
figure_type <- ifelse(str_detect(figure_type, "percentile") &
!str_detect(figure_type, "ribbon"),
"percentiles", figure_type)
figure_type <- ifelse(str_detect(figure_type, "ribbon"),
"percentile ribbon", figure_type)
# Checking that data include Study column if the figure_type is "compound
# summary" b/c otherwise won't know how to color obs points.
if(figure_type == "compound summary" &
"Study" %in% names(ct_dataframe) == FALSE){
warning(wrapn("You have requested a figure type of 'compound summary' but have not included a column named 'Study' in your source data. We need that column to determine how to color the observed data points, so we'll have to make all the observed data points the same color."),
call. = FALSE)
figure_type <- "freddy"
}
# Now that figure type is set, adjusting the number of observed data colors
# and shapes to 1 if the figure type is anything other than "compound
# summary".
if(figure_type != "compound summary"){
obs_color <- obs_color[1]
obs_shape <- obs_shape[1]
}
if(("Compound" %in% names(ct_dataframe) && length(unique(ct_dataframe$Compound)) > 1) |
("CompoundID" %in% names(ct_dataframe) && length(unique(ct_dataframe$CompoundID)) > 1)){
stop("It looks like you have more than one kind of data here because you have multiple compounds. Did you perhaps mean to use the function ct_plot_overlay instead? Because this function has been set up to deal with only one dataset at a time, no graph can be made. Please check your data and try this function with only one dataset at a time.")
}
if(length(unique(ct_dataframe$Inhibitor)) > 2){
stop("It looks like you have more than one kind of data here because you have multiple sets of inhibitors. Did you perhaps mean to use the function ct_plot_overlay instead? Because this function has been set up to deal with only one dataset at a time, no graph can be made. Please check your data and try this function with only one dataset at a time.")
}
# If user wanted hline or vline added, check that they have specified
# argument correctly and set up the character vector of preferences.
HLineAES <- str_split(hline_style, pattern = " ")[[1]]
if(length(HLineAES) < 2 & any(complete.cases(hline_position))){
warning(wrapn("You requested that a horizontal line be added to the graph, but you've supplied input that doesn't work for `hline_style`. We'll set this to `red dotted` for now, but please check the help file to get what you want."),
call. = FALSE)
HLineAES <- c("red", "dotted")
}
VLineAES <- str_split(vline_style, pattern = " ")[[1]]
if(length(VLineAES) < 2 & any(complete.cases(vline_position))){
warning(wrapn("You requested that a vertical line be added to the graph, but you've supplied input that doesn't work for `vline_style`. We'll set this to `red dotted` for now, but please check the help file to get what you want."),
call. = FALSE)
VLineAES <- c("red", "dotted")
}
# This doesn't check that they've specified legit colors or linetypes, but
# I'm hoping that ggplot2 errors will cover that.
# Getting experimental details if they didn't supply them and want to have a
# QC graph
if(qc_graph == TRUE | "logical" %in% class(existing_exp_details) == FALSE){
if("logical" %in% class(existing_exp_details)){
Deets <- tryCatch(
extractExpDetails(sim_data_file = unique(ct_dataframe$File),
exp_details = "Summary and Input")[["MainDetails"]],
error = function(x) "missing file")
} else {
Deets <- harmonize_details(existing_exp_details)[["MainDetails"]] %>%
filter(File %in% unique(ct_dataframe$File))
if(nrow(Deets) == 0){
Deets <- tryCatch(
extractExpDetails(sim_data_file = unique(ct_dataframe$File),
exp_details = "Summary and Input")[["MainDetails"]],
error = function(x) "missing file")
}
}
if(qc_graph == TRUE &
(class(Deets)[1] == "character" || nrow(Deets) == 0)){
warning(wrapn("We couldn't find the source Excel file for this graph, so we can't QC it."),
call. = FALSE)
qc_graph <- FALSE
}
}
if(any(complete.cases(time_units_to_use))){
time_units_to_use <- tolower(time_units_to_use[1])
if(time_units_to_use %in% c("hours", "minutes", "days", "weeks") == FALSE){
warning(wrapn(paste0("You requested that the graph have time units of `",
time_units_to_use,
"`, which is not among the acceptable options. We'll use hours instead.")),
call. = FALSE)
time_units_to_use <- "hours"
}
}
if(any(complete.cases(conc_units_to_use))){
conc_units_to_use <- conc_units_to_use[1]
if(conc_units_to_use %in% c("mg/L", "mg/mL", "µg/L", "ug/L", "µg/mL",
"ug/mL", "ng/L", "ng/mL", "µM", "uM",
"nM") == FALSE){
warning(wrapn(paste0("You requested that the graph have concentration units of `",
conc_units_to_use,
"`, which is not among the acceptable options. We'll use ng/mL instead.")),
call. = FALSE)
conc_units_to_use <- "ng/mL"
}
}
legend_position <- tolower(legend_position)[1]
if(complete.cases(legend_position) &&
legend_position %in% c("left", "right", "bottom", "top", "none") == FALSE){
warning(wrapn("You have specified something for the legend position that is not among the possible options. We'll set it to 'right'."),
call. = FALSE)
legend_position <- "right"
}
legend_orientation <- tolower(legend_orientation)[1]
if((complete.cases(legend_orientation) & legend_position != "none") &&
legend_orientation %in% c("horizontal", "vertical") == FALSE){
legend_orientation <- case_when(legend_position %in% c("left", "right", "none") ~ "vertical",
.default = "horizontal")
warning(wrapn(paste0("You have specified something for the legend orientation that is not among the possible options. Since you requested that the legend position be on the ",
legend_position, ", we will set the legend orientation to be ",
legend_orientation, ". ")),
call. = FALSE)
}
if(is.na(legend_orientation)){
legend_orientation <- case_when(legend_position %in% c("left", "right", "none") ~ "vertical",
.default = "horizontal")
}
# Main body of function --------------------------------------------------
# This will run orders of magnitude faster if we only include aggregate data.
# Removing individual data when possible using column IndivOrAgg, which will
# be NA for observed data and not exist for release- or dissolution-profile
# data. Dealing with that and harmonizing data.
# Adding info for IndivOrAgg for data that were extracted w/older version
# of package. Uncomment the if statement at some point?
# if("IndivOrAgg" %in% names(ct_dataframe) == FALSE){
ct_dataframe <- ct_dataframe %>%
mutate(IndivOrAgg = case_when(Simulated == FALSE ~ NA,
Simulated == TRUE & Trial %in%
c("mean", "median",
"geomean",
"per5", "per95", "per10", "per90",
"trial mean", "trial geomean",
"trial median") ~ "aggregate",
.default = "individual"))
# }
ct_dataframe <- ct_dataframe %>%
filter(Simulated == FALSE |
(Simulated == TRUE & IndivOrAgg == "aggregate"))
# Noting user's original preferences for a few things
obs_line_trans_user <- obs_line_trans
obs_fill_trans_user <- obs_fill_trans
obs_color_user <- obs_color
obs_shape_user <- obs_shape
# If user had already filtered ct_dataframe to include only the ADAM data
# they wanted, the Tissue_subtype column might not include the default
# value for Tissue_subtype. In that case, just switch to the subsection
# that *was* included and make the plot.
ADAMoptions <- c("dissolved compound", "undissolved compound",
"enterocyte concentration",
"free compound in lumen", "total compound in lumen",
"Heff", "absorption rate",
"unreleased compound in faeces",
"luminal CLint",
"dissolution rate of solid state",
"cumulative fraction of compound absorbed",
"cumulative fraction of compound dissolved")
if(EnzPlot == FALSE &&
(Tissue_subtype == "free compound in lumen" &
length(unique(ct_dataframe$Tissue_subtype)) == 1 &&
unique(ct_dataframe$Tissue_subtype) %in% ADAMoptions)){
Tissue_subtype <- unique(ct_dataframe$Tissue_subtype)
}
MyMeanType <- ct_dataframe %>%
filter(Trial %in% c("geomean", "mean", "median")) %>%
pull(Trial) %>% unique() %>%
factor(levels = c("mean", "geomean", "median")) %>%
sort()
if(switch(mean_type, "arithmetic" = "mean", "geometric" = "geomean",
"median" = "median") %in% ct_dataframe$Trial == FALSE){
warning(wrapn(paste0("You requested the ",
switch(mean_type, "arithmetic" = "arithmetic means",
"geometric" = "geometric means",
"median" = "medians"),
", but those are not included in your data. Instead, the ",
ifelse(MyMeanType[1] == "mean",
"arithmetic mean", MyMeanType[1]),
"s will be used.")),
call. = FALSE)
MyMeanType <- MyMeanType[1] %>% as.character()
} else {
MyMeanType <- switch(mean_type, "arithmetic" = "mean", "geometric" = "geomean",
"median" = "median")
}
Data <- ct_dataframe %>%
# Making sure we only have one summary aggregate measurement
filter(!Trial %in% setdiff(c("mean", "geomean", "median"),
MyMeanType))
# Set MyCompoundID to whatever compound was included.
MyCompoundID <- ifelse(EnzPlot, unique(Data$Enzyme),
unique(Data$CompoundID))
if(EnzPlot){
Data <- Data %>%
rename(Conc = Abundance) %>%
mutate(CompoundID = Enzyme,
Compound = Enzyme,
Conc_units = "ng/mL", # placeholder only
Tissue_subtype = NA, # This avoids some annoying warnings later, and it's easiest to just add it here.
# putting "conc" into decimal format b/c it works better with
# using percents on y axis labels
Conc = Conc / 100)
# Since the y axis is now scaled by 1/100, need to also scale y axis
# limits.
y_axis_limits_lin <- y_axis_limits_lin / 100
y_axis_limits_log <- y_axis_limits_log / 100
hline_position <- hline_position / 100
}
# We've discovered that, sometimes, an ADAM model can return negative
# concentrations, which causes this function to essentially freeze.
# Removing negative concs.
Data <- Data %>% filter(Conc >= 0)
# Noting whether the tissue was from an ADAM model
ADAM <- unique(Data$Tissue) %in% c("stomach", "duodenum", "jejunum I",
"jejunum II", "ileum I", "ileum II",
"ileum III", "ileum IV", "colon",
"faeces", "cumulative absorption",
"cumulative dissolution") &&
EnzPlot == FALSE
AdvBrainModel <- "Tissue_subtype" %in% names(Data) &&
unique(Data$Tissue == "brain") &
any(Data$Tissue_subtype %in%
c("intracranial", "brain ICF", "brain ISF", "spinal CSF", "cranial CSF",
"total brain", "Kp,uu,brain", "Kp,uu,ICF", "Kp,uu,ISF"))
# If the tissue was an ADAM tissue, only include the Tissue_subtype they requested.
if(any(ADAM)){
if(length(Tissue_subtype) > 1){
stop(paste0("You can only enter one option for the concentration type for ADAM-model tissues. Please set Tissue_subtype to one of ",
str_comma(paste0("`", ADAMoptions, "`"), conjunction = "or"),
"."),
call. = FALSE)
}
if(Tissue_subtype %in% ADAMoptions == FALSE){
stop(paste0("The concentration type you requested, `", Tissue_subtype,
"``, is not one of the options. Please set this value to one of ",
str_comma(paste0("`", ADAMoptions, "`"), conjunction = "or"),
"."),
call. = FALSE)
}
Data <- Data %>% filter(Tissue_subtype == {{Tissue_subtype}})
if(nrow(Data) == 0){
stop(paste0("You appear to have ADAM-model data, and you requested `",
Tissue_subtype,
"` for the Tissue_subtype argument, but that type is not present in ct_dataframe. The type(s) of ADAM data available in ct_dataframe is/are ",
str_comma(paste0("`", unique(ct_dataframe$Tissue_subtype), "`")),
". Please set the argument `Tissue_subtype` to one of these values."),
call. = FALSE)
}
}
# Error catching now that we've figured out which Tissue_subtype they want
if("Conc_units" %in% names(Data) && length(unique(Data$Conc_units)) > 1){
stop("It looks like you have more than one kind of data here because you have multiple concentration units. Maybe you've got more than one ADAM-model tissue included? Because this function has been set up to deal with only one dataset at a time, no graph can be made. Please check your data and try this function with only one dataset at a time.")
}
# Dealing with possible inhibitor 1 data ---------------------------------
# Adding a grouping variable to data and also making the inhibitor 1 name
# prettier for the graphs.
MyPerpetrator <- unique(Data$Inhibitor) %>% as.character()
MyPerpetrator <- MyPerpetrator[!MyPerpetrator == "none"]
if(length(MyPerpetrator) > 0 && complete.cases(MyPerpetrator)){
Data <- Data %>%
mutate(CompoundIsPerp = Compound == MyPerpetrator,
Inhibitor = as.character(ifelse(is.na(Inhibitor),
"none", Inhibitor)))
if(class(prettify_compound_names) == "logical" &&
prettify_compound_names){
MyPerpetrator <- prettify_compound_name(MyPerpetrator)
}
if(class(prettify_compound_names) == "character"){
MyPerpetrator <- prettify_compound_names["perpetrator"]
}
Data <-
Data %>%
mutate(Compound = ifelse(CompoundIsPerp, MyPerpetrator, Compound),
Inhibitor = ifelse(Inhibitor != "none", MyPerpetrator, Inhibitor)) %>%
unite(col = Group, remove = FALSE,
any_of(c("Compound", "Inhibitor", "Trial", "Individual"))) %>%
select(-CompoundIsPerp)
}
# Error catching for when user specifies linetype, color or shape and
# doesn't include enough values when perpetrator present
if(complete.cases(obs_shape[1]) && length(MyPerpetrator) > 0 &&
complete.cases(MyPerpetrator) &&
MyCompoundID != "inhibitor 1" &&
length(complete.cases(obs_shape)) < 2 &
figure_type != "compound summary"){
warning(wrapn("There is an inhibitor or perpetrator present, but you have specified only one shape for the observed data. The same shape will be used for both."),
call. = FALSE)
obs_shape <- rep(obs_shape, 2)
}
if(complete.cases(line_color[1]) && length(MyPerpetrator) > 0 &&
complete.cases(MyPerpetrator) &&
MyCompoundID != "inhibitor 1" &&
length(complete.cases(line_color)) < 2){
warning(wrapn("There is an inhibitor or perpetrator present, but you have specified only one line color. The same line color will be used for both."),
call. = FALSE)
line_color <- rep(line_color, 2)
}
if(complete.cases(line_type[1]) && length(MyPerpetrator) > 0 &&
complete.cases(MyPerpetrator) &&
MyCompoundID != "inhibitor 1" &&
length(complete.cases(line_type)) < 2){
warning(wrapn("There is an inhibitor or perpetrator present, but you have specified only one line type. The same line type will be used for both."),
call. = FALSE)
line_type <- rep(line_type, 2)
}
# Always want "none" to be the 1st item on the legend, and we need there
# to be some value present for "Inhibitor" for function to work correctly.
Data <- Data %>%
mutate(Inhibitor = ifelse(is.na(Inhibitor), "none", Inhibitor))
if(length(MyPerpetrator) > 0){
Data <- Data %>%
mutate(Inhibitor = factor(Inhibitor, levels = c("none", MyPerpetrator)))
}
# Setting up data.frames to graph ---------------------------------------
# Converting conc and time units if requested
if(any(complete.cases(conc_units_to_use))){
if("logical" %in% class(existing_exp_details) == FALSE){
MWs_1 <- AllCompounds %>%
mutate(Detail = paste0("MW", Suffix)) %>%
select(CompoundID, Detail) %>%
left_join(harmonize_details(existing_exp_details)[["MainDetails"]] %>%
filter(File %in% unique(ct_dataframe$File)) %>%
select(File, matches("MW_")) %>%
pivot_longer(cols = matches("MW_"),
names_to = "Detail",
values_to = "Value"),
by = "Detail")
MWs <- MWs_1$Value
names(MWs) <- MWs_1$CompoundID
} else {
MWs <- NA
}
Data <- convert_conc_units(Data, conc_units = conc_units_to_use,
MW = MWs)
}
if(any(complete.cases(time_units_to_use))){
Data <- convert_time_units(Data, time_units = time_units_to_use)
}
# Setting up the x axis using the subfunction ct_x_axis
XStuff <- ct_x_axis(Data = Data,
time_range = time_range,
t0 = t0,
pad_x_axis = pad_x_axis,
MyCompoundID = MyCompoundID,
EnzPlot = EnzPlot)
xlab <- XStuff$xlab
Data <- XStuff$Data # Is this necessary??
time_range <- XStuff$time_range
time_range_relative <- XStuff$time_range_relative
t0 <- XStuff$t0
TimeUnits <- XStuff$TimeUnits
# Checking whether there are data in the time range requested and warning if
# not.
if(any(Data$Time >= time_range_relative[1] &
Data$Time <= time_range_relative[2]) == FALSE){
warning(wrapn(paste0(
"You requested a time range of ",
time_range_relative[1], " to ", time_range_relative[2],
" h, but your data are in the range of ",
min(Data$Time), " to ", max(Data$Time), " h. ",
"Since none of your data are in the time range requested, the full time range will be returned.")),
call. = FALSE)
time_range <- c(min(Data$Time), max(Data$Time))
time_range_relative <- time_range
}
# Separating the data by type and calculating trial means
sim_data_trial <- Data %>%
filter(Simulated == TRUE &
Trial %in% switch(mean_type,
"arithmetic" = "trial mean",
"geometric" = "trial geomean",
"median" = "trial median")) %>%
ungroup() %>%
unite(col = Group, remove = FALSE,
any_of(c("Compound", "Inhibitor", "Individual", "Simulated")))
sim_data_mean <- Data %>%
filter(Simulated == TRUE &
Trial %in% c(MyMeanType, "per5", "per95")) %>%
unite(col = Group, remove = FALSE,
any_of(c("Compound", "Inhibitor", "Trial", "Individual")))
if(figure_type == "compound summary"){
# Hacking the Study column for the simulated data
sim_data_mean$Study <- "simulated"
}
# Setting up observed data per user input -------------------------------
obs_dataframe <- Data %>% filter(Simulated == FALSE) %>% droplevels() %>%
unite(col = Group, remove = FALSE,
any_of(c("Compound", "Inhibitor", "Trial", "Individual", "Study")))
# If the user set obs_color to "none", then they must not want to include
# observed data in the graph. Set nrow to 0 in that case.
if(all(complete.cases(obs_color)) && all(obs_color == "none")){
obs_dataframe <- obs_dataframe %>% filter(Trial == "mango") # hack to keep all the column names just in case
}
if(figure_type == "compound summary"){
if(all(is.na(obs_color_user))){
obs_color <- make_color_set(
color_set = "default",
num_colors = length(sort(unique(obs_dataframe$Study))))
} else if(length(obs_color) == 1){
obs_color <- make_color_set(
color_set = obs_color_user,
num_colors = length(sort(unique(obs_dataframe$Study))))
} else if(length(obs_color) < length(sort(unique(obs_dataframe$Study)))){
warning(wrapn(paste0("You have ", length(sort(unique(obs_dataframe$Study))),
" unique studies in your data but have only specified ",
length(obs_color), " color. You might want to specify more colors to distinguish between studies.")),
call. = FALSE)
obs_color <- rep(obs_color_user, length(sort(unique(obs_dataframe$Study))))
}
}
if(showBLQ == FALSE){
obs_dataframe <- obs_dataframe %>%
mutate(Conc = ifelse(Conc <= 0 & Time > 0,
NA, Conc)) %>%
filter(complete.cases(Conc))
}
# Checking whether there are multiple observations at each time point. If
# so, user should probably be using figure_type = "percentiles" and, if not,
# user should probably be using figure_type = "trial means", and Hannah
# would like user to get a warning about that.
suppressMessages(
check <- obs_dataframe %>%
group_by(across(.cols = any_of(c("CompoundID", "Inhibitor", "Time")))) %>%
summarize(N = n())
)
if(nrow(obs_dataframe) > 0 && any(check$N > 1) & figure_type %in% c("trial means")){
warning(wrapn(paste0("You have requested a figure type of '",
figure_type,
"', but you appear to be plotting individual observed data (N > 1 at each time point). You may want to switch to a figure type of 'percentiles' or 'percentile ribbon' to comply with the recommendations of the Simcyp Consultancy Team report template. Please see red text at the beginning of section 4 in the template.")),
call. = FALSE)
}
if(nrow(obs_dataframe) > 0 &&
all(check$N == 1) & figure_type %in% c("percentiles", "percentile",
"percentile ribbon", "ribbon")){
warning(wrapn(paste0("You have requested a figure type of '",
figure_type,
"', but you appear to be plotting mean observed data (N = 1 at each time point). You may want to switch to a figure type of 'trial means' or 'means only' to comply with the recommendations of the Simcyp Consultancy Team report template. Please see red text at the beginning of section 4 in the template.")),
call. = FALSE)
}
# If there are no observed data and they requested a figure type of "compound
# summary", then just set the figure type to "Freddy" b/c it's the same.
if(nrow(obs_dataframe) == 0 & figure_type == "compound summary"){
figure_type <- "freddy"
}
# Setting up the y axis using the subfunction ct_y_axis -------------------
# Setting Y axis limits for both linear and semi-log plots
Ylim_data <- switch(figure_type,
"trial means" = bind_rows(sim_data_trial, obs_dataframe),
"percentiles" = bind_rows(sim_data_trial, sim_data_mean, obs_dataframe),
"freddy" = bind_rows(sim_data_trial, sim_data_mean, obs_dataframe),
"compound summary" = bind_rows(sim_data_trial, sim_data_mean, obs_dataframe),
"percentile ribbon" = bind_rows(sim_data_trial, sim_data_mean, obs_dataframe),
"means only" = bind_rows(sim_data_mean, obs_dataframe) %>%
filter(as.character(Trial) == MyMeanType |
str_detect(as.character(Trial), "obs"))
)
if("SD_SE" %in% names(Ylim_data) &&
any(complete.cases(Ylim_data$SD_SE))){
Ylim_data <- Ylim_data %>%
mutate(MaxConc = Conc + ifelse(complete.cases(SD_SE), SD_SE, 0),
MinConc = Conc - ifelse(complete.cases(SD_SE), SD_SE, 0))
Ylim_data <- bind_rows(Ylim_data,
data.frame(Conc = c(
max(Ylim_data$MaxConc, na.rm = T),
min(Ylim_data$MinConc, na.rm = T))))
}
if(nrow(Ylim_data) == 0){
Ylim_data <- bind_rows(sim_data_trial, obs_dataframe, sim_data_mean)
}
YStuff <- ct_y_axis(ADAMorAdvBrain = any(ADAM, AdvBrainModel),
Tissue_subtype = Tissue_subtype,
EnzPlot = EnzPlot,
time_range_relative = time_range_relative,
Ylim_data = Ylim_data,
prettify_compound_names = prettify_compound_names,
pad_y_axis = pad_y_axis,
y_axis_limits_lin = y_axis_limits_lin,
time_range = time_range,
y_axis_limits_log = y_axis_limits_log,
y_axis_interval = y_axis_interval
)
ObsConcUnits <- YStuff$ObsConcUnits
ylab <- YStuff$ylab
YLabels <- YStuff$YLabels
YLogLabels <- YStuff$YLogLabels
YBreaks <- YStuff$YBreaks
YLogBreaks <- YStuff$YLogBreaks
Ylim_log <- YStuff$Ylim_log
YmaxRnd <- YStuff$YmaxRnd
pad_y_num <- YStuff$pad_y_num
pad_y_axis <- YStuff$pad_y_axis
# Figure types ---------------------------------------------------------
obs_line_trans_user <- obs_line_trans
obs_fill_trans_user <- obs_fill_trans
obs_color_user <- obs_color_user
AesthetStuff <- set_aesthet(line_type = line_type,
figure_type = figure_type,
MyPerpetrator = MyPerpetrator,
MyCompoundID = MyCompoundID,
obs_shape = obs_shape,
obs_color = obs_color,
obs_fill_trans = obs_fill_trans,
obs_line_trans = obs_line_trans,
line_color = line_color)
line_type <- AesthetStuff$line_type
line_color <- AesthetStuff$line_color
obs_shape <- AesthetStuff$obs_shape
obs_color <- AesthetStuff$obs_color
obs_fill_trans<- AesthetStuff$obs_fill_trans
obs_line_trans <- AesthetStuff$obs_line_trans
# Making sure there are enough shapes and colors for "compound summary"
# figures.
if(figure_type == "compound summary"){
obs_color <- rep(obs_color,
length(unique(obs_dataframe$Study)))
obs_shape <- rep(obs_shape,
length(unique(obs_dataframe$Study)))
}
# Warning for a figure type that's not recommended
# Is this a graph showing substrate +/- perpetrator?
Eff_plusminus <- length(MyPerpetrator) > 0 &&
complete.cases(MyPerpetrator[1]) &&
MyPerpetrator[1] != "none" &
MyCompoundID %in% c("inhibitor 1", "inhibitor 2",
"inhibitor 1 metabolite") == FALSE
if(Eff_plusminus & EnzPlot == FALSE & figure_type != "means only"){
# This is when there is a perpetrator present and the graph is of the
# substrate or a substrate metabolite
warning(wrapn("When there is a perpetrator present in the simulation, as is the case here, the Simcyp Consultancy report template recommends only showing the means. You may want to change figure_type to 'means only'."),
call. = FALSE)
}
## Setting up ggplot and aes bases for the graph -----------------------
if(figure_type == "percentile ribbon"){
RibbonDF <- sim_data_mean %>% select(-any_of(c("Group", "Individual"))) %>%
pivot_wider(names_from = Trial, values_from = Conc) %>%
rename("MyMean" = {MyMeanType})
}
A <- switch(figure_type,
"trial means" = ggplot(sim_data_trial,
aes(x = Time, y = Conc, group = Group,
linetype = Inhibitor, shape = Inhibitor,
color = Inhibitor, fill = Inhibitor)),
"percentiles" = ggplot(sim_data_mean %>%
filter(Trial %in% c("per5", "per95")) %>%
mutate(Group = paste(Group, Trial)),
aes(x = Time, y = Conc,
linetype = Inhibitor, shape = Inhibitor,
color = Inhibitor, fill = Inhibitor,
group = Group)),
"percentile ribbon" = ggplot(RibbonDF,
aes(x = Time, y = MyMean,
ymin = per5, ymax = per95,
linetype = Inhibitor, shape = Inhibitor,
color = Inhibitor, fill = Inhibitor)),
"freddy" =
switch(as.character(Eff_plusminus),
"TRUE" = ggplot(data = sim_data_mean %>%
filter(Trial == MyMeanType),
aes(x = Time, y = Conc, group = Group,
linetype = Inhibitor, shape = Inhibitor,
color = Inhibitor, fill = Inhibitor)),
"FALSE" = ggplot(sim_data_trial,
aes(x = Time, y = Conc, group = Group,
linetype = Inhibitor, shape = Inhibitor,
color = Inhibitor, fill = Inhibitor))
),
"compound summary" =
switch(as.character(Eff_plusminus),
"TRUE" = ggplot(data = sim_data_mean %>%
filter(Trial == MyMeanType),
aes(x = Time, y = Conc, group = Group,
linetype = Inhibitor, shape = Inhibitor)),
"FALSE" = ggplot(sim_data_trial,
aes(x = Time, y = Conc, group = Group))
),
"means only" = ggplot(sim_data_mean %>%
filter(Trial == MyMeanType),
aes(x = Time, y = Conc,
linetype = Inhibitor, shape = Inhibitor,
color = Inhibitor, fill = Inhibitor)))
# Adding optional horizontal line(s)
if(any(complete.cases(hline_position))){
A <- A + geom_hline(yintercept = hline_position,
color = HLineAES[1], linetype = HLineAES[2])
}
# Adding optional vertical line(s)
if(any(complete.cases(vline_position))){
A <- A + geom_vline(xintercept = vline_position,
color = VLineAES[1], linetype = VLineAES[2])
}
if(nrow(obs_dataframe) > 0 & obs_on_top == FALSE){
MapObsData <- all(is.na(obs_color_user)) & figure_type != "freddy"
A <- addObsPoints(obs_dataframe = obs_dataframe,
A = A,
# Needed the argument AES for ct_plot_overlay, but
# it's only ever going to be "linetype" for ct_plot.
AES = "linetype",
obs_shape = obs_shape,
obs_shape_user = obs_shape_user,
obs_size = obs_size,
obs_color = obs_color,
obs_color_user = obs_color_user,
obs_line_trans = obs_line_trans,
obs_line_trans_user = obs_line_trans_user,
obs_fill_trans = obs_fill_trans,
obs_fill_trans_user = obs_fill_trans_user,
connect_obs_points = connect_obs_points,
line_width = line_width,
figure_type = figure_type,
MapObsData = MapObsData,
LegCheck = TRUE)
}
## figure_type: trial means -----------------------------------------------------------
if(figure_type == "trial means"){
NumTrials <- length(unique(sim_data_trial$Trial))
AlphaToUse <- ifelse(complete.cases(line_transparency),
line_transparency,
ifelse(NumTrials > 10, 0.05, 0.2))
A <- A +
geom_line(alpha = AlphaToUse,
linewidth = ifelse(is.na(line_width), 1, line_width)) +
geom_line(data = sim_data_mean %>%
filter(Trial == MyMeanType),
linewidth = ifelse(is.na(line_width), 1, line_width))
}
## figure_type: percentiles ----------------------------------------------------------
if(figure_type == "percentiles"){
# graphs with 95th percentiles
AlphaToUse <- ifelse(complete.cases(line_transparency),
line_transparency, 0.25)
A <- A +
geom_line(alpha = AlphaToUse,
linewidth = ifelse(is.na(line_width), 0.8, line_width)) +
geom_line(data = sim_data_mean %>%
filter(Trial == MyMeanType),
linewidth = ifelse(is.na(line_width), 1, line_width))
}
## figure_type: percentile ribbon ----------------------------------------------------------
if(str_detect(figure_type, "ribbon")){
# graphs with 95th percentiles as transparent ribbons
AlphaToUse <- ifelse(complete.cases(line_transparency),
line_transparency, 0.25)
A <- A +
geom_ribbon(alpha = AlphaToUse, color = NA) +
geom_line(linewidth = ifelse(is.na(line_width), 1, line_width))
}
## figure_type: Freddy or compound summary ----------------------------------
if(figure_type %in% c("freddy", "compound summary")){
NumTrials <- length(unique(sim_data_trial$Individual))
AlphaToUse <- ifelse(complete.cases(line_transparency),
line_transparency,
ifelse(NumTrials > 10, 0.05, 0.25))
# This figure type does things differently based on whether the graph is
# of a compound alone or a compound +/- a perpetrator.
if(Eff_plusminus){
# This is when there is a perpetrator present and the graph is of the
# substrate or a substrate metabolite
## linear plot
A <- A +
geom_line(linewidth = ifelse(is.na(line_width), 0.5, line_width)) +
geom_line(data = sim_data_mean %>%
filter(Trial %in% c("per5", "per95")),
alpha = AlphaToUse,
linewidth = ifelse(is.na(line_width), 0.5, line_width))
} else {
# This is when there is no perpetrator present or the graph is of the
# perpetrator or a perpetrator metabolite.
## linear plot
if(figure_type == "freddy"){
A <- A +
geom_line(alpha = AlphaToUse,
linewidth = ifelse(is.na(line_width), 0.5, line_width)) +
geom_line(data = sim_data_mean %>%
filter(Trial == MyMeanType),
linewidth = ifelse(is.na(line_width), 0.5, line_width)) +
geom_line(data = sim_data_mean %>%
filter(Trial %in% c("per5", "per95")),
linetype = line_type[2],
alpha = 1,
color = line_color[2])
} else if(figure_type == "compound summary"){
A <- A +
geom_line(alpha = AlphaToUse,
linewidth = ifelse(is.na(line_width), 0.5, line_width),
linetype = line_type[1],
color = "black",
show.legend = FALSE) +
geom_line(data = sim_data_mean %>%
filter(Trial == MyMeanType),
color = "black", alpha = 1,
linewidth = ifelse(is.na(line_width), 0.5, line_width),
linetype = line_type[1],
show.legend = FALSE) +
geom_line(data = sim_data_mean %>%
filter(Trial %in% c("per5", "per95")),
linetype = line_type[2],
alpha = 1,
color = "black",
show.legend = FALSE)
}
}
}
## figure_type: means only -----------------------------------------------------------
if(figure_type == "means only"){
A <- A +
geom_line(linewidth = ifelse(is.na(line_width), 1, line_width))
}
# Setting colors, linetypes, etc. -------------------------------------
# Naming the linetypes, colors, fills, and shapes b/c otherwise having
# trouble with order changing between when lines are plotted and when
# observed data are added. I think this is a ggplot2 bug.
if(length(unique(Data$Inhibitor)) > 1){
names(line_type) <- levels(Data$Inhibitor)
names(line_color) <- levels(Data$Inhibitor)
} else if(figure_type == "compound summary"){
names(obs_color) <- unique(obs_dataframe$Study)
names(obs_shape) <- unique(obs_dataframe$Study)
} else {
names(line_type) <- unique(Data$Inhibitor)
names(line_color) <- unique(Data$Inhibitor)
}
if(figure_type != "compound summary"){
A <- A +
scale_linetype_manual(values = line_type) +
scale_color_manual(values = line_color) +
scale_fill_manual(values = line_color)
} else {
A <- A +
scale_color_manual(values = obs_color) +
scale_shape_manual(values = obs_shape) +
scale_fill_manual(values = obs_color)
}
# Observed data on top ------------------------------------------------------
if(nrow(obs_dataframe) > 0 & obs_on_top){
MapObsData <- all(is.na(obs_color_user)) &
figure_type %in% c("freddy") == FALSE
A <- addObsPoints(obs_dataframe = obs_dataframe,
A = A,
AES = switch(figure_type,
"percentiles" = "linetype",
"trial means" = "linetype",
"percentile ribbon" = "linetype",
"compound summary" = "color",
"freddy" = "linetype",
"means only" = "linetype"),
obs_shape = obs_shape,
obs_shape_user = obs_shape_user,
obs_size = obs_size,
obs_color = obs_color,
obs_color_user = obs_color_user,
obs_line_trans = obs_line_trans,
obs_line_trans_user = obs_line_trans_user,
obs_fill_trans = obs_fill_trans,
obs_fill_trans_user = obs_fill_trans_user,
connect_obs_points = connect_obs_points,
line_width = line_width,
figure_type = figure_type,
MapObsData = MapObsData,
LegCheck = TRUE)
}
# Applying aesthetics ------------------------------------------------
## Making linear graph -------------------------------------------------
if(nrow(obs_dataframe) == 0){
A <- A + guides(shape = "none")
} else {
if("SD_SE" %in% names(obs_dataframe) & include_errorbars){
if(figure_type == "percentile ribbon"){
A <- A + geom_errorbar(data = obs_dataframe %>% rename(MyMean = Conc),
aes(ymin = MyMean - SD_SE, ymax = MyMean + SD_SE),
width = errorbar_width)
} else {
A <- A + geom_errorbar(data = obs_dataframe,
aes(ymin = Conc - SD_SE, ymax = Conc + SD_SE),
width = errorbar_width)
}
}
}
if(str_detect(figure_type, "ribbon")){
# There's a known glitch w/ggplot2 with coord_cartesian and
# geom_ribbon. Hacking around that.
A <- A +
scale_x_time(time_range = time_range_relative,
x_axis_interval = x_axis_interval,
time_units = TimeUnits,
pad_x_axis = pad_x_axis)
if(EnzPlot){
A <- A +
scale_y_continuous(limits = c(ifelse(is.na(y_axis_limits_lin[1]),
0, y_axis_limits_lin[1]),
YmaxRnd),
labels = scales::percent,
expand = expansion(mult = pad_y_num))
} else {
A <- A +
scale_y_continuous(limits = c(ifelse(is.na(y_axis_limits_lin[1]),
0, y_axis_limits_lin[1]),
YmaxRnd),
breaks = YBreaks,
labels = YLabels,
expand = expansion(mult = pad_y_num))
}
} else {
A <- A +
coord_cartesian(xlim = time_range_relative,
ylim = c(ifelse(is.na(y_axis_limits_lin[1]),
0, y_axis_limits_lin[1]),
YmaxRnd)) +
scale_x_time(time_range = time_range_relative,
x_axis_interval = x_axis_interval,
time_units = TimeUnits,
pad_x_axis = pad_x_axis)
if(EnzPlot){
A <- A +
scale_y_continuous(labels = scales::percent,
expand = expansion(mult = pad_y_num))
} else {
A <- A +
scale_y_continuous(breaks = YBreaks,
labels = YLabels,
expand = expansion(mult = pad_y_num))
}
}
if((class(y_axis_label) == "character" && complete.cases(y_axis_label)) |
(class(y_axis_label) == "expression" && length(y_axis_label) > 0)){
ylab <- y_axis_label
} else if(EnzPlot){
ylab <- paste("Relative",
ifelse(unique(ct_dataframe$Tissue) == "liver",
"hepatic", unique(ct_dataframe$Tissue)),
unique(ct_dataframe$Enzyme),
"abundance")
}
if((class(x_axis_label) == "character" && complete.cases(x_axis_label)) |
(class(x_axis_label) == "expression" && length(x_axis_label) > 0)){
xlab <- x_axis_label
}
A <- A +
labs(x = xlab, y = ylab,
linetype = case_when(complete.cases(legend_label) ~ legend_label,
.default = "Inhibitor"),
shape = case_when(complete.cases(legend_label) ~ legend_label,
figure_type == "compound summary" ~ "Study",
.default = "Inhibitor"),
color = case_when(complete.cases(legend_label) ~ legend_label,
figure_type == "compound summary" ~ "Study",
.default = "Inhibitor"),
fill = case_when(complete.cases(legend_label) ~ legend_label,
figure_type == "compound summary" ~ "Study",
.default = "Inhibitor")) +
theme_consultancy()
# If the user didn't want the legend or if the graph is of a perpetrator,
# remove legend.
if(legend_position == "none" | MyCompoundID %in% c("inhibitor 1", "inhibitor 2",
"inhibitor 1 metabolite")){
A <- A + theme(legend.position = "none")
} else {
# Otherwise, make the legend a little wider to actually show any dashes
A <- A + theme(legend.position = legend_position,
legend.key.width = unit(2, "lines"),
legend.direction = legend_orientation)
}
# When the y label is an expression, it tends to be a little too small. Make
# it 1.25 * larger. If it's an expression, that also means that it can't be
# bold. Make the x axis title not bold as well in that case.
if("expression" %in% class(ylab)){
A <- A + theme(axis.title.y = element_text(size = A$theme$text$size * 1.25),
axis.title.x = element_text(face = "plain"))
}
## Making semi-log graph ------------------------------------------------
if(EnzPlot){
LowConc <- ct_dataframe %>% filter(Trial %in% c("mean", "per5", "per95") &
Time > 0 &
Abundance < Ylim_log[1]) %>%
pull(Abundance)
} else {
LowConc <- ct_dataframe %>% filter(Trial %in% c("mean", "per5", "per95") &
Time > 0 &
Conc < Ylim_log[1]) %>%
pull(Conc)
}
if(length(LowConc) > 0 & str_detect(figure_type, "ribbon") &
linear_or_log %in% c("both", "both vertical", "both horizontal", "semi-log", "log")){
warning(wrapn("When plotting a `percentile ribbon` graph with low concentrations, if the ribbon looks disjointed or even not present at all, please try setting the graphics backend to `AGG`. See the help file for details."),
call. = FALSE)
}
suppressWarnings(suppressMessages(
B <- A + coord_cartesian(xlim = time_range_relative,
ylim = Ylim_log)))
if(EnzPlot){
suppressWarnings(suppressMessages(
withCallingHandlers({
B <- B + scale_y_log10(labels = scales::percent,
expand = expansion(mult = pad_y_num))
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
} else {
suppressWarnings(suppressMessages(
withCallingHandlers({
B <- B + scale_y_log10(breaks = YLogBreaks,
labels = YLogLabels,
expand = expansion(mult = pad_y_num))
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
}
if(graph_labels){
labels <- "AUTO"
} else {
labels <- NULL
}
# both plots together, aligned vertically
if(MyCompoundID %in% c("inhibitor 1", "inhibitor 2",
"inhibitor 1 metabolite")){
suppressWarnings(suppressMessages(
withCallingHandlers({
AB <- ggpubr::ggarrange(A, B, ncol = 1,
labels = labels,
font.label = list(size = graph_title_size),
align = "v")
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
suppressWarnings(suppressMessages(
withCallingHandlers({
ABhoriz <- ggpubr::ggarrange(A, B, ncol = 2,
labels = labels,
font.label = list(size = graph_title_size),
align = "hv")
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
} else {
# If the user didn't want the legend or if the graph is of Inhibitor1,
# remove legend.
if(legend_position == "none" |
MyCompoundID %in% c("inhibitor 1", "inhibitor 2",
"inhibitor 1 metabolite")){
suppressWarnings(suppressMessages(
withCallingHandlers({
AB <- ggpubr::ggarrange(A, B, ncol = 1,
labels = labels,
font.label = list(size = graph_title_size),
legend = "none", align = "hv")
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
suppressWarnings(suppressMessages(
withCallingHandlers({
ABhoriz <- ggpubr::ggarrange(A, B, ncol = 2,
labels = labels,
font.label = list(size = graph_title_size),
legend = "none", align = "hv")
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
} else {
suppressWarnings(suppressMessages(
withCallingHandlers({
AB <- ggpubr::ggarrange(A, B, ncol = 1,
labels = labels,
font.label = list(size = graph_title_size),
common.legend = TRUE, legend = legend_position,
align = "hv")
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
suppressWarnings(suppressMessages(
withCallingHandlers({
ABhoriz <- ggpubr::ggarrange(A, B, ncol = 2,
labels = labels,
font.label = list(size = graph_title_size),
common.legend = TRUE, legend = legend_position,
align = "hv")
}, warning = function(w){
if(startsWith(conditionMessage(w), "In scale_y_log10(breaks = YLogBreaks"))
invokeRestart("muffleWarning")
})
))
}
}
if(complete.cases(graph_title)){
A <- A + ggtitle(graph_title) +
theme(plot.title = element_text(hjust = 0.5, size = graph_title_size),
plot.title.position = "panel")
B <- B + ggtitle(graph_title) +
theme(plot.title = element_text(hjust = 0.5, size = graph_title_size),
plot.title.position = "panel")
AB <- ggpubr::annotate_figure(
AB, top = ggpubr::text_grob(graph_title, hjust = 0.5,
face = "bold", size = graph_title_size))
ABhoriz <- ggpubr::annotate_figure(
ABhoriz, top = ggpubr::text_grob(graph_title, hjust = 0.5,
face = "bold", size = graph_title_size))
}
Out <- list("graph" = switch(linear_or_log,
"linear" = A,
"semi-log" = B,
"log" = B,
"both" = AB,
"both vertical" = AB,
"both horizontal" = ABhoriz,
"horizontal and vertical" = AB))
if(qc_graph){
QCTable <- formatTable_Simcyp(
annotateDetails(Deets, detail_set = "Methods") %>%
select(-c(SimulatorSection, Sheet, Notes, CompoundID, Compound)),
shading_column = Detail)
# Out would have been just the graph or just the two arranged graphs at
# this point, so need to convert it to a list here.
Out[["QCgraph"]] <- ggpubr::ggarrange(
plotlist = list(Out, flextable::gen_grob(QCTable)),
font.label = list(size = graph_title_size))
}
# Setting up figure caption --------------------------------------------
PlotType <- case_when(EnzPlot == TRUE ~ "enzyme-abundance",
# ReleaseProfPlot == TRUE ~ "release-profile",
# DissolutionProfPlot == TRUE ~ "dissolution-profile",
TRUE ~ "concentration-time")
FigText <- make_ct_caption(ct_dataframe = Data,
single_or_multiple_profiles = "single",
existing_exp_details = existing_exp_details,
mean_type = mean_type,
linear_or_log = linear_or_log,
figure_type = figure_type,
plot_type = PlotType,
name_clinical_study = name_clinical_study,
prettify_compound_names = prettify_compound_names,
hline_position = hline_position,
vline_position = vline_position,
hline_style = hline_style,
vline_style = vline_style)
# Saving -----------------------------------------------------------------
if(complete.cases(save_graph)){
# Checking for NA for fig_height and width
if(is.na(fig_height)){
fig_height <- switch(linear_or_log,
"linear" = 4,
"log" = 4,
"semi-log" = 4,
"both" = 6,
"both vertical" = 6,
"both horizontal" = 3.5,
"horizontal and vertical" = 3.5)
}
if(is.na(fig_width)){
fig_width <- switch(linear_or_log,
"linear" = 4.75,
"log" = 4.75,
"semi-log" = 4.75,
"both" = 5,
"both vertical" = 5,
"both horizontal" = 8,
"horizontal and vertical" = 8)
}
FileName <- save_graph
if(str_detect(FileName, "\\.")){
# Making sure they've got a good extension
Ext <- sub("\\.", "", str_extract(FileName, "\\..*"))
FileName <- sub(paste0(".", Ext), "", FileName)
if(Ext %in% c("eps", "ps", "jpeg", "tiff",
"png", "bmp", "svg", "jpg", "docx") == FALSE){
warning(wrapn(paste0("You have requested the graph's file extension be `",
Ext, "`, but we haven't set up that option. We'll save your graph as a `png` file instead.")),
call. = FALSE)
}
Ext <- ifelse(Ext %in% c("eps", "ps", "jpeg", "tiff",
"png", "bmp", "svg", "jpg", "docx"),
Ext, "png")
FileName <- paste0(FileName, ".", Ext)
} else {
FileName <- paste0(FileName, ".png")
Ext <- "png"
}
if(qc_graph & Ext != "docx"){
ggsave(sub(paste0("\\.", Ext), " - QC.png", FileName),
height = fig_height, width = fig_width * 2, dpi = 600,
plot = ggpubr::ggarrange(plotlist = list(Out$QCgraph),
nrow = 1))
}
if(Ext == "docx"){
if(linear_or_log == "horizontal and vertical"){
# Saving the horizontal version as a png file and the vertical
# version as a Word file lower down in this section of the
# script.
ggsave(sub(paste0("\\.", Ext), " - horizontal.png", FileName),
plot = ABhoriz, height = fig_height, width = fig_width, dpi = 600)
}
# This is when they want a Word file as output
OutPath <- dirname(FileName)
if(OutPath == "."){
OutPath <- getwd()
}
FileName <- basename(FileName)
if(exists("Deets", inherits = FALSE) &&
"character" %in% class(Deets)){
rm(Deets)
}
if(EnzPlot){
rmarkdown::render(system.file("rmarkdown/templates/enzyme-abundance-plot/skeleton/skeleton.Rmd",
package="SimcypConsultancy"),
output_dir = OutPath,
output_file = FileName,
quiet = TRUE)
} else {
rmarkdown::render(system.file("rmarkdown/templates/concentration-time-plots/skeleton/skeleton.Rmd",
package="SimcypConsultancy"),
output_dir = OutPath,
output_file = FileName,
quiet = TRUE)
# Note: The "system.file" part of the call means "go to where the
# package is installed, search for the file listed, and return its
# full path.
}
} else {
# This is when they want any kind of graphical file format.
if(linear_or_log %in% c("both", "both vertical")){
ggsave(FileName, height = fig_height, width = fig_width, dpi = 600,
plot = AB)
} else if(linear_or_log == "both horizontal"){
ggsave(FileName, height = fig_height, width = fig_width, dpi = 600,
plot = ABhoriz)
} else if(linear_or_log == "linear"){
ggsave(FileName, height = fig_height, width = fig_width, dpi = 600,
plot = A)
} else if(str_detect(linear_or_log, "log")){
ggsave(FileName, height = fig_height, width = fig_width, dpi = 600,
plot = B)
} else if(linear_or_log == "horizontal and vertical"){
ggsave(sub(paste0("\\.", Ext), paste0(" - vertical.", Ext), FileName),
plot = AB, height = 6, width = 5, dpi = 600)
ggsave(sub(paste0("\\.", Ext), paste0(" - horizontal.", Ext), FileName),
plot = ABhoriz, height = fig_height, width = fig_width, dpi = 600)
}
}
}
if(return_caption){
Out[["figure_heading"]] <- FigText$heading
Out[["figure_caption"]] <- FigText$caption
}
if(length(Out) == 1){
Out <- Out[[1]]
}
return(Out)
}
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.