Switch to unified view

a b/R/DIscBIO-generic-plotOrderTsne.R
1
#' @title Plotting the pseudo-time ordering in the t-SNE map
2
#' @description The tSNE representation can also be used to show the pseudo-time
3
#'   ordering.
4
#' @param object \code{DISCBIO} class object.
5
#' @return A plot of the pseudo-time ordering.
6
setGeneric("plotOrderTsne", function(object) {
7
  standardGeneric("plotOrderTsne")
8
})
9
10
#' @export
11
#' @rdname plotOrderTsne
12
setMethod(
13
  "plotOrderTsne",
14
  signature = "DISCBIO",
15
  definition = function(object) {
16
    ran_k <- length(object@tsne) > 0
17
    ran_m <- length(object@MBtsne) > 0
18
    if (ran_k) {
19
      total <- rbind(object@ndata, object@kordering)
20
      clustering_method <- "k-means"
21
      x <- object@tsne
22
    } else if (ran_m) {
23
      total <- rbind(object@ndata, object@MBordering)
24
      clustering_method <- "model-based"
25
      x <- object@MBtsne
26
    } else {
27
      stop("run comptsne before plotOrderTsne")
28
    }
29
30
    rownames(total)[nrow(total)] <- paste(
31
      "Pseudo-time ordering of", clustering_method, "clustering"
32
    )
33
    g <- rownames(total)[nrow(total)]
34
    n <- g[1]
35
    l <- apply(total[g, ] - .1, 2, sum) + .1
36
37
    mi <- min(l, na.rm = TRUE)
38
    ma <- max(l, na.rm = TRUE)
39
    ColorRamp <- colorRampPalette(
40
      rev(brewer.pal(n = 7, name = "RdYlBu"))
41
    )(100)
42
    ColorLevels <- seq(mi, ma, length = length(ColorRamp))
43
    v <- round((l - mi) / (ma - mi) * 99 + 1, 0)
44
    layout(
45
      matrix(
46
        data = c(1, 3, 2, 4),
47
        nrow = 2,
48
        ncol = 2
49
      ),
50
      widths = c(5, 1, 5, 1),
51
      heights = c(5, 1, 1, 1)
52
    )
53
    opar <- withr::local_par(mar = c(3, 5, 2.5, 2))
54
    on.exit(withr::local_par(opar))
55
    plot(
56
      x,
57
      xlab = "Dim 1",
58
      ylab = "Dim 2",
59
      main = n,
60
      pch = 20,
61
      cex = 0,
62
      col = "grey",
63
      las = 1
64
    )
65
    for (k in seq_len(length(v))) {
66
      points(
67
        x[k, 1],
68
        x[k, 2],
69
        col = ColorRamp[v[k]],
70
        pch = 20,
71
        cex = 1.5
72
      )
73
    }
74
    opar <- withr::local_par(mar = c(3, 2.5, 2.5, 2))
75
    on.exit(withr::local_par(opar))
76
    image(
77
      1,
78
      ColorLevels,
79
      matrix(
80
        data = ColorLevels,
81
        ncol = length(ColorLevels),
82
        nrow = 1
83
      ),
84
      col = ColorRamp,
85
      xlab = "",
86
      ylab = "",
87
      las = 1,
88
      xaxt = "n"
89
    )
90
    layout(1)
91
  }
92
)