Skip to content

Commit 5679538

Browse files
FeiLiyangFeiLiyang
committed
fix rev comments
1 parent b153936 commit 5679538

15 files changed

+747
-827
lines changed

‎R/BarcodePairCorrelation.R‎

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -56,8 +56,6 @@ plotBarcodePairCorrelation <- function(
5656
yAxis <- log2(corTestResults[, dataVisual] + 1)
5757
yTitle <- paste0("log2 (", dataVisual, " CPM +1)")
5858

59-
## ggplot2 has a bug that gives wrong warning of 'Removed rows containing missing values'
60-
suppressWarnings({
6159
## plotting correlations
6260
p <- ggplot(corTestResults, aes(x = cor)) +
6361
geom_histogram(
@@ -90,7 +88,6 @@ plotBarcodePairCorrelation <- function(
9088
color = "#7CAE00", alpha = 1, size = 3,
9189
label = paste0("log2(", dataVisual, "+1)=", dataCutoff)
9290
)
93-
})
9491

9592
return(p)
9693
}

‎R/helpers.R‎

Lines changed: 146 additions & 150 deletions
Large diffs are not rendered by default.

‎R/monkeyHSPC.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -7,14 +7,14 @@
77
#' Barcode counts within different samples were used to interpret the patterns of HSPC differentiation.
88
#'
99
#' The original monkey HSPC barcoding data were published in the following paper:
10-
#' [Wu, Chuanfeng, et al. "Clonal expansion and compartmentalized maintenance of rhesus macaque NK cell subsets." Science Immunology (2018)](http://dx.doi.org/10.1126/sciimmunol.aat9781)
10+
#' [Wu, Chuanfeng, et al. 'Clonal expansion and compartmentalized maintenance of rhesus macaque NK cell subsets.' Science Immunology (2018)](http://dx.doi.org/10.1126/sciimmunol.aat9781)
1111
#'
1212
#' However, the barcode count data were analysed by the original authors using the [barcodetrackR](10.18129/B9.bioc.barcodetrackR) package
1313
#' and made available through the compatible [barcodetrackRData](https://github.com/dunbarlabNIH/barcodetrackRData) repository on GitHub.
1414
#'
1515
#' Here, we directly source the raw data from `barcodetrackRData`.
1616
#'
17-
#' This dataset includes data from the "ZG66" monkey individual only. Additional datasets are available at the source link.
17+
#' This dataset includes data from the 'ZG66' monkey individual only. Additional datasets are available at the source link.
1818
#'
1919
#' @format ## `monkeyHSPC`
2020
#' A list containing:

‎R/plotBarcodeBias.R‎

Lines changed: 85 additions & 116 deletions
Original file line numberDiff line numberDiff line change
@@ -32,96 +32,70 @@
3232
#'
3333
#' @examples
3434
#' Block <- c(1, 1, 2, 3, 3, 4, 1, 1, 2, 3, 3, 4)
35-
#' Treat <- factor(rep(c("ctrl", "drug"), each = 6))
35+
#' Treat <- factor(rep(c('ctrl', 'drug'), each = 6))
3636
#' Time <- rep(rep(seq_len(2), each = 3), 2)
3737
#' nbarcodes <- 50
3838
#' nsamples <- 12
3939
#' count <- abs(matrix(rnorm(nbarcodes * nsamples), nbarcodes, nsamples))
40-
#' rownames(count) <- paste0("Barcode", seq_len(nbarcodes))
40+
#' rownames(count) <- paste0('Barcode', seq_len(nbarcodes))
4141
#' barbieQ <- createBarbieQ(count, data.frame(Treat = Treat, Time = Time))
42-
#' testBB <- testBarcodeBias(barbieQ, sampleGroups = "Treat")
43-
#' plotBarcodeBiasScatterPlot(barbieQ = testBB, elementName = "diffProp_Treat")
44-
plotBarcodeBiasScatterPlot <- function(
45-
barbieQ, elementName = NULL, reorderRank = FALSE,
42+
#' testBB <- testBarcodeBias(barbieQ, sampleGroups = 'Treat')
43+
#' plotBarcodeBiasScatterPlot(barbieQ = testBB, elementName = 'diffProp_Treat')
44+
plotBarcodeBiasScatterPlot <- function(barbieQ, elementName = NULL, reorderRank = FALSE,
4645
pValuesAdjusted = TRUE, xAxis = "avgRank") {
47-
## extract test resilts and information
48-
if (is.null(elementName)) {
49-
elementName <- names(barbieQ$testBarcodes)[length(names(barbieQ$testBarcodes))]
50-
}
51-
if (is.null(barbieQ$testBarcodes[[elementName]])) {
52-
stop("test results not specified or not found")
53-
}
54-
testInfo <- barbieQ$testBarcodes[[elementName]]
55-
statMat <- testInfo$results
56-
methodLs <- testInfo$methods
57-
## define a custom color/shape palette for test results
58-
customShape <- stats::setNames(c(21, 24, 23), c(methodLs$contrastLevels, "n.s."))
59-
customColor <- barbieQ$factorColors[[elementName]]
60-
## y axis will be p.value x axis will be optional: total occurrence, average
61-
## rank, average log CPM reorder Barcode rank within samples.
62-
if (reorderRank) {
63-
rank <- apply(barbieQ$rank, 2, rank)
64-
} else {
65-
rank <- barbieQ$rank
66-
}
67-
## choose p.values
68-
if (pValuesAdjusted) {
69-
p.value <- statMat$adj.p.value
70-
} else {
71-
p.value <- statMat$p.value
72-
}
73-
## check xAxis
74-
xOptions <- c("avgRank", "totalOcc", "avgLogCPM", "avgProportion")
75-
xAxis <- match.arg(xAxis, xOptions)
76-
xTitle <- stats::setNames(
77-
c(
78-
"Average rank of Barcode across samples", "Number of samples in which Barcode occurs",
79-
"Average Barcode Log2 CPM+1 across samples", "Average Barcode proportion across samples"
80-
),
81-
xOptions
82-
)
83-
## data.frame for ggplot
84-
mydata <- data.frame(
85-
direction = statMat$direction, minusLogP = -log10(p.value), totalOcc = rowSums(barbieQ$occurrence),
86-
avgRank = rowMeans(barbieQ$rank), BarcodeID = rownames(barbieQ$assay), avgLogCPM = log2(rowMeans((barbieQ$CPM +
87-
1))), avgProportion = rowMeans(barbieQ$proportion)
88-
)
89-
## visualize by ggplot
90-
p <- ggplot(mydata, aes(x = mydata[, xAxis], y = minusLogP, text = BarcodeID)) +
91-
geom_point(aes(
92-
color = direction,
93-
shape = direction, fill = direction
94-
), size = 4, stroke = 1) +
95-
theme_classic() +
96-
theme(aspect.ratio = 1) +
97-
labs(
98-
title = paste0(methodLs$aim, " : ", methodLs$contrastVector),
99-
y = "-log10(p.value)", x = xTitle[xAxis]
100-
) +
101-
geom_hline(
102-
yintercept = -log10(0.05),
103-
linetype = "dashed", color = "grey"
104-
) +
105-
scale_color_manual(values = customColor) +
106-
scale_shape_manual(values = customShape) +
107-
scale_fill_manual(values = alpha(
108-
customColor,
109-
0.2
110-
))
111-
## reverse x scale if displaying Barcode rank
112-
if (xAxis == "avgRank") {
113-
p <- p + annotate("text",
114-
x = min(mydata[, xAxis]) * 1.1, y = -log10(0.05), label = "p.value = 0.05",
115-
vjust = 1.5, hjust = 1
116-
) + scale_x_reverse()
117-
} else {
118-
p <- p + annotate("text",
119-
x = max(mydata[, xAxis]) * 0.9, y = -log10(0.05), label = "p.value = 0.05",
120-
vjust = 1.5, hjust = 1
121-
)
122-
}
46+
## extract test resilts and information
47+
if (is.null(elementName)) {
48+
elementName <- names(barbieQ$testBarcodes)[length(names(barbieQ$testBarcodes))]
49+
}
50+
if (is.null(barbieQ$testBarcodes[[elementName]])) {
51+
stop("test results not specified or not found")
52+
}
53+
testInfo <- barbieQ$testBarcodes[[elementName]]
54+
statMat <- testInfo$results
55+
methodLs <- testInfo$methods
56+
## define a custom color/shape palette for test results
57+
customShape <- stats::setNames(c(21, 24, 23), c(methodLs$contrastLevels, "n.s."))
58+
customColor <- barbieQ$factorColors[[elementName]]
59+
## y axis will be p.value x axis will be optional: total occurrence, average rank,
60+
## average log CPM reorder Barcode rank within samples.
61+
if (reorderRank) {
62+
rank <- apply(barbieQ$rank, 2, rank)
63+
} else {
64+
rank <- barbieQ$rank
65+
}
66+
## choose p.values
67+
if (pValuesAdjusted) {
68+
p.value <- statMat$adj.p.value
69+
} else {
70+
p.value <- statMat$p.value
71+
}
72+
## check xAxis
73+
xOptions <- c("avgRank", "totalOcc", "avgLogCPM", "avgProportion")
74+
xAxis <- match.arg(xAxis, xOptions)
75+
xTitle <- stats::setNames(c("Average rank of Barcode across samples", "Number of samples in which Barcode occurs",
76+
"Average Barcode Log2 CPM+1 across samples", "Average Barcode proportion across samples"),
77+
xOptions)
78+
## data.frame for ggplot
79+
mydata <- data.frame(direction = statMat$direction, minusLogP = -log10(p.value), totalOcc = rowSums(barbieQ$occurrence),
80+
avgRank = rowMeans(barbieQ$rank), BarcodeID = rownames(barbieQ$assay), avgLogCPM = log2(rowMeans((barbieQ$CPM +
81+
1))), avgProportion = rowMeans(barbieQ$proportion))
82+
## visualize by ggplot
83+
p <- ggplot(mydata, aes(x = mydata[, xAxis], y = minusLogP, text = BarcodeID)) + geom_point(aes(color = direction,
84+
shape = direction, fill = direction), size = 4, stroke = 1) + theme_classic() + theme(aspect.ratio = 1) +
85+
labs(title = paste0(methodLs$aim, " : ", methodLs$contrastVector), y = "-log10(p.value)",
86+
x = xTitle[xAxis]) + geom_hline(yintercept = -log10(0.05), linetype = "dashed",
87+
color = "grey") + scale_color_manual(values = customColor) + scale_shape_manual(values = customShape) +
88+
scale_fill_manual(values = alpha(customColor, 0.2))
89+
## reverse x scale if displaying Barcode rank
90+
if (xAxis == "avgRank") {
91+
p <- p + annotate("text", x = min(mydata[, xAxis]) * 1.1, y = -log10(0.05), label = "p.value = 0.05",
92+
vjust = 1.5, hjust = 1) + scale_x_reverse()
93+
} else {
94+
p <- p + annotate("text", x = max(mydata[, xAxis]) * 0.9, y = -log10(0.05), label = "p.value = 0.05",
95+
vjust = 1.5, hjust = 1)
96+
}
12397

124-
return(p)
98+
return(p)
12599
}
126100

127101

@@ -155,47 +129,42 @@ plotBarcodeBiasScatterPlot <- function(
155129
#'
156130
#' @examples
157131
#' Block <- c(1, 1, 2, 3, 3, 4, 1, 1, 2, 3, 3, 4)
158-
#' Treat <- factor(rep(c("ctrl", "drug"), each = 6))
132+
#' Treat <- factor(rep(c('ctrl', 'drug'), each = 6))
159133
#' Time <- rep(rep(seq_len(2), each = 3), 2)
160134
#' nbarcodes <- 50
161135
#' nsamples <- 12
162136
#' count <- abs(matrix(rnorm(nbarcodes * nsamples), nbarcodes, nsamples))
163-
#' rownames(count) <- paste0("Barcode", seq_len(nbarcodes))
137+
#' rownames(count) <- paste0('Barcode', seq_len(nbarcodes))
164138
#' barbieQ <- createBarbieQ(count, data.frame(Treat = Treat, Time = Time))
165-
#' testBB <- testBarcodeBias(barbieQ, sampleGroups = "Treat")
166-
#' plotBarcodeBiasHeatmap(barbieQ = testBB, elementName = "diffProp_Treat")
139+
#' testBB <- testBarcodeBias(barbieQ, sampleGroups = 'Treat')
140+
#' plotBarcodeBiasHeatmap(barbieQ = testBB, elementName = 'diffProp_Treat')
167141
plotBarcodeBiasHeatmap <- function(barbieQ, value = "CPM", elementName = NULL, sampleAnnotation = NULL) {
168-
## extract test resilts and information
169-
if (is.null(elementName)) {
170-
elementName <- names(barbieQ$testBarcodes)[length(names(barbieQ$testBarcodes))]
171-
}
172-
if (is.null(barbieQ$testBarcodes[[elementName]])) {
173-
stop("test results not specified or not found")
174-
}
175-
testInfo <- barbieQ$testBarcodes[[elementName]]
176-
statMat <- testInfo$results
177-
methodLs <- testInfo$methods
178-
modelTargets <- testInfo$targets
179-
## define a custom color/shape palette for test results
180-
customShape <- stats::setNames(c(21, 24, 23), c(methodLs$contrastLevels, "n.s."))
181-
customColor <- barbieQ$factorColors[[elementName]]
142+
## extract test resilts and information
143+
if (is.null(elementName)) {
144+
elementName <- names(barbieQ$testBarcodes)[length(names(barbieQ$testBarcodes))]
145+
}
146+
if (is.null(barbieQ$testBarcodes[[elementName]])) {
147+
stop("test results not specified or not found")
148+
}
149+
testInfo <- barbieQ$testBarcodes[[elementName]]
150+
statMat <- testInfo$results
151+
methodLs <- testInfo$methods
152+
modelTargets <- testInfo$targets
153+
## define a custom color/shape palette for test results
154+
customShape <- stats::setNames(c(21, 24, 23), c(methodLs$contrastLevels, "n.s."))
155+
customColor <- barbieQ$factorColors[[elementName]]
182156

183-
## customize row annotation
184-
barcodeAnnotation <- rowAnnotation(
185-
Direction = statMat$direction, annotation_name_side = "top",
186-
annotation_name_gp = grid::gpar(fontsize = 10), col = list(Direction = customColor),
187-
show_legend = TRUE, show_annotation_name = TRUE
188-
)
157+
## customize row annotation
158+
barcodeAnnotation <- rowAnnotation(Direction = statMat$direction, annotation_name_side = "top",
159+
annotation_name_gp = grid::gpar(fontsize = 10), col = list(Direction = customColor),
160+
show_legend = TRUE, show_annotation_name = TRUE)
189161

190-
## adjust the order of slices based on contrast levels in the test
191-
restLevels <- dplyr::setdiff(levels(modelTargets[, methodLs$contrastVector]), methodLs$contrastLevels)
192-
levels(modelTargets[, methodLs$contrastVector]) <- c(methodLs$contrastLevels, restLevels)
162+
## adjust the order of slices based on contrast levels in the test
163+
restLevels <- dplyr::setdiff(levels(modelTargets[, methodLs$contrastVector]), methodLs$contrastLevels)
164+
levels(modelTargets[, methodLs$contrastVector]) <- c(methodLs$contrastLevels, restLevels)
193165

194-
hp <- plotBarcodeHeatmap(
195-
barbieQ = barbieQ, value = value, splitSamples = TRUE, targets = modelTargets,
196-
sampleGroups = methodLs$contrastVector, barcodeAnnotation = barcodeAnnotation,
197-
sampleAnnotation = sampleAnnotation
198-
)
166+
hp <- plotBarcodeHeatmap(barbieQ = barbieQ, value = value, splitSamples = TRUE, targets = modelTargets,
167+
sampleGroups = methodLs$contrastVector, barcodeAnnotation = barcodeAnnotation, sampleAnnotation = sampleAnnotation)
199168

200-
return(hp)
169+
return(hp)
201170
}

‎R/plotBarcodeHeatmap.R‎

Lines changed: 46 additions & 58 deletions
Original file line numberDiff line numberDiff line change
@@ -37,82 +37,70 @@
3737
#' @examples
3838
#' ## sample conditions and color palettes
3939
#' sampleConditions <- data.frame(
40-
#' Treat = factor(rep(c("ctrl", "drug"), each = 6)),
40+
#' Treat = factor(rep(c('ctrl', 'drug'), each = 6)),
4141
#' Time = rep(rep(seq_len(2), each = 3), 2)
4242
#' )
4343
#' conditionColor <- list(
44-
#' Treat = c(ctrl = "#999999", drug = "#112233"),
45-
#' Time = c("1" = "#778899", "2" = "#998877")
44+
#' Treat = c(ctrl = '#999999', drug = '#112233'),
45+
#' Time = c('1' = '#778899', '2' = '#998877')
4646
#' )
4747
#' ## Barcode count data
4848
#' nbarcodes <- 50
4949
#' nsamples <- 12
5050
#' barcodeCount <- abs(matrix(10, nbarcodes, nsamples))
5151
#' barcodeCount[seq(21, 50), ] <- 0.0001
52-
#' rownames(barcodeCount) <- paste0("Barcode", seq_len(nbarcodes))
52+
#' rownames(barcodeCount) <- paste0('Barcode', seq_len(nbarcodes))
5353
#' ## create a `barbieQ` object
5454
#' myBarbieQ <- createBarbieQ(barcodeCount, sampleConditions, conditionColor)
5555
#' plotBarcodeHeatmap(myBarbieQ)
56-
plotBarcodeHeatmap <- function(
57-
barbieQ, value = "CPM", splitSamples = FALSE, targets = NULL,
56+
plotBarcodeHeatmap <- function(barbieQ, value = "CPM", splitSamples = FALSE, targets = NULL,
5857
sampleGroups = NULL, barcodeAnnotation = NULL, sampleAnnotation = NULL) {
59-
## check barbieQ dimensions
60-
checkBarbieQDimensions(barbieQ)
58+
## check barbieQ dimensions
59+
checkBarbieQDimensions(barbieQ)
6160

62-
## check which value to visualize
63-
value <- match.arg(value, c("CPM", "occurrence"))
61+
## check which value to visualize
62+
value <- match.arg(value, c("CPM", "occurrence"))
6463

65-
## extract targets and primary effector based on arguments
66-
targetsInfo <- extractTargetsAndPrimaryFactor(
67-
barbieQ = barbieQ, targets = targets,
68-
sampleGroups = sampleGroups
69-
)
70-
mytargets <- targetsInfo$mytargets
71-
pointer <- targetsInfo$pointer
72-
## set the primary effector as sample splitter displaying at bottom
73-
bottomTargets <- mytargets[, pointer, drop = FALSE]
74-
## the rest of effectors displayed at top
75-
topTargets <- mytargets[, setdiff(seq_along(colnames(mytargets)), pointer), drop = FALSE]
64+
## extract targets and primary effector based on arguments
65+
targetsInfo <- extractTargetsAndPrimaryFactor(barbieQ = barbieQ, targets = targets, sampleGroups = sampleGroups)
66+
mytargets <- targetsInfo$mytargets
67+
pointer <- targetsInfo$pointer
68+
## set the primary effector as sample splitter displaying at bottom
69+
bottomTargets <- mytargets[, pointer, drop = FALSE]
70+
## the rest of effectors displayed at top
71+
topTargets <- mytargets[, setdiff(seq_along(colnames(mytargets)), pointer), drop = FALSE]
7672

77-
sampleAnnotation <- HeatmapAnnotation(
78-
df = topTargets, annotation_name_side = "left",
79-
annotation_name_gp = grid::gpar(fontsize = 10), col = barbieQ$factorColors
80-
)
73+
sampleAnnotation <- HeatmapAnnotation(df = topTargets, annotation_name_side = "left",
74+
annotation_name_gp = grid::gpar(fontsize = 10), col = barbieQ$factorColors)
8175

82-
if (splitSamples) {
83-
groupAnnotation <- HeatmapAnnotation(
84-
df = bottomTargets, annotation_name_side = "left",
85-
annotation_name_gp = grid::gpar(fontsize = 10), col = barbieQ$factorColors
86-
)
87-
splitBy <- bottomTargets
88-
} else {
89-
groupAnnotation <- NULL
90-
splitBy <- NULL
91-
}
76+
if (splitSamples) {
77+
groupAnnotation <- HeatmapAnnotation(df = bottomTargets, annotation_name_side = "left",
78+
annotation_name_gp = grid::gpar(fontsize = 10), col = barbieQ$factorColors)
79+
splitBy <- bottomTargets
80+
} else {
81+
groupAnnotation <- NULL
82+
splitBy <- NULL
83+
}
9284

93-
## choose values to be visualised
94-
if (value == "CPM") {
95-
mat <- log2(barbieQ$CPM + 1) %>%
96-
as.matrix()
97-
matTitle <- "log2 CPM+1"
98-
colorFun <- circlize::colorRamp2(c(min(mat), mean(mat), max(mat)), c(
99-
"blue", "white",
100-
"red"
101-
))
102-
} else {
103-
mat <- (barbieQ$occurrence + 1 - 1) %>%
104-
as.matrix()
105-
matTitle <- "occurrence"
106-
colorFun <- structure(c(2, 4), names = c("1", "0"))
107-
}
85+
## choose values to be visualised
86+
if (value == "CPM") {
87+
mat <- log2(barbieQ$CPM + 1) %>%
88+
as.matrix()
89+
matTitle <- "log2 CPM+1"
90+
colorFun <- circlize::colorRamp2(c(min(mat), mean(mat), max(mat)), c("blue", "white",
91+
"red"))
92+
} else {
93+
mat <- (barbieQ$occurrence + 1 - 1) %>%
94+
as.matrix()
95+
matTitle <- "occurrence"
96+
colorFun <- structure(c(2, 4), names = c("1", "0"))
97+
}
10898

109-
hp <- Heatmap(mat,
110-
name = matTitle, width = unit(6, "cm"), height = unit(6, "cm"),
111-
cluster_rows = TRUE, cluster_columns = TRUE, show_row_names = FALSE, show_column_names = FALSE,
112-
column_title = paste0(ncol(mat), " Samples"), row_title = paste0(nrow(mat), " Barcodes"),
113-
col = colorFun, right_annotation = barcodeAnnotation, top_annotation = sampleAnnotation,
114-
bottom_annotation = groupAnnotation, column_split = splitBy, cluster_column_slices = FALSE
115-
)
99+
hp <- Heatmap(mat, name = matTitle, width = unit(6, "cm"), height = unit(6, "cm"), cluster_rows = TRUE,
100+
cluster_columns = TRUE, show_row_names = FALSE, show_column_names = FALSE, column_title = paste0(ncol(mat),
101+
" Samples"), row_title = paste0(nrow(mat), " Barcodes"), col = colorFun, right_annotation = barcodeAnnotation,
102+
top_annotation = sampleAnnotation, bottom_annotation = groupAnnotation, column_split = splitBy,
103+
cluster_column_slices = FALSE)
116104

117-
return(hp)
105+
return(hp)
118106
}

0 commit comments

Comments
 (0)