Commit 47a44611 authored by Nicolas Delhomme's avatar Nicolas Delhomme

Added data for the RobinsonDelhomme2014 aspen sexual dimorphism manuscript

parent cf77580f
This diff is collapsed.
This diff is collapsed.
## this function is originally from the lSD package
## modified to suppress the change of margins
setGeneric(name="densityPlot",
def=function(x, y, grid = 100,
ncol = 30,
nlevels = 10, ...){
standardGeneric("densityPlot")
})
setMethod(f="densityPlot",
signature=c("numeric","numeric"),
definition=function(x, y, grid = 100, ncol = 30,
nlevels = 10, ...){
if (!is.vector(x) | !is.vector(y))
stop("First two argument must be vectors !")
if (length(x) != length(y))
stop("Data vectors must be of the same length !")
d = LSD:::kde2d.adj(x, y, n = grid)
z <- d$z
nrz <- nrow(z)
ncz <- ncol(z)
couleurs <- tail(topo.colors(trunc(1.4 * ncol)), ncol)
image(d, col = couleurs, ...)
contour(d, add = TRUE, nlevels = nlevels)
box()
})
\ No newline at end of file
"plot.multidensity" <- function(x,xlab="x",col=brewer.pal(8,"Dark2"),
legend.x="top",xlim=NULL,ylim=NULL,
lty=1,legend.cex=1,...){
## pckg
library(RColorBrewer)
## check
stopifnot(is.list(x))
## densities
dens <- lapply(x,density)
if(is.null(xlim)){
xlim <- range(sapply(dens,"[[","x"))
}
if(is.null(ylim)){
ylim <- range(sapply(dens,"[[","y"))
}
## lty
if(length(lty)==1){
lty <- rep(lty,length(dens))
}
## plot
plot(0,0,xlim=xlim,ylim=ylim,ylab="density",type="n",xlab=xlab,...)
## lines
sapply(1:length(dens),function(i,dens,col,...){lines(dens[[i]],col=col[i],lty=lty[i],...)},dens,col,...)
## legend
legend(legend.x,col=col[1:length(x)],bty="n",legend=names(x),lty=lty,cex=legend.cex)
}
require("LSD")
plotDispLSD <- function(cds, name = NULL, ymin, linecol = "#00000080", xlab = "mean of normalized counts",
ylab = "dispersion", log = "xy", cex = 0.45, ...)
{
px = rowMeans(counts(cds, normalized = TRUE))
sel = (px > 0)
px = px[sel]
py = fitInfo(cds, name = name)$perGeneDispEsts[sel]
if (missing(ymin))
ymin = 10^floor(log10(min(py[py > 0], na.rm = TRUE)) -
0.1)
heatscatter(log10(px), log10(pmax(py, ymin)), xlab = xlab, ylab = ylab,
pch = ifelse(py < ymin, 6, 16), cex = cex,
xaxt='n', yaxt='n', ...)
# Fix logged axes labels
atx <- axTicks(1)
aty <- axTicks(2)
xlabels <- sapply(atx, function (i)
as.expression(bquote(10^ .(i)))
)
ylabels <- sapply(aty, function (i)
as.expression(bquote(10^ .(i)))
)
axis(1, at=atx, labels=xlabels)
axis(2, at=aty, labels=ylabels)
xg = 10^seq(-0.5, 5, length.out = 100)
lines(log10(xg), log10(fitInfo(cds, name = name)$dispFun(xg)), col = linecol,
lwd = 4, lty = 1
)
}
plotMALSD <- function (x, ylim, sign=0.05, col = 'forestgreen',
linecol = "#00000080", xlab = "mean of normalized counts",
ylab = expression(log[2] ~ fold ~ change), log = "x", cex = 0.45,
...)
{
if (!(is.data.frame(x) && all(c("baseMean", "log2FoldChange") %in%
colnames(x))))
stop("'x' must be a data frame with columns named 'baseMean', 'log2FoldChange'.")
x = subset(x, baseMean != 0)
py = x$log2FoldChange
if (missing(ylim))
ylim = c(-1, 1) * quantile(abs(py[is.finite(py)]), probs = 0.99) *
1.1
heatscatter(log10(x$baseMean), pmax(ylim[1], pmin(ylim[2], py)),
pch = ifelse(py < ylim[1], 6, ifelse(py > ylim[2], 2, 16)),
cex = cex,
xlab = xlab,
ylab = ylab,
xaxt = 'n',
ylim = ylim, ...)
# Fix logged x-axis
atx <- axTicks(1)
labels <- sapply(atx, function (i)
as.expression(bquote(10^ .(i)))
)
axis(1, at=atx, labels=labels)
abline(h = 0, lwd = 4, col = linecol, lty=1)
# Mark the significant DEGs, quite ugly, right?
sign <- subset(x, padj < sign)
pointy <- sign$log2FoldChange
points(log10(sign$baseMean),
pmax(ylim[1], pmin(ylim[2], pointy)),
pch = 1,
col = col,
cex = cex + 0.5)
}
setMethod(f="plotMA",
signature="DataFrame",
definition=function(object,alpha=0.001){
## lib
require(LSD)
## check
if(!existsFunction("densityPlot")){
stop("Load the densityPlot function prior to using this function.")
}
## selectors
sel <- ! is.na(object$padj)
sel2 <- object$padj[sel]<=alpha
## graphic params
orig.par <- par(no.readonly=TRUE)
par(mfrow=c(2,1))
## plots
densityPlot(log10(object$baseMean[sel]),
object$log2FoldChange[sel],
grid=250,ncol=30,nlevels=10,
main="MA density estimation"
)
mtext("log10 mean expression",side=2,line=2)
mtext("log2 FC",side=1,line=2)
heatscatter(log10(object$baseMean[sel]),
object$log2FoldChange[sel],
add.contour=TRUE,main="MA",
xlab="log10 mean expression",
ylab="log2 FC",sub=paste(sum(sel2),
"sign. feats. @",
alpha,"cutoff"))
points(log10(object$baseMean[sel][sel2]),
object$log2FoldChange[sel][sel2],
col="darkred",pch=19,cex=.5)
legend("topright",pch=19,col="darkred","sign. feats.")
par(orig.par,no.readonly=TRUE)
invisible(TRUE)
})
setGeneric(name="volcanoPlot",def=function(object,alpha=0.001){
standardGeneric("volcanoPlot")
})
setMethod(f="volcanoPlot",
signature="DataFrame",
definition=function(object,alpha=0.001){
## lib
require(LSD)
## selectors
sel <- ! is.na(object$padj)
sel2 <- object$padj[sel]<=alpha
## plot
heatscatter(object$log2FoldChange[sel],
-log10(object$padj[sel]),
main="Volcano",xlab="Log2 Fold Change",
ylab="- log(10) adj. p-value")
## legend
legend("topleft",bty="n",paste("cutoff @",alpha),lty=2,col="gray")
## points
points(object$log2FoldChange[sel][sel2],-log10(object$padj[sel][sel2]),col="lightblue",pch=19)
points(object$log2FoldChange[sel][sel2],-log10(object$padj[sel][sel2]),col="dodgerblue3",pch=19,cex=0.5)
## circle the points for the dot plot
abline(h=-log10(alpha),lty=2,col="gray")
})
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment