[381c22]: / R / DIscBIO-generic-plotExptSNE.R

Download this file

103 lines (100 with data), 2.9 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
#' @title Highlighting gene expression in the t-SNE map
#' @description The t-SNE map representation can also be used to analyze
#' expression of a gene or a group of genes, to investigate cluster specific
#' gene expression patterns
#' @param object \code{DISCBIO} class object.
#' @param g Individual gene name or vector with a group of gene names
#' corresponding to a subset of valid row names of the \code{ndata} slot of
#' the \code{DISCBIO} object.
#' @param n String of characters representing the title of the plot. Default is
#' NULL and the first element of \code{g} is chosen.
#' @return t-SNE plot for one particular gene
setGeneric("plotExptSNE", function(object, g, n = NULL) {
standardGeneric("plotExptSNE")
})
#' @export
#' @rdname plotExptSNE
setMethod(
"plotExptSNE",
signature = "DISCBIO",
definition = function(object, g, n = NULL) {
# ======================================================================
# Validation
# ======================================================================
ran_k <- length(object@tsne) > 0
ran_m <- length(object@MBtsne) > 0
if (ran_k) {
x <- object@tsne
} else if (ran_m) {
x <- object@MBtsne
} else {
stop("run comptSNE before plotExptSNE")
}
if (length(intersect(g, rownames(object@ndata))) < length(unique(g))) {
stop(
"second argument does not correspond to set of rownames slot",
"ndata of SCseq object"
)
}
if (is.null(n)) n <- g[1]
# ======================================================================
# Plotting
# ======================================================================
logObj <- log(object@ndata)
l <- apply(logObj[g, ] - .1, 2, sum) + .1
mi <- min(l, na.rm = TRUE)
ma <- max(l, na.rm = TRUE)
ColorRamp <- colorRampPalette(
rev(brewer.pal(n = 7, name = "RdYlBu"))
)(100)
ColorLevels <- seq(mi, ma, length = length(ColorRamp))
v <- round((l - mi) / (ma - mi) * 99 + 1, 0)
layout(
matrix(
data = c(1, 3, 2, 4),
nrow = 2,
ncol = 2
),
widths = c(5, 1, 5, 1),
heights = c(5, 1, 1, 1)
)
opar <- withr::local_par(mar = c(3, 5, 2.5, 2))
on.exit(withr::local_par(opar))
plot(
x,
xlab = "Dim 1",
ylab = "Dim 2",
main = n,
pch = 20,
cex = 0,
col = "grey",
las = 1
)
for (k in seq_len(length(v))) {
points(
x[k, 1],
x[k, 2],
col = ColorRamp[v[k]],
pch = 20,
cex = 1.5
)
}
opar <- withr::local_par(mar = c(3, 2.5, 2.5, 2))
on.exit(withr::local_par(opar))
image(
1,
ColorLevels,
matrix(
data = ColorLevels,
ncol = length(ColorLevels),
nrow = 1
),
col = ColorRamp,
xlab = "",
ylab = "",
las = 1,
xaxt = "n"
)
layout(1)
}
)