R/priorPosterior.R

In morseTKTD: Bayesian Inference of TKTD Models

#' @name PriorPosterior
#' 
#' @title Return Prior and Posterior density of parameters of \code{SurvFit} object
#'
#' @description
#' This is the generic \code{pp} S3 method for the \code{survFitTT} class. It
#' plots the predicted values with 95 \% credible intervals versus the observed
#' values for \code{SurvFit} objects.
#'
#' The coordinates of black points are the observed values of the number of survivors
#' (pooled replicates) for a given concentration (\eqn{X}-axis) and the corresponding
#' predicted values (\eqn{Y}-axis). 95\% prediction intervals are added to each predicted
#' value, colored in green if this interval contains the observed value and in red
#' otherwise.
#' The bisecting line (y = x) is added to the plot in order to see if each
#' prediction interval contains each observed value. As replicates are shifted
#' on the x-axis, this line is represented by steps.
#'
#' @param fit An object of class \code{SurvFit}
#' @param \dots Further arguments to be passed to generic methods
#'
#' @return a plot of class \code{ggplot}
#'
#' @import ggplot2
#' @import grDevices
#' @importFrom graphics plot
#'
#' @export
priorPosterior <- function(fit, ...){
    UseMethod("priorPosterior")
}

#' @name PriorPosterior
#' @export
priorPosterior.SurvFit <- function(fit, ...) {
    df_prior <- priors_distribution(fit)
    df_prior$pp <- "prior"
    df_posterior <- extract_param(fit)
    df_posterior$pp <- "posterior"
    df <- rbind(df_prior, df_posterior, make.row.names = FALSE)
    class(df) <- append("PriorPosterior", class(df))
    return(df)
}


#' @name PlotPriorPosterior
#' 
#' @title Plot of Prior and Posterior distributions
#' 
#' @description
#' A function to plot priors and posteriors distribution after using the priorPosterior
#' function  on a SurvFit object.
#' 
#' @param x a \code{\link{PriorPosterior}} object
#' @param \dots Further arguments to be passed to generic methods
#' 
#' @return an object of class \code{ggplot}, see function \code{\link[ggplot2]{ggplot}}
#' 
#' @export
plot.PriorPosterior <- function(x, ...){
    
    dfr <- x[, colnames(x) != "pp"]
    coldfr = colnames(dfr)
    
    df_melt <- data.frame(
        value = c(dfr[, 1], dfr[, 2], dfr[, 3], dfr[, 4]),
        name = rep(coldfr, each = nrow(dfr)),
        pp = rep(x$pp, 4)
    )
    df_melt$pp <- factor(df_melt$pp, levels = c("prior", "posterior"))
    
    plt <- ggplot(data = df_melt) + 
        theme_minimal() +
        labs(x = "value (log10)") +
        scale_x_log10() +
        scale_fill_manual(
            name = NULL,
            labels = c("prior", "posterior"),
            values = c("grey80", colmed)) +
        geom_density(aes(value, fill = pp), color = NA) + 
        facet_wrap(~ name, scales = "free")
    
    return(plt)
    
}