R/diagP.R

In EvansLaboratory/OBIF: Omics-Based Interaction Framework

#' OBIF Diagnostic Plots
#'
#' This functions derives the regression diagnostic plots of any of the models fitted by OBIF to be used as Quality Control and Quality Assessment steps. To the apply this functions, the fitted model objects must be already fortified.
#' The diagnostic plots include: 1, Residual vs Fitted plot; 2, Normal Q-Q plot; 3, Scale-Location plot; 4, Cook's distance plot; 5, Residuals vs Leverage plot; 6, Cook's dist vs Leverage hii/1-hii plot.
#'
#' @param model A fitted model object of the Omics-based interaction analysis or the Full Factorial Analysis performed by OBIF.
#'
#' @return A list of plots containing 6 diagnostics plots of the regression model.
#' @export
#'
#' @import ggbiplot ggplot2
diagP <- function(model){
  p1<-ggplot(model, aes(.fitted, .resid))+geom_point()
  p1<-p1+stat_smooth(method="lm")+geom_hline(yintercept=0, col="red", linetype="dashed")
  p1<-p1+xlab("Fitted values")+ylab("Residuals")
  p1<-p1+ggtitle(label="Residual vs Fitted Plot", subtitle = deparse(substitute(model)))+theme_bw()

  p2<-ggplot(model, aes(qqnorm(.stdresid)[[1]], .stdresid))+geom_point(na.rm = TRUE)
  p2<-p2+geom_abline(aes(qqline(.stdresid)))+xlab("Theoretical Quantiles")+ylab("Standardized Residuals")
  p2<-p2+ggtitle(label="Normal Q-Q Plot", subtitle = deparse(substitute(model)))+theme_bw()

  p3<-ggplot(model, aes(.fitted, sqrt(abs(.stdresid))))+geom_point(na.rm=TRUE)
  p3<-p3+stat_smooth(method="lm", na.rm = TRUE)+xlab("Fitted Value")
  p3<-p3+ylab(expression(sqrt("|Standardized residuals|")))
  p3<-p3+ggtitle(label="Scale-Location", subtitle = deparse(substitute(model)))+theme_bw()

  p4<-ggplot(model, aes(seq_along(.cooksd), .cooksd))+geom_bar(stat="identity", position="identity")
  p4<-p4+xlab("Obs. Number")+ylab("Cook's distance")
  p4<-p4+ggtitle(label="Cook's distance", subtitle = deparse(substitute(model)))+theme_bw()

  p5<-ggplot(model, aes(.hat, .stdresid))+geom_point(aes(size=.cooksd), na.rm=TRUE)
  p5<-p5+stat_smooth(method="lm", na.rm=TRUE)
  p5<-p5+xlab("Leverage")+ylab("Standardized Residuals")
  p5<-p5+ggtitle(label="Residual vs Leverage Plot", subtitle = deparse(substitute(model)))
  p5<-p5+scale_size_continuous("Cook's Distance", range=c(1,5))
  p5<-p5+theme_bw()+theme(legend.position="bottom")

  p6<-ggplot(model, aes(.hat, .cooksd))+geom_point(na.rm=TRUE)+stat_smooth(method="lm", na.rm=TRUE)
  p6<-p6+xlab("Leverage hii")+ylab("Cook's Distance")
  p6<-p6+ggtitle(label="Cook's dist vs Leverage hii/(1-hii)", subtitle = deparse(substitute(model)))
  p6<-p6+geom_abline(slope=seq(0,3,0.5), color="gray", linetype="dashed")
  p6<-p6+theme_bw()

  return(list(ResvsFit=p1, NormQQ=p2, ScLoc=p3, CookD=p4, ResvsLev=p5, CookvsLev=p6))
}