BiocStyle::markdown() knitr::opts_chunk$set(dpi=300)
library("hdxstats") library("dplyr") library("ggplot2") library("RColorBrewer") library("tidyr") library("pheatmap") library("scales") library("viridis") library("patchwork") library("Biostrings")
This vignette describeds how to analyse time-resolved differential HDX-MS experiments. The key elements are at least two conditions i.e. apo + antibody, apo + small molecule or protein closed + protien open, etc. The experiment can be replicated, though if there are sufficient time points analysed (>=3) then occasionally signficant results can be obtained. The data provided should be centroid-centric data. This package does not yet support analysis straight from raw spectra. Typically this will be provided as a .csv from tools such as dynamiX or HDExaminer.
The package relies of Bioconductor infrastructure so that it integrates with
other data types and can benefit from advantages in other fields of mass-spectrometry.
There are package specific object, classes and methods but importantly there is
reuse of classes found in quantitative proteomics data, mainly the QFeatures
object which extends the SummarisedExperiment
class for mass spectrometry data.
The focus of this package is on testing and visualisation of the testing results.
We will begin with a structural variant experiment in which MHP and a structural variant were mixed in different proportions. HDX-MS was performed on these samples and we expect to see reproducible but subtle differences. We first load the data from the package and it is .csv format.
MBPpath <- system.file("extdata", "MBP.csv", package = "hdxstats")
We can now read in the .csv file and have a quick look at the .csv.
MBP <- read.csv(MBPpath) head(MBP) # have a look length(unique(MBP$pep_sequence)) # peptide sequences
Let us have a quick visualisation of some the data so that we can see some of the features
filter(MBP, pep_sequence == unique(MBP$pep_sequence[1]), pep_charge == 2) %>% ggplot(aes(x = hx_time, y = d, group = factor(replicate_cnt), color = factor(hx_sample, unique(MBP$hx_sample)[c(7,5,1,2,3,4,6)]))) + theme_classic() + geom_point(size = 2) + scale_color_manual(values = brewer.pal(n = 7, name = "Set2")) + labs(color = "experiment", x = "Deuterium Exposure", y = "Deuterium incoperation")
We can see that the units of the time dimension are in seconds and that Deuterium incoperation has been normalized into Daltons.
Working from a .csv is likely to cause issues downstream. Indeed, we run
the risk of accidently changing the data or corrupting the file in some way.
Secondly, all .csvs will be formatted slightly different and so making extensible
tools for these files will be inefficient. Furthermore, working with a generic
class used in other mass-spectrometry fields can speed up analysis and adoption
of new methods. We will work the class QFeatures
from the QFeatures
class
as it is a powerful and scalable way to store quantitative mass-spectrometry data.
Firstly, the data is storted in long format rather than wide format. We first switch the data to wide format.
MBP_wide <- pivot_wider(data.frame(MBP), values_from = d, names_from = c("hx_time", "replicate_cnt", "hx_sample"), id_cols = c("pep_sequence", "pep_charge")) head(MBP_wide)
We notice that there are many columns with NA
s. The follow code chunk removes
these columns.
MBP_wide <- MBP_wide[, colSums(is.na(MBP_wide)) != nrow(MBP_wide)]
We also note that the colnames are not very informative. We are going to format in a very specific way so that later functions can automatically infer the design from the column names. We provide in the format X(time)rep(replicate)cond(condition)
colnames(MBP_wide)[-c(1,2)] new.colnames <- gsub("0_", "0rep", paste0("X", colnames(MBP_wide)[-c(1,2)])) new.colnames <- gsub("_", "cond", new.colnames) # remove annoying % signs new.colnames <- gsub("%", "", new.colnames) # remove space (NULL could get confusing later and WT is clear) new.colnames <- gsub(" .*", "", new.colnames) new.colnames
We will now parse the data into an object of class QFeatures
, we have provided
a function to assist with this in the package. If you want to do this yourself
use the readQFeatures
function from the QFeatures
package.
MBPqDF <- parseDeutData(object = DataFrame(MBP_wide), design = new.colnames, quantcol = 3:102)
To help us get used to the QFeatures
we show how to generate a heatmap
of these data from this object:
pheatmap(t(assay(MBPqDF)), cluster_rows = FALSE, cluster_cols = FALSE, color = brewer.pal(n = 9, name = "BuPu"), main = "Stuctural variant deuterium incoperation heatmap", fontsize = 14, legend_breaks = c(0, 2, 4, 6, 8, 10, 12, max(assay(MBPqDF))), legend_labels = c("0", "2", "4", "6", "8","10", "12", "Incorporation"))
If you prefer to have the start-to-end residue numbers in the heatmap instead you can change the plot as follows:
regions <- unique(MBP[,c("pep_start", "pep_end")]) xannot <- paste0("[", regions[,1], ",", regions[,2], "]") pheatmap(t(assay(MBPqDF)), cluster_rows = FALSE, cluster_cols = FALSE, color = brewer.pal(n = 9, name = "BuPu"), main = "Stuctural variant deuterium incoperation heatmap", fontsize = 14, legend_breaks = c(0, 2, 4, 6, 8, 10, 12, max(assay(MBPqDF))), legend_labels = c("0", "2", "4", "6", "8","10", "12", "Incorporation"), labels_col = xannot)
It maybe useful to normalize HDX-MS data for either interpretation or visualization purposes. We can normalize by the number of exchangeable amides or by using back-exchange correction values. We first use percentage incorporation as normalisation and visualise as a heatmap.
MBPqDF_norm1 <- normalisehdx(MBPqDF, sequence = unique(MBP$pep_sequence), method = "pc") pheatmap(t(assay(MBPqDF_norm1)), cluster_rows = FALSE, cluster_cols = FALSE, color = brewer.pal(n = 9, name = "BuPu"), main = "Stuctural variant deuterium incoperation heatmap normalised", fontsize = 14, legend_breaks = c(0, 0.2, 0.4, 0.6, 0.8, 1, 1.2), legend_labels = c("0", "0.2", "0.4", "0.6", "0.8","1", "Incorporation"), labels_col = xannot)
Now, we demonstrate a back-exchange correction calculation. The back-exchange value are fictious by the code chunk below demonstrates how to set this up.
# made-up correction factor correction <- (exchangeableAmides(unique(MBP$pep_sequence)) + 1) * 0.9 MBPqDF_norm2 <- normalisehdx(MBPqDF, sequence = unique(MBP$pep_sequence), method = "bc", correction = correction) pheatmap(t(assay(MBPqDF_norm2)), cluster_rows = FALSE, cluster_cols = FALSE, color = brewer.pal(n = 9, name = "BuPu"), main = "Stuctural variant deuterium incoperation heatmap normalised", fontsize = 14, legend_breaks = c(0, 0.2, 0.4, 0.6, 0.8, 1, 1.2), legend_labels = c("0", "0.2", "0.4", "0.6", "0.8","1", "Incorporation"), labels_col = xannot)
The hdxstats
package uses an empirical Bayes functional approach to analyse
the data. We explain this idea in steps so that we can get an idea of the approach.
First we fit the parametric model to the data. This will allow us to explore
the HdxStatModel
class.
res <- differentialUptakeKinetics(object = MBPqDF[,1:100], #provide a QFeature object feature = rownames(MBPqDF)[[1]][37], # which peptide to do we fit start = list(a = NULL, b = NULL, d = NULL, p = 1)) # what are the starting parameter guesses
Here, we see the HdxStatModel
class, and that a Functional Model was applied
to the data and a total of 7 models were fitted.
res
The nullmodel
and alternative
slots of an instance of HdxStatModel
provide
the underlying fitted models. The method
and formula
slots provide vital
information about what analysis was performed. The vis
slot provides a ggplot
object so that we can visualise the functional fits.
res@vis
Since this is a ggplot object, we can customise in the usual grammatical ways.
res@vis + scale_color_manual(values = brewer.pal(n = 8, name = "Set2"))
A number of standard methods are available and can be applied to a HdxStatModels
,
these extend the usual base
stats methods. These include
anova
: An analysis of variancelogLik
: The log-likelihood of all the fitted modelsresiduals
: The residuals for the fitted modelsvcov
: The variance-covariance matrix between parameters of the modelslikRatio
: The likelihood ratio between null and alternative modelswilk
: Applies wilk's theorem to obtain a p-value from the liklihood ratiocoef
: The fitted model coefficientsdeviance
: The deviance of the fitted modelssummary
: The statistical summary of the models.anova(res) logLik(res) residuals(res) vcov(res) likRatio(res) wilk(res) coef(res) deviance(res) summary(res)
We have seen the basic aspects of our functional modelling approach. We now
wish to roll out our method across all peptides in the experiment. The
fitUptakeKinetics
function allows us to apply our modelling approach across
all the peptide in the experiment. We need to provide a QFeatures
object
and the features for which we are fitting the model. The design will be extracted
from the column names or you can provide a design yourself. The parameter
initilisation should also be provided. Sometimes the model can't be fit on the
kinetics. This is either because there is not enough data or through lack of
convergence. An error will be reported in these cases but this should not
perturb the user. You may wish to try a few starting values if there
excessive models that fail fitting.
res <- fitUptakeKinetics(object = MBPqDF[,c(1:24)], feature = rownames(MBPqDF[,c(1:24)])[[1]], start = list(a = NULL, b = 0.001, d = NULL, p = 1))
The code chunk above returns a class HdxStatModels
indicating that a number
of models for peptide have been fit. This is simply a holder for a list
of HdxStatModel
instances.
res
We can easily examine indivual fits by going to the underyling HdxStatModel
class:
res@statmodels[[1]]@vis + scale_color_manual(values = brewer.pal(n = 2, name = "Set2"))
We now wish to apply statistical analysis to these fitted curves. Our approach
is an empirical Bayes testing procedure, which borrows information across peptides
to stablise variance estimates. Here, we need to provide the original data
that was analysed and the HdxStatModels
class. The following code chunk
returns an object of class HdxStatRes
. This object tell us that statistical
analysis was performed using our Functional model.
out <- processFunctional(object = MBPqDF[,1:24], params = res) out
The main slot of interest is the results
slot which returns quantities of
interest such as p-values
and fdr
corrected p-values because of multiple testing.
The following is the DataFrame
of interest.
out@results
We can now examine the peptides for which the false discovery rate is less than 0.05
which(out@results$ebayes.fdr < 0.05)
Let us visualise some of these examples:
res@statmodels[[42]]@vis + res@statmodels[[45]]@vis
As we can see our model has picked up some subtle differences, we can further
visualise these using a forest plot. We can see the the functions are very similar
as the parameters are almost identical (a,b,p,d)
. However, we can see that
the deuterium differences are lower in 10% structural variant condition.
fp <- forestPlot(params = res@statmodels[[42]])
We can produce a table to actual numbers. We see that at all 4 timepoints the deuterium difference is negative, though the confidence intervals overlap with 0. Our functional approach is picking up this small but reproducible difference.
knitr::kable(fp$data)
It is also possible to visualize, these plots on a different scale. Of course,
changing the natural scaling will emphasis different parts of the plot and
could distort interpretation. In particular, if a log transform is used then
care should be taken when interpreting values around 0. We suggest examining
the numerical values in a forest plot or table alongside any transformation of
the variables. We suggest using the pseudo log transform
as this allows
control the linearity of the plot, clearly demonstrating this a choice
of visualisation (and not of statistical modelling). The parameter sigma
below controls the scaling factor of the linear part of the transformation.
res@statmodels[[42]]@vis + scale_x_continuous( trans = pseudo_log_trans(base = 10, sigma = 0.01), breaks = c(0, 10^(1:7))) res@statmodels[[42]]@vis + scale_x_continuous( trans = pseudo_log_trans(base = 10, sigma = 0.0001), breaks = c(0, 10^(1:7))) res@statmodels[[42]]@vis + scale_x_continuous( trans = pseudo_log_trans(base = 10, sigma = 10), breaks = c(0, 10^(1:7)))
Let's us now have a look a situation where the changes are more dramatic.
res_wt <- fitUptakeKinetics(object = MBPqDF[, c(61:100)], feature = rownames(MBPqDF[, c(61:100)])[[1]], start = list(a = NULL, b = 0.001, d = NULL, p = 1))
out_wt <- processFunctional(object = MBPqDF[, c(61:100)], params = res_wt)
We can visualise some of the result and generate plots.
res_wt@statmodels[[27]]@vis/res_wt@statmodels[[28]]@vis + plot_layout(guides = "collect")|(forestPlot(params = res_wt@statmodels[[27]], condition = c("WT", "W169G"))/forestPlot(params = res_wt@statmodels[[28]], condition = c("WT", "W169G")) + plot_layout(guides = "collect")) + plot_annotation(tag_levels = 'a') + plot_layout(widths = c(1, 1))
We now describe the analysis of an epitope mapping experiment. Here, the data analysis is more challenging, since only 1 replicate in each condition, apo and antibody, was performed. If we make some simplifying assumptions rigorous statistical analysis can still be performed.
The experiment was performed on HOIP-RBR, we loaded the data below from inside the package
HOIPpath <- system.file("extdata", "N64184_1a2_state.csv", package = "hdxstats") HOIP <- read.csv(HOIPpath)
unique(HOIP$State)
HOIP$Exposure <- HOIP$Exposure * 60 #convert to seconds filter(HOIP, Sequence == unique(HOIP$Sequence[1])) %>% ggplot(aes(x = Exposure, y = Center, color = factor(State, unique(HOIP$State)))) + theme_classic() + geom_point(size = 3) + scale_color_manual(values = colorRampPalette(brewer.pal(8, name = "Set2"))(11)) + labs(color = "experiment", x = "Deuterium Exposure", y = "Deuterium incoperation")
As before we need to convert data to an object of classes QFeatures
for ease of analysis.
First, we put the data into a DataFrame
object. Currently, its in long format
so we switch to a wide format
HOIP_wide <- pivot_wider(data.frame(HOIP), values_from = Center, names_from = c("Exposure", "State"), id_cols = c("Sequence"))
Now remove all columns with only NAs
HOIP_wide <- HOIP_wide[, colSums(is.na(HOIP_wide)) != nrow(HOIP_wide)]
The colanmes are not very informative, provide in the format X(time)rep(repliate)cond(condition)
colnames(HOIP_wide)[-c(1)] new.colnames <- gsub("0_", "0rep1", paste0("X", colnames(HOIP_wide)[-c(1)])) new.colnames <- gsub("rep1", "rep1cond", new.colnames) # remove annoying % signs new.colnames <- gsub("%", "", new.colnames) # remove space (NULL could get confusing later and WT is clear) new.colnames <- gsub(" .*", "", new.colnames)
Now, we can provide rownames and convert the data to a QFeatures
object:
qDF <- parseDeutData(object = DataFrame(HOIP_wide), design = new.colnames, quantcol = 2:34, rownames = HOIP_wide$Sequence)
As before, we can produce a heatmap, we perform a simple normalisation for ease of visualisation:
mat <- assay(qDF) mat <- apply(mat, 2, function(x) x - assay(qDF)[,1]) pheatmap(t(mat), cluster_rows = FALSE, cluster_cols = FALSE, color = brewer.pal(n = 9, name = "BuPu"), main = "HOIP RBR heatmap", fontsize = 14, legend_breaks = c(0, 2, 4, 6,8,10,12, max(assay(qDF))), legend_labels = c("0", "2", "4", "6", "8","10", "12", "Incorporation"))
Let us first perform a quick test:
res <- differentialUptakeKinetics(object = qDF[,1:33], feature = rownames(qDF)[[1]][3], start = list(a = NULL, b = 0.01, d = NULL), formula = value ~ a * (1 - exp(-b*(timepoint))) + d) res@vis+ scale_color_manual(values = colorRampPalette(brewer.pal(8, name = "Set2"))(11))
Whilst this analysis performs good fits for the functions, there are too many degrees of freedom to perform sound statistical analysis. Hence, we normalize to remove the degree of freedom for the intercept. For simplicity and to preserve the original matrix, we reprocess the data. We then fit a simplified kinetic model, where only the plateau is inferred.
cn <- new.colnames[c(1:3,10:12)] HOIP_wide_nrm <- data.frame(HOIP_wide) HOIP_wide_nrm[, c(2:4)] <- HOIP_wide_nrm[,c(2:4)] - HOIP_wide_nrm[,c(2)] # normalise by intercept HOIP_wide_nrm[, c(11:13)] <- HOIP_wide_nrm[,c(11:13)] - HOIP_wide_nrm[,c(11)] # normalised by intercept newqDF <- parseDeutData(object = DataFrame(HOIP_wide_nrm), design = cn, quantcol = c(2:4, 11:13), rownames = HOIP_wide$Sequence) res_all <- fitUptakeKinetics(object = newqDF[,1:6], feature = rownames(newqDF[,1:6])[[1]], start = list(a = NULL), formula = value ~ a * (1 - exp(-0.05*(timepoint))), maxAttempts = 1) funresdAb25_1 <- processFunctional(object = newqDF[,1:6], params = res_all)
We can have a look at the results:
funresdAb25_1@results which(funresdAb25_1@results$ebayes.fdr < 0.05)
We can plot these kinetics to see what is happening. This allows us to visualise region of protection and deprotection, potentially identifiying the epitope.
(res_all@statmodels[[36]]@vis + res_all@statmodels[[42]]@vis + res_all@statmodels[[43]]@vis + res_all@statmodels[[65]]@vis + res_all@statmodels[[68]]@vis + res_all@statmodels[[70]]@vis + res_all@statmodels[[52]]@vis + res_all@statmodels[[53]]@vis ) + plot_layout(guides = 'collect')
We can make a Manhattan plot to better specially visualise what's happening.
#We need to provide an indication of "difference" so we can examine deprotected # or prected regions diffdata <- assay(newqDF)[,6] - assay(newqDF)[,3] sigplots <- manhattanplot(params = funresdAb25_1, sequences = HOIP$Sequence, region = HOIP[, c("Start", "End")], difference = diffdata, nrow = 1) sigplots[[1]] + plot_layout(guides = 'collect')
We can visualise this in a peptide plot which helps us understand the nature of the overlap
fpath <- system.file("extdata", "HOIP.txt", package = "hdxstats", mustWork = TRUE) HOIPfasta <- readAAStringSet(filepath = fpath, "fasta") scores <- funresdAb25_1@results$ebayes.fdr out <- plotEpitopeMap(AAString = HOIPfasta[[1]], peptideSeqs = unique(HOIP$Sequence), numlines = 2, maxmismatch = 1, by = 1, scores = 1 * (-log10(scores[unique(HOIP$Sequence)]) > -log10(0.05)) + 0.0001, name = "significant") out[[1]]/(out[[2]]) + plot_layout(guides = 'collect') & theme(legend.position = "right")
We can further visualise this a barcode of particular residues, here we use residue level averaging to obtain results at the residue level.
scores <- funresdAb25_1@results$ebayes.fdr out2 <- plotEpitopeMapResidue(AAString = HOIPfasta[[1]], peptideSeqs = unique(HOIP$Sequence), numlines = 2, maxmismatch = 1, by = 5, scores = scores[unique(HOIP$Sequence)], name = "-log10 p value") out2[[1]]/out2[[2]] + plot_layout(guides = 'collect') & theme(legend.position = "right")
We can also plot multiple residue maps on the same plot so that we can compare different antibodies.
scores <- funresdAb25_1@results$ebayes.fdr avMap25_1 <- ComputeAverageMap(AAString = HOIPfasta[[1]], peptideSeqs = unique(HOIP$Sequence), numlines = 2, maxmismatch = 1, by = 10, scores = scores[unique(HOIP$Sequence)], name = "-log10 p value") ## generate results from other dAB cn <- new.colnames[c(1:3,19:21)] HOIP_wide_nrm <- data.frame(HOIP_wide) HOIP_wide_nrm[,c(2:4)] <- HOIP_wide_nrm[,c(2:4)] - HOIP_wide_nrm[,c(2)] HOIP_wide_nrm[,c(20:22)] <- HOIP_wide_nrm[,c(20:22)] - HOIP_wide_nrm[,c(20)] newqDF2 <- parseDeutData(object = DataFrame(HOIP_wide_nrm), design = cn, quantcol = c(2:4,20:22), rownames = HOIP_wide$Sequence) res_all2 <- fitUptakeKinetics(object = newqDF2[,1:6], feature = rownames(newqDF2[,1:6])[[1]], start = list(a = NULL), formula = value ~ a * (1 - exp(-0.07*(timepoint))), maxAttempts = 1) funresdAb27_2 <- processFunctional(object = newqDF[,1:6], params = res_all2) scores <- funresdAb27_2@results$ebayes.fdr # compute average map avMap27_2 <- ComputeAverageMap(AAString = HOIPfasta[[1]], peptideSeqs = unique(HOIP$Sequence), numlines = 2, maxmismatch = 1, by = 10, scores = scores[unique(HOIP$Sequence)], name = "-log10 p value") # set rownames rownames(avMap25_1) <- "dAb25_1" rownames(avMap27_2) <- "dAb27_2" # store in a list avMap <- list(avMap27_2 = avMap27_2, avMap25_1 = avMap25_1) #plotting out3 <- plotAverageMaps(avMap, by = 20) out3[[1]]/out3[[2]] + plot_layout(guides = 'collect') & theme(legend.position = "right")
Users may also wish to colour according to protection or deprotections of hdx. The following functions determine whether there is protection or not by computing deuterium difference. The users pass the argument for which to compute the differences. The user pass can any scores though it is useful to look at the FDR provided by previous analysis. As is typical blue indicates protection whilst red deprotection. The binding epitope is very clear from these diagrams.
scores <- funresdAb27_2@results$ebayes.fdr hdxdiff1 <- hdxdifference(object = newqDF2, AAString = HOIPfasta[[1]], peptideSeqs = unique(HOIP$Sequence), numlines = 2, maxmismatch = 1, by = 10, scores = scores[unique(HOIP$Sequence)], cols = c(2,5), # columns of object to use for differences name = "-log10 p value (signed)") scores <- funresdAb25_1@results$ebayes.fdr hdxdiff2 <- hdxdifference(object = newqDF, AAString = HOIPfasta[[1]], peptideSeqs = unique(HOIP$Sequence), numlines = 2, maxmismatch = 1, by = 10, scores = scores[unique(HOIP$Sequence)], cols = c(2,5), name = "-log10 p value (signed)") dMap <- list(hdxdiff1$diffMap, hdxdiff2$diffMap) out4 <- hdxheatmap(averageMaps = avMap, diffMaps = dMap) out4[[1]]/out4[[2]] + plot_layout(guides = 'collect') & theme(legend.position = "right")
Advanced users and those struggling to find any significant results may wish to employ a more complex method. Here, we introduce a multi-level testing procedure that allows us to combine p-values in the spatial axis of the data. Individual p-value may not be significant but once grouped we might obtain additional power. This approach also controls a different form of multiplicity correction called the strong-sense family wise error rate (ssFWER). The FWER is the probability of of making at least one type 1 error (false discovery) and is hence a more stringent notion than FDR. We control this quantity in the strong sense, which means we do not require the global null hypothesis to be true. Typically, we wish to control this quantity at some level $\alpha = 0.05$, which means the probability of there being at least one false discovery is less than $0.05$. Our strategy combines $p$-values in the spatial axis using the harmonic mean p-value approach. The cost for this is that the regions which we cover become wider, potentially impacting interpretation. Furthermore, becuase of combining p-values it no longer makes sense to examine protection/deprotection factors. However, it is valid to then examine only the region with significant results without affecting multiplicity. In the following code chunk, we combined p-values spatially and control for multiplicity using an interval of size 20. This means a sliding window of $20$ peptide is used to combine p-values. The region that this covers is plotted in the x-axis. For example, from the plot below we can deduce that there is at least 1 peptide in region [49,120] where there is a significant difference, where the probability that this is a false discovery is $0.05$.
hmpplot <- hmpWindow(params = funresdAb25_1, sequences = HOIP$Sequence, region = HOIP[, c("Start", "End")], interval = 20) hmpplot
We suggest saving files in .rds
format. However, if you wish to export data
to .csv
format this can be done as in the following exampe.
# not run write.csv(funresdAb25_1@results, file = "myhdxresuts.csv")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.