Nothing
R/DIAnn.R
In ProtE: Processing Proteomics Data, Statistical Analysis and Visualization
Defines functions
dianno
Documented in
dianno
#' DIA NN proteomics data analysis
#'
#' Processes the DIA-NN proteomics output and performs exploratory statistical analysis for a single categorical variable. Accepts as input either of the files pg_matrix.tsv or unique_gene_matrix.tsv.
#'
#' @param file The whole path to the DIA-NN pg_matrix.tsv file (or alternatively, to the unique_genes_matrix.tsv file). The folders in the file path must be separated either with the forward slashes (/), or with the double backslashes (\\). See the example for inserting correctly the file path.
#' @param group_names A character vector specifying group names. The order of the names should align with the order of the sample groups in the input tsv file.
#' @param samples_per_group A numerical vector giving the number of samples in each group. The order of the numbers should align with the order of the names in group_names.
#' @param normalization The specific method for normalizing the data.By default it is set to FALSE. As DIA-NN output has already been normalized with the MaxLFQ algorithm, we suggest to be cautious if you select any method. Options are FALSE for no normalization of the data, "log2" for a simple log2 transformation, "Quantile" for a quantiles based normalization and "Cyclic_Loess" for a Cyclic Loess normalization of the log2 data, "median" for a median one, "TIC" for Total Ion Current normalization, "VSN" for Variance Stabilizing Normalization and "PPM" for Parts per Million transformation of the data.
#' @param filtering_value The maximum allowable percentage of missing values for a protein. Proteins with missing values exceeding this percentage will be excluded from the analysis. By default it is set to 50.
#' @param global_filtering TRUE/FALSE. If TRUE, the per-protein percentage of missing values will be calculated across the entire dataset. If FALSE, it will be calculated separately for each group, allowing proteins to remain in the analysis if they meet the criteria within any group. By default it is set to TRUE.
#' @param imputation Imputes all remaining missing values. Available methods: "LOD" for assigning the dataset's Limit Of Detection (lowest protein intensity identified), "LOD/2", "Gaussian_LOD" for selecting random values from the normal distribution around LOD with sd= 0.2*LOD, "zeros" for simply assigning 0 to MVs, mean" for replacing missing values with the mean of each protein across the entire dataset, "kNN" for a k-nearest neighbors imputation using 5 neighbors (from the package VIM) and "missRanger" for a random forest based imputation using predictive mean matching (from the package missRanger). By default it is set to FALSE (skips imputation).
#' @param independent TRUE/FALSE If TRUE, the samples come from different populations, if FALSE they come from the same population (Dependent samples). By default, it is set to TRUE. If set to FALSE, the numbers given in the samples_per_group param must be equal to each other.
#' @param parametric TRUE/FALSE. Specifies the statistical tests that will be taken into account for creating the PCA plots and heatmap. By default it is set to FALSE (non-parametric).
#' @param significance "p" or "BH" Specifies which of the p-values (nominal vs BH adjusted for multiple hypothesis) will be taken into account for creating the PCA plots and the heatmap. By default it is set to "p" (nominal p-value).
#' @param description TRUE/FALSE. If TRUE, establishes connection to the Uniprot database (via the Uniprot.ws package) and adds the "Description" annotation in the data. This option requires protein Accession IDs and is thus applicable only to the pg.matrix file. It requires also internet access. By default it is set to FALSE (No description fetching).
#'
#'
#' @return Returns the complete output of the exploratory analysis: i) The processed, or filtered/normalized data ii) Statistical output containing results for the parametric (limma+ANOVA) and non-parametric tests (Wilcoxon_p_+Kruskal-Wallis+PERMANOVA), along with statistical tests for heteroscedasticity, iii) Quality metrics for the input samples iv) QC plots and exploratory visualizations.
#' @importFrom openxlsx write.xlsx read.xlsx
#' @importFrom grDevices dev.off bmp colorRampPalette
#' @importFrom dplyr select group_by group_modify everything %>% any_of
#' @importFrom tidyr gather pivot_longer
#' @importFrom broom tidy
#' @importFrom reshape2 melt
#' @importFrom ggpubr ggarrange
#' @importFrom ggplot2 ggplot ggsave geom_violin scale_x_discrete scale_color_gradient element_line theme_linedraw scale_fill_manual scale_color_manual aes geom_histogram element_rect geom_point geom_smooth xlab ylab ggtitle theme_bw theme_minimal theme element_text guides guide_legend geom_boxplot labs theme_classic element_blank geom_jitter position_jitter
#' @importFrom VIM kNN
#' @importFrom stats kruskal.test p.adjust prcomp sd wilcox.test friedman.test rnorm bartlett.test model.matrix heatmap median na.omit
#' @importFrom forcats fct_inorder
#' @importFrom limma topTable eBayes contrasts.fit normalizeCyclicLoess normalizeVSN lmFit normalizeQuantiles duplicateCorrelation
#' @importFrom grid gpar
#' @importFrom pheatmap pheatmap
#' @importFrom UniprotR GetProteinAnnontate
#' @importFrom stringr str_extract
#' @importFrom missRanger missRanger
#' @importFrom car leveneTest
#' @importFrom utils read.delim2
#' @importFrom vegan adonis2
#'
#' @examples
#' #Example of running the function with paths for two groups.
#' # The file path is a placeholder, replace it with an actual file.
#'
#' jittered.pg_matrix.tsv <- system.file("extdata", "report.pg_matrix.tsv", package = "ProtE")
#'
#' # Copy the file to a temporary directory for CRAN checks
#' temp_file <- file.path(tempdir(), "report.pg_matrix.tsv")
#' file.copy(jittered.pg_matrix.tsv, temp_file, overwrite = TRUE)
#'
#' dianno(file = temp_file,
#' group_names = c("Healthy","Control"),
#' samples_per_group = c(5,4), filtering_value = 80)
#'
#' @export
dianno <- function(file,
group_names,
samples_per_group,
normalization = FALSE,
imputation = FALSE,
global_filtering = TRUE,
independent = TRUE,
filtering_value = 50,
parametric= FALSE,
significance = "p", description = FALSE)
{message("The ProtE process starts now!")
Protein.Ids =Protein.Names =Symbol =X =Y = Mean = SD = Description = df4_wide= percentage=Sample= Genes = variable =.=key=Accession =value =g1.name=g2.name= NULL
groups_number <- length(group_names)
if (length(samples_per_group) != groups_number) {
stop("The length of 'samples_per_group' must be equal to the length of 'group_names'. Each of the numerical values in 'samples_per_group' must denote the sample size for the corresponding group in 'group_names") }
for (i in 1:groups_number) {
assign(paste0("g",i,".name"),group_names[[i]])}
if(grepl("\\.tsv$", file)) {
dataspace <- utils::read.delim2(file, header = TRUE, sep = "\t")
}
else if(grepl("\\.xlsx$", file)) {
dataspace <- openxlsx::read.xlsx(file)
} else {stop("Error, the file you provided is not on .tsv or .xlsx format")}
path <- dirname(file)
path_res <- file.path(path , "ProtE_Analysis")
dir.create(path_res, showWarnings = FALSE)
path_restat <- file.path(path_res, "Statistical_Analysis")
path_resman <- file.path(path_res, "Data_processing")
path_resplot <- file.path(path_res, "Plots")
dir.create(path_restat, showWarnings = FALSE)
dir.create(path_resman, showWarnings = FALSE)
dir.create(path_resplot, showWarnings = FALSE)
if("Protein.Ids" %in% colnames(dataspace)) {
dataspace <- dataspace[!grepl("^;",dataspace$Protein.Ids),]
dataspace <- dataspace[,-c(1,4:5)]
dataspace[, -c(1,2)] <- lapply(dataspace[, -c(1,2)], as.numeric)
col_names <- colnames(dataspace)
col_names[-1:-2] <- gsub("\\\\", "/", col_names[-1:-2])
col_names[-1:-2] <- basename(col_names[-1:-2])
colnames(dataspace) <- col_names
dataspace <- dataspace[rowSums(!is.na(dataspace[,-c(1,2)])) > 0, ]
if (description == TRUE ) {
message("The Description fetching from UniProt starts now, it might take some time depending on you Network speed.")
id_numbers <- dataspace$Protein.Ids
for (j in 1:length(id_numbers)){id_numbers[j] <- stringr::str_extract(id_numbers[j], "^[^;]*")}
df_description <- data.frame("Description" = character(), stringsAsFactors = FALSE)
dataspace$Protein.Ids<-id_numbers
conv_ID <- GetProteinAnnontate(dataspace$Protein.Ids, columns =c("organism_name" , "protein_name" , "id" ,"gene_names") )
details<-paste(conv_ID$Protein.names," OS=",conv_ID$Organism," GN=",conv_ID$Gene.Names," -[",conv_ID$Entry.Name,"]")
df_description <- rbind(df_description, data.frame(Description = details, stringsAsFactors = FALSE))
dataspace<-cbind(dataspace[,1:2],df_description,dataspace[,3:ncol(dataspace)])
colnames(dataspace)[colnames(dataspace) == "Protein.Ids"] <- "Accession"
dataspace <- dataspace[,-2]
}
colnames(dataspace)[colnames(dataspace) == "Protein.Ids"] <- "Accession"
} else {
dataspace <- dataspace[!grepl("^;", dataspace[["Genes"]]), ]
dataspace[, -1] <- lapply(dataspace[,-1], as.numeric)
col_names <- colnames(dataspace)
col_names[-1] <- gsub("\\\\", "/", col_names[-1])
col_names[-1] <- basename(col_names[-1])
colnames(dataspace) <- col_names
dataspace <- dataspace[rowSums(!is.na(dataspace[,-1])) > 0, ]
dataspace$Description <- rep("Not Available", nrow(dataspace))
dataspace<-dataspace %>%
dplyr::select(Genes,any_of(c("Protein.Names","Description")) , everything())
message("The description fetching is not available when the input is a unique_genes matrix")
}
colnames(dataspace) <- make.names(colnames(dataspace), unique = TRUE)
rownames(dataspace) <- make.names(rownames(dataspace), unique = TRUE)
if (sum(samples_per_group) != ncol(dataspace)-2) {stop("Error: The specified number of samples in the parameter samples_per_group does not align with the total samples in the input file.")}
zero_per_sample <- colSums(is.na(dataspace[,-1:-2]))*100/nrow(dataspace)
IDs <- colSums(!is.na(dataspace[,-1:-2]))
name_dataspace <- dataspace[, -1:-2]
dat.dataspace<-dataspace
if (normalization == "PPM"){
dataspace[, -1:-2] <- lapply(dataspace[, -1:-2], function(x) {
sum_x <- sum(x, na.rm = TRUE)
ifelse(is.na(x), NA, (x / sum_x) * 10^6)
})
Gdataspace<-dataspace
norm_file_path <- file.path(path_resman, "Normalized.xlsx")
openxlsx::write.xlsx(Gdataspace, file = norm_file_path)
message("Applying the selected normalization, saved as Normalized.xlsx")}
if (normalization == "Quantile"){
dataspace[, -1:-2] <- log(dataspace[, -1:-2]+1,2)
dataspace[, -1:-2] <- limma::normalizeQuantiles(dataspace[, -1:-2])
Gdataspace<-dataspace
norm_file_path <- file.path(path_resman, "Normalized.xlsx")
openxlsx::write.xlsx(Gdataspace, file = norm_file_path)
message("Applying the selected normalization, saved as Normalized.xlsx") }
if (normalization == "log2"){
dataspace[, -1:-2] <- log(dataspace[, -1:-2]+1,2)
Gdataspace<-dataspace
norm_file_path <- file.path(path_resman, "Normalized.xlsx")
openxlsx::write.xlsx(Gdataspace, file = norm_file_path)
message("Applying the selected normalization, saved as Normalized.xlsx") }
if (normalization == "Total_Ion_Current") {
dataspace[, -1:-2] <- lapply(dataspace[, -1:-2], function(x) (x / sum(x, na.rm = TRUE)) * mean(colSums(dataspace[, -1:-2], na.rm = TRUE)))
Gdataspace<-dataspace
norm_file_path <- file.path(path_resman, "Normalized.xlsx")
openxlsx::write.xlsx(Gdataspace, file = norm_file_path)
message("Applying the selected normalization, saved as Normalized.xlsx")}
if (normalization == "Cyclic_Loess"){
dataspace[, -1:-2] <- log(dataspace[, -1:-2]+1,2)
dataspace[, -1:-2] <- limma::normalizeCyclicLoess(dataspace[, -1:-2])
Gdataspace<-dataspace
norm_file_path <- file.path(path_resman, "Normalized.xlsx")
openxlsx::write.xlsx(Gdataspace, file = norm_file_path)
message("Applying the selected normalization, saved as Normalized.xlsx") }
if ( normalization == "VSN") {
dataspace[, -1:-2] <- suppressMessages(limma::normalizeVSN(dataspace[, -1:-2]))
Gdataspace<-dataspace
norm_file_path <- file.path(path_resman, "Normalized.xlsx")
openxlsx::write.xlsx(Gdataspace, file = norm_file_path)
message("Applying the selected normalization, saved as Normalized.xlsx")
}
if (normalization == "median") {
sample_medians <- apply(dataspace[, -1:-2], 2, median, na.rm = TRUE)
dataspace[, -1:-2] <- sweep(dataspace[, -1:-2], 2, sample_medians, FUN = "/")
Gdataspace<-dataspace
norm_file_path <- file.path(path_resman, "Normalized.xlsx")
openxlsx::write.xlsx(Gdataspace, file = norm_file_path)
message("Applying the selected normalization, saved as Normalized.xlsx")}
if (normalization %in% c(FALSE,"median", "Total_Ion_Current", "PPM") ){
log.dataspace <- log(dataspace[,-c(1:2)]+1,2)
row_means <- rowMeans(log.dataspace, na.rm = TRUE)
row_sds <- apply(log.dataspace, 1, sd, na.rm = TRUE)
plot_data <- data.frame(Mean = row_means, SD = row_sds)
meansd <- ggplot(plot_data, aes(x = Mean, y = SD)) +
geom_point(alpha = 0.5, color = "blue") +
geom_smooth(method = "loess", color = "red", se = FALSE) +
theme_minimal() +
labs(title = "Mean-SD Plot on the log2 normalized data", x = "Mean Expression", y = "Standard Deviation")
meansd
ggplot2::ggsave("meanSdPlot.bmp", plot = meansd, path = path_resplot,
scale = 1, width = 5, height = 4, units = "in",
dpi = 300, limitsize = TRUE)
message("Creating Mean-SD plot on the log2 data.")
} else {
row_means <- rowMeans(dataspace[,-c(1,2)], na.rm = TRUE)
row_sds <- apply(dataspace[,-c(1,2)], 1, sd, na.rm = TRUE)
plot_data <- data.frame(Mean = row_means, SD = row_sds)
meansd <- ggplot(plot_data, aes(x = Mean, y = SD)) +
geom_point(alpha = 0.5, color = "blue") +
suppressMessages(geom_smooth(method = "loess", color = "red", se = FALSE)) +
theme_minimal() +
labs(title = "Mean-SD Plot on the log2 normalized data", x = "Mean Expression", y = "Standard Deviation")
meansd
ggplot2::ggsave("meanSdPlot.bmp", plot = meansd, path = path_resplot,
scale = 1, width = 5, height = 4, units = "in",
dpi = 300, limitsize = TRUE)
message("Creating Mean-SD plot.")
}
if (filtering_value < 0 && filtering_value > 100) {stop("Error: The filtering_value must be a number ranging from 0 to 100")}
if (global_filtering == TRUE) {
filtering_value <- 100- as.numeric(filtering_value)
threshold <- ceiling(sum(samples_per_group)-(sum(samples_per_group)*(as.numeric(filtering_value)/100))+0.00000000001)
}
if (global_filtering == FALSE) {
threshold<-numeric(groups_number)
filtering_value <- 100- as.numeric(filtering_value)
for (i in 1:groups_number) {
threshold[i] <- ceiling(samples_per_group[i]-(samples_per_group[i])*(as.numeric(filtering_value)/100)+0.00000000001)}
}
coln <- list()
case_last <- 2
for (i in 1:groups_number) {
case_last <- case_last + samples_per_group[i]
coln[[i]] <- (case_last - samples_per_group[i] + 1):case_last
}
Gdataspace<-dataspace
Gdataspace<-Gdataspace %>%
dplyr::select(any_of(c("Accession","Genes")),any_of(c("Protein.Names","Description")) , everything())
colnames(Gdataspace) <- gsub(".xlsx", "", colnames(Gdataspace))
dataspace[is.na(dataspace)] <- 0
for (j in 1:groups_number){
for (i in c(1:nrow(dataspace))){
a <- table(dataspace[i,coln[[j]]]==0)["TRUE"]
if(is.na(a)){
dataspace[i,paste0("Number_0_group",j)] <- 0
} else{
dataspace[i,paste0("Number_0_group",j)] <- table(dataspace[i,coln[[j]]]==0)["TRUE"]
}
}
}
dataspace$Number_0_all_groups <- rowSums(dataspace[,paste0("Number_0_group", 1:groups_number)])
dataspace <- dataspace[dataspace$Number_0_all_groups < sum(samples_per_group),]
if (global_filtering == TRUE) {
dataspace <- dataspace[dataspace$Number_0_all_groups<threshold,]
at_file_path <- file.path(path_resman, "Dataset_after_filtering.xlsx")
openxlsx::write.xlsx(dataspace, file = at_file_path)
}
if (global_filtering == FALSE) {
keep_rows <- rep(FALSE, nrow(dataspace))
for (j in 1:groups_number) {
keep_rows <- keep_rows | (dataspace[,paste0("Number_0_group", j)] < threshold[j])
}
dataspace <- dataspace[keep_rows, ]
at_file_path <- file.path(path_resman, "Dataset_after_filtering.xlsx")
openxlsx::write.xlsx(dataspace, file = at_file_path)}
message("An excel file with the proteins remaining in the data after filtering for missing values, has been created as Dataset_after_filtering.xlsx")
dataspace_0s<- dataspace
dataspace[,paste0("Number_0_group", 1:groups_number)] <- NULL
dataspace$Number_0_all_groups <- NULL
zero_per_sample1 <- colSums(dataspace[,-1:-2] == 0)*100/nrow(dataspace)
sample_names <- colnames(dataspace[,-1:-2])
qc <- cbind(sample_names,IDs,zero_per_sample,zero_per_sample1)
qc <- as.data.frame(qc)
colnames(qc) <- c("Sample Name","Number of proteins detected in the sample","% of Missing values before filtering","% of Missing values after filtering")
rownames(qc) <- NULL
pre_dataspace <- dataspace
if (imputation == "kNN") {
message("kNN imputation starts now")
dataspace[dataspace==0] <- NA
dataspace[, -c(1, 2)] <- VIM::kNN(dataspace[, -c(1, 2)], imp_var = FALSE, k= 5)
imp_file_path <- file.path(path_resman, "Dataset_Imputed.xlsx")
openxlsx::write.xlsx(dataspace, file = imp_file_path)
}
if (imputation == "Zeros"){
imp_file_path <- file.path(path_resman, "Dataset_Imputed.xlsx")
openxlsx::write.xlsx(dataspace, file = imp_file_path) }
if (imputation == "Gaussian_LOD") {
dataspace[dataspace==0] <- NA
LOD <- min(as.matrix(dataspace[, -c(1, 2)]),na.rm = TRUE)
replace_gaussian <- function(x) {
ifelse(is.na(x), rnorm(length(x), mean = LOD, sd = LOD*0.2), x)
}
dataspace[, -c(1, 2)] <- apply(dataspace[, -c(1, 2)], 2, replace_gaussian)
imp_file_path <- file.path(path_resman, "Dataset_Imputed.xlsx")
openxlsx::write.xlsx(dataspace, file = imp_file_path)
}
if (imputation == "mean"){
data_to_impute <- dataspace[, 3:(2 + sum(samples_per_group))]
for (i in seq_len(nrow(data_to_impute))) {
row_data <- data_to_impute[i, ]
if (any(is.na(row_data))) {
row_data <- as.numeric(row_data)
row_mean <- mean(row_data, na.rm = TRUE)
row_data[is.na(row_data)] <- row_mean
data_to_impute[i, ] <- row_data
}
}
dataspace[, 3:(2 + sum(samples_per_group))] <- data_to_impute
imp_file_path <- file.path(path_resman, "Dataset_Imputed.xlsx")
openxlsx::write.xlsx(dataspace, file = imp_file_path) }
if (imputation == "LOD"){
dataspace[dataspace==0] <- NA
impute_value <- min(as.matrix(dataspace[, -c(1, 2)]),na.rm = TRUE)
dataspace[, -c(1, 2)][is.na(dataspace[, -c(1, 2)])] <- impute_value
imp_file_path <- file.path(path_resman, "Dataset_Imputed.xlsx")
openxlsx::write.xlsx(dataspace, file = imp_file_path) }
if (imputation == "LOD/2"){
dataspace[dataspace==0] <- NA
impute_value <- min(as.matrix(dataspace[, -c(1, 2)]),na.rm = TRUE)/2
dataspace[, -c(1, 2)][is.na(dataspace[, -c(1, 2)])] <- impute_value
imp_file_path <- file.path(path_resman, "Dataset_Imputed.xlsx")
openxlsx::write.xlsx(dataspace, file = imp_file_path) }
if(imputation == "missRanger"){
message("missRanger imputation starts now")
dataspace[dataspace==0] <- NA
dataspace[,-c(1,2)] <- missRanger::missRanger(dataspace[,-c(1,2)])
imp_file_path <- file.path(path_resman, "Dataset_Imputed.xlsx")
openxlsx::write.xlsx(dataspace, file = imp_file_path) }
if (imputation %in% c("kNN","missRanger","mean")) {
pre_dataspace1<-pre_dataspace[,-1:-2]
dataspace1<-dataspace[,-1:-2]
imp.values<- dataspace1 - pre_dataspace1
his_dataspace<-rbind(dataspace1,pre_dataspace1,imp.values)
loghis_dataspace<-log2(his_dataspace+1)
his_long <-tidyr::pivot_longer(loghis_dataspace, cols = everything())
nrows<-nrow(his_long)
his_long$Group <- rep(c("Final","Initial","Imputed"), each = (nrows/3))
his_long_filtered <- his_long[his_long$value != 0,]
his_long_filtered$Group <- factor(his_long_filtered$Group, levels = c("Final", "Initial", "Imputed"))
imp_hist<- ggplot(his_long_filtered, aes(x = value, fill = Group, colour = Group)) +
labs( x = expression(Log[2]~"Protein Abundance"), y = "Count") +
scale_fill_manual(values = c("Final" = "#FF99FF", "Initial" = "#990000", "Imputed" = "#000033")) +
scale_color_manual(values = c("Final" = "#FF99FF", "Initial" = "#990000", "Imputed" = "#000033")) +
geom_histogram(alpha = 0.5, binwidth = 0.3, position = "identity") +
theme_minimal() +
theme(plot.background = element_rect(fill = "white")) + theme(panel.background = element_rect(fill = "white"))
imp_hist
ggplot2::ggsave("Imputed_values_histogram.bmp", plot = imp_hist, path = path_resplot,
scale = 1, width = 5, height = 4, units = "in",
dpi = 300, limitsize = TRUE)
message("A frequency histogram of real and imputed values has been created as Imputed_values_histogram.bmp")
}
if (imputation %in% c("LOD/2","LOD","kNN","missRanger","mean","zeros","Gaussian_LOD")){
message("An excel with the imputed missing values has been created as Dataset_Imputed.xlsx")
dataspace_0s$percentage <- dataspace_0s$Number_0_all_groups*100/sum(samples_per_group)
dataspace$percentage <- dataspace_0s$percentage
dataspace$mean <- rowMeans(dataspace[,3:(2+sum(samples_per_group))])
dataspace$log<-log2(dataspace$mean)
dataspace$rank <- rank(-dataspace$mean)
abund.plot <- ggplot(dataspace, aes(x = rank, y = log, colour = percentage)) +
geom_point(size = 3, alpha = 0.8) +
labs(title = "Protein Abundance Rank", x = "Rank", y = "Mean", expression(Log[2] ~ "Protein Abundance")) +
scale_color_gradient(low = "darkblue", high = "yellow",
name = "Imputations\nin each\nprotein\n(%)",limits = c(0,100-filtering_value)) +
theme_linedraw()+
theme(plot.title = element_text(hjust = 0.5, face = "bold"),
panel.grid = element_line(color = "grey80"),
legend.title = element_text(size = 10, face = "bold"),
legend.text = element_text(size = 9))
abund.plot
ggplot2::ggsave("Proteins_abundance_rank.bmp", plot = abund.plot , path = path_resplot,
scale = 1, width = 12, height = 5, units = "in",
dpi = 300, limitsize = TRUE, bg = "white")
}
if (imputation == FALSE){
dataspace_0s$percentage <- dataspace_0s$Number_0_all_groups*100/sum(samples_per_group)
dataspace$percentage <- dataspace_0s$percentage
dataspace[, 3:(2 + sum(samples_per_group))] <- lapply(dataspace[, 3:(2 + sum(samples_per_group))], as.numeric)
dataspace$mean <- apply(dataspace[, 3:(2+sum(samples_per_group))], 1, function(x) mean(x[x != 0]))
dataspace$log<-log2(dataspace$mean)
dataspace$rank <- rank(-dataspace$mean)
abund.plot <- ggplot(dataspace, aes(x = rank, y = log, colour = percentage)) +
geom_point(size = 3, alpha = 0.8) +
labs(title = "Protein Abundance Rank", x = "Rank", y = expression(Log[2] ~ "Proteins Abundance")) +
scale_color_gradient(low = "darkblue", high = "yellow",
name = "MVs\nin each\nprotein\n(%)",limits = c(0,100-filtering_value)) +
theme_linedraw()+
theme(plot.title = element_text(hjust = 0.5, face = "bold"),
panel.grid = element_line(color = "grey80"),
legend.title = element_text(size = 10, face = "bold"),
legend.text = element_text(size = 9))
abund.plot
ggplot2::ggsave("Proteins_abundance_rank.bmp", plot = abund.plot , path = path_resplot,
scale = 1, width = 12, height = 5, units = "in",
dpi = 300, limitsize = TRUE, bg = "white")
}
message("A protein abundance rank order plot has been created as Proteins_abundance_rank.bmp")
dataspace$percentage <- NULL
dataspace$mean <- NULL
dataspace$log<- NULL
dataspace$rank <- NULL
groups_list <- list("character")
for (i in 1:groups_number) {
groups_list[[i]] <- rep(group_names[i], times = samples_per_group[i])
}
groups_list_u <- unlist(groups_list)
groups_list_f <- factor(groups_list_u, levels = unique(groups_list_u))
mm <- model.matrix(~groups_list_f + 0)
colnames(mm)<- group_names
nndataspace<- dataspace[,-1:-2]
nndataspace[nndataspace < 0] <- 0
nndataspace <- log2(nndataspace+1)
if (independent == FALSE){
if (length(unique(samples_per_group)) != 1){
message("Error: The paired group analysis requires an equal number of samples in each group. Please consider removing any samples that lack a corresponding matched pair.")
}
n = sum(samples_per_group)/groups_number
pairing <- rep(1:n, each = groups_number)
corfit <- limma::duplicateCorrelation(nndataspace, design = mm, block = pairing)
fit <- limma::lmFit(nndataspace, mm, block = pairing, correlation = corfit$consensus.correlation)
}
if (independent == TRUE){
fit <- limma::lmFit(nndataspace, mm)}
fit<- limma::eBayes(fit)
if (groups_number>2){
anova_res <- data.frame()
anova_res<- limma::topTable(fit, adjust.method = "BH", number = Inf, sort.by = "none")
colnames(anova_res)<-paste("ANOVA",colnames(anova_res), sep = "_")
anova_res<- anova_res[,-c(1:groups_number)]}
lima.res <- data.frame()
for (i in 1:(ncol(mm)-1)) {
for (j in (i+1):ncol(mm)) {
comparison <- paste(colnames(mm)[i], "vs", colnames(mm)[j], sep = " ")
contrast_fref <- limma::makeContrasts(contrasts = paste0(colnames(mm)[i],"-",colnames(mm)[j]), levels = mm)
fit2 <- limma::contrasts.fit(fit, contrast_fref)
fit2 <- limma::eBayes(fit2)
top_table<- limma::topTable(fit2, adjust.method = "BH", number = Inf, sort.by = "none")
column_groups<- top_table[,c("logFC","AveExpr","t","P.Value","adj.P.Val","B")]
colnames(column_groups)<-paste(colnames(column_groups), comparison, sep = "_")
if (nrow(lima.res) == 0){
lima.res <- column_groups
} else {lima.res<- cbind(lima.res, column_groups)}
}}
if (groups_number>2){
limma_dataspace <- cbind(anova_res,lima.res,dataspace)} else {limma_dataspace <- cbind(lima.res,dataspace)}
ncollimma <- ncol(limma_dataspace) - ncol(dataspace) + 2
limma_dataspace<-limma_dataspace %>%
dplyr::select(any_of(c("Accession","Genes")),any_of(c("Protein.Names","Description")) , everything())
limma_dataspace <- limma_dataspace[,1:ncollimma]
limma_file_path <- file.path(path_restat, "Dataset_limma.test.xlsx")
openxlsx::write.xlsx(limma_dataspace, file = limma_file_path)
message("The limma output has been saved as Dataset_limma.test.xlsx")
if (independent != FALSE && independent != TRUE){stop("Error: Sample relationship between groups should be defined in the parameter 'independent' either as TRUE or FALSE")}
data2 <- dataspace
for (j in 1:groups_number) {
data2[[paste0("Average_G", j)]] <- apply(data2[, coln[[j]]], 1, function(row) {
if (all(is.na(row))) {
0
} else {
mean(row, na.rm = TRUE)
}
})
data2[[paste0("St_Dv_G", j)]] <- apply(data2[, coln[[j]]], 1, function(row) {
if (sum(!is.na(row)) < 2) {
0
} else {
sd(row, na.rm = TRUE)
}
})
for (k in 1:j) {
if (k < j) {
for (i in 1:nrow(data2)) {
values_k <- as.numeric(data2[i, coln[[k]]])
values_j <- as.numeric(data2[i, coln[[j]]])
if (independent == TRUE) {
if (sum(!is.na(values_k)) > 0 & sum(!is.na(values_j)) > 0) {
test_list <- stats::wilcox.test(
values_k, values_j,
exact = FALSE, paired = FALSE, na.rm = TRUE
)
data2[i, paste0("Wilcoxon_p_G", j, "vsG", k)] <- test_list$p.value
} else {
data2[i, paste0("Wilcoxon_p_G", j, "vsG", k)] <- NA
}
} else if (independent == FALSE) {
paired_values <- na.omit(cbind(values_k, values_j))
if (nrow(paired_values) > 0) {
test_list <- stats::wilcox.test(
paired_values[, 1], paired_values[, 2],
exact = FALSE, paired = TRUE
)
data2[i, paste0("Wilcoxon_p_G", j, "vsG", k)] <- test_list$p.value
} else {
data2[i, paste0("Wilcoxon_p_G", j, "vsG", k)] <- NA
}
}
}
data2[[paste0("BH_p_G", j, "vsG", k)]] <- p.adjust(
data2[[paste0("Wilcoxon_p_G", j, "vsG", k)]],
method = "BH"
)
avg_j <- data2[[paste0("Average_G", j)]]
avg_k <- data2[[paste0("Average_G", k)]]
data2[[paste0("Ratio_G", j, "vsG", k)]] <- ifelse(
avg_k == 0, NA, avg_j / avg_k
)
data2[[paste0("Log2_Ratio_G", j, "vsG", k)]] <- log2(
data2[[paste0("Ratio_G", j, "vsG", k)]]
)
}
}
}
for(i in 1:nrow(data2)){
group_values <- list()
for (j in 1:groups_number) {
group_values[[j]]<- as.numeric(data2[i, coln[[j]]])
}
valid_groups <- group_values[sapply(group_values, function(x) sum(!is.na(x)) > 1)]
if (length(valid_groups) >= 2) {
bartlett_result <- bartlett.test(valid_groups)
data2[i, "Bartlett_p"] <- bartlett_result$p.value
leve_data <- data.frame(
Value = unlist(valid_groups),
Group = rep(seq_along(valid_groups), sapply(valid_groups, length)) )
levene_result <- car::leveneTest(Value ~ as.factor(Group), data = leve_data, center = median)
data2[i, "Levene_p"] <- levene_result$`Pr(>F)`[1] } else {
data2[i, "Bartlett_p"] <- NA
data2[i, "Levene_p"] <- NA
}
}
only.data <- dataspace[,-c(1:2)]
transposed_data <- t(only.data)
metadata2 <- data.frame(group = groups_list_u)
rownames(transposed_data) <- metadata2$group
metadata2$samples <- colnames(only.data)
adonis2_results <- vegan::adonis2(transposed_data ~ group, data = metadata2, method = "bray", na.rm = TRUE, permutations = 999)
permanova_psF <- adonis2_results[4]
permanova_psF<- permanova_psF[-c(2:3),]
permanova_pValue <- adonis2_results[5]
permanova_pValue<- permanova_pValue[-c(2:3),]
data2[1, "PERMANOVA_PseudoF"] <- permanova_psF
data2[1, "PERMANOVA_p"] <- permanova_pValue
Ddataspace<-data2
if (description ==TRUE ){
Ddataspace$Symbol = sub(".*GN=(.*?) .*","\\1",Ddataspace$Description)
Ddataspace$Symbol[Ddataspace$Symbol==Ddataspace$Description] = "Not available"
}else {Ddataspace$Symbol = "Not available"}
Fdataspace <- Ddataspace %>%
dplyr::select(any_of(c("Accession","Genes")),
dplyr::any_of(c("Description", "Protein.Names")),
Symbol,
everything())
Group<-list()
times<-vector()
for (i in (1:groups_number)){
times<-samples_per_group[i]
Group[[i]] <- rep(paste0("G",i), times)
times<-NULL}
Group<-unlist(Group)
dataspace3<-t(dataspace[,-c(1:2)])
dataspace3<-data.frame(dataspace3)
dataspace<-data.frame(dataspace)
colnames(dataspace3)<-dataspace[,1]
dataspace4<-cbind(Group,dataspace3)
dataspace4$Group<-as.factor(dataspace4$Group)
colnames(dataspace4) <- make.names(colnames(dataspace4), unique = TRUE)
if (groups_number > 2) {
if (independent == TRUE) {
message("Mann-Whitney, Levene's and Bartlett's tests have been completed, calculating the Kruskal-Wallis p-values:")
df3 <- dataspace4 %>% tidyr::gather(key, value, -Group)
df4 <- df3 %>% dplyr::group_by(key)
df4$value <- as.numeric(df4$value)
df5 <- df4 %>%
dplyr::group_modify(~ broom::tidy(kruskal.test(value ~ Group, data = .x)))
df5<- df5[,c(1,3)]
data3 <- merge(Ddataspace, df5, by.x = colnames(Ddataspace)[1], by.y = "key", all.x = TRUE)
data3 <- data3[match(Ddataspace[, 1], data3[, 1]), ]
test_type <- "Kruskal_Wallis"
} else if (independent == FALSE) {
message("Wilcoxon, Levene's and Bartlett's tests have been completed, performing Friedman test for paired samples:")
df3 <- dataspace4 %>% tidyr::gather(key, value, -Group)
df4 <- df3 %>% dplyr::group_by(key)
df4$value <- as.numeric(df4$value)
samples_fried <- rep(1:samples_per_group[1],nrow(dataspace)*groups_number)
df4<- suppressMessages(cbind(df4, samples_fried ))
colnames(df4)[ncol(df4)] <- "sample"
p_values <- numeric(nrow(df4_wide))
for (i in seq_along(unique(df4$key))) {
gene_data <- subset(df4, key == unique(df4$key)[i])
friedman_result <- tryCatch({
friedman.test(value ~ Group | sample, data = gene_data)$p.value
}, error = function(e) NA)
p_values[i] <- friedman_result
}
Test.pvalue <- p_values
test_type <- "Friedman"
data3 <- cbind(Ddataspace, Test.pvalue)
}
colnames(data3)[ncol(data3)] <- paste0(test_type, ".pvalue")
data3[[paste0(test_type, ".pvalue_BH.adjusted")]] <- p.adjust(data3[[paste0(test_type, ".pvalue")]], method = "BH")
Fdataspace <- data3
if (description == TRUE) {
Fdataspace$Symbol <- sub(".*GN=(.*?) .*", "\\1", Fdataspace$Description)
Fdataspace$Symbol[Fdataspace$Symbol == Fdataspace$Description] <- "Not available"
} else {
Fdataspace$Symbol <- "Not available"
}
Fdataspace <- Fdataspace %>%
dplyr::select(
any_of(c("Accession", "Genes")),
dplyr::any_of(c("Description", "Protein.Names")),
Symbol,
everything()
)
} else {Fdataspace <- Ddataspace}
for (i in 1:groups_number){
namesc<- colnames(Fdataspace)
namesc<- gsub(paste0("G",i), get(paste0("g",i,".name")),namesc)
colnames(Fdataspace)<-namesc
}
colnames(Fdataspace) <- gsub(".xlsx", "", colnames(Fdataspace))
start_col <- 3 + as.numeric(sum(samples_per_group))
Fdataspace <- Fdataspace[,-c(4:start_col)]
stats_file_path <- file.path(path_restat, "Statistics.xlsx")
openxlsx::write.xlsx(Fdataspace, file = stats_file_path)
message("The non-parametric statistical output along with tests for homoscedasticity have been saved as Statistical_analysis.xlsx")
dataspace[is.na(dataspace)] <- 0
Group <- groups_list_f
Group2<-unique(groups_list_f)
dataspace[dataspace < 0] <- 0
log.dataspace <- log(dataspace[,-c(1:2)]+1,2)
dataspace[is.na(dataspace)] <- 0
pca<-prcomp(t(log.dataspace), scale=TRUE, center=TRUE)
pca.data <- data.frame(Sample=rownames(pca$x),
X=pca$x[,1],
Y=pca$x[,2],
Group = Group)
qc$PC1.score <- pca$x[,1]
qc$PC2.score <-pca$x[,2]
if (groups_number == 2){
Group<-list()
times<-vector()
for (i in (1:length(samples_per_group))){
times<-samples_per_group[i]
Group[[i]] <- rep(paste0("G",i), times)
times<-NULL
}
Group<-unlist(Group)
Group<-gsub("G1", g1.name, Group)
Group<-gsub("G2", g2.name, Group)
}
pca.var<-pca$sdev^2
pca.var.per<-round(pca.var/sum(pca.var)*100,1)
pca.data$Group<-factor(pca.data$Group, levels=Group2)
pca.ent<-ggplot2::ggplot(data=pca.data, ggplot2::aes(x=X, y=Y, label=Sample))+
geom_point(aes(color=Group), size = 2, alpha = 1)+
xlab(paste("PC1 - ", pca.var.per[1], "%", sep=""))+
ylab(paste("PC2 - ", pca.var.per[2], "%", sep=""))+
ggtitle("Complete set of proteins")+
theme_bw()+
theme(plot.title = element_text(hjust=0.5))+
guides(color = guide_legend(override.aes = list(size=5)))+
theme(legend.text = element_text(size = 12))+
theme(legend.title = element_text(size = 12))+
theme(legend.position="right")
pca.ent
ggplot2::ggsave("PCA_plot_alldata.bmp", plot = pca.ent, path = path_resplot,
scale = 1, width = 5, height = 4, units = "in",
dpi = 300, limitsize = TRUE)
message("PCA plot using all post-processing proteins has been created as PCA_plot_alldata.bmp")
groups_list_f <- factor(groups_list_f, levels=c(unique(groups_list_f)))
which.sig<-vector()
if (parametric == TRUE) {
if (significance == "p"){
if (groups_number != 2){
which.sig <- which(limma_dataspace$ANOVA_P.Value < 0.05)
} else {(which.sig <- which(limma_dataspace[,grep("P.Value",colnames(limma_dataspace))] < 0.05))}
}
if (significance == "BH"){
if (groups_number != 2){
which.sig <- which(limma_dataspace$ANOVA_adj.P.Val < 0.05)
} else {(which.sig <- which(limma_dataspace[,grep("adj.P.Val",colnames(limma_dataspace))] < 0.05))}
}
}
if (parametric == FALSE) {
if (significance == "p"){
if (groups_number != 2){
which.sig <- which(Fdataspace$Kruskal_Wallis.pvalue < 0.05)
} else {(which.sig <- which(Ddataspace$Wilcoxon_p_G2vsG1 < 0.05))}
}
if (significance == "BH"){
if (groups_number != 2){
which.sig <- which(Fdataspace$Kruskal_Wallis.pvalue_BH.adjusted < 0.05)
} else {(which.sig <- which(Ddataspace$BH_p_G2vsG1 < 0.05))}
}}
if (length(which.sig) <2 ){
message("PCA and heatmap plots of the significant data cannot be generated since there are no significant proteins")
qc[,-1] <- lapply(qc[,-1], function(x) as.numeric(unlist(x)))
qc[,-1]<-round(qc[,-1],3)
qc_file_path <- file.path(path_restat, "Sample_QC.xlsx")
openxlsx::write.xlsx(qc, file = qc_file_path)
} else {
log.dataspace.sig <- log.dataspace[which.sig,]
zlog.dataspace.sig <- t(scale(t(log.dataspace.sig)))
colnames(zlog.dataspace.sig) <- colnames(log.dataspace.sig)
zlog.dataspace.sig <- zlog.dataspace.sig[,order(groups_list_f)]
range_limit <- min(abs(min(zlog.dataspace.sig, na.rm = TRUE)), abs(max(zlog.dataspace.sig, na.rm = TRUE)))
breaks <- seq(-range_limit, range_limit, length.out = 101)
mycols_vector <- grDevices::colorRampPalette(c("blue", "white", "red"))(100)
annotation_col <- data.frame(Group = factor(groups_list_f))
rownames(annotation_col) <- colnames(zlog.dataspace.sig)
colnames(annotation_col) <- " "
bmp_file_path <- file.path(path_resplot, "heatmap.bmp")
bmp(bmp_file_path,width = 1500, height = 1080, res = 150)
pheatmap(as.matrix(zlog.dataspace.sig),
cluster_rows = TRUE,
cluster_cols = FALSE,
show_rownames = FALSE,
show_colnames = FALSE,
annotation_col = annotation_col,
color = mycols_vector,
breaks = breaks,
legend = TRUE,
legend_labels = NULL,
annotation_legend = TRUE,
scale = "none")
dev.off()
message("A heatmap with the differentially expressed proteins was created as heatmap.bmp")
pca<-prcomp(t(log.dataspace.sig), scale=TRUE, center=TRUE)
pca.data <- data.frame(Sample=rownames(pca$x),
X=pca$x[,1],
Y=pca$x[,2],
Group = Group)
qc$PC1.score.Significant <- pca$x[,1]
qc$PC2.score.Significant <-pca$x[,2]
qc[,-1] <- lapply(qc[,-1], function(x) as.numeric(unlist(x)))
qc[,-1]<-round(qc[,-1],3)
qc_file_path <- file.path(path_restat, "Sample_QC.xlsx")
openxlsx::write.xlsx(qc, file = qc_file_path)
message("Sample quality metrics and association scores to the first two Principal Components have been saved as Sample_QC.xlsx")
pca.var<-pca$sdev^2
pca.var.per<-round(pca.var/sum(pca.var)*100,1)
pca.sig<-ggplot2::ggplot(data=pca.data, aes(x=X, y=Y, label=Sample))+
geom_point(aes(color=Group), size = 2, alpha = 1)+
xlab(paste("PC1 - ", pca.var.per[1], "%", sep=""))+
ylab(paste("PC2 - ", pca.var.per[2], "%", sep=""))+
ggtitle("Statistically significant proteins")+
theme_bw()+
theme(plot.title = element_text(hjust=0.5))+
guides(color = guide_legend(override.aes = list(size=5)))+
theme(legend.text = element_text(size = 12))+
theme(legend.title = element_text(size = 12))+
theme(legend.position="right")
pca.sig
ggplot2::ggsave("PCA_plot_significant.bmp", plot = pca.sig, path = path_resplot,
scale = 1, width = 5, height = 4, units = "in",
dpi = 300, limitsize = TRUE)
message("PCA plot using only the significant proteins was created as PCA_plot_significant.bmp" )
a<-ggpubr::ggarrange(pca.ent, pca.sig, nrow = 1, ncol=2,
common.legend = TRUE, legend = "bottom")
ggplot2::ggsave("PCA_plots_combined.bmp", plot = a, path = path_resplot,
scale = 1, width = 8, height = 4.5, units = "in",
dpi = 300, limitsize = TRUE)
message ("The 2 PCA plots are combined in PCA_plots_combined.bmp")
}
p<- function(x) {
sapply(x, function(label) {
truncated_label <- substr(label, nchar(label) - 24, nchar(label))
truncated_label
})
}
melt.log.dataspace <- reshape2::melt(log.dataspace, id.vars = NULL)
repvec <- as.data.frame(table(Group))$Freq * nrow(log.dataspace)
storevec <- NULL
storeres <- list()
for (i in seq_along(Group2)){
storevev <- rep(Group2[i], repvec[i])
storeres[[i]] <- storevev
}
melt.log.dataspace$Group <- unlist(storeres)
melt.log.dataspace$Group <- factor(melt.log.dataspace$Group, levels = Group2)
if (imputation == FALSE) {
qc.boxplots<-ggplot2::ggplot(melt.log.dataspace, aes(x=forcats::fct_inorder(variable), y=value, color=Group))+
geom_boxplot(aes(color = Group),lwd=1, outlier.size=0.2, outlier.alpha = 0.2)+
xlab("Sample")+
ylab(expression(Log[2]~"Protein Abundance"))+
theme_classic()+
theme(text = element_text(size = 19),
axis.text.x=element_text(size = 9, angle=90, vjust = 0.5, hjust = 0.5),
axis.title.x=element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold"))+
guides(color = guide_legend(override.aes = list(size = 1)))+
scale_x_discrete(labels = p) +
geom_jitter(shape=16, position=position_jitter(0.2), size = 0.5, alpha = 0.5)
qc.boxplots
ggplot2::ggsave("Boxplot_withZeros.bmp", plot = qc.boxplots, path = path_resplot,
scale = 1, width = 12, height = 5, units = "in",
dpi = 300, limitsize = TRUE, bg = "white")
}
melt.log.dataspace.na <- melt.log.dataspace
melt.log.dataspace.na$value[melt.log.dataspace.na$value == 0] <- NA
melt.log.dataspace.na$Group <- factor(melt.log.dataspace.na$Group, levels = Group2)
qc.boxplots.na<-ggplot2::ggplot(melt.log.dataspace.na, aes(x=forcats::fct_inorder(variable), y=value, color=Group))+
geom_boxplot(aes(color = Group),lwd=1, outlier.size=0.2, outlier.alpha = 0.2)+
xlab("Sample")+
ylab(expression(Log[2]~"Protein Abundance"))+
theme_classic()+
theme(text = element_text(size = 19),
axis.text.x=element_text(size = 9, angle=90, vjust = 0.5, hjust = 0.5),
axis.title.x=element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold"))+
guides(color = guide_legend(override.aes = list(size = 1)))+
scale_x_discrete(labels = p) +
geom_jitter(shape=16, position=position_jitter(0.2), size = 0.5, alpha = 0.5)
qc.boxplots.na
if (imputation == FALSE) {
ggplot2::ggsave("Boxplot_withoutZeros.bmp", plot = qc.boxplots.na, path = path_resplot,
scale = 1, width = 12, height = 5, units = "in",
dpi = 300, limitsize = TRUE, bg = "white")
}else{
ggplot2::ggsave("Boxplot.bmp", plot = qc.boxplots.na, path = path_resplot,
scale = 1, width = 12, height = 5, units = "in",
dpi = 300, limitsize = TRUE, bg = "white")
}
message("A boxplot showing the log2 Abundance of each protein, across the samples has been created as Boxplot.bmp" )
qc.violin<-ggplot2::ggplot(melt.log.dataspace.na, aes(x=forcats::fct_inorder(variable), y=value, color=Group))+
geom_violin(aes(color = Group),lwd=1)+
xlab("Sample")+
ylab(expression(Log[2]~"Protein Abundance"))+
theme_classic()+
theme(text = element_text(size = 19),
axis.text.x=element_text(size = 9, angle=90, vjust = 0.5, hjust = 0.5),
axis.title.x=element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold"))+
guides(color = guide_legend(override.aes = list(size = 1)))+
scale_x_discrete(labels = p) +
geom_jitter(shape=16, position=position_jitter(0.2), size = 0.5, alpha = 0.5)
ggplot2::ggsave("Violin_plot.bmp", plot = qc.violin, path = path_resplot,
scale = 1, width = 12, height = 5, units = "in",
dpi = 300, limitsize = TRUE, bg = "white")
message("A Violin Plot showing the log2 Protein Abundance of each protein, across the samples was created as Violin_plot.bmp" )
message("The analysis has been completed. All results are saved inside the ProtE_Analysis folder. Thank you for activating the Proteomics Eye!")
}
Try the ProtE package in your browser
Any scripts or data that you put into this service are public.
ProtE documentation built on April 3, 2025, 6:13 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions dianno
Documented in dianno
#' DIA NN proteomics data analysis
#'
#' Processes the DIA-NN proteomics output and performs exploratory statistical analysis for a single categorical variable. Accepts as input either of the files pg_matrix.tsv or unique_gene_matrix.tsv.
#'
#' @param file The whole path to the DIA-NN pg_matrix.tsv file (or alternatively, to the unique_genes_matrix.tsv file). The folders in the file path must be separated either with the forward slashes (/), or with the double backslashes (\\). See the example for inserting correctly the file path.
#' @param group_names A character vector specifying group names. The order of the names should align with the order of the sample groups in the input tsv file.
#' @param samples_per_group A numerical vector giving the number of samples in each group. The order of the numbers should align with the order of the names in group_names.
#' @param normalization The specific method for normalizing the data.By default it is set to FALSE. As DIA-NN output has already been normalized with the MaxLFQ algorithm, we suggest to be cautious if you select any method. Options are FALSE for no normalization of the data, "log2" for a simple log2 transformation, "Quantile" for a quantiles based normalization and "Cyclic_Loess" for a Cyclic Loess normalization of the log2 data, "median" for a median one, "TIC" for Total Ion Current normalization, "VSN" for Variance Stabilizing Normalization and "PPM" for Parts per Million transformation of the data.
#' @param filtering_value The maximum allowable percentage of missing values for a protein. Proteins with missing values exceeding this percentage will be excluded from the analysis. By default it is set to 50.
#' @param global_filtering TRUE/FALSE. If TRUE, the per-protein percentage of missing values will be calculated across the entire dataset. If FALSE, it will be calculated separately for each group, allowing proteins to remain in the analysis if they meet the criteria within any group. By default it is set to TRUE.
#' @param imputation Imputes all remaining missing values. Available methods: "LOD" for assigning the dataset's Limit Of Detection (lowest protein intensity identified), "LOD/2", "Gaussian_LOD" for selecting random values from the normal distribution around LOD with sd= 0.2*LOD, "zeros" for simply assigning 0 to MVs, mean" for replacing missing values with the mean of each protein across the entire dataset, "kNN" for a k-nearest neighbors imputation using 5 neighbors (from the package VIM) and "missRanger" for a random forest based imputation using predictive mean matching (from the package missRanger). By default it is set to FALSE (skips imputation).
#' @param independent TRUE/FALSE If TRUE, the samples come from different populations, if FALSE they come from the same population (Dependent samples). By default, it is set to TRUE. If set to FALSE, the numbers given in the samples_per_group param must be equal to each other.
#' @param parametric TRUE/FALSE. Specifies the statistical tests that will be taken into account for creating the PCA plots and heatmap. By default it is set to FALSE (non-parametric).
#' @param significance "p" or "BH" Specifies which of the p-values (nominal vs BH adjusted for multiple hypothesis) will be taken into account for creating the PCA plots and the heatmap. By default it is set to "p" (nominal p-value).
#' @param description TRUE/FALSE. If TRUE, establishes connection to the Uniprot database (via the Uniprot.ws package) and adds the "Description" annotation in the data. This option requires protein Accession IDs and is thus applicable only to the pg.matrix file. It requires also internet access. By default it is set to FALSE (No description fetching).
#'
#'
#' @return Returns the complete output of the exploratory analysis: i) The processed, or filtered/normalized data ii) Statistical output containing results for the parametric (limma+ANOVA) and non-parametric tests (Wilcoxon_p_+Kruskal-Wallis+PERMANOVA), along with statistical tests for heteroscedasticity, iii) Quality metrics for the input samples iv) QC plots and exploratory visualizations.
#' @importFrom openxlsx write.xlsx read.xlsx
#' @importFrom grDevices dev.off bmp colorRampPalette
#' @importFrom dplyr select group_by group_modify everything %>% any_of
#' @importFrom tidyr gather pivot_longer
#' @importFrom broom tidy
#' @importFrom reshape2 melt
#' @importFrom ggpubr ggarrange
#' @importFrom ggplot2 ggplot ggsave geom_violin scale_x_discrete scale_color_gradient element_line theme_linedraw scale_fill_manual scale_color_manual aes geom_histogram element_rect geom_point geom_smooth xlab ylab ggtitle theme_bw theme_minimal theme element_text guides guide_legend geom_boxplot labs theme_classic element_blank geom_jitter position_jitter
#' @importFrom VIM kNN
#' @importFrom stats kruskal.test p.adjust prcomp sd wilcox.test friedman.test rnorm bartlett.test model.matrix heatmap median na.omit
#' @importFrom forcats fct_inorder
#' @importFrom limma topTable eBayes contrasts.fit normalizeCyclicLoess normalizeVSN lmFit normalizeQuantiles duplicateCorrelation
#' @importFrom grid gpar
#' @importFrom pheatmap pheatmap
#' @importFrom UniprotR GetProteinAnnontate
#' @importFrom stringr str_extract
#' @importFrom missRanger missRanger
#' @importFrom car leveneTest
#' @importFrom utils read.delim2
#' @importFrom vegan adonis2
#'
#' @examples
#' #Example of running the function with paths for two groups.
#' # The file path is a placeholder, replace it with an actual file.
#'
#' jittered.pg_matrix.tsv <- system.file("extdata", "report.pg_matrix.tsv", package = "ProtE")
#'
#' # Copy the file to a temporary directory for CRAN checks
#' temp_file <- file.path(tempdir(), "report.pg_matrix.tsv")
#' file.copy(jittered.pg_matrix.tsv, temp_file, overwrite = TRUE)
#'
#' dianno(file = temp_file,
#' group_names = c("Healthy","Control"),
#' samples_per_group = c(5,4), filtering_value = 80)
#'
#' @export
dianno <- function(file,
group_names,
samples_per_group,
normalization = FALSE,
imputation = FALSE,
global_filtering = TRUE,
independent = TRUE,
filtering_value = 50,
parametric= FALSE,
significance = "p", description = FALSE)
{message("The ProtE process starts now!")
Protein.Ids =Protein.Names =Symbol =X =Y = Mean = SD = Description = df4_wide= percentage=Sample= Genes = variable =.=key=Accession =value =g1.name=g2.name= NULL
groups_number <- length(group_names)
if (length(samples_per_group) != groups_number) {
stop("The length of 'samples_per_group' must be equal to the length of 'group_names'. Each of the numerical values in 'samples_per_group' must denote the sample size for the corresponding group in 'group_names") }
for (i in 1:groups_number) {
assign(paste0("g",i,".name"),group_names[[i]])}
if(grepl("\\.tsv$", file)) {
dataspace <- utils::read.delim2(file, header = TRUE, sep = "\t")
}
else if(grepl("\\.xlsx$", file)) {
dataspace <- openxlsx::read.xlsx(file)
} else {stop("Error, the file you provided is not on .tsv or .xlsx format")}
path <- dirname(file)
path_res <- file.path(path , "ProtE_Analysis")
dir.create(path_res, showWarnings = FALSE)
path_restat <- file.path(path_res, "Statistical_Analysis")
path_resman <- file.path(path_res, "Data_processing")
path_resplot <- file.path(path_res, "Plots")
dir.create(path_restat, showWarnings = FALSE)
dir.create(path_resman, showWarnings = FALSE)
dir.create(path_resplot, showWarnings = FALSE)
if("Protein.Ids" %in% colnames(dataspace)) {
dataspace <- dataspace[!grepl("^;",dataspace$Protein.Ids),]
dataspace <- dataspace[,-c(1,4:5)]
dataspace[, -c(1,2)] <- lapply(dataspace[, -c(1,2)], as.numeric)
col_names <- colnames(dataspace)
col_names[-1:-2] <- gsub("\\\\", "/", col_names[-1:-2])
col_names[-1:-2] <- basename(col_names[-1:-2])
colnames(dataspace) <- col_names
dataspace <- dataspace[rowSums(!is.na(dataspace[,-c(1,2)])) > 0, ]
if (description == TRUE ) {
message("The Description fetching from UniProt starts now, it might take some time depending on you Network speed.")
id_numbers <- dataspace$Protein.Ids
for (j in 1:length(id_numbers)){id_numbers[j] <- stringr::str_extract(id_numbers[j], "^[^;]*")}
df_description <- data.frame("Description" = character(), stringsAsFactors = FALSE)
dataspace$Protein.Ids<-id_numbers
conv_ID <- GetProteinAnnontate(dataspace$Protein.Ids, columns =c("organism_name" , "protein_name" , "id" ,"gene_names") )
details<-paste(conv_ID$Protein.names," OS=",conv_ID$Organism," GN=",conv_ID$Gene.Names," -[",conv_ID$Entry.Name,"]")
df_description <- rbind(df_description, data.frame(Description = details, stringsAsFactors = FALSE))
dataspace<-cbind(dataspace[,1:2],df_description,dataspace[,3:ncol(dataspace)])
colnames(dataspace)[colnames(dataspace) == "Protein.Ids"] <- "Accession"
dataspace <- dataspace[,-2]
}
colnames(dataspace)[colnames(dataspace) == "Protein.Ids"] <- "Accession"
} else {
dataspace <- dataspace[!grepl("^;", dataspace[["Genes"]]), ]
dataspace[, -1] <- lapply(dataspace[,-1], as.numeric)
col_names <- colnames(dataspace)
col_names[-1] <- gsub("\\\\", "/", col_names[-1])
col_names[-1] <- basename(col_names[-1])
colnames(dataspace) <- col_names
dataspace <- dataspace[rowSums(!is.na(dataspace[,-1])) > 0, ]
dataspace$Description <- rep("Not Available", nrow(dataspace))
dataspace<-dataspace %>%
dplyr::select(Genes,any_of(c("Protein.Names","Description")) , everything())
message("The description fetching is not available when the input is a unique_genes matrix")
}
colnames(dataspace) <- make.names(colnames(dataspace), unique = TRUE)
rownames(dataspace) <- make.names(rownames(dataspace), unique = TRUE)
if (sum(samples_per_group) != ncol(dataspace)-2) {stop("Error: The specified number of samples in the parameter samples_per_group does not align with the total samples in the input file.")}
zero_per_sample <- colSums(is.na(dataspace[,-1:-2]))*100/nrow(dataspace)
IDs <- colSums(!is.na(dataspace[,-1:-2]))
name_dataspace <- dataspace[, -1:-2]
dat.dataspace<-dataspace
if (normalization == "PPM"){
dataspace[, -1:-2] <- lapply(dataspace[, -1:-2], function(x) {
sum_x <- sum(x, na.rm = TRUE)
ifelse(is.na(x), NA, (x / sum_x) * 10^6)
})
Gdataspace<-dataspace
norm_file_path <- file.path(path_resman, "Normalized.xlsx")
openxlsx::write.xlsx(Gdataspace, file = norm_file_path)
message("Applying the selected normalization, saved as Normalized.xlsx")}
if (normalization == "Quantile"){
dataspace[, -1:-2] <- log(dataspace[, -1:-2]+1,2)
dataspace[, -1:-2] <- limma::normalizeQuantiles(dataspace[, -1:-2])
Gdataspace<-dataspace
norm_file_path <- file.path(path_resman, "Normalized.xlsx")
openxlsx::write.xlsx(Gdataspace, file = norm_file_path)
message("Applying the selected normalization, saved as Normalized.xlsx") }
if (normalization == "log2"){
dataspace[, -1:-2] <- log(dataspace[, -1:-2]+1,2)
Gdataspace<-dataspace
norm_file_path <- file.path(path_resman, "Normalized.xlsx")
openxlsx::write.xlsx(Gdataspace, file = norm_file_path)
message("Applying the selected normalization, saved as Normalized.xlsx") }
if (normalization == "Total_Ion_Current") {
dataspace[, -1:-2] <- lapply(dataspace[, -1:-2], function(x) (x / sum(x, na.rm = TRUE)) * mean(colSums(dataspace[, -1:-2], na.rm = TRUE)))
Gdataspace<-dataspace
norm_file_path <- file.path(path_resman, "Normalized.xlsx")
openxlsx::write.xlsx(Gdataspace, file = norm_file_path)
message("Applying the selected normalization, saved as Normalized.xlsx")}
if (normalization == "Cyclic_Loess"){
dataspace[, -1:-2] <- log(dataspace[, -1:-2]+1,2)
dataspace[, -1:-2] <- limma::normalizeCyclicLoess(dataspace[, -1:-2])
Gdataspace<-dataspace
norm_file_path <- file.path(path_resman, "Normalized.xlsx")
openxlsx::write.xlsx(Gdataspace, file = norm_file_path)
message("Applying the selected normalization, saved as Normalized.xlsx") }
if ( normalization == "VSN") {
dataspace[, -1:-2] <- suppressMessages(limma::normalizeVSN(dataspace[, -1:-2]))
Gdataspace<-dataspace
norm_file_path <- file.path(path_resman, "Normalized.xlsx")
openxlsx::write.xlsx(Gdataspace, file = norm_file_path)
message("Applying the selected normalization, saved as Normalized.xlsx")
}
if (normalization == "median") {
sample_medians <- apply(dataspace[, -1:-2], 2, median, na.rm = TRUE)
dataspace[, -1:-2] <- sweep(dataspace[, -1:-2], 2, sample_medians, FUN = "/")
Gdataspace<-dataspace
norm_file_path <- file.path(path_resman, "Normalized.xlsx")
openxlsx::write.xlsx(Gdataspace, file = norm_file_path)
message("Applying the selected normalization, saved as Normalized.xlsx")}
if (normalization %in% c(FALSE,"median", "Total_Ion_Current", "PPM") ){
log.dataspace <- log(dataspace[,-c(1:2)]+1,2)
row_means <- rowMeans(log.dataspace, na.rm = TRUE)
row_sds <- apply(log.dataspace, 1, sd, na.rm = TRUE)
plot_data <- data.frame(Mean = row_means, SD = row_sds)
meansd <- ggplot(plot_data, aes(x = Mean, y = SD)) +
geom_point(alpha = 0.5, color = "blue") +
geom_smooth(method = "loess", color = "red", se = FALSE) +
theme_minimal() +
labs(title = "Mean-SD Plot on the log2 normalized data", x = "Mean Expression", y = "Standard Deviation")
meansd
ggplot2::ggsave("meanSdPlot.bmp", plot = meansd, path = path_resplot,
scale = 1, width = 5, height = 4, units = "in",
dpi = 300, limitsize = TRUE)
message("Creating Mean-SD plot on the log2 data.")
} else {
row_means <- rowMeans(dataspace[,-c(1,2)], na.rm = TRUE)
row_sds <- apply(dataspace[,-c(1,2)], 1, sd, na.rm = TRUE)
plot_data <- data.frame(Mean = row_means, SD = row_sds)
meansd <- ggplot(plot_data, aes(x = Mean, y = SD)) +
geom_point(alpha = 0.5, color = "blue") +
suppressMessages(geom_smooth(method = "loess", color = "red", se = FALSE)) +
theme_minimal() +
labs(title = "Mean-SD Plot on the log2 normalized data", x = "Mean Expression", y = "Standard Deviation")
meansd
ggplot2::ggsave("meanSdPlot.bmp", plot = meansd, path = path_resplot,
scale = 1, width = 5, height = 4, units = "in",
dpi = 300, limitsize = TRUE)
message("Creating Mean-SD plot.")
}
if (filtering_value < 0 && filtering_value > 100) {stop("Error: The filtering_value must be a number ranging from 0 to 100")}
if (global_filtering == TRUE) {
filtering_value <- 100- as.numeric(filtering_value)
threshold <- ceiling(sum(samples_per_group)-(sum(samples_per_group)*(as.numeric(filtering_value)/100))+0.00000000001)
}
if (global_filtering == FALSE) {
threshold<-numeric(groups_number)
filtering_value <- 100- as.numeric(filtering_value)
for (i in 1:groups_number) {
threshold[i] <- ceiling(samples_per_group[i]-(samples_per_group[i])*(as.numeric(filtering_value)/100)+0.00000000001)}
}
coln <- list()
case_last <- 2
for (i in 1:groups_number) {
case_last <- case_last + samples_per_group[i]
coln[[i]] <- (case_last - samples_per_group[i] + 1):case_last
}
Gdataspace<-dataspace
Gdataspace<-Gdataspace %>%
dplyr::select(any_of(c("Accession","Genes")),any_of(c("Protein.Names","Description")) , everything())
colnames(Gdataspace) <- gsub(".xlsx", "", colnames(Gdataspace))
dataspace[is.na(dataspace)] <- 0
for (j in 1:groups_number){
for (i in c(1:nrow(dataspace))){
a <- table(dataspace[i,coln[[j]]]==0)["TRUE"]
if(is.na(a)){
dataspace[i,paste0("Number_0_group",j)] <- 0
} else{
dataspace[i,paste0("Number_0_group",j)] <- table(dataspace[i,coln[[j]]]==0)["TRUE"]
}
}
}
dataspace$Number_0_all_groups <- rowSums(dataspace[,paste0("Number_0_group", 1:groups_number)])
dataspace <- dataspace[dataspace$Number_0_all_groups < sum(samples_per_group),]
if (global_filtering == TRUE) {
dataspace <- dataspace[dataspace$Number_0_all_groups<threshold,]
at_file_path <- file.path(path_resman, "Dataset_after_filtering.xlsx")
openxlsx::write.xlsx(dataspace, file = at_file_path)
}
if (global_filtering == FALSE) {
keep_rows <- rep(FALSE, nrow(dataspace))
for (j in 1:groups_number) {
keep_rows <- keep_rows | (dataspace[,paste0("Number_0_group", j)] < threshold[j])
}
dataspace <- dataspace[keep_rows, ]
at_file_path <- file.path(path_resman, "Dataset_after_filtering.xlsx")
openxlsx::write.xlsx(dataspace, file = at_file_path)}
message("An excel file with the proteins remaining in the data after filtering for missing values, has been created as Dataset_after_filtering.xlsx")
dataspace_0s<- dataspace
dataspace[,paste0("Number_0_group", 1:groups_number)] <- NULL
dataspace$Number_0_all_groups <- NULL
zero_per_sample1 <- colSums(dataspace[,-1:-2] == 0)*100/nrow(dataspace)
sample_names <- colnames(dataspace[,-1:-2])
qc <- cbind(sample_names,IDs,zero_per_sample,zero_per_sample1)
qc <- as.data.frame(qc)
colnames(qc) <- c("Sample Name","Number of proteins detected in the sample","% of Missing values before filtering","% of Missing values after filtering")
rownames(qc) <- NULL
pre_dataspace <- dataspace
if (imputation == "kNN") {
message("kNN imputation starts now")
dataspace[dataspace==0] <- NA
dataspace[, -c(1, 2)] <- VIM::kNN(dataspace[, -c(1, 2)], imp_var = FALSE, k= 5)
imp_file_path <- file.path(path_resman, "Dataset_Imputed.xlsx")
openxlsx::write.xlsx(dataspace, file = imp_file_path)
}
if (imputation == "Zeros"){
imp_file_path <- file.path(path_resman, "Dataset_Imputed.xlsx")
openxlsx::write.xlsx(dataspace, file = imp_file_path) }
if (imputation == "Gaussian_LOD") {
dataspace[dataspace==0] <- NA
LOD <- min(as.matrix(dataspace[, -c(1, 2)]),na.rm = TRUE)
replace_gaussian <- function(x) {
ifelse(is.na(x), rnorm(length(x), mean = LOD, sd = LOD*0.2), x)
}
dataspace[, -c(1, 2)] <- apply(dataspace[, -c(1, 2)], 2, replace_gaussian)
imp_file_path <- file.path(path_resman, "Dataset_Imputed.xlsx")
openxlsx::write.xlsx(dataspace, file = imp_file_path)
}
if (imputation == "mean"){
data_to_impute <- dataspace[, 3:(2 + sum(samples_per_group))]
for (i in seq_len(nrow(data_to_impute))) {
row_data <- data_to_impute[i, ]
if (any(is.na(row_data))) {
row_data <- as.numeric(row_data)
row_mean <- mean(row_data, na.rm = TRUE)
row_data[is.na(row_data)] <- row_mean
data_to_impute[i, ] <- row_data
}
}
dataspace[, 3:(2 + sum(samples_per_group))] <- data_to_impute
imp_file_path <- file.path(path_resman, "Dataset_Imputed.xlsx")
openxlsx::write.xlsx(dataspace, file = imp_file_path) }
if (imputation == "LOD"){
dataspace[dataspace==0] <- NA
impute_value <- min(as.matrix(dataspace[, -c(1, 2)]),na.rm = TRUE)
dataspace[, -c(1, 2)][is.na(dataspace[, -c(1, 2)])] <- impute_value
imp_file_path <- file.path(path_resman, "Dataset_Imputed.xlsx")
openxlsx::write.xlsx(dataspace, file = imp_file_path) }
if (imputation == "LOD/2"){
dataspace[dataspace==0] <- NA
impute_value <- min(as.matrix(dataspace[, -c(1, 2)]),na.rm = TRUE)/2
dataspace[, -c(1, 2)][is.na(dataspace[, -c(1, 2)])] <- impute_value
imp_file_path <- file.path(path_resman, "Dataset_Imputed.xlsx")
openxlsx::write.xlsx(dataspace, file = imp_file_path) }
if(imputation == "missRanger"){
message("missRanger imputation starts now")
dataspace[dataspace==0] <- NA
dataspace[,-c(1,2)] <- missRanger::missRanger(dataspace[,-c(1,2)])
imp_file_path <- file.path(path_resman, "Dataset_Imputed.xlsx")
openxlsx::write.xlsx(dataspace, file = imp_file_path) }
if (imputation %in% c("kNN","missRanger","mean")) {
pre_dataspace1<-pre_dataspace[,-1:-2]
dataspace1<-dataspace[,-1:-2]
imp.values<- dataspace1 - pre_dataspace1
his_dataspace<-rbind(dataspace1,pre_dataspace1,imp.values)
loghis_dataspace<-log2(his_dataspace+1)
his_long <-tidyr::pivot_longer(loghis_dataspace, cols = everything())
nrows<-nrow(his_long)
his_long$Group <- rep(c("Final","Initial","Imputed"), each = (nrows/3))
his_long_filtered <- his_long[his_long$value != 0,]
his_long_filtered$Group <- factor(his_long_filtered$Group, levels = c("Final", "Initial", "Imputed"))
imp_hist<- ggplot(his_long_filtered, aes(x = value, fill = Group, colour = Group)) +
labs( x = expression(Log[2]~"Protein Abundance"), y = "Count") +
scale_fill_manual(values = c("Final" = "#FF99FF", "Initial" = "#990000", "Imputed" = "#000033")) +
scale_color_manual(values = c("Final" = "#FF99FF", "Initial" = "#990000", "Imputed" = "#000033")) +
geom_histogram(alpha = 0.5, binwidth = 0.3, position = "identity") +
theme_minimal() +
theme(plot.background = element_rect(fill = "white")) + theme(panel.background = element_rect(fill = "white"))
imp_hist
ggplot2::ggsave("Imputed_values_histogram.bmp", plot = imp_hist, path = path_resplot,
scale = 1, width = 5, height = 4, units = "in",
dpi = 300, limitsize = TRUE)
message("A frequency histogram of real and imputed values has been created as Imputed_values_histogram.bmp")
}
if (imputation %in% c("LOD/2","LOD","kNN","missRanger","mean","zeros","Gaussian_LOD")){
message("An excel with the imputed missing values has been created as Dataset_Imputed.xlsx")
dataspace_0s$percentage <- dataspace_0s$Number_0_all_groups*100/sum(samples_per_group)
dataspace$percentage <- dataspace_0s$percentage
dataspace$mean <- rowMeans(dataspace[,3:(2+sum(samples_per_group))])
dataspace$log<-log2(dataspace$mean)
dataspace$rank <- rank(-dataspace$mean)
abund.plot <- ggplot(dataspace, aes(x = rank, y = log, colour = percentage)) +
geom_point(size = 3, alpha = 0.8) +
labs(title = "Protein Abundance Rank", x = "Rank", y = "Mean", expression(Log[2] ~ "Protein Abundance")) +
scale_color_gradient(low = "darkblue", high = "yellow",
name = "Imputations\nin each\nprotein\n(%)",limits = c(0,100-filtering_value)) +
theme_linedraw()+
theme(plot.title = element_text(hjust = 0.5, face = "bold"),
panel.grid = element_line(color = "grey80"),
legend.title = element_text(size = 10, face = "bold"),
legend.text = element_text(size = 9))
abund.plot
ggplot2::ggsave("Proteins_abundance_rank.bmp", plot = abund.plot , path = path_resplot,
scale = 1, width = 12, height = 5, units = "in",
dpi = 300, limitsize = TRUE, bg = "white")
}
if (imputation == FALSE){
dataspace_0s$percentage <- dataspace_0s$Number_0_all_groups*100/sum(samples_per_group)
dataspace$percentage <- dataspace_0s$percentage
dataspace[, 3:(2 + sum(samples_per_group))] <- lapply(dataspace[, 3:(2 + sum(samples_per_group))], as.numeric)
dataspace$mean <- apply(dataspace[, 3:(2+sum(samples_per_group))], 1, function(x) mean(x[x != 0]))
dataspace$log<-log2(dataspace$mean)
dataspace$rank <- rank(-dataspace$mean)
abund.plot <- ggplot(dataspace, aes(x = rank, y = log, colour = percentage)) +
geom_point(size = 3, alpha = 0.8) +
labs(title = "Protein Abundance Rank", x = "Rank", y = expression(Log[2] ~ "Proteins Abundance")) +
scale_color_gradient(low = "darkblue", high = "yellow",
name = "MVs\nin each\nprotein\n(%)",limits = c(0,100-filtering_value)) +
theme_linedraw()+
theme(plot.title = element_text(hjust = 0.5, face = "bold"),
panel.grid = element_line(color = "grey80"),
legend.title = element_text(size = 10, face = "bold"),
legend.text = element_text(size = 9))
abund.plot
ggplot2::ggsave("Proteins_abundance_rank.bmp", plot = abund.plot , path = path_resplot,
scale = 1, width = 12, height = 5, units = "in",
dpi = 300, limitsize = TRUE, bg = "white")
}
message("A protein abundance rank order plot has been created as Proteins_abundance_rank.bmp")
dataspace$percentage <- NULL
dataspace$mean <- NULL
dataspace$log<- NULL
dataspace$rank <- NULL
groups_list <- list("character")
for (i in 1:groups_number) {
groups_list[[i]] <- rep(group_names[i], times = samples_per_group[i])
}
groups_list_u <- unlist(groups_list)
groups_list_f <- factor(groups_list_u, levels = unique(groups_list_u))
mm <- model.matrix(~groups_list_f + 0)
colnames(mm)<- group_names
nndataspace<- dataspace[,-1:-2]
nndataspace[nndataspace < 0] <- 0
nndataspace <- log2(nndataspace+1)
if (independent == FALSE){
if (length(unique(samples_per_group)) != 1){
message("Error: The paired group analysis requires an equal number of samples in each group. Please consider removing any samples that lack a corresponding matched pair.")
}
n = sum(samples_per_group)/groups_number
pairing <- rep(1:n, each = groups_number)
corfit <- limma::duplicateCorrelation(nndataspace, design = mm, block = pairing)
fit <- limma::lmFit(nndataspace, mm, block = pairing, correlation = corfit$consensus.correlation)
}
if (independent == TRUE){
fit <- limma::lmFit(nndataspace, mm)}
fit<- limma::eBayes(fit)
if (groups_number>2){
anova_res <- data.frame()
anova_res<- limma::topTable(fit, adjust.method = "BH", number = Inf, sort.by = "none")
colnames(anova_res)<-paste("ANOVA",colnames(anova_res), sep = "_")
anova_res<- anova_res[,-c(1:groups_number)]}
lima.res <- data.frame()
for (i in 1:(ncol(mm)-1)) {
for (j in (i+1):ncol(mm)) {
comparison <- paste(colnames(mm)[i], "vs", colnames(mm)[j], sep = " ")
contrast_fref <- limma::makeContrasts(contrasts = paste0(colnames(mm)[i],"-",colnames(mm)[j]), levels = mm)
fit2 <- limma::contrasts.fit(fit, contrast_fref)
fit2 <- limma::eBayes(fit2)
top_table<- limma::topTable(fit2, adjust.method = "BH", number = Inf, sort.by = "none")
column_groups<- top_table[,c("logFC","AveExpr","t","P.Value","adj.P.Val","B")]
colnames(column_groups)<-paste(colnames(column_groups), comparison, sep = "_")
if (nrow(lima.res) == 0){
lima.res <- column_groups
} else {lima.res<- cbind(lima.res, column_groups)}
}}
if (groups_number>2){
limma_dataspace <- cbind(anova_res,lima.res,dataspace)} else {limma_dataspace <- cbind(lima.res,dataspace)}
ncollimma <- ncol(limma_dataspace) - ncol(dataspace) + 2
limma_dataspace<-limma_dataspace %>%
dplyr::select(any_of(c("Accession","Genes")),any_of(c("Protein.Names","Description")) , everything())
limma_dataspace <- limma_dataspace[,1:ncollimma]
limma_file_path <- file.path(path_restat, "Dataset_limma.test.xlsx")
openxlsx::write.xlsx(limma_dataspace, file = limma_file_path)
message("The limma output has been saved as Dataset_limma.test.xlsx")
if (independent != FALSE && independent != TRUE){stop("Error: Sample relationship between groups should be defined in the parameter 'independent' either as TRUE or FALSE")}
data2 <- dataspace
for (j in 1:groups_number) {
data2[[paste0("Average_G", j)]] <- apply(data2[, coln[[j]]], 1, function(row) {
if (all(is.na(row))) {
0
} else {
mean(row, na.rm = TRUE)
}
})
data2[[paste0("St_Dv_G", j)]] <- apply(data2[, coln[[j]]], 1, function(row) {
if (sum(!is.na(row)) < 2) {
0
} else {
sd(row, na.rm = TRUE)
}
})
for (k in 1:j) {
if (k < j) {
for (i in 1:nrow(data2)) {
values_k <- as.numeric(data2[i, coln[[k]]])
values_j <- as.numeric(data2[i, coln[[j]]])
if (independent == TRUE) {
if (sum(!is.na(values_k)) > 0 & sum(!is.na(values_j)) > 0) {
test_list <- stats::wilcox.test(
values_k, values_j,
exact = FALSE, paired = FALSE, na.rm = TRUE
)
data2[i, paste0("Wilcoxon_p_G", j, "vsG", k)] <- test_list$p.value
} else {
data2[i, paste0("Wilcoxon_p_G", j, "vsG", k)] <- NA
}
} else if (independent == FALSE) {
paired_values <- na.omit(cbind(values_k, values_j))
if (nrow(paired_values) > 0) {
test_list <- stats::wilcox.test(
paired_values[, 1], paired_values[, 2],
exact = FALSE, paired = TRUE
)
data2[i, paste0("Wilcoxon_p_G", j, "vsG", k)] <- test_list$p.value
} else {
data2[i, paste0("Wilcoxon_p_G", j, "vsG", k)] <- NA
}
}
}
data2[[paste0("BH_p_G", j, "vsG", k)]] <- p.adjust(
data2[[paste0("Wilcoxon_p_G", j, "vsG", k)]],
method = "BH"
)
avg_j <- data2[[paste0("Average_G", j)]]
avg_k <- data2[[paste0("Average_G", k)]]
data2[[paste0("Ratio_G", j, "vsG", k)]] <- ifelse(
avg_k == 0, NA, avg_j / avg_k
)
data2[[paste0("Log2_Ratio_G", j, "vsG", k)]] <- log2(
data2[[paste0("Ratio_G", j, "vsG", k)]]
)
}
}
}
for(i in 1:nrow(data2)){
group_values <- list()
for (j in 1:groups_number) {
group_values[[j]]<- as.numeric(data2[i, coln[[j]]])
}
valid_groups <- group_values[sapply(group_values, function(x) sum(!is.na(x)) > 1)]
if (length(valid_groups) >= 2) {
bartlett_result <- bartlett.test(valid_groups)
data2[i, "Bartlett_p"] <- bartlett_result$p.value
leve_data <- data.frame(
Value = unlist(valid_groups),
Group = rep(seq_along(valid_groups), sapply(valid_groups, length)) )
levene_result <- car::leveneTest(Value ~ as.factor(Group), data = leve_data, center = median)
data2[i, "Levene_p"] <- levene_result$`Pr(>F)`[1] } else {
data2[i, "Bartlett_p"] <- NA
data2[i, "Levene_p"] <- NA
}
}
only.data <- dataspace[,-c(1:2)]
transposed_data <- t(only.data)
metadata2 <- data.frame(group = groups_list_u)
rownames(transposed_data) <- metadata2$group
metadata2$samples <- colnames(only.data)
adonis2_results <- vegan::adonis2(transposed_data ~ group, data = metadata2, method = "bray", na.rm = TRUE, permutations = 999)
permanova_psF <- adonis2_results[4]
permanova_psF<- permanova_psF[-c(2:3),]
permanova_pValue <- adonis2_results[5]
permanova_pValue<- permanova_pValue[-c(2:3),]
data2[1, "PERMANOVA_PseudoF"] <- permanova_psF
data2[1, "PERMANOVA_p"] <- permanova_pValue
Ddataspace<-data2
if (description ==TRUE ){
Ddataspace$Symbol = sub(".*GN=(.*?) .*","\\1",Ddataspace$Description)
Ddataspace$Symbol[Ddataspace$Symbol==Ddataspace$Description] = "Not available"
}else {Ddataspace$Symbol = "Not available"}
Fdataspace <- Ddataspace %>%
dplyr::select(any_of(c("Accession","Genes")),
dplyr::any_of(c("Description", "Protein.Names")),
Symbol,
everything())
Group<-list()
times<-vector()
for (i in (1:groups_number)){
times<-samples_per_group[i]
Group[[i]] <- rep(paste0("G",i), times)
times<-NULL}
Group<-unlist(Group)
dataspace3<-t(dataspace[,-c(1:2)])
dataspace3<-data.frame(dataspace3)
dataspace<-data.frame(dataspace)
colnames(dataspace3)<-dataspace[,1]
dataspace4<-cbind(Group,dataspace3)
dataspace4$Group<-as.factor(dataspace4$Group)
colnames(dataspace4) <- make.names(colnames(dataspace4), unique = TRUE)
if (groups_number > 2) {
if (independent == TRUE) {
message("Mann-Whitney, Levene's and Bartlett's tests have been completed, calculating the Kruskal-Wallis p-values:")
df3 <- dataspace4 %>% tidyr::gather(key, value, -Group)
df4 <- df3 %>% dplyr::group_by(key)
df4$value <- as.numeric(df4$value)
df5 <- df4 %>%
dplyr::group_modify(~ broom::tidy(kruskal.test(value ~ Group, data = .x)))
df5<- df5[,c(1,3)]
data3 <- merge(Ddataspace, df5, by.x = colnames(Ddataspace)[1], by.y = "key", all.x = TRUE)
data3 <- data3[match(Ddataspace[, 1], data3[, 1]), ]
test_type <- "Kruskal_Wallis"
} else if (independent == FALSE) {
message("Wilcoxon, Levene's and Bartlett's tests have been completed, performing Friedman test for paired samples:")
df3 <- dataspace4 %>% tidyr::gather(key, value, -Group)
df4 <- df3 %>% dplyr::group_by(key)
df4$value <- as.numeric(df4$value)
samples_fried <- rep(1:samples_per_group[1],nrow(dataspace)*groups_number)
df4<- suppressMessages(cbind(df4, samples_fried ))
colnames(df4)[ncol(df4)] <- "sample"
p_values <- numeric(nrow(df4_wide))
for (i in seq_along(unique(df4$key))) {
gene_data <- subset(df4, key == unique(df4$key)[i])
friedman_result <- tryCatch({
friedman.test(value ~ Group | sample, data = gene_data)$p.value
}, error = function(e) NA)
p_values[i] <- friedman_result
}
Test.pvalue <- p_values
test_type <- "Friedman"
data3 <- cbind(Ddataspace, Test.pvalue)
}
colnames(data3)[ncol(data3)] <- paste0(test_type, ".pvalue")
data3[[paste0(test_type, ".pvalue_BH.adjusted")]] <- p.adjust(data3[[paste0(test_type, ".pvalue")]], method = "BH")
Fdataspace <- data3
if (description == TRUE) {
Fdataspace$Symbol <- sub(".*GN=(.*?) .*", "\\1", Fdataspace$Description)
Fdataspace$Symbol[Fdataspace$Symbol == Fdataspace$Description] <- "Not available"
} else {
Fdataspace$Symbol <- "Not available"
}
Fdataspace <- Fdataspace %>%
dplyr::select(
any_of(c("Accession", "Genes")),
dplyr::any_of(c("Description", "Protein.Names")),
Symbol,
everything()
)
} else {Fdataspace <- Ddataspace}
for (i in 1:groups_number){
namesc<- colnames(Fdataspace)
namesc<- gsub(paste0("G",i), get(paste0("g",i,".name")),namesc)
colnames(Fdataspace)<-namesc
}
colnames(Fdataspace) <- gsub(".xlsx", "", colnames(Fdataspace))
start_col <- 3 + as.numeric(sum(samples_per_group))
Fdataspace <- Fdataspace[,-c(4:start_col)]
stats_file_path <- file.path(path_restat, "Statistics.xlsx")
openxlsx::write.xlsx(Fdataspace, file = stats_file_path)
message("The non-parametric statistical output along with tests for homoscedasticity have been saved as Statistical_analysis.xlsx")
dataspace[is.na(dataspace)] <- 0
Group <- groups_list_f
Group2<-unique(groups_list_f)
dataspace[dataspace < 0] <- 0
log.dataspace <- log(dataspace[,-c(1:2)]+1,2)
dataspace[is.na(dataspace)] <- 0
pca<-prcomp(t(log.dataspace), scale=TRUE, center=TRUE)
pca.data <- data.frame(Sample=rownames(pca$x),
X=pca$x[,1],
Y=pca$x[,2],
Group = Group)
qc$PC1.score <- pca$x[,1]
qc$PC2.score <-pca$x[,2]
if (groups_number == 2){
Group<-list()
times<-vector()
for (i in (1:length(samples_per_group))){
times<-samples_per_group[i]
Group[[i]] <- rep(paste0("G",i), times)
times<-NULL
}
Group<-unlist(Group)
Group<-gsub("G1", g1.name, Group)
Group<-gsub("G2", g2.name, Group)
}
pca.var<-pca$sdev^2
pca.var.per<-round(pca.var/sum(pca.var)*100,1)
pca.data$Group<-factor(pca.data$Group, levels=Group2)
pca.ent<-ggplot2::ggplot(data=pca.data, ggplot2::aes(x=X, y=Y, label=Sample))+
geom_point(aes(color=Group), size = 2, alpha = 1)+
xlab(paste("PC1 - ", pca.var.per[1], "%", sep=""))+
ylab(paste("PC2 - ", pca.var.per[2], "%", sep=""))+
ggtitle("Complete set of proteins")+
theme_bw()+
theme(plot.title = element_text(hjust=0.5))+
guides(color = guide_legend(override.aes = list(size=5)))+
theme(legend.text = element_text(size = 12))+
theme(legend.title = element_text(size = 12))+
theme(legend.position="right")
pca.ent
ggplot2::ggsave("PCA_plot_alldata.bmp", plot = pca.ent, path = path_resplot,
scale = 1, width = 5, height = 4, units = "in",
dpi = 300, limitsize = TRUE)
message("PCA plot using all post-processing proteins has been created as PCA_plot_alldata.bmp")
groups_list_f <- factor(groups_list_f, levels=c(unique(groups_list_f)))
which.sig<-vector()
if (parametric == TRUE) {
if (significance == "p"){
if (groups_number != 2){
which.sig <- which(limma_dataspace$ANOVA_P.Value < 0.05)
} else {(which.sig <- which(limma_dataspace[,grep("P.Value",colnames(limma_dataspace))] < 0.05))}
}
if (significance == "BH"){
if (groups_number != 2){
which.sig <- which(limma_dataspace$ANOVA_adj.P.Val < 0.05)
} else {(which.sig <- which(limma_dataspace[,grep("adj.P.Val",colnames(limma_dataspace))] < 0.05))}
}
}
if (parametric == FALSE) {
if (significance == "p"){
if (groups_number != 2){
which.sig <- which(Fdataspace$Kruskal_Wallis.pvalue < 0.05)
} else {(which.sig <- which(Ddataspace$Wilcoxon_p_G2vsG1 < 0.05))}
}
if (significance == "BH"){
if (groups_number != 2){
which.sig <- which(Fdataspace$Kruskal_Wallis.pvalue_BH.adjusted < 0.05)
} else {(which.sig <- which(Ddataspace$BH_p_G2vsG1 < 0.05))}
}}
if (length(which.sig) <2 ){
message("PCA and heatmap plots of the significant data cannot be generated since there are no significant proteins")
qc[,-1] <- lapply(qc[,-1], function(x) as.numeric(unlist(x)))
qc[,-1]<-round(qc[,-1],3)
qc_file_path <- file.path(path_restat, "Sample_QC.xlsx")
openxlsx::write.xlsx(qc, file = qc_file_path)
} else {
log.dataspace.sig <- log.dataspace[which.sig,]
zlog.dataspace.sig <- t(scale(t(log.dataspace.sig)))
colnames(zlog.dataspace.sig) <- colnames(log.dataspace.sig)
zlog.dataspace.sig <- zlog.dataspace.sig[,order(groups_list_f)]
range_limit <- min(abs(min(zlog.dataspace.sig, na.rm = TRUE)), abs(max(zlog.dataspace.sig, na.rm = TRUE)))
breaks <- seq(-range_limit, range_limit, length.out = 101)
mycols_vector <- grDevices::colorRampPalette(c("blue", "white", "red"))(100)
annotation_col <- data.frame(Group = factor(groups_list_f))
rownames(annotation_col) <- colnames(zlog.dataspace.sig)
colnames(annotation_col) <- " "
bmp_file_path <- file.path(path_resplot, "heatmap.bmp")
bmp(bmp_file_path,width = 1500, height = 1080, res = 150)
pheatmap(as.matrix(zlog.dataspace.sig),
cluster_rows = TRUE,
cluster_cols = FALSE,
show_rownames = FALSE,
show_colnames = FALSE,
annotation_col = annotation_col,
color = mycols_vector,
breaks = breaks,
legend = TRUE,
legend_labels = NULL,
annotation_legend = TRUE,
scale = "none")
dev.off()
message("A heatmap with the differentially expressed proteins was created as heatmap.bmp")
pca<-prcomp(t(log.dataspace.sig), scale=TRUE, center=TRUE)
pca.data <- data.frame(Sample=rownames(pca$x),
X=pca$x[,1],
Y=pca$x[,2],
Group = Group)
qc$PC1.score.Significant <- pca$x[,1]
qc$PC2.score.Significant <-pca$x[,2]
qc[,-1] <- lapply(qc[,-1], function(x) as.numeric(unlist(x)))
qc[,-1]<-round(qc[,-1],3)
qc_file_path <- file.path(path_restat, "Sample_QC.xlsx")
openxlsx::write.xlsx(qc, file = qc_file_path)
message("Sample quality metrics and association scores to the first two Principal Components have been saved as Sample_QC.xlsx")
pca.var<-pca$sdev^2
pca.var.per<-round(pca.var/sum(pca.var)*100,1)
pca.sig<-ggplot2::ggplot(data=pca.data, aes(x=X, y=Y, label=Sample))+
geom_point(aes(color=Group), size = 2, alpha = 1)+
xlab(paste("PC1 - ", pca.var.per[1], "%", sep=""))+
ylab(paste("PC2 - ", pca.var.per[2], "%", sep=""))+
ggtitle("Statistically significant proteins")+
theme_bw()+
theme(plot.title = element_text(hjust=0.5))+
guides(color = guide_legend(override.aes = list(size=5)))+
theme(legend.text = element_text(size = 12))+
theme(legend.title = element_text(size = 12))+
theme(legend.position="right")
pca.sig
ggplot2::ggsave("PCA_plot_significant.bmp", plot = pca.sig, path = path_resplot,
scale = 1, width = 5, height = 4, units = "in",
dpi = 300, limitsize = TRUE)
message("PCA plot using only the significant proteins was created as PCA_plot_significant.bmp" )
a<-ggpubr::ggarrange(pca.ent, pca.sig, nrow = 1, ncol=2,
common.legend = TRUE, legend = "bottom")
ggplot2::ggsave("PCA_plots_combined.bmp", plot = a, path = path_resplot,
scale = 1, width = 8, height = 4.5, units = "in",
dpi = 300, limitsize = TRUE)
message ("The 2 PCA plots are combined in PCA_plots_combined.bmp")
}
p<- function(x) {
sapply(x, function(label) {
truncated_label <- substr(label, nchar(label) - 24, nchar(label))
truncated_label
})
}
melt.log.dataspace <- reshape2::melt(log.dataspace, id.vars = NULL)
repvec <- as.data.frame(table(Group))$Freq * nrow(log.dataspace)
storevec <- NULL
storeres <- list()
for (i in seq_along(Group2)){
storevev <- rep(Group2[i], repvec[i])
storeres[[i]] <- storevev
}
melt.log.dataspace$Group <- unlist(storeres)
melt.log.dataspace$Group <- factor(melt.log.dataspace$Group, levels = Group2)
if (imputation == FALSE) {
qc.boxplots<-ggplot2::ggplot(melt.log.dataspace, aes(x=forcats::fct_inorder(variable), y=value, color=Group))+
geom_boxplot(aes(color = Group),lwd=1, outlier.size=0.2, outlier.alpha = 0.2)+
xlab("Sample")+
ylab(expression(Log[2]~"Protein Abundance"))+
theme_classic()+
theme(text = element_text(size = 19),
axis.text.x=element_text(size = 9, angle=90, vjust = 0.5, hjust = 0.5),
axis.title.x=element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold"))+
guides(color = guide_legend(override.aes = list(size = 1)))+
scale_x_discrete(labels = p) +
geom_jitter(shape=16, position=position_jitter(0.2), size = 0.5, alpha = 0.5)
qc.boxplots
ggplot2::ggsave("Boxplot_withZeros.bmp", plot = qc.boxplots, path = path_resplot,
scale = 1, width = 12, height = 5, units = "in",
dpi = 300, limitsize = TRUE, bg = "white")
}
melt.log.dataspace.na <- melt.log.dataspace
melt.log.dataspace.na$value[melt.log.dataspace.na$value == 0] <- NA
melt.log.dataspace.na$Group <- factor(melt.log.dataspace.na$Group, levels = Group2)
qc.boxplots.na<-ggplot2::ggplot(melt.log.dataspace.na, aes(x=forcats::fct_inorder(variable), y=value, color=Group))+
geom_boxplot(aes(color = Group),lwd=1, outlier.size=0.2, outlier.alpha = 0.2)+
xlab("Sample")+
ylab(expression(Log[2]~"Protein Abundance"))+
theme_classic()+
theme(text = element_text(size = 19),
axis.text.x=element_text(size = 9, angle=90, vjust = 0.5, hjust = 0.5),
axis.title.x=element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold"))+
guides(color = guide_legend(override.aes = list(size = 1)))+
scale_x_discrete(labels = p) +
geom_jitter(shape=16, position=position_jitter(0.2), size = 0.5, alpha = 0.5)
qc.boxplots.na
if (imputation == FALSE) {
ggplot2::ggsave("Boxplot_withoutZeros.bmp", plot = qc.boxplots.na, path = path_resplot,
scale = 1, width = 12, height = 5, units = "in",
dpi = 300, limitsize = TRUE, bg = "white")
}else{
ggplot2::ggsave("Boxplot.bmp", plot = qc.boxplots.na, path = path_resplot,
scale = 1, width = 12, height = 5, units = "in",
dpi = 300, limitsize = TRUE, bg = "white")
}
message("A boxplot showing the log2 Abundance of each protein, across the samples has been created as Boxplot.bmp" )
qc.violin<-ggplot2::ggplot(melt.log.dataspace.na, aes(x=forcats::fct_inorder(variable), y=value, color=Group))+
geom_violin(aes(color = Group),lwd=1)+
xlab("Sample")+
ylab(expression(Log[2]~"Protein Abundance"))+
theme_classic()+
theme(text = element_text(size = 19),
axis.text.x=element_text(size = 9, angle=90, vjust = 0.5, hjust = 0.5),
axis.title.x=element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold"))+
guides(color = guide_legend(override.aes = list(size = 1)))+
scale_x_discrete(labels = p) +
geom_jitter(shape=16, position=position_jitter(0.2), size = 0.5, alpha = 0.5)
ggplot2::ggsave("Violin_plot.bmp", plot = qc.violin, path = path_resplot,
scale = 1, width = 12, height = 5, units = "in",
dpi = 300, limitsize = TRUE, bg = "white")
message("A Violin Plot showing the log2 Protein Abundance of each protein, across the samples was created as Violin_plot.bmp" )
message("The analysis has been completed. All results are saved inside the ProtE_Analysis folder. Thank you for activating the Proteomics Eye!")
}
Try the ProtE package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.