## plot2dist.R
## Karl W Broman
#' Plot two sets of inter-individual distances against one another
#'
#' Plot two sets of inter-individual distances against one another, colored by
#' self and non-self distances.
#'
#'
#' @param d1 Output of [distee()].
#' @param d2 Output of [distee()].
#' @param hirow Names of rows to highlight in green.
#' @param hicol Names of columns to highlight in orange.
#' @param xlab X-axis label (optional)
#' @param ylab Y-axis label (optional)
#' @param smoothScatter If TRUE, plot non-self distances with
#' [graphics::smoothScatter()]; if FALSE, use `base::plot()`.
#' @param colself Color to use for the self-self points. If NULL, these aren't
#' plotted.
#' @param colnonself Color to use for the non-self points. If NULL, these
#' aren't plotted.
#' @param colhirow Color to use for the `hirow` points. If NULL, these
#' aren't plotted.
#' @param colhicol Color to use for the `hicol` points. If NULL, these
#' aren't plotted.
#' @param \dots Passed to `base::plot()` and
#' [graphics::points()].
#' @return None.
#' @author Karl W Broman, \email{broman@@wisc.edu}
#' @seealso [pulldiag()], [distee()],
#' [summary.lineupdist()]
#' @keywords graphics
#' @examples
#' data(expr1, expr2)
#'
#' \dontshow{expr1 <- expr1[,1:500]
#' expr2 <- expr2[,1:500]}
#'
#' # distances as RMS difference and correlation
#' d_rmsd <- distee(expr1, expr2, "rmsd")
#' d_cor <- distee(expr1, expr2, "cor")
#'
#' # plot distances against one another
#' plot2dist(d_rmsd, d_cor)
#'
#' @importFrom graphics points
#' @importFrom grDevices colorRampPalette
#' @export
plot2dist <-
function(d1, d2, hirow=NULL, hicol=NULL, xlab=NULL, ylab=NULL, smoothScatter=FALSE,
colself="black", colnonself="gray", colhirow="green", colhicol="orange", ...)
{
xmis <- ymix <- FALSE
if(is.null(xlab)) {
xmis <- TRUE
meth <- attr(d1, "d.method")
if(is.null(meth)) xlab <- "d1"
else if(meth=="cor") xlab <- "Correlation"
else if(meth=="rmsd") xlab <- "RMS difference"
else if(meth=="prop.mismatch") xlab <- "Proportion mismatches"
else xlab <- "d1"
}
if(is.null(ylab)) {
ymis <- TRUE
meth <- attr(d2, "d.method")
if(is.null(meth)) ylab <- "d2"
else if(meth=="cor") ylab <- "Correlation"
else if(meth=="rmsd") ylab <- "RMS difference"
else if(meth=="prop.mismatch") ylab <- "Proportion mismatches"
else ylab <- "d2"
}
if(xlab == ylab && (xmis || ymis)) {
xlab <- "d1"
ylab <- "d2"
}
if(any(dim(d1) != dim(d2)) || any(rownames(d1) != rownames(d2)) ||
any(colnames(d1) != colnames(d2))) {
# pull out just the common rows and columns
rn1 <- rownames(d1)
rn2 <- rownames(d2)
cn1 <- colnames(d1)
cn2 <- colnames(d2)
# line up rows
m1 <- match(rn1, rn2)
m2 <- match(rn2, rn1)
if(any(is.na(m1))) {
d1 <- d1[!is.na(m1),,drop=FALSE]
rn1 <- rn1[!is.na(m1)]
}
if(any(is.na(m2))) {
d2 <- d2[!is.na(m2),,drop=FALSE]
rn2 <- rn2[!is.na(m1)]
}
d2 <- d2[match(rn1, rn2),,drop=FALSE]
# line up columns
m1 <- match(cn1, cn2)
m2 <- match(cn2, cn1)
if(any(is.na(m1))) {
d1 <- d1[,!is.na(m1),drop=FALSE]
cn1 <- cn1[!is.na(m1)]
}
if(any(is.na(m2))) {
d2 <- d2[,!is.na(m2),drop=FALSE]
cn2 <- cn2[!is.na(m1)]
}
d2 <- d2[,match(cn1, cn2),drop=FALSE]
}
rn <- rownames(d1)
cn <- colnames(d1)
m <- match(rn, cn)
self <- matrix(ncol=2, nrow=sum(!is.na(m)))
wh <- which(!is.na(m))
m <- m[!is.na(m)]
xl <- range(d1, na.rm=TRUE)
yl <- range(d2, na.rm=TRUE)
for(i in seq(along=wh)) {
self[i,] <- c(d1[wh[i],m[i]], d2[wh[i],m[i]])
d1[wh[i],m[i]] <- d2[wh[i],m[i]] <- NA
}
if(!is.null(hirow)) {
hirowd1 <- d1[hirow,]
hirowd2 <- d2[hirow,]
d1[hirow,] <- d2[hirow,] <- NA
}
if(!is.null(hicol)) {
hicold1 <- d1[,hicol]
hicold2 <- d2[,hicol]
d1[,hicol] <- d2[,hicol] <- NA
}
if(is.null(colnonself))
plot(0,0,type="n", xlab=xlab, ylab=ylab, xlim=xl, ylim=yl, ...)
else {
if(smoothScatter)
graphics::smoothScatter(d1, d2, xlab=xlab, ylab=ylab, xlim=xl, ylim=yl,
colramp=colorRampPalette(c("white","blue")))
else {
plot(unclass(d1), unclass(d2), xlab=xlab, ylab=ylab, xlim=xl, ylim=yl, col=colnonself, ...)
}
}
if(!is.null(hirow) && !is.null(colhirow)) points(hirowd1, hirowd2, col=colhirow, ...)
if(!is.null(hicol) && !is.null(colhicol)) points(hicold1, hicold2, col=colhicol, ...)
if(!is.null(colself)) points(self, col=colself, pch=16, ...)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.