/
cyto_plot_gating_tree.R
192 lines (150 loc) · 5.17 KB
/
cyto_plot_gating_tree.R
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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
## CYTO_PLOT_GATING_TREE -------------------------------------------------------
#' Plot Gating Trees
#'
#' \code{cyto_plot_gating_tree} provides a simpler visualisation of the gating
#' scheme for \code{GatingHierarchy}, \code{GatingSet} and \code{gatingTemplate}
#' objects. The \code{GatingHierachy} method is also capable of displaying
#' population statistics such as frequency of parent or count.
#'
#' @param x object of class \code{GatingHierarchy}, \code{GatingSet} or
#' \code{gatingTemplate}.
#' @param stat used in \code{GatingHierachy} method to add either "percent" or
#' "count" statistics onto the gating tree, set to NULL by default to exclude
#' statistics.
#' @param ... not in use.
#'
#' @importFrom openCyto gh_generate_template CytoExploreR_.preprocess_csv
#' @importFrom magrittr %>%
#' @importFrom visNetwork visNetwork visEdges
#' @importFrom data.table as.data.table
#'
#' @author Dillon Hammill (Dillon.Hammill@anu.edu.au)
#'
#' @examples
#' library(CytoExploreRData)
#'
#' # Load in samples
#' fs <- Activation
#'
#' # Add samples to GatingSet
#' gs <- GatingSet(fs)
#'
#' # Apply compensation
#' gs <- cyto_compensate(gs)
#'
#' # Transform fluorescent channels
#' gs <- cyto_transform(gs, select = "Stim-D", trans_type = "logicle")
#'
#' # Gating
#' gt <- Activation_gatingTemplate
#' cyto_gatingTemplate_apply(gs, gt)
#'
#' # Visualise gating tree using gatingTemplate
#' cyto_plot_gating_tree(gt)
#'
#' # Visualise gating tree for GatingSet (same output as gatingTemplate)
#' cyto_plot_gating_tree(gs)
#'
#' # Visualise gating tree for GatingHierarchy
#' cyto_plot_gating_tree(gs[[32]], stat = "percent")
#' cyto_plot_gating_tree(gs[[32]], stat = "count")
#'
#' @name cyto_plot_gating_tree
NULL
#' @noRd
#' @export
cyto_plot_gating_tree <- function(x, ...){
UseMethod("cyto_plot_gating_tree")
}
#' @rdname cyto_plot_gating_tree
#' @export
cyto_plot_gating_tree.GatingHierarchy <- function(x,
stat = NULL,
...) {
# Extract gatingTemplate from GatingHierarchy
gt <- gh_generate_template(x)
# Extract nodes
nodes <- rbind("root", gt[, c("alias","alias"), drop = FALSE])
colnames(nodes) <- c("id","label")
# Add group column for colours
nodes$group <- nodes$id
# Extract alias and parent columns
edges <- gt[, c("alias","parent")]
# Rename columns for visNetwork
colnames(edges) <- c("to", "from")
# Convert parent to basename
edges[, "from"] <- basename(edges[, "from"])
# Scale nodes by frequency & add labels
if(!is.null(stat)){
# Calculate counts for each node
node_counts <- cyto_stats_compute(x,
alias = nodes$id,
stat = "count",
format = "long")
# Normalise as a percentage of "root"
if(stat == "count"){
# Extract counts
stats <- node_counts$Count
}
# Normalise as a percentage of parent
if(stat %in% c("percent","freq")){
# Order counts based on parent names
stats <- node_counts$Count/
node_counts[match(c("root", edges$from),
node_counts$Population), "Count"] * 100
stats <- LAPPLY(stats, function(z){.round(z, 2)})
stats <- paste(stats, "%")
}
# Add value column to adjust node sizes
nodes$value <- node_counts$Count/node_counts$Count[1]
# Add percent labels to edges
edges$label <- stats[-1]
}
# Call to visNetwork
visNetwork(nodes, edges) %>%
visEdges(arrows = "to", color = "black")
}
#' @rdname cyto_plot_gating_tree
#' @export
cyto_plot_gating_tree.GatingSet <- function(x, ...) {
# Generate template based on first sample
gt <- gh_generate_template(x[[1]])
# Extract nodes
nodes <- rbind("root", gt[, c("alias","alias"), drop = FALSE])
colnames(nodes) <- c("id","label")
# Add group column for colours
nodes$group <- nodes$id
# Extract alias and parent columns
edges <- gt[, c("alias","parent")]
# Rename columns for visNetwork
colnames(edges) <- c("to", "from")
# Convert parent to basename
edges[, "from"] <- basename(edges[, "from"])
# Call to visNetwork
visNetwork(nodes, edges) %>%
visEdges(arrows = "to", color = "black")
}
#' @rdname cyto_plot_gating_tree
#' @export
cyto_plot_gating_tree.gatingTemplate <- function(x, ...){
# Convert gatingTemplate to data.table
gt <- as.data.table(x)
# Preprocess gatingTemplate
gt <- CytoExploreR_.preprocess_csv(gt)
# Convert preprocessed gt to data.frame
gt <- as.data.frame(gt[, c("alias","parent"), with = FALSE])
# Extract nodes
nodes <- rbind("root", gt[, c("alias","alias"), drop = FALSE])
colnames(nodes) <- c("id","label")
# Add group column for colours
nodes$group <- nodes$id
# Extract alias and parent columns
edges <- gt[, c("alias","parent")]
# Rename columns for visNetwork
colnames(edges) <- c("to", "from")
# Convert parent to basename
edges[, "from"] <- basename(edges[, "from"])
# Call to visNetwork
visNetwork(nodes, edges) %>%
visEdges(arrows = "to", color = "black")
}