R/default_plot.R

Defines functions vpcPlot shadedPlot spaghettiPlot getColumn uniteColumns dosingOnly obsOnly factorScenarios

Documented in dosingOnly factorScenarios getColumn obsOnly shadedPlot spaghettiPlot uniteColumns vpcPlot

#' Factor scenarios columns if not done yet.
#' 
#' @param x data frame
#' @param scenarios scenarios
#' @importFrom dplyr mutate_at
#' @keywords internal
factorScenarios <- function(x, scenarios=NULL) {
  if (length(scenarios) > 0) {
    return(x %>% dplyr::mutate_at(.vars=scenarios, .funs=function(col){
      if (!is.factor(col)) {
        return(factor(col))
      } else {
        return(col)
      }
    }))
  } else {
    return(x)
  }
}

#' Filter CAMPSIS output on observation rows.
#' 
#' @param x data frame, CAMPSIS output
#' @return a data frame with the observation rows
#' @importFrom dplyr filter
#' @export
obsOnly <- function(x) {
  if ("EVID" %in% colnames(x)) {
    return(x %>% dplyr::filter(.data$EVID==0))
  } else {
    return(x)
  }
}

#' Filter CAMPSIS output on dosing rows.
#' 
#' @param x data frame, CAMPSIS output
#' @return a data frame with the dosing rows
#' @importFrom dplyr filter
#' @export
dosingOnly <- function(x) {
  if ("EVID" %in% colnames(x)) {
    return(x %>% dplyr::filter(.data$EVID==1))
  } else {
    return(x)
  }
}

#' Unite the given column names.
#' 
#' @param x data frame, CAMPSIS output
#' @param columns columns to unify
#' @param colname destination column name
#' @param factor factor the destination column
#' @return a data frame
#' @importFrom dplyr all_of
#' @importFrom tidyr unite
#' @keywords internal
uniteColumns <- function(x, columns, colname, factor=TRUE) {
  x <- x %>%
    tidyr::unite(!!colname, dplyr::all_of(columns), remove=FALSE, sep=" / ")
  if (factor) {
    x <- x %>%
      dplyr::mutate(!!colname := factor(.data[[colname]], levels=unique(.data[[colname]])))
  }
  return(x)
}

#' Get data of given column unless if does not exist (return NULL in that case).
#' 
#' @param .data data frame
#' @param colname column name
#' @return a vector
#' @keywords internal
getColumn <- function(.data, colname) {
  if (is.null(colname)) {
    return(NULL)
  } else {
    return(.data[[colname]])
  }
}

#' Spaghetti plot.
#' 
#' @param x data frame
#' @param output variable to show
#' @param colour variable(s) to colour
#' @return plot
#' @importFrom ggplot2 aes ggplot geom_line
#' @export
spaghettiPlot <- function(x, output, colour=NULL) {
  group <- "GROUP_GGPLOT"
  x <- uniteColumns(x=x %>% obsOnly(), columns=c("ID", colour), colname=group)
  
  if (length(colour) > 0) {
    colourColumn <- "COLOUR_GGPLOT"
    x <- uniteColumns(x=x, columns=colour, colname=colourColumn)
  } else {
    colourColumn <- NULL
  }
  plot <- ggplot2::ggplot(x, ggplot2::aes(x=.data$TIME, y=.data[[output]], group=.data[[group]], colour=getColumn(.data, colourColumn))) +
    ggplot2::geom_line()
  
  if (length(colour) > 0) {
    plot <- plot + ggplot2::labs(colour=paste0(colour, collapse = " / "))
  }
    
  return(plot)
}

#' Shaded plot (or prediction interval plot).
#' 
#' @param x data frame
#' @param output variable to show
#' @param colour variable(s) to colour
#' @param strat_extra variable(s) to stratify, but not to colour (useful for use with facet_wrap)
#' @param level PI level, default is 0.9 (90\% PI)
#' @param alpha alpha parameter (transparency) given to geom_ribbon
#' @return a ggplot object
#' @importFrom ggplot2 aes ggplot geom_line geom_ribbon ylab
#' @export
shadedPlot <- function(x, output, colour=NULL, strat_extra=NULL, level=0.90, alpha=0.25) {
  if (length(colour) > 0) {
    colourColumn <- "COLOUR_GGPLOT"
    x <- uniteColumns(x=x %>% obsOnly(), columns=colour, colname=colourColumn)
  } else {
    colourColumn <- NULL
  }
  x <- PI(x=x, output=output, scenarios=c(colour, strat_extra, colourColumn), level=level, gather=FALSE)

  plot <- ggplot2::ggplot(data=x, mapping=ggplot2::aes(x=.data$TIME, colour=getColumn(.data, colourColumn))) +
    ggplot2::geom_line(ggplot2::aes(y=.data$med)) +
    ggplot2::geom_ribbon(ggplot2::aes(ymin=.data$low, ymax=.data$up, colour=getColumn(.data, colourColumn), fill=getColumn(.data, colourColumn)), colour=NA, alpha=alpha) +
    ggplot2::ylab(output)
  
  if (length(colour) > 0) {
    plot <- plot + ggplot2::labs(colour=paste0(colour, collapse = " / "),
                                 fill=paste0(colour, collapse = " / "))
  }

  return(plot)
}

#' Scatter plot (or X vs Y plot).
#' 
#' @param x data frame
#' @param output the 2 variables to show, character vector
#' @param colour variable(s) to colour
#' @param time the time to look at those 2 variables, if NULL, min time is used (usually 0)
#' @return a ggplot object
#' @importFrom dplyr filter
#' @importFrom ggplot2 aes ggplot geom_point
#' @export
scatterPlot <- function (x, output, colour=NULL, time=NULL) {
  group <- "GROUP_GGPLOT"
  x <- uniteColumns(x=x %>% obsOnly(), columns=c("ID", colour), colname=group)
  
  if (is.null(time)) {
    time <- min(x$TIME)
  }
  x <- x %>% dplyr::filter(.data$TIME %in% time)
  
  if (output %>% length() == 1) {
    x$MY_OUTPUT_2 <- 0
    output <- c(output, "MY_OUTPUT_2")
  } else if (output %>% length() > 2) {
    stop("Please provide 2 outputs at most !")
  }

  if (length(colour) > 0) {
    colourColumn <- "COLOUR_GGPLOT"
    x <- uniteColumns(x=x, columns=colour, colname=colourColumn)
  } else {
    colourColumn <- NULL
  }
  
  plot <- ggplot2::ggplot(x, ggplot2::aes(x=.data[[output[1]]], y=.data[[output[2]]], group=.data[[group]], colour=getColumn(.data, colourColumn))) +
    ggplot2::geom_point()
  
  if (length(colour) > 0) {
    plot <- plot + ggplot2::labs(colour=paste0(colour, collapse = " / "))
  }
  
  return(plot)
}

#' VPC plot.
#' 
#' @param x data frame, output of CAMPSIS with replicates
#' @param scenarios scenarios, character vector, NULL is default
#' @param level PI level, default is 0.9 (90\% PI)
#' @param alpha alpha parameter (transparency) given to geom_ribbon
#' @return a ggplot object
#' @importFrom ggplot2 aes ggplot ylab
#' @export
vpcPlot <- function(x, scenarios=NULL, level=0.90, alpha=0.15) {
  if (length(scenarios) > 1) {
    stop("Currently max 1 scenario allowed")
  }
  summary <- VPC(x=x, scenarios=scenarios, level=level)
  if (length(scenarios) > 0) {
    group <- "GROUP_GGPLOT"
    summary <- uniteColumns(x=x, columns=scenarios, colname=group)
  } else {
    group <- NULL
  }

  plot <- ggplot2::ggplot(summary, ggplot2::aes(x=.data$TIME, group=getColumn(.data, group))) +
    ggplot2::geom_ribbon(ggplot2::aes(ymin=.data$med_low, ymax=.data$med_up), alpha=alpha, color=NA, fill="red") +
    ggplot2::geom_ribbon(ggplot2::aes(ymin=.data$low_low, ymax=.data$low_up), alpha=alpha, color=NA, fill="blue") +
    ggplot2::geom_ribbon(ggplot2::aes(ymin=.data$up_low, ymax=.data$up_up), alpha=alpha, color=NA, fill="blue") +
    ggplot2::ylab("")
  
  return(plot)
}
Calvagone/campsis documentation built on Feb. 25, 2024, 8:35 p.m.