diff --git a/pvactools/tools/pvacview/.Rhistory b/pvactools/tools/pvacview/.Rhistory new file mode 100644 index 000000000..a4aeb13a5 --- /dev/null +++ b/pvactools/tools/pvacview/.Rhistory @@ -0,0 +1,512 @@ +geom_tile() + +labs(x = "X.sample_a", y = "sample_b", title = "ibs2") + +scale_fill_gradient(low="white", high="blue") + +theme(axis.text.x = element_text(angle = 45, hjust = 1, size=5), axis.text.y = element_text(size=5)) +#heatmap +ggplot(pairs_filtered, aes(Group_a, Group_b,, fill= ibs2)) + +geom_tile() + +labs(x = "X.sample_a", y = "sample_b", title = "ibs2") + +scale_fill_gradient(low="white", high="blue") + +theme(axis.text.x = element_text(angle = 45, hjust = 1, size=5), axis.text.y = element_text(size=5)) +ggplot(pairs_filtered, aes(X.sample_a, sample_b, fill= relatedness)) + +geom_tile() + +labs(x = "Sample A", y = "Sample B", title = "relatedness") + +scale_fill_gradient(low="white", high="red") + +theme(axis.text.x = element_text(angle = 45, hjust = 1, size=5), axis.text.y = element_text(size=5)) +#heatmap +ggplot(pairs_filtered, aes(Group_a, Group_b, fill= ibs2)) + +geom_tile() + +labs(x = "X.sample_a", y = "sample_b", title = "ibs2") + +scale_fill_gradient(low="white", high="blue") + +theme(axis.text.x = element_text(angle = 45, hjust = 1, size=5), axis.text.y = element_text(size=5)) +ggplot(pairs_filtered, aes(Group_a, Group_b, fill= relatedness)) + +geom_tile() + +labs(x = "Sample A", y = "Sample B", title = "relatedness") + +scale_fill_gradient(low="white", high="red") + +theme(axis.text.x = element_text(angle = 45, hjust = 1, size=5), axis.text.y = element_text(size=5)) +ggplot(pairs_filtered, aes(Group_a, Group_b, fill= ibs0)) + +geom_tile() + +labs(x = "Sample A", y = "Sample B", title = "ibs0") + +scale_fill_gradient(low="white", high="forestgreen") + +theme(axis.text.x = element_text(angle = 45, hjust = 1, size=5), axis.text.y = element_text(size=5)) +pairs <- read.csv("/Volumes/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/raw_data/exome/somalier/updated_somalier/somalier.pairs.tsv", sep="\t") +pairs <- pairs %>% +mutate(Sample = paste(X.sample_a, sample_b, sep = " ")) %>% +mutate(Group_a = sub("^(.*?)_(.*?)_.*", "\\2", X.sample_a)) %>% +mutate(Group_b = sub("^(.*?)_(.*?)_.*", "\\2", sample_b)) %>% +mutate(GL_Bulk_a = sub("^(.*?)_(.*?)_(.*?)", "\\3", X.sample_a)) %>% +mutate(GL_Bulk_b = sub("^(.*?)_(.*?)_(.*?)", "\\3", sample_b)) %>% +mutate(as.numeric(relatedness)) %>% +arrange(X.sample_a, sample_b) +# Remove samples not meant to be in cohort +values_to_remove <- c("M57", "M200", "M201") +# Investigating unexpectedly related samples +ggplot(pairs_filtered %>% filter(relatedness > 0.5) %>% filter(expected_relatedness == -1), aes(x = X.sample_a, y = sample_b, color = relatedness)) + +geom_point() + +scale_color_gradient(low = "red", high = "blue") + +labs(x = "Sample A", y = "Sample B", title = "Unexpected Sample To Sample Relatedness") + +theme(axis.text.x = element_text(angle = 45, hjust = 1)) +pairs <- read.csv("/Volumes/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/somalier_final_RR_cohort/somalier.pairs.tsv", sep="\t") +colnames(pairs) +#heatmap +ggplot(pairs, aes(X.sample_a, sample_b, fill= ibs2)) + +geom_tile() + +labs(x = "X.sample_a", y = "sample_b", title = "ibs2") + +scale_fill_gradient(low="white", high="blue") + +theme(axis.text.x = element_text(angle = 45, hjust = 1, size=5), axis.text.y = element_text(size=5)) +ggplot(pairs, aes(X.sample_a, sample_b, fill= relatedness)) + +geom_tile() + +labs(x = "X.sample_a", y = "sample_b", title = "relatedness") + +scale_fill_gradient(low="white", high="red") + +theme(axis.text.x = element_text(angle = 45, hjust = 1, size=5), axis.text.y = element_text(size=5)) +ggplot(pairs, aes(X.sample_a, sample_b, fill= ibs0)) + +geom_tile() + +labs(x = "X.sample_a", y = "sample_b", title = "ibs0") + +scale_fill_gradient(low="white", high="forestgreen") + +theme(axis.text.x = element_text(angle = 45, hjust = 1, size=5), axis.text.y = element_text(size=5)) +# sample to sample relatedness for samples with higher than 0.5 relatednes +ggplot(pairs %>% filter(relatedness >= 0.20) %>% filter(expected_relatedness == -1), aes(x = X.sample_a, y = sample_b, color = relatedness)) + +geom_point() + +scale_color_gradient(low = "red", high = "blue") + +labs(x = "Sample A", y = "Sample B", title = "Unexpected Sample To Sample Relatedness") + +theme(axis.text.x = element_text(angle = 45, hjust = 1)) +ggplot(pairs %>% filter(relatedness >= 0.20) %>% filter(expected_relatedness == -1), aes(x = X.sample_a, y = sample_b, color = ibs2)) + +geom_point() + +scale_color_gradient(low = "grey", high="purple") + +labs(x = "Sample A", y = "Sample B", title = "Sample To Sample IBS2") + +theme(axis.text.x = element_text(angle = 45, hjust = 1)) +ggplot(pairs %>% filter(relatedness >= 0.20) %>% filter(expected_relatedness == -1), aes(x = X.sample_a, y = sample_b, color = ibs0)) + +geom_point() + +scale_color_gradient(low = "grey", high="forestgreen") + +labs(x = "Sample A", y = "Sample B", title = "Sample To Sample IBS0") + +theme(axis.text.x = element_text(angle = 45, hjust = 1)) +# sample to sample relatedness for samples with higher than 0.5 relatednes +ggplot(pairs %>% filter(relatedness >= 0.20) %>% filter(expected_relatedness == -1), aes(x = X.sample_a, y = sample_b, color = relatedness)) + +geom_point() + +scale_color_gradient(low = "red", high = "blue") + +labs(x = "Sample A", y = "Sample B", title = "Unexpected Sample To Sample Relatedness") + +theme(axis.text.x = element_text(angle = 45, hjust = 1)) +pairs <- read.csv("/Volumes/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/raw_data/exome/somalier/updated_somalier/somalier.pairs.tsv", sep="\t") +pairs <- read.csv("/Volumes/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/raw_data/exome/somalier/somalier.pairs.tsv", sep="\t") +pairs <- pairs %>% +mutate(Sample = paste(X.sample_a, sample_b, sep = " ")) %>% +mutate(Group_a = sub("^(.*?)_(.*?)_.*", "\\2", X.sample_a)) %>% +mutate(Group_b = sub("^(.*?)_(.*?)_.*", "\\2", sample_b)) %>% +mutate(GL_Bulk_a = sub("^(.*?)_(.*?)_(.*?)", "\\3", X.sample_a)) %>% +mutate(GL_Bulk_b = sub("^(.*?)_(.*?)_(.*?)", "\\3", sample_b)) %>% +mutate(as.numeric(relatedness)) %>% +arrange(X.sample_a, sample_b) +# Remove samples not meant to be in cohort +values_to_remove <- c("M57", "M200", "M201") +pairs_filtered <- pairs %>% +filter(!(Group_a %in% values_to_remove | Group_b %in% values_to_remove)) +#heatmap +ggplot(pairs_filtered, aes(Group_a, Group_b, fill= ibs2)) + +geom_tile() + +labs(x = "X.sample_a", y = "sample_b", title = "ibs2") + +scale_fill_gradient(low="white", high="blue") + +theme(axis.text.x = element_text(angle = 45, hjust = 1, size=5), axis.text.y = element_text(size=5)) +ggplot(pairs_filtered, aes(Group_a, Group_b, fill= relatedness)) + +geom_tile() + +labs(x = "Sample A", y = "Sample B", title = "relatedness") + +scale_fill_gradient(low="white", high="red") + +theme(axis.text.x = element_text(angle = 45, hjust = 1, size=5), axis.text.y = element_text(size=5)) +ggplot(pairs_filtered, aes(Group_a, Group_b, fill= ibs0)) + +geom_tile() + +labs(x = "Sample A", y = "Sample B", title = "ibs0") + +scale_fill_gradient(low="white", high="forestgreen") + +theme(axis.text.x = element_text(angle = 45, hjust = 1, size=5), axis.text.y = element_text(size=5)) +# Investigating unexpectedly related samples +ggplot(pairs_filtered %>% filter(relatedness > 0.5) %>% filter(expected_relatedness == -1), aes(x = X.sample_a, y = sample_b, color = relatedness)) + +geom_point() + +scale_color_gradient(low = "red", high = "blue") + +labs(x = "Sample A", y = "Sample B", title = "Unexpected Sample To Sample Relatedness") + +theme(axis.text.x = element_text(angle = 45, hjust = 1)) +ggplot(pairs_filtered %>% filter(relatedness >= 0.50) %>% filter(expected_relatedness == -1), aes(x = X.sample_a, y = sample_b, color = ibs2)) + +geom_point() + +scale_color_gradient(low = "grey", high="purple") + +labs(x = "Sample A", y = "Sample B", title = "Unexpected Sample To Sample IBS2") + +theme(axis.text.x = element_text(angle = 45, hjust = 1)) +ggplot(pairs_filtered %>% filter(relatedness >= 0.50) %>% filter(expected_relatedness == -1), aes(x = X.sample_a, y = sample_b, color = ibs0)) + +geom_point() + +scale_color_gradient(low = "grey", high="forestgreen") + +labs(x = "Sample A", y = "Sample B", title = "Unexpected Sample To Sample IBS0") + +theme(axis.text.x = element_text(angle = 45, hjust = 1)) +ggplot(pairs_filtered %>% filter(relatedness > 0.5) %>% filter(expected_relatedness == -1), aes(x = X.sample_a, y = sample_b, color = relatedness)) + +geom_point() + +scale_color_gradient(low = "red", high = "blue") + +labs(x = "Sample A", y = "Sample B", title = "Unexpected Sample To Sample Relatedness") + +theme(axis.text.x = element_text(angle = 45, hjust = 1)) +# see the Bulk and Germline samples for problematic samples +values_to_keep <- c("M102", "M208", "M209", "M26", "M58", "M59", "M62", "M66", "M67") +pairs_problematic <- pairs %>% +filter((Group_a %in% values_to_remove | Group_b %in% values_to_remove)) +ggplot(pairs_problematic, aes(x = X.sample_a, y = sample_b, color = relatedness)) + +geom_point() + +scale_color_gradient(low = "red", high = "blue") + +labs(x = "Sample A", y = "Sample B", title = "Unexpected Sample To Sample Relatedness") + +theme(axis.text.x = element_text(angle = 45, hjust = 1)) +# see the Bulk and Germline samples for problematic samples +values_to_keep <- c("M102", "M208", "M209", "M26", "M58", "M59", "M62", "M66", "M67") +pairs_problematic <- pairs %>% +filter((Group_a %in% values_to_keep | Group_b %in% values_to_remove)) +ggplot(pairs_problematic, aes(x = X.sample_a, y = sample_b, color = relatedness)) + +geom_point() + +scale_color_gradient(low = "red", high = "blue") + +labs(x = "Sample A", y = "Sample B", title = "Unexpected Sample To Sample Relatedness") + +theme(axis.text.x = element_text(angle = 45, hjust = 1)) +pairs_problematic <- pairs %>% +filter((Group_a %in% values_to_keep & Group_b %in% values_to_remove)) +ggplot(pairs_problematic, aes(x = X.sample_a, y = sample_b, color = relatedness)) + +geom_point() + +scale_color_gradient(low = "red", high = "blue") + +labs(x = "Sample A", y = "Sample B", title = "Unexpected Sample To Sample Relatedness") + +theme(axis.text.x = element_text(angle = 45, hjust = 1)) +pairs_problematic <- pairs %>% +filter((Group_a %in% values_to_keep | Group_b %in% values_to_keep)) +ggplot(pairs_problematic, aes(x = X.sample_a, y = sample_b, color = relatedness)) + +geom_point() + +scale_color_gradient(low = "red", high = "blue") + +labs(x = "Sample A", y = "Sample B", title = "Unexpected Sample To Sample Relatedness") + +theme(axis.text.x = element_text(angle = 45, hjust = 1)) +pairs_problematic <- pairs %>% +filter((Group_a %in% values_to_keep & Group_b %in% values_to_keep)) +ggplot(pairs_problematic, aes(x = X.sample_a, y = sample_b, color = relatedness)) + +geom_point() + +scale_color_gradient(low = "red", high = "blue") + +labs(x = "Sample A", y = "Sample B", title = "Unexpected Sample To Sample Relatedness") + +theme(axis.text.x = element_text(angle = 45, hjust = 1)) +View(pairs_problematic) +View(pairs_problematic) +View(pairs) +View(pairs) +library(Seurat) +object <- readRDS("/Volumes/tfehnige/Active/scRNA-seq/ML_NK/Mechanisms_paper/fortestruns/invitro_fxn_final_final/56546and9792.20230711.PCA.NK_clustering_harmony_cutoff_Rerun.cite-seq_hto_WNNclusteringshort-term_fxn.rds") +object <- readRDS("/Volumes/tfehnige/Active/scRNA-seq/ML_NK/Mechanisms_paper/fortestruns/invitro_fxn_final_final/56546and9792.20230711.PCA.NK_clustering_harmony_cutoff_Rerun.cite-seq_hto_WNNclusteringshort-term_fxn.rds") +Idents(object) <- "Cell_Types" +object <- subset(object, idents = c("LD_unstim", "ML_unstim", "LD_K562_2hr", "LD_K562_4hr", "ML_K562_2hr", "ML_K562_4hr")) +table(Idents(object)) +# remove all metadata that are factors: +# Also change the seurat_cluster factor to chatacter naames +str(object@meta.data) +object$wsnn_res.0.4 <- NULL +str(object@meta.data) # Check to see if all factors are gone +object$seurat_clusters +object <- readRDS("/Volumes/mgriffit/Active/griffithlab/gc2596/e.schmidt/fig4_foltz/730_451_3228.20230801.NK.harmony_reductiononRNAnoKIRs.LD_MLNK_withharmonybatchcorrectandwnnPC20_PC19.rds") +Idents(object) <- "Cell_Types" +table(Idents(object)) +# remove all metadata that are factors: +# Also change the seurat_cluster factor to chatacter naames +str(object@meta.data) +object <- readRDS("/Volumes/tfehnige/Active/scRNA-seq/ML_NK/Mechanisms_paper/fortestruns/invitro_fxn_final_final/56546and9792.20230711.PCA.NK_clustering_harmony_cutoff_Rerun.cite-seq_hto_WNNclusteringshort-term_fxn.rds") +Idents(object) <- "Cell_Types" +object <- subset(object, idents = c("LD_unstim", "ML_unstim", "LD_K562_2hr", "LD_K562_4hr", "ML_K562_2hr", "ML_K562_4hr")) +table(Idents(object)) +# remove all metadata that are factors: +# Also change the seurat_cluster factor to chatacter naames +str(object@meta.data) +seurat_object$Cell_TypesF <- as.character(seurat_object$Cell_TypesF) +object$Cell_TypesF <- as.character(object$Cell_TypesF) +object$ +str(object@meta.data) # Check to see if all factors are gone +# remove all metadata that are factors: +# Also change the seurat_cluster factor to chatacter naames +str(object@meta.data) +object$wsnn_res.0.4 <- NULL +object$Cell_TypesF <- as.character(object$Cell_TypesF) +str(object@meta.data) # Check to see if all factors are gone +object$seurat_clusters <- as.integer(object$seurat_clusters) +object$seurat_clusters +str(object@meta.data) # Check to see if all factors are gone +# now do cell cycle scoring because it is easier in Seurat than scanpy: +s.genes <- cc.genes.updated.2019$s.genes +g2m.genes <- cc.genes.updated.2019$g2m.genes +DefaultAssay(object) <- "RNA" +object <- CellCycleScoring(object, s.features=s.genes, g2m.features=g2m.genes) +mtx_object <- GetAssayData(object, assay = "RNA", slot = "counts") +adt_object <- GetAssayData(object, assay = "ADT", slot = "counts") +meta_object <- object[[]] +str(meta_object) +write.csv(mtx_object, "/Volumes/mgriffit/Active/griffithlab/gc2596/e.schmidt/fig4_foltz/conversion/5_prime_data/object_RNAcounts.csv") +write.csv(meta_object, "/Volumes/mgriffit/Active/griffithlab/gc2596/e.schmidt/fig4_foltz/conversion/5_prime_data/object_meta.csv") +write.csv(adt_object, "/Volumes/mgriffit/Active/griffithlab/gc2596/e.schmidt/fig4_foltz/conversion/5_prime_data/object_ADTcounts.csv") +library(dplyr) +library(data.table) +library(vcfR) +library(ComplexUpset) +library(grid) +germline_pon <- read.csv('/storage1/fs1/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/malignant_B_cells/malignant_vs_non_malignant/vartrix/germline_pon_1009.tsv', sep = '\t') +germline_pon <- read.csv('/Volumes/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/malignant_B_cells/malignant_vs_non_malignant/vartrix/germline_pon_1009.tsv', sep = '\t') +germline_pon_list <- germline_pon$germline_snps +germline_pon_list +#read in gnomad txt file we made (with both V2 and V3 SNPs), make snps column similar to germline_pon +gnomad_df <- read.csv('/Volumes/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/malignant_B_cells/malignant_vs_non_malignant/vartrix/gnomad/gnomad_v2_and_v3_cancer_only.txt', sep = ' ') +sums +library(Matrix) +library(dplyr) +library(tidyr) +library(stringr) +library(ggplot2) +library(dplyr) +#Read in vartrix output matrix +M89_snv_matrix <- readMM("/Volumes/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/malignant_B_cells/malignant_vs_non_malignant/vartrix/FilterGermlineVartrix/output/vartrix_output/M89_filtered.mtx") +M89_snv_matrix <- as.data.frame(as.matrix(M89_snv_matrix)) +barcodes_M89 <- read.table("/Volumes/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/malignant_B_cells/malignant_vs_non_malignant/vartrix/FilterGermlineVartrix/data/barcode_files/barcodes_split_by_sample/M89.tsv", header = F) +#Read in a text file that has SNPs information +snps <- read.table("/Volumes/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/malignant_B_cells/malignant_vs_non_malignant/vartrix/FilterGermlineVartrix/output/vartrix_output/M89_filtered_loci.txt", header = F) +#Set columns to be all the cell barcodes, and rows to be the variants +colnames(M89_snv_matrix) <- barcodes_M89$V1 +row.names(M89_snv_matrix) <- snps$V1 +# Construct the data.frame +M89_df <- data.frame(t(M89_snv_matrix)) +# Make the encoding more readable +# See documentation of the consensus scoring mode (`-s consensus`) +# Assuming your dataframe is named "M1_df" +M89_df <- M89_df %>% +mutate_all(~str_replace(as.character(.), "0", "No Call")) %>% +mutate_all(~str_replace(as.character(.), "1", "Ref")) %>% +mutate_all(~str_replace(as.character(.), "2", "Alt")) %>% +mutate_all(~str_replace(as.character(.), "3", "Alt/Ref")) +# +barcode_classifications <- read.table("/Volumes/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/malignant_B_cells/malignant_vs_non_malignant/vartrix/FilterGermlineVartrix/data/all_barcodes_malignant_classification.tsv", sep="\t", header=T) +row.names(barcode_classifications) <- barcode_classifications$barcode +# Re-appened -SAMP to the end of each barcode +rownames(M89_df) <- paste0(rownames(M89_df), "-M89") +M89_df$barcode <- rownames(M89_df) +# Add the cell classification +M89_df_classified <- merge(M89_df, barcode_classifications, by = "row.names", all.x = TRUE) +M89_df_classified <- M89_df_classified[, c(names(M89_df_classified)[1], "bclass", names(M89_df_classified)[-c(1, which(names(M89_df_classified) == "bclass"))])] +M89_df_classified[, 3:ncol(M89_df_classified)] <- data.frame(lapply(M89_df_classified[, 3:ncol(M89_df_classified)], function(col) paste0(col, '-', M89_df_classified$bclass))) +# Remove variants with no coverage (aka no call) or insufficent coverage (aka ref) +# Remove columns with all entries as "No Call" or "Ref" +ncol(M89_df_classified) # 2316 +M89_df_classified <- M89_df_classified %>% +select(-which(sapply(M89_df_classified, function(col) all(col == "No Call-B" | col == "Ref-B" | col == "No Call-non-B" | col == "Ref-non-B")))) +ncol(M89_df_classified) # 978 +# All Cells are Identified As +# "Alt-B" +# "Alt-non-B" +# "Ref-B" +# "Ref-non-B" +# "Alt/Ref-B" +# "Alt/Ref-non-B" +# "No Call-B" +# "No Call-non-B" +# Get the number of Germline Variants +# (Non B cells with alt (>1) +M89_df_classified <- M89_df_classified %>% +select(-which(sapply(M89_df_classified, function(col) all(col == "Alt-non-B")))) +ncol(M89_df_classified) # 978 +# Get the number of Somatic Variants +# B cells with alt (>1) and Non B-Cell with no alt (>1) +ncol(M89_df_classified %>% +select(-which(sapply(M89_df_classified, function(col) all(col == "Alt-B" | col == "Ref-non-B" | col == "Ref-non-B" | col == "No Call-non-B" | col == "No Call-B"))))) +# 868 +library(tidyverse) +# Values to count +values_to_count <- c("Alt-non-B", "Alt/Ref-non-B") +# Sum occurrences of specified values in each column +sums <- data.frame(colSums(M89_df_classified == values_to_count)) +sums <- sums %>% +rename("Sum":= "colSums.M89_df_classified....values_to_count.") %>% +rownames_to_column(sums, var = "name") +sums +sums <- sums %>% +rename("Sum":= "colSums.M89_df_classified....values_to_count.") %>% +rownames_to_column(var = "name") +sums +sums <- sums %>% filter(Sum != 0) +sums +ggplot(aes(x = name, y = Sum, fill = name)) + +geom_bar(colour = "black", stat = "identity") +ggplot(sums, aes(x = name, y = Sum, fill = name)) + +geom_bar(stat = "identity") +sums <- sums %>% filter(Sum > 5) +sums +ggplot(sums, aes(x = name, y = Sum, fill = name)) + +geom_bar(stat = "identity") +sums <- sums %>% filter(Sum > 10) +ggplot(sums, aes(x = name, y = Sum, fill = name)) + +geom_bar(stat = "identity") +ggplot(sums, aes(x = name, y = Sum)) + +geom_bar(stat = "identity") +ggplot(sums, aes(x = name, y = Sum)) + +geom_bar(stat = "identity") + +coord_flip() +sums <- sums %>% filter(Sum > 0) +ggplot(sums, aes(x = name, y = Sum)) + +geom_bar(stat = "identity") + +coord_flip() +# Sum occurrences of specified values in each column +sums <- data.frame(colSums(M89_df_classified == values_to_count)) +sums <- sums %>% +rename("Sum":= "colSums.M89_df_classified....values_to_count.") %>% +rownames_to_column(var = "name") +sums <- sums %>% filter(Sum > 0) +ggplot(sums, aes(x = name, y = Sum)) + +geom_bar(stat = "identity") + +coord_flip() +# Sum occurrences of specified values in each column +sums <- data.frame(colSums(M89_df_classified == c("Alt-non-B", "Alt/Ref-non-B"))) +sums <- sums %>% +rename("Sum":= "colSums.M89_df_classified....values_to_count.") %>% +rownames_to_column(var = "name") +ggplot(sums %>% filter(Sum > 10), aes(x = name, y = Sum)) + +geom_bar(stat = "identity") + +coord_flip() +# Sum occurrences of specified values in each column +sums <- data.frame(colSums(M89_df_classified == c("Alt-non-B", "Alt/Ref-non-B"))) +sums <- sums %>% +rename("Sum":= "colSums.M89_df_classified....values_to_count.") %>% +rownames_to_column(var = "name") +sums +sums <- sums %>% +rename("Sum":= "colSums.M89_df_classified....c..Alt.non.B....Alt.Ref.non.B...") %>% +rownames_to_column(var = "name") +ggplot(sums %>% filter(Sum > 10), aes(x = name, y = Sum)) + +geom_bar(stat = "identity") + +coord_flip() +ggplot(sums %>% filter(Sum > 10), aes(x = name, y = Sum)) + +geom_bar(stat = "identity") + +coord_flip() + +ggtitle("M89") +install.packages('plotly') +install.packages('gapminder') +shiny::runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +update.packages(ask = FALSE, checkBuilt = TRUE) +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +shiny::runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +x +x +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +x +input$yvrbl +input$xvrbl +df[input$xvrbl] +input$yvrbl +df[input$yvrbl] +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +runApp('pVACtools/pvactools/tools/pvacview_dev_eve') +setwd("~/pVACtools/pvactools/tools/pvacview_dev_eve") +shiny::runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +feature +type(feature) +class(feature) +list( names(df)[sapply(df, is.numeric)]) +list(names(df)[sapply(df, is.numeric)]) +sapply(df, is.numeric) +as.list(names(df)[sapply(df, is.numeric)]) +feature <- as.list(names(df)[sapply(df, is.numeric)]) +feature[0] +feature[[0]] +feature +feature[[1]] +default_selection <- feature[[1]] +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +#LSF_DOCKER_PRESERVE_ENVRIONMENT=false bsub -q general -n 16 -G compute-oncology -M 256G -R 'select[mem>256G] span[hosts=1] rusage[mem=256G]' -oo run_cytotrace_B_cells_0118.log -a 'docker(ksinghal28/singlecell_big:1.6)' Rscript run_cytotrace_B_cells_0181.R +# pip install scanoramaCT +# pip install numpy +library(Seurat) +library(dplyr) +library(ggplot2) +library(tidyr) +library(ggrepel) +library(grid) +library(cowplot) +library(CytoTRACE) +library(stringr) +raw_data_dir <- paste0("/storage1/fs1/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/cell_ranger_runs_final_RR_cohort/") +all_barcodes <- read.csv("/storage1/fs1/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/malignant_B_cells/malignant_vs_non_malignant/all_barcodes_malignant_classification_0107.tsv", sep = "\t") +all_barcodes <- read.csv("/storage1/fs1/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/malignant_B_cells/malignant_vs_non_malignant/dataframe_tsv_0118/patient_id_leiden_res0_5_df_malignant_Bcells_0118.tsv", sep = "\t") +raw_data_dir <- paste0("/Volumes/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/cell_ranger_runs_final_RR_cohort/") +all_barcodes <- read.csv("/Volumes/tfehnige/Active/mdaccwashu/DLBCL_scAtlas/malignant_B_cells/malignant_vs_non_malignant/dataframe_tsv_0118/patient_id_leiden_res0_5_df_malignant_Bcells_0118.tsv", sep = "\t") +# will limit this all_barcodes file to malignant B cell barcodes only +B_barcodes <- all_barcodes[all_barcodes$bcr_cnv_snv_consensus_call != "non-B",] +B_barcodes <- B_barcodes[B_barcodes$bcr_cnv_snv_consensus_call == "malignant",] +list_of_samples <- unique(B_barcodes$sample_id) +#list_of_samples_without_GEM_pairs <- setdiff(list_of_samples_without_GEM_pairs, samples_not_in_final_cohort) +list_of_samples_final <- setdiff(list_of_samples, samples_not_in_final_cohort) +samples_not_in_final_cohort <- c("M101", "M109", "M111", "M199", "M200", "M201", "M202", "M204") +#list_of_samples_without_GEM_pairs <- setdiff(list_of_samples_without_GEM_pairs, samples_not_in_final_cohort) +list_of_samples_final <- setdiff(list_of_samples, samples_not_in_final_cohort) +#Initialize a dataframe to hold all barcodes and cytotrace scores +all_barcodes_cyto <- data.frame() +#for (sample in list_of_samples_final) { +#tryCatch({ +#print(paste("Starting sample", sample)) +sample="M191" +#create seurat object +obj <- Read10X_h5(paste0(raw_data_dir, sample, "/outs/raw_feature_bc_matrix.h5")) +obj <- CreateSeuratObject(counts = obj, min.cells = 10, min.features = 100) #will filter out cells soon so don't need to filter here +#log normalize it +obj <- NormalizeData(obj, normalization.method = "LogNormalize", scale.factor = 10000) +log_matrix <- as.matrix(Seurat::GetAssayData(obj, assay = "RNA", slot = "counts")) +#limit expression matrix to filtered set of sample barcodes and remove +##first limit B_barcodes file to our sample +sample_barcodes <- B_barcodes[B_barcodes$sample_id == sample, ] +##add sample id information to each barcode in the log_matrix table (so change 'AAACAGCCAAGTTATC-1' to 'AAACAGCCAAGTTATC-1-M1') +for (col in colnames(log_matrix)) { +colnames(log_matrix)[colnames(log_matrix) == col] <- paste(col, paste0("-", sample), sep = "") +} +##find barcodes that overlap both my conicsmat log matrix and the list of filtered barcodes +barcodes_to_keep <- intersect(colnames(log_matrix), sample_barcodes$barcode) +##now filter out columns that aren't in my filtered barcodes list +log_matrix_filtered <- subset(log_matrix, select = barcodes_to_keep) +sample_cyto <- CytoTRACE(log_matrix_filtered, ncores = 16) +library(CytoTRACE) +devtools::install_local("/Users/evelynschmidt/Downloads/CytoTRACE_0.3.3.tar.gz") +library(CytoTRACE) +devtools::install_local("/Users/evelynschmidt/Downloads/CytoTRACE_0.3.3.tar.gz") +install.packages("sva") +library(stringr) +install.packages("CytoTRACE") +remotes::install_github("CzechowskiLab/CytoTRACE") diff --git a/pvactools/tools/pvacview/__init__.py b/pvactools/tools/pvacview/__init__.py deleted file mode 100644 index 6a7ed93a9..000000000 --- a/pvactools/tools/pvacview/__init__.py +++ /dev/null @@ -1,5 +0,0 @@ -__all__ = [ - 'run', -] - -from . import * diff --git a/pvactools/tools/pvacview/anchor_and_helper_functions.R b/pvactools/tools/pvacview/anchor_and_helper_functions.R index 74d7ced4f..d17feb751 100644 --- a/pvactools/tools/pvacview/anchor_and_helper_functions.R +++ b/pvactools/tools/pvacview/anchor_and_helper_functions.R @@ -83,7 +83,7 @@ peptide_coloring <- function(hla_allele, peptide_row) { #calculate anchor list for specific peptide length and HLA allele combo given contribution cutoff calculate_anchor <- function(hla_allele, peptide_length, anchor_contribution) { result <- tryCatch({ - anchor_raw_data <- as.numeric(anchor_data[[peptide_length]][anchor_data[[peptide_length]]["HLA"] == hla_allele][2:(peptide_length + 1)]) + anchor_raw_data <- as.numeric(anchor_data[[peptide_length]][anchor_data[[peptide_length]]["HLA"] == hla_allele][2:(peptide_length + 1)]) if (any(is.na(anchor_raw_data))) { return("NA") } @@ -100,7 +100,7 @@ calculate_anchor <- function(hla_allele, peptide_length, anchor_contribution) { } } return(anchor_list) - }, error = function(e) { return("NA") }) + }, error = function(e) { return("NA") }) } #converts string range (e.g. '2-4', '6') to associated list @@ -224,7 +224,7 @@ tier <- function(variant_info, anchor_contribution, dna_cutoff, allele_expr_cuto return("Pass") } } - + if ((mt_binding < binding_threshold) && allele_expr_pass && vaf_clonal_pass && tsl_pass && !anchor_residue_pass) { if (percentile_filter) { if (mt_percent <= percentile_threshold) { @@ -275,7 +275,7 @@ tier_numbers <- function(variant_info, anchor_contribution, dna_cutoff, allele_e rna_depth <- as.numeric(variant_info["RNA Depth"]) allele_expr <- as.numeric(variant_info["Allele Expr"]) if (use_allele_specific_binding_thresholds && hla_allele %in% names(meta_data[["allele_specific_binding_thresholds"]][hla_allele])) { - binding_threshold <- as.numeric(meta_data[["allele_specific_binding_thresholds"]][hla_allele]) + binding_threshold <- as.numeric(meta_data[["allele_specific_binding_thresholds"]][hla_allele]) } trna_vaf <- as.numeric(meta_data["trna_vaf"]) trna_cov <- as.numeric(meta_data["trna_cov"]) @@ -305,11 +305,11 @@ tier_numbers <- function(variant_info, anchor_contribution, dna_cutoff, allele_e range_stop <- as.numeric(strsplit(mutation_pos_list, "-")[[1]][2]) mutation_pos_list <- c(range_start:range_stop) if (all(mutation_pos_list %in% anchor_list)) { - if (is.na(wt_binding)) { - anchor_residue_pass <- FALSE - }else if (wt_binding < binding_threshold) { - anchor_residue_pass <- FALSE - } + if (is.na(wt_binding)) { + anchor_residue_pass <- FALSE + }else if (wt_binding < binding_threshold) { + anchor_residue_pass <- FALSE + } } }else if (!is.na(mutation_pos_list)) { if (all(as.numeric(mutation_pos_list) %in% anchor_list)) { @@ -354,7 +354,7 @@ tier_numbers <- function(variant_info, anchor_contribution, dna_cutoff, allele_e return(5) } }else { - return(5) + return(5) } } if ((mt_binding < binding_threshold) && allele_expr_pass && !vaf_clonal_pass && tsl_pass && anchor_residue_pass) { diff --git a/pvactools/tools/pvacview/app.R b/pvactools/tools/pvacview/app.R index e705e9d9e..69788aa07 100644 --- a/pvactools/tools/pvacview/app.R +++ b/pvactools/tools/pvacview/app.R @@ -2,6 +2,8 @@ library(shiny) source(server.R) source(ui.R) +source(neofox_ui.R) +source(custom_ui.R) options(shiny.host = '127.0.0.1') options(shiny.port = 3333) diff --git a/pvactools/tools/pvacview_dev_eve/custom_ui.R b/pvactools/tools/pvacview/custom_ui.R old mode 100755 new mode 100644 similarity index 72% rename from pvactools/tools/pvacview_dev_eve/custom_ui.R rename to pvactools/tools/pvacview/custom_ui.R index a9388f172..b910f518a --- a/pvactools/tools/pvacview_dev_eve/custom_ui.R +++ b/pvactools/tools/pvacview/custom_ui.R @@ -24,9 +24,16 @@ custom_tab <- tabItem("custom", br(), br(), uiOutput("custom_upload_ui") ), - uiOutput("custom_group_by_feature_ui"), - uiOutput("custom_order_by_feature_ui"), - uiOutput("custom_peptide_features_ui"), + box( + title = "Choose How to Visualize Data", status = "primary", solidHeader = TRUE, width = NULL, + uiOutput("custom_group_by_feature_ui"), + h5("Group peptides together by a certain feature. For example, grouping by variant would allow user to explore all proposed peptides for one variant at a time."), + uiOutput("custom_order_by_feature_ui"), + h5("Order peptides by a certain feature. For example, ordering peptides by binding scores to find the best binders."), + uiOutput("custom_peptide_features_ui"), + h5("Choose what features you would like to consider for each group of peptides.") + ), + actionButton("visualize_custom", "Visualize") ), column(6, @@ -59,14 +66,38 @@ custom_tab <- tabItem("custom", enable_sidebar = TRUE, sidebar_width = 25, sidebar_start_open = TRUE, DTOutput('customTable')%>% withSpinner(color="#8FCCFA"), span("Currently investigating row: ", verbatimTextOutput("customSelected")), - style = "overflow-x: scroll;font-size:100%") + style = "overflow-x: scroll;font-size:100%"), ), fluidRow( box(width = 12, title = "Detailed Data", solidHeader = TRUE, collapsible = TRUE, status = "primary", - tabBox(width = 12, title = " ", - tabPanel("Peptide candidates grouped by selected feature", - DTOutput('customPeptideTable')%>% withSpinner(color="#8FCCFA"), style = "overflow-x: scroll;font-size:100%") + DTOutput('customPeptideTable')%>% withSpinner(color="#8FCCFA"), style = "overflow-x: scroll;font-size:100%" + ) + ), + fluidRow( + box(width = 12, + title = "Dynamic Scatter Plot", status = "primary", solidHeader = TRUE, collapsible = TRUE, + h4("Scatter plot to explore characteristics of data"), + sidebarPanel( + #variable selection for x-axis + uiOutput("xvrbl_custom"), + uiOutput("xvrbl_log_custom"), + uiOutput("xvrbl_scale_custom"), + # variable selection for y-axis + uiOutput("yvrbl_custom"), + uiOutput("yvrbl_log_custom"), + uiOutput("yvrbl_scale_custom"), + # color + uiOutput("color_custom"), + uiOutput("min_color_custom"), + uiOutput("max_color_custom"), + # size + uiOutput("size_custom") + ), + mainPanel( + align = "center", + plotlyOutput(outputId = "scatter_custom", height = "800px") %>% withSpinner(color = "#8FCCFA"), ) + ) ) ) diff --git a/pvactools/tools/pvacview/data/.DS_Store b/pvactools/tools/pvacview/data/.DS_Store index 5008ddfcf..cc78c467c 100644 Binary files a/pvactools/tools/pvacview/data/.DS_Store and b/pvactools/tools/pvacview/data/.DS_Store differ diff --git a/pvactools/tools/pvacview_dev_eve/test_data/HCC1395Run.neoantigens.txt b/pvactools/tools/pvacview/data/HCC1395Run.neoantigens.txt similarity index 100% rename from pvactools/tools/pvacview_dev_eve/test_data/HCC1395Run.neoantigens.txt rename to pvactools/tools/pvacview/data/HCC1395Run.neoantigens.txt diff --git a/pvactools/tools/pvacview_dev_eve/test_data/ag_test_antigen.tsv b/pvactools/tools/pvacview/data/ag_test_antigen.tsv similarity index 100% rename from pvactools/tools/pvacview_dev_eve/test_data/ag_test_antigen.tsv rename to pvactools/tools/pvacview/data/ag_test_antigen.tsv diff --git a/pvactools/tools/pvacview_dev_eve/test_data/all_barcodes_sample_id.tsv b/pvactools/tools/pvacview/data/all_barcodes_sample_id.tsv similarity index 100% rename from pvactools/tools/pvacview_dev_eve/test_data/all_barcodes_sample_id.tsv rename to pvactools/tools/pvacview/data/all_barcodes_sample_id.tsv diff --git a/pvactools/tools/pvacview_dev_eve/test_data/download_cwls.py b/pvactools/tools/pvacview/data/download_cwls.py old mode 100755 new mode 100644 similarity index 100% rename from pvactools/tools/pvacview_dev_eve/test_data/download_cwls.py rename to pvactools/tools/pvacview/data/download_cwls.py diff --git a/pvactools/tools/pvacview_dev_eve/test_data/mcdb044-tumor-exome.all_epitopes.aggregated.metrics.json b/pvactools/tools/pvacview/data/mcdb044-tumor-exome.all_epitopes.aggregated.metrics.json similarity index 100% rename from pvactools/tools/pvacview_dev_eve/test_data/mcdb044-tumor-exome.all_epitopes.aggregated.metrics.json rename to pvactools/tools/pvacview/data/mcdb044-tumor-exome.all_epitopes.aggregated.metrics.json diff --git a/pvactools/tools/pvacview_dev_eve/test_data/mcdb044-tumor-exome.all_epitopes.aggregated.tsv b/pvactools/tools/pvacview/data/mcdb044-tumor-exome.all_epitopes.aggregated.tsv similarity index 100% rename from pvactools/tools/pvacview_dev_eve/test_data/mcdb044-tumor-exome.all_epitopes.aggregated.tsv rename to pvactools/tools/pvacview/data/mcdb044-tumor-exome.all_epitopes.aggregated.tsv diff --git a/pvactools/tools/pvacview_dev_eve/test_data/test_pt1_neoantigen_candidates_annotated.tsv b/pvactools/tools/pvacview/data/test_pt1_neoantigen_candidates_annotated.tsv similarity index 100% rename from pvactools/tools/pvacview_dev_eve/test_data/test_pt1_neoantigen_candidates_annotated.tsv rename to pvactools/tools/pvacview/data/test_pt1_neoantigen_candidates_annotated.tsv diff --git a/pvactools/tools/pvacview/data/vaxrank_output.tsv b/pvactools/tools/pvacview/data/vaxrank_output.tsv new file mode 100644 index 000000000..754578115 --- /dev/null +++ b/pvactools/tools/pvacview/data/vaxrank_output.tsv @@ -0,0 +1,450 @@ +Allele Mutant peptide sequence Score Predicted mutant pMHC affinity Variant allele RNA read count Wildtype sequence Predicted wildtype pMHC affinity Gene name Genomic variant +HLA-C*06:02 RKFSYRSTV 3.602910221 44.90 nM 1457 RKFSYRSRV 228.5788773 DDX3X chrX g.41344255G>C +HLA-C*06:02 SYRSTVRPC 3.602910221 85.53 nM 1457 SYRSRVRPC 153.3440023 DDX3X chrX g.41344255G>C +HLA-A*29:02 STVRPCVVY 3.602910221 115.78 nM 1457 SRVRPCVVY 3415.131825 DDX3X chrX g.41344255G>C +HLA-C*06:02 YRSTVRPCV 3.602910221 208.58 nM 1457 YRSRVRPCV 548.3181491 DDX3X chrX g.41344255G>C +HLA-C*06:02 RSTVRPCVV 3.602910221 1589.50 nM 1457 RSRVRPCVV 1348.951038 DDX3X chrX g.41344255G>C +HLA-C*06:02 STVRPCVVY 3.602910221 2966.25 nM 1457 SRVRPCVVY 1102.5797 DDX3X chrX g.41344255G>C +HLA-B*45:01 RKFSYRSTV 3.602910221 3326.48 nM 1457 RKFSYRSRV 7941.639945 DDX3X chrX g.41344255G>C +HLA-B*45:01 AQFAERTVA 1.489573625 134.53 nM 2674 AEFAERTVA 29.80038255 TPM4 chr19 g.16093699G>C +HLA-B*45:01 AETRAQFAE 1.489573625 321.63 nM 2674 AETRAEFAE 418.3439228 TPM4 chr19 g.16093699G>C +HLA-B*45:01 KEAETRAQF 1.489573625 1241.20 nM 2674 KEAETRAEF 1098.707476 TPM4 chr19 g.16093699G>C +HLA-C*06:02 RAQFAERTV 1.489573625 1607.98 nM 2674 RAEFAERTV 3171.485995 TPM4 chr19 g.16093699G>C +HLA-B*45:01 EAETRAQFA 1.489573625 3719.07 nM 2674 EAETRAEFA 5025.395893 TPM4 chr19 g.16093699G>C +HLA-A*29:02 AMAFNLSRF 1.804660097 148.81 nM 370 ATAFNLSRF 528.7201279 ASMTL chrX g.1419026G>A +HLA-C*06:02 TACQVAMAF 1.804660097 194.42 nM 370 TACQVATAF 158.2175455 ASMTL chrX g.1419026G>A +HLA-C*06:02 KLTACQVAM 1.804660097 657.40 nM 370 KLTACQVAT 8676.429253 ASMTL chrX g.1419026G>A +HLA-C*06:02 MAFNLSRFS 1.804660097 2570.13 nM 370 TAFNLSRFS 2752.077857 ASMTL chrX g.1419026G>A +HLA-B*45:01 CQVAMAFNL 1.804660097 3316.06 nM 370 CQVATAFNL 2490.814173 ASMTL chrX g.1419026G>A +HLA-A*29:02 TACQVAMAF 1.804660097 3718.46 nM 370 TACQVATAF 8444.476352 ASMTL chrX g.1419026G>A +HLA-B*45:01 VENYSQNVA 2.535483315 104.40 nM 120 VEDYSQNVA 293.7501652 MSH6 chr2 g.47806320G>A +HLA-C*06:02 HYHSLVENY 2.535483315 104.73 nM 120 HYHSLVEDY 97.29545576 MSH6 chr2 g.47806320G>A +HLA-A*29:02 HYHSLVENY 2.535483315 266.64 nM 120 HYHSLVEDY 387.7106346 MSH6 chr2 g.47806320G>A +HLA-C*06:02 ENYSQNVAV 2.535483315 1295.51 nM 120 EDYSQNVAV 5739.266384 MSH6 chr2 g.47806320G>A +HLA-C*06:02 NYSQNVAVR 2.535483315 2172.81 nM 120 DYSQNVAVR 4019.625504 MSH6 chr2 g.47806320G>A +HLA-B*45:01 AERMGFTVV 1.110753323 32.61 nM 425 AERMGFTEV 50.26144854 ADAR chr1 g.154590263T>A +HLA-C*06:02 MGFTVVTPV 1.110753323 648.86 nM 425 MGFTEVTPV 258.6704215 ADAR chr1 g.154590263T>A +HLA-B*45:01 ERMGFTVVT 1.110753323 1706.10 nM 425 ERMGFTEVT 5352.472889 ADAR chr1 g.154590263T>A +HLA-C*06:02 ERMGFTVVT 1.110753323 3557.04 nM 425 ERMGFTEVT 5964.834777 ADAR chr1 g.154590263T>A +HLA-B*45:01 RELKLIINS 0.90623923 237.02 nM 524 PELKLIINS 4716.731205 DHX32 chr10 g.125859826G>C +HLA-C*06:02 ARRELKLII 0.90623923 615.96 nM 524 ARPELKLII 662.5893591 DHX32 chr10 g.125859826G>C +HLA-C*06:02 LARRELKLI 0.90623923 1372.52 nM 524 LARPELKLI 189.7700731 DHX32 chr10 g.125859826G>C +HLA-C*06:02 LLARRELKL 0.90623923 3250.51 nM 524 LLARPELKL 4737.775164 DHX32 chr10 g.125859826G>C +HLA-C*06:02 YSLPRAAAL 1.87478118 73.06 nM 99 HSLPRAAAL 371.6531775 TESK1 chr9 g.35609476C>T +HLA-B*45:01 AQYSLPRAA 1.87478118 113.18 nM 99 AQHSLPRAA 77.95562291 TESK1 chr9 g.35609476C>T +HLA-A*29:02 GEPWNRAQY 1.87478118 964.73 nM 99 GEPWNRAQH 13303.85342 TESK1 chr9 g.35609476C>T +HLA-C*06:02 AQYSLPRAA 1.87478118 2659.29 nM 99 AQHSLPRAA 4014.1895 TESK1 chr9 g.35609476C>T +HLA-B*45:01 QYSLPRAAA 1.87478118 2690.69 nM 99 QHSLPRAAA 901.6996504 TESK1 chr9 g.35609476C>T +HLA-B*45:01 RAQYSLPRA 1.87478118 3438.34 nM 99 RAQHSLPRA 4305.915134 TESK1 chr9 g.35609476C>T +HLA-A*29:02 VVFEYVAIY 2.555281522 20.83 nM 48 VVFEDVAIY 37.52031991 ZNF548 chr19 g.57397066G>T +HLA-A*29:02 VFEYVAIYF 2.555281522 172.66 nM 48 VFEDVAIYF 122.7867722 ZNF548 chr19 g.57397066G>T +HLA-C*06:02 VVFEYVAIY 2.555281522 452.72 nM 48 VVFEDVAIY 446.5820268 ZNF548 chr19 g.57397066G>T +HLA-B*45:01 FEYVAIYFS 2.555281522 565.86 nM 48 FEDVAIYFS 1127.624405 ZNF548 chr19 g.57397066G>T +HLA-B*45:01 GRVVFEYVA 2.555281522 696.66 nM 48 GRVVFEDVA 2526.1046 ZNF548 chr19 g.57397066G>T +HLA-A*29:02 TQGRVVFEY 2.555281522 800.73 nM 48 TQGRVVFED 32241.49028 ZNF548 chr19 g.57397066G>T +HLA-A*29:02 YVAIYFSQE 2.555281522 3715.44 nM 48 DVAIYFSQE 18780.26188 ZNF548 chr19 g.57397066G>T +HLA-C*06:02 VFEYVAIYF 2.555281522 3765.47 nM 48 VFEDVAIYF 810.1706638 ZNF548 chr19 g.57397066G>T +HLA-A*29:02 ILLHPWFEF 1.695914262 122.56 nM 98 ILLHPWFES 7594.745181 TRIB1 chr8 g.125436371C>T +HLA-A*29:02 FEFVLEPGY 1.695914262 203.91 nM 98 FESVLEPGY 271.8917693 TRIB1 chr8 g.125436371C>T +HLA-C*06:02 LLHPWFEFV 1.695914262 1729.22 nM 98 LLHPWFESV 346.6233889 TRIB1 chr8 g.125436371C>T +HLA-A*29:02 LLHPWFEFV 1.695914262 3161.05 nM 98 LLHPWFESV 9490.740443 TRIB1 chr8 g.125436371C>T +HLA-A*29:02 MASVDLKTY 1.133292546 197.25 nM 218 MASVDFKTY 116.6318686 NXT1 chr20 g.23354059C>G +HLA-C*06:02 MASVDLKTY 1.133292546 478.36 nM 218 MASVDFKTY 812.873609 NXT1 chr20 g.23354059C>G +HLA-C*06:02 ASVDLKTYV 1.133292546 1607.16 nM 218 ASVDFKTYV 1417.461466 NXT1 chr20 g.23354059C>G +HLA-C*06:02 FIFTWCLQI 1.902762381 169.96 nM 74 FIFTWCLEI 184.120661 MTRR chr5 g.7886680G>C +HLA-A*29:02 FIFTWCLQI 1.902762381 194.67 nM 74 FIFTWCLEI 250.8987576 MTRR chr5 g.7886680G>C +HLA-C*06:02 TWCLQIRAI 1.902762381 537.42 nM 74 TWCLEIRAI 585.9480489 MTRR chr5 g.7886680G>C +HLA-A*29:02 QFIFTWCLQ 1.902762381 1137.83 nM 74 QFIFTWCLE 2808.147732 MTRR chr5 g.7886680G>C +HLA-A*29:02 FTWCLQIRA 1.902762381 3227.57 nM 74 FTWCLEIRA 4035.024712 MTRR chr5 g.7886680G>C +HLA-A*29:02 ILLHPWFEF 1.695914262 122.56 nM 93 ILLHPWFES 7594.745181 TRIB1 chr8 g.125436371CC>TT +HLA-A*29:02 FEFVLEPGY 1.695914262 203.91 nM 93 FESVLEPGY 271.8917693 TRIB1 chr8 g.125436371CC>TT +HLA-C*06:02 LLHPWFEFV 1.695914262 1729.22 nM 93 LLHPWFESV 346.6233889 TRIB1 chr8 g.125436371CC>TT +HLA-A*29:02 LLHPWFEFV 1.695914262 3161.05 nM 93 LLHPWFESV 9490.740443 TRIB1 chr8 g.125436371CC>TT +HLA-B*45:01 GELLLVSAA 0.987565069 19.97 nM 249 GELLLV C19orf48 chr19 g.50798096C>G +HLA-A*29:02 WFDLLKHIF 1.590328039 163.51 nM 89 WFDLLKDIF 2081.42089 VPS54 chr2 g.63942506C>G +HLA-C*06:02 QWFDLLKHI 1.590328039 241.45 nM 89 QWFDLLKDI 253.1330979 VPS54 chr2 g.63942506C>G +HLA-A*29:02 HIFSKFTIF 1.590328039 1665.78 nM 89 DIFSKFTIF 3801.751064 VPS54 chr2 g.63942506C>G +HLA-C*06:02 LLKHIFSKF 1.590328039 1858.00 nM 89 LLKDIFSKF 1125.998051 VPS54 chr2 g.63942506C>G +HLA-A*29:02 LLKHIFSKF 1.590328039 2143.20 nM 89 LLKDIFSKF 1770.648394 VPS54 chr2 g.63942506C>G +HLA-C*06:02 HIFSKFTIF 1.590328039 2456.40 nM 89 DIFSKFTIF 4924.345509 VPS54 chr2 g.63942506C>G +HLA-A*29:02 QWFDLLKHI 1.590328039 3462.89 nM 89 QWFDLLKDI 4719.005672 VPS54 chr2 g.63942506C>G +HLA-A*29:02 PQWFDLLKH 1.590328039 3503.00 nM 89 PQWFDLLKD 26154.9323 VPS54 chr2 g.63942506C>G +HLA-B*45:01 SELSNSQHS 0.849381379 344.24 nM 303 SELSNSQQS 318.4233344 RPRD1A chr18 g.36067342C>G +HLA-B*45:01 SQHSVQTLS 0.849381379 504.78 nM 303 SQQSVQTLS 526.6832846 RPRD1A chr18 g.36067342C>G +HLA-C*06:02 NSQHSVQTL 0.849381379 1333.24 nM 303 NSQQSVQTL 1076.587333 RPRD1A chr18 g.36067342C>G +HLA-C*06:02 QHSVQTLSL 0.849381379 1479.61 nM 303 QQSVQTLSL 2675.122158 RPRD1A chr18 g.36067342C>G +HLA-C*06:02 ELSNSQHSV 0.849381379 1978.65 nM 303 ELSNSQQSV 2672.299479 RPRD1A chr18 g.36067342C>G +HLA-C*06:02 HSVQTLSLW 0.849381379 3651.90 nM 303 QSVQTLSLW 4689.895086 RPRD1A chr18 g.36067342C>G +HLA-A*29:02 FLALDAPQH 0.69146008 269.95 nM 448 FLALDASQH 383.9042349 TXNDC15 chr5 g.134893642T>C +HLA-A*29:02 HFLALDAPQ 0.69146008 2198.28 nM 448 HFLALDASQ 3026.609605 TXNDC15 chr5 g.134893642T>C +HLA-A*29:02 IVCADADLY 1.566169368 109.95 nM 82 IVCADADLD 23800.24557 ALDH1A3 chr15 g.100900577G>T +HLA-C*06:02 VCADADLYL 1.566169368 299.91 nM 82 VCADADLDL 718.3311328 ALDH1A3 chr15 g.100900577G>T +HLA-B*45:01 ADADLYLAV 1.566169368 1001.15 nM 82 ADADLDLAV 3930.79975 ALDH1A3 chr15 g.100900577G>T +HLA-A*29:02 LYLAVECAH 1.566169368 1765.30 nM 82 LDLAVECAH 14673.39817 ALDH1A3 chr15 g.100900577G>T +HLA-B*45:01 CADADLYLA 1.566169368 2580.76 nM 82 CADADLDLA 7528.473289 ALDH1A3 chr15 g.100900577G>T +HLA-B*45:01 ADLYLAVEC 1.566169368 2933.58 nM 82 ADLDLAVEC 4166.823085 ALDH1A3 chr15 g.100900577G>T +HLA-B*45:01 RKWKLKLIA 0.654780341 428.04 nM 429 RKWKLNLIA 805.2494555 SURF1 chr9 g.133354715G>C +HLA-C*06:02 RRKWKLKLI 0.654780341 536.97 nM 429 RRKWKLNLI 811.118878 SURF1 chr9 g.133354715G>C +HLA-C*06:02 QRRKWKLKL 0.654780341 1419.86 nM 429 QRRKWKLNL 1063.179285 SURF1 chr9 g.133354715G>C +HLA-C*06:02 WKLKLIAEL 0.654780341 2608.14 nM 429 WKLNLIAEL 1702.419592 SURF1 chr9 g.133354715G>C +HLA-C*06:02 VKFEAARLL 1.124362079 68.07 nM 107 VKFEAASLL 117.1344763 MAU2 chr19 g.19336158A>C +HLA-A*29:02 AARLLSELY 1.124362079 601.64 nM 107 AASLLSELY 174.7500134 MAU2 chr19 g.19336158A>C +HLA-C*06:02 EAARLLSEL 1.124362079 2361.58 nM 107 EAASLLSEL 1204.535956 MAU2 chr19 g.19336158A>C +HLA-B*45:01 ADFRDCLAA 0.813981725 419.19 nM 167 ADFRDCRAA 1046.053601 FARP1 chr13 g.98431278G>T +HLA-C*06:02 DFRDCLAAL 0.813981725 439.35 nM 167 DFRDCRAAL 243.7204185 FARP1 chr13 g.98431278G>T +HLA-C*06:02 SHADFRDCL 0.813981725 3427.26 nM 167 SHADFRDCR 18188.13674 FARP1 chr13 g.98431278G>T +HLA-B*45:01 EKWKLLTPA 1.067953732 261.95 nM 89 EEWKLLTPA 16.42927051 ZNF25 chr10 g.37957501C>T +HLA-C*06:02 FTKEKWKLL 1.067953732 455.64 nM 89 FTKEEWKLL 430.3792441 ZNF25 chr10 g.37957501C>T +HLA-C*06:02 TRIMNQRVL 0.927259915 95.28 nM 118 TRMMNQRVL 35.72947194 SLC25A30 chr13 g.45399009C>T +HLA-C*06:02 VDVVRTRIM 0.927259915 3517.29 nM 118 VDVVRTRMM 3048.078447 SLC25A30 chr13 g.45399009C>T +HLA-C*06:02 MKSADVVKL 0.520826277 365.73 nM 322 MKSADVEKL 822.694169 TIPRL chr1 g.168179178A>T +HLA-C*06:02 VKLADELHM 0.520826277 1389.48 nM 322 EKLADELHM 2243.923583 TIPRL chr1 g.168179178A>T +HLA-B*45:01 QENWFYFEA 1.980553937 16.21 nM 22 QEHWFYFEA 18.16812255 ADPRHL1 chr13 g.113425168G>T +HLA-A*29:02 EYQENWFYF 1.980553937 340.64 nM 22 EYQEHWFYF 354.3200456 ADPRHL1 chr13 g.113425168G>T +HLA-A*29:02 AEYQENWFY 1.980553937 533.10 nM 22 AEYQEHWFY 271.4782031 ADPRHL1 chr13 g.113425168G>T +HLA-B*45:01 AEYQENWFY 1.980553937 599.57 nM 22 AEYQEHWFY 393.3930985 ADPRHL1 chr13 g.113425168G>T +HLA-A*29:02 NWFYFEAKW 1.980553937 1559.74 nM 22 HWFYFEAKW 1456.698637 ADPRHL1 chr13 g.113425168G>T +HLA-C*06:02 EYQENWFYF 1.980553937 2687.63 nM 22 EYQEHWFYF 3181.425943 ADPRHL1 chr13 g.113425168G>T +HLA-C*06:02 NWFYFEAKW 1.980553937 3730.15 nM 22 HWFYFEAKW 3015.946118 ADPRHL1 chr13 g.113425168G>T +HLA-B*45:01 QENGMQSAS 1.04773502 45.86 nM 78 QENGMESAS 79.03278915 SIX4 chr14 g.60724008C>G +HLA-B*45:01 KQENGMQSA 1.04773502 734.70 nM 78 KQENGMESA 975.6688048 SIX4 chr14 g.60724008C>G +HLA-B*45:01 QSASEGQEA 1.04773502 3091.61 nM 78 ESASEGQEA 6119.917386 SIX4 chr14 g.60724008C>G +HLA-A*29:02 ALGWEFLAF 0.777320444 216.71 nM 124 ALGWEFLAS 10960.35196 PANX2 chr22 g.50177152C>T +HLA-C*06:02 AFTRLTSEL 0.777320444 2660.89 nM 124 ASTRLTSEL 6101.337874 PANX2 chr22 g.50177152C>T +HLA-A*29:02 FLAFTRLTS 0.777320444 2784.43 nM 124 FLASTRLTS 3515.530528 PANX2 chr22 g.50177152C>T +HLA-B*45:01 AELRRTLSP 0.422199915 420.33 nM 415 AQLRRTLSP 2800.218619 WNK1 chr12 g.889170C>G +HLA-B*45:01 SEKKAVIVK 0.49647191 386.74 nM 293 SKKKAVIVK 6972.79339 ATRX chrX g.77681733T>C +HLA-C*06:02 TSSEKKAVI 0.49647191 998.24 nM 293 TSSKKKAVI 3440.434887 ATRX chrX g.77681733T>C +HLA-C*06:02 RTSSEKKAV 0.49647191 1519.44 nM 293 RTSSKKKAV 1607.886358 ATRX chrX g.77681733T>C +HLA-A*29:02 MHQICVLQY 0.949010606 71.24 nM 78 MHQICVLHY 92.51084487 CREBBP chr16 g.3745300G>C +HLA-C*06:02 MHQICVLQY 0.949010606 2166.47 nM 78 MHQICVLHY 2582.285212 CREBBP chr16 g.3745300G>C +HLA-B*45:01 LQYDIIWPS 0.949010606 2360.47 nM 78 LHYDIIWPS 6598.634905 CREBBP chr16 g.3745300G>C +HLA-C*06:02 IAVHLVRCI 0.758741363 228.81 nM 117 IAVHLVRCR 5911.88638 ADNP2 chr18 g.80138229G>T +HLA-C*06:02 ELHPRITQL 0.57563178 335.14 nM 189 ELHPRIKQL 175.0602357 TRPM7 chr15 g.50643417T>G +HLA-C*06:02 LHPRITQLL 0.57563178 2871.07 nM 189 LHPRIKQLL 6316.965318 TRPM7 chr15 g.50643417T>G +HLA-B*45:01 SEVDPKVVS 0.781381174 218.84 nM 93 SEVDPKLVS 349.8890727 SMARCAL1 chr2 g.216428742C>G +HLA-C*06:02 KVVSNLMPF 0.781381174 1101.04 nM 93 KLVSNLMPF 925.1969021 SMARCAL1 chr2 g.216428742C>G +HLA-A*29:02 KVVSNLMPF 0.781381174 3144.94 nM 93 KLVSNLMPF 2719.88194 SMARCAL1 chr2 g.216428742C>G +HLA-A*29:02 EPLYLSFEY 0.773994988 218.93 nM 89 EPLYLSSEY 1628.065126 ZBTB3 chr11 g.62752451G>A +HLA-A*29:02 LHEPLYLSF 0.773994988 1971.11 nM 89 LHEPLYLSS 21285.98774 ZBTB3 chr11 g.62752451G>A +HLA-B*45:01 FEYEAAPGS 0.773994988 2050.36 nM 89 SEYEAAPGS 103.8870501 ZBTB3 chr11 g.62752451G>A +HLA-A*29:02 LYLSFEYEA 0.773994988 3742.56 nM 89 LYLSSEYEA 5905.618407 ZBTB3 chr11 g.62752451G>A +HLA-C*06:02 VLNEHKKIY 1.174000875 291.16 nM 33 VLNEHKKIH 3435.971683 ZNF141 chr4 g.373602C>T +HLA-B*45:01 NEHKKIYTG 1.174000875 368.16 nM 33 NEHKKIHTG 655.7250905 ZNF141 chr4 g.373602C>T +HLA-A*29:02 VLNEHKKIY 1.174000875 1193.22 nM 33 VLNEHKKIH 10977.01474 ZNF141 chr4 g.373602C>T +HLA-C*06:02 AYLECLQNV 0.916751026 106.00 nM 48 AYLECLQNL 91.95860627 SUSD4 chr1 g.223264672G>C +HLA-C*06:02 YLECLQNVI 0.916751026 2573.98 nM 48 YLECLQNLI 3134.811326 SUSD4 chr1 g.223264672G>C +HLA-A*29:02 MAIFGGGRY 1.003473561 20.82 nM 39 MPIFGGGRY 115.115431 EDRF1 chr10 g.125729433C>G +HLA-C*06:02 MLVGSNMAI 1.003473561 979.04 nM 39 MLVGSNMPI 1008.602315 EDRF1 chr10 g.125729433C>G +HLA-C*06:02 LVGSNMAIF 1.003473561 1695.67 nM 39 LVGSNMPIF 2690.78964 EDRF1 chr10 g.125729433C>G +HLA-A*29:02 LVGSNMAIF 1.003473561 2000.87 nM 39 LVGSNMPIF 2816.542127 EDRF1 chr10 g.125729433C>G +HLA-A*29:02 SIFEKHQVY 0.892021396 129.46 nM 47 SIFVIFEKH 1834.488137 PARP12 chr7 g.140024673_140024681delCAAAGATCA +HLA-C*06:02 SIFEKHQVY 0.892021396 1785.04 nM 47 SIFVIFEKH 19809.92034 PARP12 chr7 g.140024673_140024681delCAAAGATCA +HLA-A*29:02 DLANIHSEY 1.030538479 91.98 nM 35 DLANIRSEY 290.0160827 SETD6 chr16 g.58516555G>A +HLA-C*06:02 IHSEYQSIV 1.030538479 696.51 nM 35 IRSEYQSIV 106.1646709 SETD6 chr16 g.58516555G>A +HLA-C*06:02 NIHSEYQSI 1.030538479 1385.55 nM 35 NIRSEYQSI 3348.475658 SETD6 chr16 g.58516555G>A +HLA-A*29:02 SLGVLKRKY 0.364648852 454.59 nM 248 SLGVLKRQY 292.4918504 SMOX chr20 g.4182497C>A +HLA-C*06:02 LKRKYTSFF 0.364648852 3140.47 nM 248 LKRQYTSFF 946.0563516 SMOX chr20 g.4182497C>A +HLA-A*29:02 STLKKTTTY 0.645009268 304.11 nM 78 SKGIMEEDE 35320.37096 JUP chr17 g.41771695_41771736delTGTACTGGCGCCCGCAGGCCTCATCCTCCTCCATGATGCCCT +HLA-C*06:02 CVPSVSSTL 0.645009268 1033.08 nM 78 CVPSVSSKG 24767.74716 JUP chr17 g.41771695_41771736delTGTACTGGCGCCCGCAGGCCTCATCCTCCTCCATGATGCCCT +HLA-C*06:02 TCVPSVSST 0.645009268 1307.62 nM 78 TCVPSVSSK 4554.410039 JUP chr17 g.41771695_41771736delTGTACTGGCGCCCGCAGGCCTCATCCTCCTCCATGATGCCCT +HLA-C*06:02 STLKKTTTY 0.645009268 2561.30 nM 78 SKGIMEEDE 32834.79919 JUP chr17 g.41771695_41771736delTGTACTGGCGCCCGCAGGCCTCATCCTCCTCCATGATGCCCT +HLA-C*06:02 EVHPDVKCV 0.727740816 248.22 nM 61 EVHPEVKCV 281.1082854 C8orf76 chr8 g.123220247C>A +HLA-C*06:02 FWNKKKSMI 0.298416687 504.66 nM 334 FWKKKKSMI 480.8166527 CLPTM1L chr5 g.1331836C>A +HLA-C*06:02 SFWNKKKSM 0.298416687 1052.55 nM 334 SFWKKKKSM 1518.365572 CLPTM1L chr5 g.1331836C>A +HLA-C*06:02 VSFEEINKY 1.441433698 312.97 nM 14 VSFEEIKKY 181.353689 COL19A1 chr6 g.70190344G>C +HLA-A*29:02 VSFEEINKY 1.441433698 404.04 nM 14 VSFEEIKKY 418.478491 COL19A1 chr6 g.70190344G>C +HLA-C*06:02 SFEEINKYI 1.441433698 535.54 nM 14 SFEEIKKYI 593.5729176 COL19A1 chr6 g.70190344G>C +HLA-C*06:02 NKYINQEVL 1.441433698 653.54 nM 14 KKYINQEVL 319.3070762 COL19A1 chr6 g.70190344G>C +HLA-B*45:01 HESLITGEA 0.800912994 200.74 nM 39 DESLITGEA 607.6132891 ATP7A chrX g.78015863G>C +HLA-C*06:02 HSMVHESLI 0.800912994 1930.81 nM 39 HSMVDESLI 3549.358426 ATP7A chrX g.78015863G>C +HLA-C*06:02 YYQSSETRL 0.285741608 515.69 nM 195 YYQSPETRL 569.8895244 ASMTL chrX g.1419096G>A +HLA-A*29:02 QSSETRLRF 0.285741608 1024.26 nM 195 QSPETRLRF 3487.09955 ASMTL chrX g.1419096G>A +HLA-B*45:01 SETRLRFMR 0.285741608 1473.75 nM 195 PETRLRFMR 15873.70901 ASMTL chrX g.1419096G>A +HLA-C*06:02 DAYYQSSET 0.285741608 3534.80 nM 195 DAYYQSPET 7183.04642 ASMTL chrX g.1419096G>A +HLA-C*06:02 AYYQSSETR 0.285741608 3645.10 nM 195 AYYQSPETR 3503.049991 ASMTL chrX g.1419096G>A +HLA-C*06:02 RRLHLPRHV 0.615187931 318.81 nM 33 RRLHLPGHV 1552.868947 SZT2 chr1 g.43432296G>C +HLA-C*06:02 LHLPRHVLL 0.615187931 1068.99 nM 33 LHLPGHVLL 1334.391143 SZT2 chr1 g.43432296G>C +HLA-C*06:02 RLHLPRHVL 0.615187931 1419.98 nM 33 RLHLPGHVL 1736.079767 SZT2 chr1 g.43432296G>C +HLA-C*06:02 YALKQSSIF 0.25633687 528.15 nM 174 YALKQSSIL 364.8091164 ZNF277 chr7 g.112342711G>C +HLA-C*06:02 SSIFNQLLL 0.25633687 2468.79 nM 174 SSILNQLLL 3193.862 ZNF277 chr7 g.112342711G>C +HLA-A*29:02 SSIFNQLLL 0.25633687 2535.08 nM 174 SSILNQLLL 7084.239097 ZNF277 chr7 g.112342711G>C +HLA-A*29:02 YALKQSSIF 0.25633687 3333.85 nM 174 YALKQSSIL 19542.83185 ZNF277 chr7 g.112342711G>C +HLA-C*06:02 KQSSIFNQL 0.25633687 3591.81 nM 174 KQSSILNQL 2723.200098 ZNF277 chr7 g.112342711G>C +HLA-C*06:02 FFKDMDALL 0.605398983 318.77 nM 30 FFEDMDALL 676.9148785 ZKSCAN2 chr16 g.25246938C>T +HLA-A*29:02 FFKDMDALL 0.605398983 1952.60 nM 30 FFEDMDALL 2055.379005 ZKSCAN2 chr16 g.25246938C>T +HLA-C*06:02 AFFKDMDAL 0.605398983 2323.78 nM 30 AFFEDMDAL 737.8334759 ZKSCAN2 chr16 g.25246938C>T +HLA-A*29:02 MLEPCAFFK 0.605398983 3368.43 nM 30 MLEPCAFFE 3984.891474 ZKSCAN2 chr16 g.25246938C>T +HLA-C*06:02 CAFFKDMDA 0.605398983 3470.40 nM 30 CAFFEDMDA 3925.907063 ZKSCAN2 chr16 g.25246938C>T +HLA-B*45:01 AELDGRCLS 0.469541526 393.48 nM 46 AELDGRCPS 220.7945403 PHF19 chr9 g.120858191G>A +HLA-B*45:01 RERKRPVKA 0.867673658 150.38 nM 13 RERERPVKA 191.8609442 IQCA1 chr2 g.236392011C>T +HLA-C*06:02 VDRERKRPV 0.867673658 2854.94 nM 13 VDRERERPV 2713.531933 IQCA1 chr2 g.236392011C>T +HLA-C*06:02 LLPDQATQL 0.257636808 527.16 nM 145 LFPDQATQL 365.7112908 MED14 chrX g.40655058G>T +HLA-B*45:01 LELLPDQAT 0.257636808 2224.09 nM 145 LELFPDQAT 2353.830791 MED14 chrX g.40655058G>T +HLA-B*45:01 QEQDEQLAS 1.694761465 83.75 nM 3 QEQEEQLAS 60.58677717 CCDC40 chr17 g.80086143G>C +HLA-B*45:01 DEQLASLDA 1.694761465 230.10 nM 3 EEQLASLDA 33.13189727 CCDC40 chr17 g.80086143G>C +HLA-B*45:01 TQEQDEQLA 1.694761465 1906.64 nM 3 TQEQEEQLA 2975.804283 CCDC40 chr17 g.80086143G>C +HLA-A*29:02 PMAEVQLCY 1.959638482 16.32 nM 2 PKAEVQLCY 1159.868053 AKAP6 chr14 g.32600791A>T +HLA-B*45:01 EEGTGSPMA 1.959638482 45.44 nM 2 EEGTGSPKA 57.99516934 AKAP6 chr14 g.32600791A>T +HLA-C*06:02 MAEVQLCYL 1.959638482 1921.58 nM 2 KAEVQLCYL 2741.274148 AKAP6 chr14 g.32600791A>T +HLA-A*29:02 CIAMNKYQH 1.017232181 288.07 nM 7 CIPMNKYQH 1317.249987 ZNF519 chr18 g.14106119G>C +HLA-A*29:02 AMNKYQHKF 1.017232181 459.27 nM 7 PMNKYQHKF 1191.202696 ZNF519 chr18 g.14106119G>C +HLA-C*06:02 AMNKYQHKF 1.017232181 3802.82 nM 7 PMNKYQHKF 8515.643845 ZNF519 chr18 g.14106119G>C +HLA-C*06:02 AAYSVVSGL 0.781042662 233.86 nM 10 AAYSVVSGN 6764.393726 HLA-F chr6 g.29726903AA>CT +HLA-A*29:02 YSVVSGLLM 0.781042662 885.74 nM 10 YSVVSGNLM 4954.306045 HLA-F chr6 g.29726903AA>CT +HLA-C*06:02 YSVVSGLLM 0.781042662 1661.73 nM 10 YSVVSGNLM 1436.796051 HLA-F chr6 g.29726903AA>CT +HLA-C*06:02 SVVSGLLMI 0.781042662 1812.15 nM 10 SVVSGNLMI 1220.857652 HLA-F chr6 g.29726903AA>CT +HLA-C*06:02 AYSVVSGLL 0.781042662 3229.11 nM 10 AYSVVSGNL 3904.378778 HLA-F chr6 g.29726903AA>CT +HLA-C*06:02 FKSSSFCEV 0.340978715 469.43 nM 43 FKSSSSCEV 260.4193878 ZNF490 chr19 g.12580948G>A +HLA-C*06:02 EAFKSSSFC 0.340978715 2314.12 nM 43 EAFKSSSSC 1216.901089 ZNF490 chr19 g.12580948G>A +HLA-B*45:01 GEAFKSSSF 0.340978715 2628.52 nM 43 GEAFKSSSS 756.6389415 ZNF490 chr19 g.12580948G>A +HLA-B*45:01 GQMHAAISS 0.168049583 676.88 nM 164 GQMHAGISS 2144.086153 ARID1B chr6 g.157133136G>C +HLA-C*06:02 QMHAAISSF 0.168049583 786.95 nM 164 QMHAGISSF 424.5335015 ARID1B chr6 g.157133136G>C +HLA-A*29:02 QMHAAISSF 0.168049583 1836.68 nM 164 QMHAGISSF 1147.663377 ARID1B chr6 g.157133136G>C +HLA-C*06:02 LAFTEKEVL 0.309871297 489.85 nM 40 LASTEKEVL 1379.039221 CEP85L chr6 g.118491774G>A +HLA-B*45:01 FEQKLAFTE 0.309871297 1903.18 nM 40 FEQKLASTE 3848.339414 CEP85L chr6 g.118491774G>A +HLA-B*45:01 GEFEQKLAF 0.309871297 2411.61 nM 40 GEFEQKLAS 562.8096691 CEP85L chr6 g.118491774G>A +HLA-C*06:02 KLAFTEKEV 0.309871297 2479.38 nM 40 KLASTEKEV 1121.208488 CEP85L chr6 g.118491774G>A +HLA-C*06:02 FTEKEVLQL 0.309871297 2606.04 nM 40 STEKEVLQL 5666.107506 CEP85L chr6 g.118491774G>A +HLA-B*45:01 RERDAQILG 0.521738472 364.71 nM 14 RERDAQILR 1863.983749 JAKMIP3 chr10 g.132163377C>G +HLA-C*06:02 ILGERMELL 0.521738472 1729.78 nM 14 ILRERMELL 794.875294 JAKMIP3 chr10 g.132163377C>G +HLA-C*06:02 QILGERMEL 0.521738472 1992.79 nM 14 QILRERMEL 4166.195629 JAKMIP3 chr10 g.132163377C>G +HLA-B*45:01 GERMELLQL 0.521738472 3055.00 nM 14 RERMELLQL 2577.368891 JAKMIP3 chr10 g.132163377C>G +HLA-C*06:02 KFKQQLAAF 0.262925204 523.16 nM 54 EFKQQLAAF 831.0563037 TLN2 chr15 g.62819537G>A +HLA-B*45:01 PKFKQQLAA 0.262925204 3665.25 nM 54 PEFKQQLAA 494.6245231 TLN2 chr15 g.62819537G>A +HLA-A*29:02 KEIYAKLRY 0.764563499 435.14 nM 6 KEIDAKLRY 477.9663245 PCLO chr7 g.82916603C>A +HLA-C*06:02 EIYAKLRYL 0.764563499 569.03 nM 6 EIDAKLRYL 3903.429777 PCLO chr7 g.82916603C>A +HLA-B*45:01 DEEEKEIYA 0.764563499 648.92 nM 6 DEEEKEIDA 1565.720162 PCLO chr7 g.82916603C>A +HLA-C*06:02 YAKLRYLEM 0.764563499 936.62 nM 6 DAKLRYLEM 8193.525679 PCLO chr7 g.82916603C>A +HLA-B*45:01 EEEKEIYAK 0.764563499 1124.97 nM 6 EEEKEIDAK 3739.220141 PCLO chr7 g.82916603C>A +HLA-B*45:01 EEKEIYAKL 0.764563499 1327.81 nM 6 EEKEIDAKL 3702.543421 PCLO chr7 g.82916603C>A +HLA-A*29:02 IYAKLRYLE 0.764563499 2803.89 nM 6 IDAKLRYLE 15361.29057 PCLO chr7 g.82916603C>A +HLA-A*29:02 SHRLTWTQY 0.298268752 498.50 nM 34 SHCLTWTQY 329.6432875 PRELID2 chr5 g.145817967A>G +HLA-C*06:02 HRLTWTQYA 0.298268752 1387.45 nM 34 HCLTWTQYA 2401.470474 PRELID2 chr5 g.145817967A>G +HLA-C*06:02 AIRSHRLTW 0.298268752 3023.42 nM 34 AIRSHCLTW 3872.308124 PRELID2 chr5 g.145817967A>G +HLA-C*06:02 SHRLTWTQY 0.298268752 3698.11 nM 34 SHCLTWTQY 4500.734065 PRELID2 chr5 g.145817967A>G +HLA-C*06:02 RTLQQARQL 0.098132982 711.78 nM 307 RTLEQARQL 455.7628987 MACF1 chr1 g.39429922G>C +HLA-B*45:01 LQQARQLAT 0.098132982 1089.29 nM 307 LEQARQLAT 142.1254765 MACF1 chr1 g.39429922G>C +HLA-C*06:02 ISYPQILIL 0.903310774 123.05 nM 3 ISYPQILTL 45.53676292 IL1R2 chr2 g.102015966C>T +HLA-C*06:02 FISYPQILI 0.903310774 1179.93 nM 3 FISYPQILT 10040.37932 IL1R2 chr2 g.102015966C>T +HLA-C*06:02 ILSTSGVLV 0.903310774 2116.76 nM 3 TLSTSGVLV 2292.72888 IL1R2 chr2 g.102015966C>T +HLA-A*29:02 FISYPQILI 0.903310774 2126.06 nM 3 FISYPQILT 5122.006533 IL1R2 chr2 g.102015966C>T +HLA-C*06:02 LILSTSGVL 0.903310774 2776.03 nM 3 LTLSTSGVL 2363.377298 IL1R2 chr2 g.102015966C>T +HLA-C*06:02 ILILSTSGV 0.903310774 2893.15 nM 3 ILTLSTSGV 5799.714823 IL1R2 chr2 g.102015966C>T +HLA-C*06:02 EMLGLSKTL 0.14364638 633.89 nM 91 EMLGLSKRL 2150.998674 CENPE chr4 g.103145956C>G +HLA-B*45:01 IEMLGLSKT 0.14364638 2741.37 nM 91 IEMLGLSKR 9569.072735 CENPE chr4 g.103145956C>G +HLA-C*06:02 VAQDQKKIL 0.833418635 177.97 nM 2 VAQDQEKIL 239.1273369 SYNE1 chr6 g.152325134C>T +HLA-C*06:02 AVAQDQKKI 0.833418635 1417.73 nM 2 AVAQDQEKI 3617.262318 SYNE1 chr6 g.152325134C>T +HLA-B*45:01 QKKILEDAV 0.833418635 2798.20 nM 2 QEKILEDAV 158.4808715 SYNE1 chr6 g.152325134C>T +HLA-B*45:01 KECDHSEGA 0.137201525 641.79 nM 65 ECDHSNNDR 26821.59647 PLCD3 chr17 g.45119015_45119029delAGACGGTCGTTGTTG +HLA-B*45:01 SEGAEIEEF 0.137201525 2436.25 nM 65 NNDRLEGAE 24462.76558 PLCD3 chr17 g.45119015_45119029delAGACGGTCGTTGTTG +HLA-B*45:01 ARQGARVAA 0.184203666 592.42 nM 31 AREGARVAA 935.3318189 SLC35E1 chr19 g.16572289C>G +HLA-B*45:01 GARQGARVA 0.184203666 1281.84 nM 31 GAREGARVA 1343.735606 SLC35E1 chr19 g.16572289C>G +HLA-C*06:02 RQGARVAAL 0.184203666 1671.00 nM 31 REGARVAAL 4414.16154 SLC35E1 chr19 g.16572289C>G +HLA-B*45:01 RQGARVAAL 0.184203666 1924.90 nM 31 REGARVAAL 220.9423298 SLC35E1 chr19 g.16572289C>G +HLA-C*06:02 GARQGARVA 0.184203666 3125.79 nM 31 GAREGARVA 2821.907809 SLC35E1 chr19 g.16572289C>G +HLA-C*06:02 EAVQKEKPI 0.039099637 844.69 nM 533 EAVQKEEPI 1612.572497 MAP7D1 chr1 g.36179728G>A +HLA-C*06:02 EAVQKEKPI 0.039099637 844.69 nM 531 AVQKEEPIP 26515.70044 MAP7D1 chr1 g.36179727GG>AA +HLA-C*06:02 EMADQGCLL 0.08945136 713.57 nM 94 EMADQGRLL 826.6038629 TRIO chr5 g.14507135C>T +HLA-B*45:01 LEMADQGCL 0.08945136 1660.83 nM 94 LEMADQGRL 5125.203334 TRIO chr5 g.14507135C>T +HLA-A*29:02 CLLDCVVRW 0.08945136 2134.45 nM 94 RLLDCVVRW 5678.018091 TRIO chr5 g.14507135C>T +HLA-C*06:02 CLLDCVVRW 0.08945136 2365.67 nM 94 RLLDCVVRW 1884.720034 TRIO chr5 g.14507135C>T +HLA-C*06:02 NLFNCECDL 0.295175389 506.04 nM 7 NPFNCECDL 2315.85221 ELFN2 chr22 g.37374978G>A +HLA-B*45:01 CELAGNLFN 0.295175389 1075.48 nM 7 CELAGNPFN 742.8520659 ELFN2 chr22 g.37374978G>A +HLA-A*29:02 LFNCECDLF 0.295175389 1800.15 nM 7 PFNCECDLF 3648.209873 ELFN2 chr22 g.37374978G>A +HLA-C*06:02 MVCELAGNL 0.295175389 1835.33 nM 7 MVCELAGNP 13529.05477 ELFN2 chr22 g.37374978G>A +HLA-C*06:02 MAMGFVGCL 0.032757042 903.77 nM 550 MAIGFVGCL 1115.346152 TSPAN4 chr11 g.862687C>G +HLA-C*06:02 ITGAFVMAM 0.032757042 1129.78 nM 550 ITGAFVMAI 1723.465751 TSPAN4 chr11 g.862687C>G +HLA-A*29:02 GAFVMAMGF 0.032757042 1845.73 nM 550 GAFVMAIGF 2201.43047 TSPAN4 chr11 g.862687C>G +HLA-C*06:02 GAFVMAMGF 0.032757042 3781.12 nM 550 GAFVMAIGF 4323.925388 TSPAN4 chr11 g.862687C>G +HLA-B*45:01 SEEGTAKLI 0.05558175 789.82 nM 183 AEEGTAKLI 481.7690564 GALK2 chr15 g.49282071G>T +HLA-C*06:02 LSEEGTAKL 0.05558175 1760.99 nM 183 LAEEGTAKL 521.4861134 GALK2 chr15 g.49282071G>T +HLA-C*06:02 WFRGTLSRV 0.155272923 620.45 nM 21 WFHGTLSRV 270.4484003 SH2B2 chr7 g.102317256A>G +HLA-A*29:02 ELSDYPWFR 0.155272923 1817.72 nM 21 ELSDYPWFH 82.01824119 SH2B2 chr7 g.102317256A>G +HLA-C*06:02 DYPWFRGTL 0.155272923 2326.30 nM 21 DYPWFHGTL 3545.123847 SH2B2 chr7 g.102317256A>G +HLA-C*06:02 FRGTLSRVK 0.155272923 3306.32 nM 21 FHGTLSRVK 10439.60494 SH2B2 chr7 g.102317256A>G +HLA-A*29:02 WFRGTLSRV 0.155272923 3590.23 nM 21 WFHGTLSRV 3155.610969 SH2B2 chr7 g.102317256A>G +HLA-C*06:02 SFKNFQACI 0.045072101 828.97 nM 241 SLKNFQACI 1914.255877 NSMCE2 chr8 g.125102411G>C +HLA-C*06:02 SALSSFKNF 0.045072101 1309.54 nM 241 SALSSLKNF 966.0305854 NSMCE2 chr8 g.125102411G>C +HLA-B*45:01 VESALSSFK 0.045072101 2682.50 nM 241 VESALSSLK 3452.040344 NSMCE2 chr8 g.125102411G>C +HLA-C*06:02 SSFKNFQAC 0.045072101 3528.63 nM 241 SSLKNFQAC 11057.15455 NSMCE2 chr8 g.125102411G>C +HLA-C*06:02 LLADPTGAL 0.012763604 1016.31 nM 2699 LLADPTGAF 1269.438189 PRDX5 chr11 g.64320895T>C +HLA-C*06:02 LGKETDLLL 0.012763604 2551.84 nM 2699 FGKETDLLL 1036.828343 PRDX5 chr11 g.64320895T>C +HLA-C*06:02 GALGKETDL 0.012763604 2823.41 nM 2699 GAFGKETDL 944.1948018 PRDX5 chr11 g.64320895T>C +HLA-C*06:02 FTPLNVHAI 0.443085692 408.38 nM 2 FTPLNVDAI 2337.6054 KCNQ3 chr8 g.132141243C>G +HLA-C*06:02 VKYVYKLII 0.044097392 826.03 nM 193 VKYVYKLTI 293.3713872 RGP1 chr9 g.35750918C>T +HLA-C*06:02 SVKYVYKLI 0.044097392 1930.77 nM 193 SVKYVYKLT 12706.78881 RGP1 chr9 g.35750918C>T +HLA-B*45:01 SKSAFMQFG 0.138955482 640.00 nM 14 SKSAFMEFG 1091.871639 DLX6 chr7 g.97006044G>C +HLA-A*29:02 FMQFGQQQQ 0.138955482 1573.56 nM 14 FMEFGQQQQ 2001.19274 DLX6 chr7 g.97006044G>C +HLA-A*29:02 AFMQFGQQQ 0.138955482 2578.02 nM 14 AFMEFGQQQ 2341.623955 DLX6 chr7 g.97006044G>C +HLA-A*29:02 SSKSAFMQF 0.138955482 3042.75 nM 14 SSKSAFMEF 4031.53875 DLX6 chr7 g.97006044G>C +HLA-B*45:01 KETRKLLVS 0.070798505 751.74 nM 48 KETRKSLVS 609.494947 CCDC7 chr10 g.32567833C>T +HLA-C*06:02 LEKETRKLL 0.070798505 1581.89 nM 48 LEKETRKSL 1114.290454 CCDC7 chr10 g.32567833C>T +HLA-B*45:01 AEFRTNRYL 0.193776036 582.42 nM 6 AEFQTNRYL 596.8006608 EN2 chr7 g.155462476A>G +HLA-C*06:02 AEFRTNRYL 0.193776036 1327.32 nM 6 AEFQTNRYL 478.332033 EN2 chr7 g.155462476A>G +HLA-A*29:02 KAEFRTNRY 0.193776036 3171.07 nM 6 KAEFQTNRY 2172.906275 EN2 chr7 g.155462476A>G +HLA-B*45:01 AEEGKKEQV 0.025313679 911.84 nM 298 AEEAKKEQV 311.931863 GOLGB1 chr3 g.121697677G>C +HLA-C*06:02 IWVWKTLNV 0.02464516 916.02 nM 302 MWVWKTLNV 743.2954712 TMEM18 chr2 g.669670C>T +HLA-A*29:02 MIIVVIWVW 0.02464516 2086.34 nM 302 MIIVVMWVW 1258.018628 TMEM18 chr2 g.669670C>T +HLA-C*06:02 VVIWVWKTL 0.02464516 2782.05 nM 302 VVMWVWKTL 1680.100942 TMEM18 chr2 g.669670C>T +HLA-B*45:01 TEHTYHQCG 0.288058071 515.80 nM 2 TEHTYHQGG 1331.952829 NPHS1 chr19 g.35841841C>A +HLA-C*06:02 TYHQCGVHS 0.288058071 1018.84 nM 2 TYHQGGVHS 1879.01899 NPHS1 chr19 g.35841841C>A +HLA-C*06:02 QCGVHSSLL 0.288058071 1253.96 nM 2 QGGVHSSLL 3280.711199 NPHS1 chr19 g.35841841C>A +HLA-C*06:02 HQCGVHSSL 0.288058071 2117.65 nM 2 HQGGVHSSL 3997.573875 NPHS1 chr19 g.35841841C>A +HLA-A*29:02 HTYHQCGVH 0.288058071 3032.57 nM 2 HTYHQGGVH 3975.289975 NPHS1 chr19 g.35841841C>A +HLA-C*06:02 CSYLNEASL 0.112180482 675.93 nM 13 CSYLHEASL 913.4990033 AMN1 chr12 g.31697922G>T +HLA-B*45:01 NEASLKRCC 0.112180482 1834.27 nM 13 HEASLKRCC 2499.617312 AMN1 chr12 g.31697922G>T +HLA-B*45:01 SSCSYLNEA 0.112180482 2798.73 nM 13 SSCSYLHEA 1987.316149 AMN1 chr12 g.31697922G>T +HLA-C*06:02 LRREETDSF 0.081224938 728.92 nM 17 LRREETDWF 2279.067543 PCLO chr7 g.82908983C>G +HLA-B*45:01 EERAEMNQS 0.232387155 547.85 nM 2 EERAELNQS 822.5010594 AGER chr6 g.32181196G>T +HLA-B*45:01 AEMNQSEEP 0.232387155 1408.78 nM 2 AELNQSEEP 2490.091689 AGER chr6 g.32181196G>T +HLA-B*45:01 EEEERAEMN 0.232387155 3477.76 nM 2 EEEERAELN 3567.49538 AGER chr6 g.32181196G>T +HLA-B*45:01 EEEEERAEM 0.232387155 3776.97 nM 2 EEEEERAEL 3439.492672 AGER chr6 g.32181196G>T +HLA-A*29:02 MLGQPAHPH 0.184797077 589.49 nM 3 MLGQPARPH 2880.672088 NDUFS6 chr5 g.1814505G>A +HLA-C*06:02 MLGQPAHPH 0.184797077 3231.00 nM 3 MLGQPARPH 3169.203856 NDUFS6 chr5 g.1814505G>A +HLA-B*45:01 RELSPEDPG 0.028130241 895.62 nM 100 RELSPEGPG 847.3812968 SCRIB chr8 g.143795430C>T +HLA-C*06:02 YYLLRLLSL 0.198106251 576.91 nM 2 YYLLSLLSL 811.896934 OR56A5 chr11 g.5968294G>C +HLA-C*06:02 LRLLSLLDI 0.198106251 1917.69 nM 2 LSLLSLLDI 5955.805301 OR56A5 chr11 g.5968294G>C +HLA-C*06:02 PLYYLLRLL 0.198106251 2009.37 nM 2 PLYYLLSLL 2828.02021 OR56A5 chr11 g.5968294G>C +HLA-C*06:02 YLLRLLSLL 0.198106251 2019.02 nM 2 YLLSLLSLL 1017.621059 OR56A5 chr11 g.5968294G>C +HLA-A*29:02 YLLRLLSLL 0.198106251 2942.46 nM 2 YLLSLLSLL 1083.489517 OR56A5 chr11 g.5968294G>C +HLA-A*29:02 YYLLRLLSL 0.198106251 3074.31 nM 2 YYLLSLLSL 1869.642181 OR56A5 chr11 g.5968294G>C +HLA-B*45:01 KEQRYQTGL 0.008548636 1077.26 nM 658 KEQRYQRGL 1792.613291 NUFIP2 chr17 g.29286060C>G +HLA-B*45:01 AKEQRYQTG 0.008548636 2067.24 nM 658 AKEQRYQRG 5986.347489 NUFIP2 chr17 g.29286060C>G +HLA-C*06:02 QRYQTGLER 0.008548636 2296.32 nM 658 QRYQRGLER 2961.068558 NUFIP2 chr17 g.29286060C>G +HLA-C*06:02 TLYRVPLLV 0.008484945 1115.63 nM 494 TLYRVPFLV 5544.268174 OSTC chr4 g.108650682C>G +HLA-B*45:01 METLYRVPL 0.008484945 1309.01 nM 494 METLYRVPF 1169.131422 OSTC chr4 g.108650682C>G +HLA-C*06:02 LYRVPLLVL 0.008484945 1908.56 nM 494 LYRVPFLVL 3271.062342 OSTC chr4 g.108650682C>G +HLA-C*06:02 YRVPLLVLE 0.008484945 3029.26 nM 494 YRVPFLVLE 2083.492292 OSTC chr4 g.108650682C>G +HLA-C*06:02 ETLYRVPLL 0.008484945 3201.17 nM 494 ETLYRVPFL 5607.945096 OSTC chr4 g.108650682C>G +HLA-A*29:02 TLYRVPLLV 0.008484945 3384.09 nM 494 TLYRVPFLV 2408.651713 OSTC chr4 g.108650682C>G +HLA-A*29:02 FLTPACARW 0.006507538 1118.48 nM 771 FLTPPCARW 1072.807462 STAT1 chr2 g.190982494G>C +HLA-C*06:02 SFFLTPACA 0.006507538 2157.60 nM 771 SFFLTPPCA 5209.296484 STAT1 chr2 g.190982494G>C +HLA-C*06:02 PACARWAQL 0.006507538 2188.04 nM 771 PPCARWAQL 13122.2045 STAT1 chr2 g.190982494G>C +HLA-C*06:02 FLTPACARW 0.006507538 3688.99 nM 771 FLTPPCARW 2369.88537 STAT1 chr2 g.190982494G>C +HLA-B*45:01 GERAGDRAP 0.022457053 930.20 nM 63 GERAGDGAP 699.2332832 NELFB chr9 g.137255474G>C +HLA-C*06:02 DRAPSRAVA 0.022457053 3688.52 nM 63 DGAPSRAVA 9461.032574 NELFB chr9 g.137255474G>C +HLA-B*45:01 EEEDDADCS 0.056254046 787.72 nM 8 EEEDDADSS 627.3238144 CCDC136 chr7 g.128815876C>G +HLA-B*45:01 EEEEDDADC 0.056254046 2000.66 nM 8 EEEEDDADS 1411.418782 CCDC136 chr7 g.128815876C>G +HLA-C*06:02 LKFNPQTDY 0.007284437 1106.13 nM 416 LKFNPETDY 1677.155087 ACO2 chr22 g.41524891G>C +HLA-C*06:02 KFNPQTDYL 0.007284437 1648.79 nM 416 KFNPETDYL 1899.184537 ACO2 chr22 g.41524891G>C +HLA-A*29:02 LKFNPQTDY 0.007284437 1868.11 nM 416 LKFNPETDY 2506.025029 ACO2 chr22 g.41524891G>C +HLA-B*45:01 GTLKFNPQT 0.007284437 3662.78 nM 416 GTLKFNPET 2947.708521 ACO2 chr22 g.41524891G>C +HLA-A*29:02 GALVRSRTY 0.008713157 1171.87 nM 259 GALVHSRTY 568.7939933 TUBGCP6 chr22 g.50243801T>C +HLA-C*06:02 GALVRSRTY 0.008713157 1185.92 nM 259 GALVHSRTY 978.5780698 TUBGCP6 chr22 g.50243801T>C +HLA-C*06:02 LVRSRTYDM 0.008713157 2329.18 nM 259 LVHSRTYDM 916.2376287 TUBGCP6 chr22 g.50243801T>C +HLA-C*06:02 LLDSLTRMM 0.066719998 821.52 nM 2 LLDYLTRMM 1927.431299 RGL1 chr1 g.183880711A>C +HLA-C*06:02 KLLDSLTRM 0.066719998 937.87 nM 2 KLLDYLTRM 793.2570891 RGL1 chr1 g.183880711A>C +HLA-C*06:02 FLEDYVRCT 0.009390639 1063.23 nM 94 FLEDYVRYT 1055.260564 WASHC5 chr8 g.125028639T>C +HLA-C*06:02 RCTKLPRRV 0.009390639 1943.45 nM 94 RYTKLPRRV 1668.786643 WASHC5 chr8 g.125028639T>C +HLA-C*06:02 SRMPTQHLC 0.060095953 897.47 nM 2 SRMPTQHLY 294.7945689 NSUN7 chr4 g.40808809A>G +HLA-C*06:02 TQHLCCRWV 0.060095953 947.36 nM 2 TQHLYCRWV 1352.058542 NSUN7 chr4 g.40808809A>G +HLA-B*45:01 QHLCCRWVA 0.060095953 1022.95 nM 2 QHLYCRWVA 827.8350412 NSUN7 chr4 g.40808809A>G +HLA-B*45:01 TQHLCCRWV 0.060095953 2077.53 nM 2 TQHLYCRWV 2513.433699 NSUN7 chr4 g.40808809A>G +HLA-C*06:02 TSVPKLVPV 0.033465257 868.82 nM 5 TSVPELVPV 819.5115914 VEGFD chrX g.15355262C>T +HLA-C*06:02 PLTSVPKLV 0.033465257 3593.82 nM 5 PLTSVPELV 9262.884424 VEGFD chrX g.15355262C>T +HLA-B*45:01 SSAPFCPPS 0.009109972 1067.39 nM 56 SSAPFSPPS 845.8961939 CROCC chr1 g.16972418C>G +HLA-A*29:02 FILPRDSTH 0.009343426 1063.56 nM 53 FILPRESTH 1456.477651 ABCA3 chr16 g.2295601C>G +HLA-C*06:02 IKLEETSLV 0.045589991 820.73 nM 2 SKLEETSLV 856.173556 FRMPD3 chrX g.107601386G>T +HLA-B*45:01 QKSSFTVHC 0.000701743 1453.08 nM 5629 QKSSFTVDC 1724.129852 FLNA chrX g.154349377C>G +HLA-C*06:02 HCSKAGNNM 0.000701743 3462.71 nM 5629 DCSKAGNNM 8558.158106 FLNA chrX g.154349377C>G +HLA-C*06:02 VVQPVMPTL 0.003795689 1202.54 nM 188 VVQPVMPTS 11919.40109 DLGAP5 chr14 g.55180754G>A +HLA-C*06:02 PVMPTLLRM 0.003795689 1784.54 nM 188 PVMPTSLRM 1493.627544 DLGAP5 chr14 g.55180754G>A +HLA-A*29:02 PVMPTLLRM 0.003795689 2627.64 nM 188 PVMPTSLRM 1905.649376 DLGAP5 chr14 g.55180754G>A +HLA-A*29:02 TVVHNCQFF 0.028690003 907.00 nM 3 TVVHNYQFF 1096.998735 CRAT chr9 g.129102404T>C +HLA-A*29:02 CQFFELDVY 0.028690003 1258.40 nM 3 YQFFELDVY 185.5383455 CRAT chr9 g.129102404T>C +HLA-C*06:02 TVVHNCQFF 0.028690003 2442.89 nM 3 TVVHNYQFF 3923.921801 CRAT chr9 g.129102404T>C +HLA-A*29:02 ITVVHNCQF 0.028690003 3078.02 nM 3 ITVVHNYQF 190.7989078 CRAT chr9 g.129102404T>C +HLA-C*06:02 ITVVHNCQF 0.028690003 3337.58 nM 3 ITVVHNYQF 5325.778333 CRAT chr9 g.129102404T>C +HLA-C*06:02 MRNSGQGLF 0.027724837 897.86 nM 2 MRNRGQGLF 1776.434916 AMPD2 chr1 g.109621023C>A +HLA-A*29:02 MRNSGQGLF 0.027724837 3167.95 nM 2 MRNRGQGLF 4987.913057 AMPD2 chr1 g.109621023C>A +HLA-C*06:02 YLNPRSGGM 0.002578516 1257.61 nM 231 YLNPRSGGI 1407.122468 CCNT1 chr12 g.48693120G>C +HLA-C*06:02 QHAGVCKSV 0.004962119 1258.46 nM 50 QHAGVYKSV 1098.408556 SPEG chr2 g.219471925A>G +HLA-C*06:02 HAGVCKSVI 0.004962119 1268.52 nM 50 HAGVYKSVI 1903.427235 SPEG chr2 g.219471925A>G +HLA-C*06:02 FQIGPEEAM 0.001454661 1346.61 nM 508 SQIGPEEAM 4440.400335 KIF1C chr17 g.5007047C>T +HLA-A*29:02 SFSPNTEFQ 0.001454661 1933.64 nM 508 SFSPNTESQ 4597.716796 KIF1C chr17 g.5007047C>T +HLA-B*45:01 TEFQIGPEE 0.001454661 2920.25 nM 508 TESQIGPEE 1646.909059 KIF1C chr17 g.5007047C>T +HLA-C*06:02 PSFSPNTEF 0.001454661 3197.27 nM 508 PSFSPNTES 14617.31782 KIF1C chr17 g.5007047C>T +HLA-C*06:02 PARPPQQPV 0.002240797 1278.71 nM 172 PPRPPQQPV 7659.071988 GGA1 chr22 g.37631021C>G +HLA-A*29:02 GMDAGQPKH 0.009118587 1067.25 nM 9 GMHAGQPKH 641.9742646 SHC2 chr19 g.422193G>C +HLA-B*45:01 AEKIDRQYE 0.001732702 1317.37 nM 168 AEKIHRQYE 1103.554021 PSME4 chr2 g.53901385G>C +HLA-A*29:02 LAEKIDRQY 0.001732702 2743.17 nM 168 LAEKIHRQY 1431.403291 PSME4 chr2 g.53901385G>C +HLA-B*45:01 QDVPPGTPA 0.000948378 1408.21 nM 59 QDAPPGTPA 919.677382 IL27RA chr19 g.14049195CC>TT +HLA-C*06:02 DVPPGTPAI 0.000948378 2321.61 nM 59 DAPPGTPAI 1809.455977 IL27RA chr19 g.14049195CC>TT +HLA-B*45:01 QDVPPGTPA 0.000948378 1408.21 nM 59 QDAPPGTPA 919.677382 IL27RA chr19 g.14049195C>T +HLA-C*06:02 DVPPGTPAI 0.000948378 2321.61 nM 59 DAPPGTPAI 1809.455977 IL27RA chr19 g.14049195C>T +HLA-C*06:02 TGAPDGCFL 0.000381374 1544.59 nM 172 TGAPDGSFL 2621.952711 PLCG1 chr20 g.41165772C>G +HLA-C*06:02 VTKPVGVDV 0.000489796 1542.74 nM 83 VAKPVGVDV 612.7666976 APBB1 chr11 g.6401001C>T +HLA-C*06:02 YYLGNVPVT 0.000489796 1740.18 nM 83 YYLGNVPVA 1391.281741 APBB1 chr11 g.6401001C>T +HLA-C*06:02 GNVPVTKPV 0.000489796 2737.10 nM 83 GNVPVAKPV 2566.202014 APBB1 chr11 g.6401001C>T +HLA-C*06:02 GARTQRCLL 0.000816994 1430.27 nM 18 GARTQRSLL 2181.747053 DCHS2 chr4 g.154491219G>C +HLA-C*06:02 SGARTQRCL 0.000816994 2781.79 nM 18 SGARTQRSL 1466.581905 DCHS2 chr4 g.154491219G>C +HLA-C*06:02 ARTQRCLLW 0.000816994 3400.67 nM 18 ARTQRSLLW 3137.51015 DCHS2 chr4 g.154491219G>C +HLA-C*06:02 IYELDTRGL 0.00022751 1681.42 nM 200 IYELDTSGL 2853.377679 NAA25 chr12 g.112043095A>C +HLA-C*06:02 RGLEDTMEI 0.00022751 1789.98 nM 200 SGLEDTMEI 1913.162866 NAA25 chr12 g.112043095A>C +HLA-C*06:02 LLSETTYRI 0.0001277 1730.10 nM 295 LLPETTYRI 1710.207901 FNDC3B chr3 g.172353067C>T +HLA-B*45:01 SETTYRIRI 0.0001277 2011.70 nM 295 PETTYRIRI 16743.32851 FNDC3B chr3 g.172353067C>T +HLA-A*29:02 LLSETTYRI 0.0001277 3650.08 nM 295 LLPETTYRI 7939.816087 FNDC3B chr3 g.172353067C>T +HLA-C*06:02 SRTSQSPQM 8.87587E-05 1781.82 nM 190 SRTSQWPQM 2899.530713 UQCC1 chr20 g.35384132C>G +HLA-B*45:01 SPQMSQSQA 8.87587E-05 2086.37 nM 190 WPQMSQSRA 8079.874819 UQCC1 chr20 g.35384132C>G +HLA-B*45:01 SQSPQMSQS 8.87587E-05 3489.03 nM 190 SQWPQMSQS 3420.43278 UQCC1 chr20 g.35384132C>G +HLA-C*06:02 LEKHQIKTL 0.000579371 1481.84 nM 4 LEKDQIKTL 652.7492752 SHROOM2 chrX g.9937279G>C +HLA-C*06:02 NGSEFPSQL 6.30813E-05 1847.35 nM 219 NGSEFPSEL 2058.041113 PXDC1 chr6 g.3723708C>G +HLA-B*45:01 SEFPSQLED 6.30813E-05 2058.64 nM 219 SEFPSELED 2594.652746 PXDC1 chr6 g.3723708C>G +HLA-B*45:01 AASDEAEPA 0.000160577 1674.68 nM 32 AASEEAEPA 1164.514998 TPRN chr9 g.137199428T>A +HLA-C*06:02 AASDEAEPA 0.000160577 2604.40 nM 32 AASEEAEPA 3144.81125 TPRN chr9 g.137199428T>A +HLA-C*06:02 LNPQNKQSL 2.27246E-05 1967.70 nM 1390 LNLQNKQSL 1442.191513 HSPA4 chr5 g.133103959T>C +HLA-C*06:02 PQNKQSLTM 2.27246E-05 3367.76 nM 1390 LQNKQSLTM 1555.245725 HSPA4 chr5 g.133103959T>C +HLA-C*06:02 KITTHNKVI 4.26493E-05 1877.49 nM 97 KITTDNKVI 3160.63169 AKAP9 chr7 g.92077867G>C +HLA-C*06:02 LKITTHNKV 4.26493E-05 2410.52 nM 97 LKITTDNKV 4061.264616 AKAP9 chr7 g.92077867G>C +HLA-C*06:02 QRRVGLNEF 0.000200125 1641.34 nM 4 QRRAGLNEF 830.6783483 SGK3 chr8 g.66813874C>T +HLA-C*06:02 RRVGLNEFI 0.000200125 3382.41 nM 4 RRAGLNEFI 3441.163136 SGK3 chr8 g.66813874C>T +HLA-C*06:02 AGHMFEVVV 0.000281007 1592.42 nM 2 AGHMFDVVV 1918.337304 MAOA chrX g.43656386C>A +HLA-C*06:02 GHMFEVVVI 0.000281007 2238.60 nM 2 GHMFDVVVI 1627.270734 MAOA chrX g.43656386C>A +HLA-A*29:02 GGPDGGPGY 0.000144116 1690.60 nM 6 GGPGGGPGY 1139.034188 HOXA4 chr7 g.27130624C>T +HLA-B*45:01 IEGLPQDPT 3.90461E-05 1886.49 nM 70 IEGLPQGPT 2329.190841 POLH chr6 g.43587457G>A +HLA-C*06:02 SIVSRNCEI 4.1105E-05 1878.79 nM 49 VSRNCEHFV 4068.176525 PLAAT4 chr11 g.63544841_63544860delTGAGCACTTTGTCACCCAGC +HLA-C*06:02 SRNCEIWQV 4.1105E-05 3414.28 nM 49 NCEHFVTQL 1193.843052 PLAAT4 chr11 g.63544841_63544860delTGAGCACTTTGTCACCCAGC +HLA-C*06:02 IGKHGGVSL 2.61879E-05 1946.41 nM 78 IGKPGGVSL 1479.559726 TPST2 chr22 g.26540810G>T +HLA-B*45:01 GKHGGVSLS 2.61879E-05 3698.30 nM 78 GKPGGVSLS 15053.44775 TPST2 chr22 g.26540810G>T +HLA-B*45:01 EEHEDDDHG 1.2672E-05 2055.30 nM 207 EEDEDDDHG 6212.262151 USP34 chr2 g.61348285C>G +HLA-B*45:01 IELQTANLS 3.36365E-05 2003.98 nM 11 IEPQTANLS 9727.660168 DNAH1 chr3 g.52395055C>T +HLA-C*06:02 LQTANLSVV 3.36365E-05 2025.90 nM 11 PQTANLSVV 4061.466622 DNAH1 chr3 g.52395055C>T +HLA-C*06:02 FIELQTANL 3.36365E-05 2581.83 nM 11 FIEPQTANL 561.9878352 DNAH1 chr3 g.52395055C>T +HLA-C*06:02 ELQTANLSV 3.36365E-05 3575.95 nM 11 EPQTANLSV 12245.27104 DNAH1 chr3 g.52395055C>T +HLA-C*06:02 VLVGILLAL 5.06577E-06 2241.41 nM 146 VLVEILLAL 1082.668031 MYBBP1A chr17 g.4545725T>C +HLA-A*29:02 VLVGILLAL 5.06577E-06 2385.95 nM 146 VLVEILLAL 3814.936276 MYBBP1A chr17 g.4545725T>C +HLA-B*45:01 EVLVGILLA 5.06577E-06 3293.84 nM 146 EVLVEILLA 7882.962398 MYBBP1A chr17 g.4545725T>C +HLA-C*06:02 RIVVGVKRM 6.32993E-06 2159.42 nM 83 RIVVRVKRM 1378.613953 XDH chr2 g.31366061G>C +HLA-C*06:02 KYGLSDHPV 3.81782E-06 2235.26 nM 114 KYGLSAHPV 903.7589232 SCP2 chr1 g.52961570C>A +HLA-C*06:02 HMTEVVRHC 7.34312E-07 2482.53 nM 1413 HMTEVVRRC 3459.26184 TP53 chr17 g.7675088C>T +HLA-C*06:02 ENAGTITPL 3.64218E-06 2308.97 nM 23 ENAVTITPL 3283.304294 SCRIB chr8 g.143805314A>C +HLA-C*06:02 VEPENAGTI 3.64218E-06 2396.13 nM 23 VEPENAVTI 1045.580474 SCRIB chr8 g.143805314A>C +HLA-B*45:01 PENAGTITP 3.64218E-06 3682.28 nM 23 PENAVTITP 4399.722836 SCRIB chr8 g.143805314A>C +HLA-C*06:02 PYLGSAPSL 1.71579E-06 2412.80 nM 74 PYLGSARSL 335.2049714 SORBS3 chr8 g.22566401G>C +HLA-B*45:01 APYLGSAPS 1.71579E-06 2526.74 nM 74 APYLGSARS 10446.78388 SORBS3 chr8 g.22566401G>C +HLA-C*06:02 QCLLRLGVM 1.11214E-06 2420.27 nM 96 QCLLRLGVL 2703.937491 MICAL1 chr6 g.109451608G>T +HLA-C*06:02 RKFSWKKPE 1.53709E-06 2371.73 nM 40 GKFSWKKPE 6121.111269 ZNF318 chr6 g.43340178C>G +HLA-A*29:02 LFFYEHVRK 1.54166E-06 2371.50 nM 19 LFFYEHLRK 831.9358031 B3GNTL1 chr17 g.82961145G>C +HLA-A*29:02 LLFFYEHVR 1.54166E-06 3393.10 nM 19 LLFFYEHLR 921.635514 B3GNTL1 chr17 g.82961145G>C +HLA-C*06:02 FFYEHVRKG 1.54166E-06 3550.34 nM 19 FFYEHLRKG 5947.177815 B3GNTL1 chr17 g.82961145G>C +HLA-C*06:02 YCSAGCGRT 4.18008E-07 2567.05 nM 118 HCSAGCGRT 6902.786707 PTPN12 chr7 g.77600799C>T +HLA-B*45:01 SQSTGDKVT 3.34024E-07 2600.69 nM 114 QSTGDIDKV 19931.49761 TAF1 chrX g.71378282_71378287delAGATAT +HLA-C*06:02 VTAKNDLEL 2.77768E-07 2628.35 nM 59 VTAKKDLEL 4352.840665 HAUS8 chr19 g.17052842C>G +HLA-A*29:02 KSDLVSRNY 2.6316E-07 2672.30 nM 42 TSDLVSRNY 1305.891354 BMT2 chr7 g.112821985G>T +HLA-C*06:02 ISLKTKSDL 2.6316E-07 2885.50 nM 42 ISLKTTSDL 1864.084043 BMT2 chr7 g.112821985G>T +HLA-C*06:02 FRKISLKTK 2.6316E-07 3206.07 nM 42 FRKISLKTT 813.3780415 BMT2 chr7 g.112821985G>T +HLA-A*29:02 FFAPRLIKK 4.20884E-07 2599.91 nM 12 FFTPRLIKK 3722.305645 ABL2 chr1 g.179109010T>C +HLA-A*29:02 GFFAPRLIK 4.20884E-07 2805.75 nM 12 GFFTPRLIK 3434.549169 ABL2 chr1 g.179109010T>C +HLA-C*06:02 ELGSLRLPL 3.62839E-08 2933.67 nM 432 ELGSLPLPL 2924.816179 STX12 chr1 g.27793607C>G +HLA-C*06:02 ESVQKPKFL 6.39137E-08 2848.74 nM 63 ESVQKPKFP 20199.03442 KNL1 chr15 g.40622779C>T +HLA-C*06:02 ESVQKPKFL 6.39137E-08 2848.74 nM 63 ESVQKPKFP 20199.03442 KNL1 chr15 g.40622779CC>TT +HLA-C*06:02 ESVQKPKFL 6.39137E-08 2848.74 nM 63 ESVQKPKFP 20199.03442 KNL1 chr15 g.40622780C>T +HLA-A*29:02 SFKKGLPQH 8.50517E-09 3151.27 nM 337 SFKKGLPQR 13657.96523 SPATS2 chr12 g.49526215G>A +HLA-C*06:02 VDFGTGRNI 4.06748E-09 3261.92 nM 199 VDFGTGSNI 5887.00572 GLB1 chr3 g.33053545G>T +HLA-B*45:01 SEGNKVQKG 7.63574E-09 3177.28 nM 13 SEGKKVQKG 1298.695053 ANKEF1 chr20 g.10054509G>C +HLA-C*06:02 NKVQKGNVV 7.63574E-09 3581.05 nM 13 KKVQKGNVV 2169.254948 ANKEF1 chr20 g.10054509G>C +HLA-B*45:01 NKVGDEIVA 5.39763E-09 3219.48 nM 4 KVGDEIVDR 27765.92696 PLD2 chr17 g.4818362_4818376delGGACAGAATCCTGAA +HLA-B*45:01 AQNQGKKVK 5.59919E-10 3559.37 nM 358 AQNQGKKVE 3394.961956 RRBP1 chr20 g.17659331C>T +HLA-B*45:01 AEEDEGEEN 1.46206E-09 3415.40 nM 5 AEEDEEEEN 3836.730968 SH2D3A chr19 g.6755018T>C +HLA-C*06:02 DLKGDNVLI 2.10258E-10 3706.29 nM 94 DIKGDNVLI 4602.053273 MAP3K6 chr1 g.27359863T>G diff --git a/pvactools/tools/pvacview_dev_eve/extra_modulas.R b/pvactools/tools/pvacview/extra_modulas.R similarity index 100% rename from pvactools/tools/pvacview_dev_eve/extra_modulas.R rename to pvactools/tools/pvacview/extra_modulas.R diff --git a/pvactools/tools/pvacview_dev_eve/neofox_ui.R b/pvactools/tools/pvacview/neofox_ui.R old mode 100755 new mode 100644 similarity index 77% rename from pvactools/tools/pvacview_dev_eve/neofox_ui.R rename to pvactools/tools/pvacview/neofox_ui.R index 3770761c2..1c7b10b6f --- a/pvactools/tools/pvacview_dev_eve/neofox_ui.R +++ b/pvactools/tools/pvacview/neofox_ui.R @@ -1,3 +1,7 @@ +# ui.R +library(shiny) +library(plotly) + neofox_tab <- tabItem("neofox", tabsetPanel(type = "tabs", id = "neofox_tabs", tabPanel(title = "Upload Data", value = "neofox_upload", @@ -37,8 +41,10 @@ neofox_tab <- tabItem("neofox", #selectInput("neofox_page_length", "Number of entries displayed per page:", selected = "10", c("10", "20", "50", "100"), width = "280px"), DTOutput("neofoxTable") %>% withSpinner(color = "#8FCCFA"), span("Currently investigating row(s): ", verbatimTextOutput("neofox_selected")), - style = "overflow-x: scroll;font-size:100%" + style = "overflow-x: scroll;font-size:100%", + "* indicates variable of interested designated by authors" ) + ), fluidRow( @@ -46,29 +52,41 @@ neofox_tab <- tabItem("neofox", title = "Data Visualization", status = "primary", solidHeader = TRUE, collapsible = TRUE, h4("Violin Plots showing distribution of various neoantigen features for selected variants."), uiOutput("noefox_features_ui"), - plotOutput(outputId = "neofox_violin_plots_row1") %>% withSpinner(color = "#8FCCFA") + plotOutput(outputId = "neofox_violin_plots_row1") %>% withSpinner(color = "#8FCCFA"), + "* indicates variable of interested designated by authors" ) + ), fluidRow( box(width = 12, title = "Dynamic Scatter Plot", status = "primary", solidHeader = TRUE, collapsible = TRUE, h4("Scatter plot to explore characteristics of data"), - - sidebarLayout( - sidebarPanel( - uiOutput("noefox_features_ui1"), - uiOutput("noefox_features_ui2"), - uiOutput("noefox_features_ui3"), - uiOutput("noefox_features_ui4") + sidebarPanel( + # variable selection for x-axis + uiOutput("xvrbl"), + uiOutput("xvrbl_log"), + uiOutput("xvrbl_scale"), + # variable selection for y-axis + uiOutput("yvrbl"), + uiOutput("yvrbl_log"), + uiOutput("yvrbl_scale"), + # color + uiOutput("color_noefox"), + uiOutput("min_color"), + uiOutput("max_color"), + # size + uiOutput("size_neofox"), + "* indicates variable of interested designated by authors" ), - mainPanel( - plotOutput("scatter") + align = "center", + plotlyOutput(outputId = "scatter", height = "800px") %>% withSpinner(color = "#8FCCFA"), ) - ) + ) ) + ) ) ) diff --git a/pvactools/tools/pvacview/pvacview.Rproj b/pvactools/tools/pvacview/pvacview.Rproj new file mode 100644 index 000000000..8e3c2ebc9 --- /dev/null +++ b/pvactools/tools/pvacview/pvacview.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/pvactools/tools/pvacview/run.py b/pvactools/tools/pvacview/run.py index 8eec2e8d8..080abb4f6 100644 --- a/pvactools/tools/pvacview/run.py +++ b/pvactools/tools/pvacview/run.py @@ -16,7 +16,7 @@ def define_parser(): def main(args_input = sys.argv[1:]): parser = define_parser() args = parser.parse_args(args_input) - arguments = ['{}'.format(args.r_path), "-e", "shiny::runApp('{}', port=3333)".format(args.pvacseq_dir)] + arguments = ['{}'.format(args.r_path), "-e", "shiny::runApp('{}')".format(args.pvacseq_dir)] response = run(arguments, check=True) if __name__ == '__main__': diff --git a/pvactools/tools/pvacview/server.R b/pvactools/tools/pvacview/server.R index 4ef1b1d6b..aceba8c6e 100644 --- a/pvactools/tools/pvacview/server.R +++ b/pvactools/tools/pvacview/server.R @@ -1,3 +1,4 @@ +# Developement library(shiny) library(ggplot2) library(DT) @@ -7,7 +8,14 @@ library(tibble) library(tidyr) library(plyr) library(dplyr) -library("stringr") +library("stringr") +library(grid) +library(gridExtra) +library(shinyWidgets) +library(plotly) +library(tidyverse) +library(colourpicker) + source("anchor_and_helper_functions.R", local = TRUE) source("styling.R") @@ -18,7 +26,7 @@ options(shiny.host = '127.0.0.1') options(shiny.port = 3333) server <- shinyServer(function(input, output, session) { - + ##############################DATA UPLOAD TAB################################### ## helper function defined for generating shinyInputs in mainTable (Evaluation dropdown menus) shinyInput <- function(data, FUN, len, id, ...) { @@ -59,7 +67,7 @@ server <- shinyServer(function(input, output, session) { use_allele_specific_binding_thresholds = NULL, aggregate_inclusion_binding_threshold = NULL, percentile_threshold = NULL, - allele_specific_binding_thresholds = NULL, + allele_specific_binding_thresholds = NULL, allele_expr = NULL, anchor_mode = NULL, anchor_contribution = NULL, @@ -68,7 +76,7 @@ server <- shinyServer(function(input, output, session) { ) #Option 1: User uploaded main aggregate report file observeEvent(input$mainDataInput$datapath, { - session$sendCustomMessage("unbind-DT", "mainTable") + # session$sendCustomMessage("unbind-DT", "mainTable") # KEPT COMMENTED DESPITE BEING IN NEWER VERSION OF PVACVIEW mainData <- read.table(input$mainDataInput$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) colnames(mainData) <- mainData[1, ] mainData <- mainData[-1, ] @@ -86,16 +94,17 @@ server <- shinyServer(function(input, output, session) { observeEvent(input$metricsDataInput, { df$metricsData <- fromJSON(input$metricsDataInput$datapath) df$binding_threshold <- df$metricsData$`binding_threshold` - df$use_allele_specific_binding_thresholds <- df$metricsData$`use_allele_specific_binding_thresholds` - df$allele_specific_binding_thresholds <- df$metricsData$`allele_specific_binding_thresholds` - df$aggregate_inclusion_binding_threshold <- df$metricsData$`aggregate_inclusion_binding_threshold` - df$percentile_threshold <- df$metricsData$`percentile_threshold` + df$use_allele_specific_binding_thresholds <- df$metricsData$`use_allele_specific_binding_thresholds` + df$allele_specific_binding_thresholds <- df$metricsData$`allele_specific_binding_thresholds` + df$aggregate_inclusion_binding_threshold <- df$metricsData$`aggregate_inclusion_binding_threshold` + df$percentile_threshold <- df$metricsData$`percentile_threshold` df$dna_cutoff <- df$metricsData$vaf_clonal df$allele_expr <- df$metricsData$allele_expr_threshold df$anchor_mode <- ifelse(df$metricsData$`allele_specific_anchors`, "allele-specific", "default") df$allele_specific_anchors <- df$metricsData$`allele_specific_anchors` df$anchor_contribution <- df$metricsData$`anchor_contribution_threshold` - hla <- df$metricsData$alleles + + hla <- df$metricsData$alleles converted_hla_names <- unlist(lapply(hla, function(x) { if (grepl("HLA-", x)) { strsplit(x, "HLA-")[[1]][2] @@ -103,6 +112,8 @@ server <- shinyServer(function(input, output, session) { x } })) + + if (!("Ref Match" %in% colnames(df$mainTable))) { df$mainTable$`Ref Match` <- "Not Run" } @@ -116,10 +127,22 @@ server <- shinyServer(function(input, output, session) { df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) } df$mainTable <- df$mainTable[, columns_needed] - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode, df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold)) + + df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) + tier_numbers(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, + x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], + df$anchor_mode, df$allele_specific_binding_thresholds, + df$use_allele_specific_binding_thresholds, df$binding_threshold)) + df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) rownames(df$comments) <- df$mainTable$ID - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold, x["Allele"], x["IC50 MT"])) + + df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) + scale_binding_affinity(df$allele_specific_binding_thresholds, + df$use_allele_specific_binding_thresholds, + df$binding_threshold, x["Allele"], x["IC50 MT"])) + + df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse(is.null(df$percentile_threshold), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) df$mainTable$`Bad TSL` <- apply(df$mainTable, 1, function(x) {x["TSL"] == "NA" | (x["TSL"] != "NA" & x["TSL"] != "Not Supported" & x["TSL"] > df$metricsData$maximum_transcript_support_level)}) df$mainTable$`Col RNA Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Expr"]), 0, x["RNA Expr"])}) @@ -149,107 +172,107 @@ server <- shinyServer(function(input, output, session) { df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) }) #Option 2: Load from HCC1395 demo data from github - observeEvent(input$loadDefaultmain, { - ## Class I demo aggregate report - session$sendCustomMessage("unbind-DT", "mainTable") - data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/4ab3139a92d314da7b207e009fd8a1e4715a8166/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_I.all_epitopes.aggregated.tsv") - mainData <- read.table(text = data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - mainData$`Eval` <- shinyInput(mainData, selectInput, nrow(mainData), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - mainData$Select <- shinyInputSelect(actionButton, nrow(mainData), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') - mainData$`IC50 MT` <- as.numeric(mainData$`IC50 MT`) - mainData$`%ile MT` <- as.numeric(mainData$`%ile MT`) - mainData$`RNA Depth` <- as.integer(mainData$`RNA Depth`) - mainData$`TSL`[is.na(mainData$`TSL`)] <- "NA" - df$mainTable <- mainData - ## Class I demo metrics file - metricsdata <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/4ab3139a92d314da7b207e009fd8a1e4715a8166/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_I.all_epitopes.aggregated.metrics.json") - df$metricsData <- fromJSON(txt = metricsdata) - df$binding_threshold <- df$metricsData$`binding_threshold` - df$allele_specific_binding_thresholds <- df$metricsData$`allele_specific_binding_thresholds` - df$use_allele_specific_binding_thresholds <- df$metricsData$`use_allele_specific_binding_thresholds` - df$aggregate_inclusion_binding_threshold <- df$metricsData$`aggregate_inclusion_binding_threshold` - df$percentile_threshold <- df$metricsData$`percentile_threshold` - df$dna_cutoff <- df$metricsData$vaf_clonal - df$allele_expr <- df$metricsData$allele_expr_threshold - df$anchor_mode <- ifelse(df$metricsData$`allele_specific_anchors`, "allele-specific", "default") - df$allele_specific_anchors <- df$metricsData$`allele_specific_anchors` - df$anchor_contribution <- df$metricsData$`anchor_contribution_threshold` - hla <- df$metricsData$alleles - converted_hla_names <- unlist(lapply(hla, function(x) { - if (grepl("HLA-", x)) { - strsplit(x, "HLA-")[[1]][2] - } else { - x - } - })) - if (!("Ref Match" %in% colnames(df$mainTable))) { - df$mainTable$`Ref Match` <- "Not Run" - } - columns_needed <- c("ID", converted_hla_names, "Gene", "AA Change", "Num Passing Transcripts", "Best Peptide", "Best Transcript", "TSL", "Allele", - "Pos", "Prob Pos", "Num Passing Peptides", "IC50 MT", "IC50 WT", "%ile MT", "%ile WT", "RNA Expr", "RNA VAF", - "Allele Expr", "RNA Depth", "DNA VAF", "Tier", "Ref Match", "Evaluation", "Eval", "Select") - if ("Comments" %in% colnames(df$mainTable)) { - columns_needed <- c(columns_needed, "Comments") - df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) - }else { - df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) - } - df$mainTable <- df$mainTable[, columns_needed] - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode, df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold)) - df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) - if ("Comments" %in% colnames(df$mainTable)) { - df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) - }else { - df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) - } - rownames(df$comments) <- df$mainTable$ID - ## Class II additional demo aggregate report - add_data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/4ab3139a92d314da7b207e009fd8a1e4715a8166/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_II.all_epitopes.aggregated.tsv") - addData <- read.table(text = add_data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(addData) <- addData[1, ] - addData <- addData[-1, ] - row.names(addData) <- NULL - df$additionalData <- addData - ## Hotspot gene list autoload - gene_data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/4ab3139a92d314da7b207e009fd8a1e4715a8166/pvactools/tools/pvacview/data/cancer_census_hotspot_gene_list.tsv") - gene_list <- read.table(text = gene_data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - df$gene_list <- gene_list - df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold, x["Allele"], x["IC50 MT"])) - df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse(is.null(df$percentile_threshold), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) - df$mainTable$`Bad TSL` <- apply(df$mainTable, 1, function(x) {x["TSL"] == "NA" | (x["TSL"] != "NA" & x["TSL"] != "Not Supported" & x["TSL"] > df$metricsData$maximum_transcript_support_level)}) - df$mainTable$`Col RNA Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Expr"]), 0, x["RNA Expr"])}) - df$mainTable$`Col RNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA VAF"]), 0, x["RNA VAF"])}) - df$mainTable$`Col Allele Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["Allele Expr"]), 0, x["Allele Expr"])}) - df$mainTable$`Col RNA Depth` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Depth"]), 0, x["RNA Depth"])}) - df$mainTable$`Col DNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["DNA VAF"]), 0, x["DNA VAF"])}) - if (is.null(df$percentile_threshold)) { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) - }else { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) - } - df$mainTable$`Has Prob Pos` <- apply(df$mainTable, 1, function(x) {ifelse(x["Prob Pos"] != "None", TRUE, FALSE)}) - updateTabItems(session, "tabs", "explore") - }) - ##Clear file inputs if demo data load button is clicked - output$aggregate_report_ui <- renderUI({ - input$loadDefaultmain - fileInput(inputId = "mainDataInput", label = "1. Neoantigen Candidate Aggregate Report (tsv required)", - accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) - }) - output$metrics_ui <- renderUI({ - input$loadDefaultmain - fileInput(inputId = "metricsDataInput", label = "2. Neoantigen Candidate Metrics file (json required)", - accept = c("application/json", ".json")) - }) - output$add_file_ui <- renderUI({ - input$loadDefaultmain - fileInput(inputId = "additionalDataInput", label = "3. Additional Neoantigen Candidate Aggregate Report (tsv required)", - accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) - }) + observeEvent(input$loadDefaultmain, { + ## Class I demo aggregate report + # session$sendCustomMessage("unbind-DT", "mainTable") # THIS LINE IS IN THE MOST UPDATED VERSION OF PVACVIEW BUT PREVENTS NEOFOX/PVAC TO BEING LOADED AT THE SAME TIME + data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/4ab3139a92d314da7b207e009fd8a1e4715a8166/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_I.all_epitopes.aggregated.tsv") + mainData <- read.table(text = data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) + colnames(mainData) <- mainData[1, ] + mainData <- mainData[-1, ] + row.names(mainData) <- NULL + mainData$`Eval` <- shinyInput(mainData, selectInput, nrow(mainData), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") + mainData$Select <- shinyInputSelect(actionButton, nrow(mainData), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') + mainData$`IC50 MT` <- as.numeric(mainData$`IC50 MT`) + mainData$`%ile MT` <- as.numeric(mainData$`%ile MT`) + mainData$`RNA Depth` <- as.integer(mainData$`RNA Depth`) + mainData$`TSL`[is.na(mainData$`TSL`)] <- "NA" + df$mainTable <- mainData + ## Class I demo metrics file + metricsdata <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/4ab3139a92d314da7b207e009fd8a1e4715a8166/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_I.all_epitopes.aggregated.metrics.json") + df$metricsData <- fromJSON(txt = metricsdata) + df$binding_threshold <- df$metricsData$`binding_threshold` + df$allele_specific_binding_thresholds <- df$metricsData$`allele_specific_binding_thresholds` + df$use_allele_specific_binding_thresholds <- df$metricsData$`use_allele_specific_binding_thresholds` + df$aggregate_inclusion_binding_threshold <- df$metricsData$`aggregate_inclusion_binding_threshold` + df$percentile_threshold <- df$metricsData$`percentile_threshold` + df$dna_cutoff <- df$metricsData$vaf_clonal + df$allele_expr <- df$metricsData$allele_expr_threshold + df$anchor_mode <- ifelse(df$metricsData$`allele_specific_anchors`, "allele-specific", "default") + df$allele_specific_anchors <- df$metricsData$`allele_specific_anchors` + df$anchor_contribution <- df$metricsData$`anchor_contribution_threshold` + hla <- df$metricsData$alleles + converted_hla_names <- unlist(lapply(hla, function(x) { + if (grepl("HLA-", x)) { + strsplit(x, "HLA-")[[1]][2] + } else { + x + } + })) + if (!("Ref Match" %in% colnames(df$mainTable))) { + df$mainTable$`Ref Match` <- "Not Run" + } + columns_needed <- c("ID", converted_hla_names, "Gene", "AA Change", "Num Passing Transcripts", "Best Peptide", "Best Transcript", "TSL", "Allele", + "Pos", "Prob Pos", "Num Passing Peptides", "IC50 MT", "IC50 WT", "%ile MT", "%ile WT", "RNA Expr", "RNA VAF", + "Allele Expr", "RNA Depth", "DNA VAF", "Tier", "Ref Match", "Evaluation", "Eval", "Select") + if ("Comments" %in% colnames(df$mainTable)) { + columns_needed <- c(columns_needed, "Comments") + df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) + }else { + df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) + } + df$mainTable <- df$mainTable[, columns_needed] + df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode, df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold)) + df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) + if ("Comments" %in% colnames(df$mainTable)) { + df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) + }else { + df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) + } + rownames(df$comments) <- df$mainTable$ID + ## Class II additional demo aggregate report + add_data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/4ab3139a92d314da7b207e009fd8a1e4715a8166/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_II.all_epitopes.aggregated.tsv") + addData <- read.table(text = add_data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) + colnames(addData) <- addData[1, ] + addData <- addData[-1, ] + row.names(addData) <- NULL + df$additionalData <- addData + ## Hotspot gene list autoload + gene_data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/4ab3139a92d314da7b207e009fd8a1e4715a8166/pvactools/tools/pvacview/data/cancer_census_hotspot_gene_list.tsv") + gene_list <- read.table(text = gene_data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) + df$gene_list <- gene_list + df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) + df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold, x["Allele"], x["IC50 MT"])) + df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse(is.null(df$percentile_threshold), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) + df$mainTable$`Bad TSL` <- apply(df$mainTable, 1, function(x) {x["TSL"] == "NA" | (x["TSL"] != "NA" & x["TSL"] != "Not Supported" & x["TSL"] > df$metricsData$maximum_transcript_support_level)}) + df$mainTable$`Col RNA Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Expr"]), 0, x["RNA Expr"])}) + df$mainTable$`Col RNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA VAF"]), 0, x["RNA VAF"])}) + df$mainTable$`Col Allele Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["Allele Expr"]), 0, x["Allele Expr"])}) + df$mainTable$`Col RNA Depth` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Depth"]), 0, x["RNA Depth"])}) + df$mainTable$`Col DNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["DNA VAF"]), 0, x["DNA VAF"])}) + if (is.null(df$percentile_threshold)) { + df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) + }else { + df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) + } + df$mainTable$`Has Prob Pos` <- apply(df$mainTable, 1, function(x) {ifelse(x["Prob Pos"] != "None", TRUE, FALSE)}) + updateTabItems(session, "tabs", "explore") + }) + ##Clear file inputs if demo data load button is clicked + output$aggregate_report_ui <- renderUI({ + input$loadDefaultmain + fileInput(inputId = "mainDataInput", label = "1. Neoantigen Candidate Aggregate Report (tsv required)", + accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) + }) + output$metrics_ui <- renderUI({ + input$loadDefaultmain + fileInput(inputId = "metricsDataInput", label = "2. Neoantigen Candidate Metrics file (json required)", + accept = c("application/json", ".json")) + }) + output$add_file_ui <- renderUI({ + input$loadDefaultmain + fileInput(inputId = "additionalDataInput", label = "3. Additional Neoantigen Candidate Aggregate Report (tsv required)", + accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) + }) ##Visualize button observeEvent(input$visualize, { updateTabItems(session, "tabs", "explore") @@ -296,43 +319,43 @@ server <- shinyServer(function(input, output, session) { }) #reactions for once "regenerate table" command is submitted observeEvent(input$submit, { - session$sendCustomMessage("unbind-DT", "mainTable") - df$binding_threshold <- input$binding_threshold - df$use_allele_specific_binding_thresholds <- input$allele_specific_binding - df$percentile_threshold <- input$percentile_threshold - df$dna_cutoff <- input$dna_cutoff - df$allele_expr <- input$allele_expr - df$allele_specific_anchors <- input$use_anchor + session$sendCustomMessage("unbind-DT", "mainTable") + df$binding_threshold <- input$binding_threshold + df$use_allele_specific_binding_thresholds <- input$allele_specific_binding + df$percentile_threshold <- input$percentile_threshold + df$dna_cutoff <- input$dna_cutoff + df$allele_expr <- input$allele_expr + df$allele_specific_anchors <- input$use_anchor + df$anchor_contribution <- input$anchor_contribution + df$mainTable$`Evaluation` <- shinyValue("selecter_", nrow(df$mainTable), df$mainTable) + if (input$use_anchor) { + df$anchor_mode <- "allele-specific" df$anchor_contribution <- input$anchor_contribution - df$mainTable$`Evaluation` <- shinyValue("selecter_", nrow(df$mainTable), df$mainTable) - if (input$use_anchor) { - df$anchor_mode <- "allele-specific" - df$anchor_contribution <- input$anchor_contribution - }else { - df$anchor_mode <- "default" - } - df$mainTable$`Tier` <- apply(df$mainTable, 1, function(x) tier(x, df$anchor_contribution, input$dna_cutoff, input$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode, df$use_allele_specific_binding_thresholds, df$binding_threshold)) - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, input$dna_cutoff, input$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode, df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold)) - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold, x["Allele"], x["IC50 MT"])) - df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse((is.null(df$percentile_threshold) || is.na(df$percentile_threshold)), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) - if (is.null(df$percentile_threshold) || is.na(df$percentile_threshold)) { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) - }else { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) - } - tier_sorter <- c("Pass", "LowExpr", "Anchor", "Subclonal", "Poor", "NoExpr") - df$mainTable$`Rank_ic50` <- NA - df$mainTable$`Rank_expr` <- NA - df$mainTable$`Rank_ic50` <- rank(as.numeric(df$mainTable$`IC50 MT`), ties.method = "first") - df$mainTable$`Rank_expr` <- rank(desc(as.numeric(df$mainTable$`Allele Expr`)), ties.method = "first") - df$mainTable$`Rank` <- df$mainTable$`Rank_ic50` + df$mainTable$`Rank_expr` - df$mainTable <- df$mainTable %>% - arrange(factor(Tier, levels = tier_sorter), Rank) - df$mainTable$`Rank` <- NULL - df$mainTable$`Rank_ic50` <- NULL - df$mainTable$`Rank_expr` <- NULL - df$mainTable$Select <- shinyInputSelect(actionButton, nrow(df$mainTable), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') - df$mainTable$`Eval` <- shinyInput(df$mainTable, selectInput, nrow(df$mainTable), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") + }else { + df$anchor_mode <- "default" + } + df$mainTable$`Tier` <- apply(df$mainTable, 1, function(x) tier(x, df$anchor_contribution, input$dna_cutoff, input$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode, df$use_allele_specific_binding_thresholds, df$binding_threshold)) + df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, input$dna_cutoff, input$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode, df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold)) + df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold, x["Allele"], x["IC50 MT"])) + df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse((is.null(df$percentile_threshold) || is.na(df$percentile_threshold)), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) + if (is.null(df$percentile_threshold) || is.na(df$percentile_threshold)) { + df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) + }else { + df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) + } + tier_sorter <- c("Pass", "LowExpr", "Anchor", "Subclonal", "Poor", "NoExpr") + df$mainTable$`Rank_ic50` <- NA + df$mainTable$`Rank_expr` <- NA + df$mainTable$`Rank_ic50` <- rank(as.numeric(df$mainTable$`IC50 MT`), ties.method = "first") + df$mainTable$`Rank_expr` <- rank(desc(as.numeric(df$mainTable$`Allele Expr`)), ties.method = "first") + df$mainTable$`Rank` <- df$mainTable$`Rank_ic50` + df$mainTable$`Rank_expr` + df$mainTable <- df$mainTable %>% + arrange(factor(Tier, levels = tier_sorter), Rank) + df$mainTable$`Rank` <- NULL + df$mainTable$`Rank_ic50` <- NULL + df$mainTable$`Rank_expr` <- NULL + df$mainTable$Select <- shinyInputSelect(actionButton, nrow(df$mainTable), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') + df$mainTable$`Eval` <- shinyInput(df$mainTable, selectInput, nrow(df$mainTable), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") }) #reset tier-ing with original parameters observeEvent(input$reset_params, { @@ -405,13 +428,13 @@ server <- shinyServer(function(input, output, session) { data <- data.frame( "HLA Alleles" = df$metricsData$alleles, "Binding Cutoffs" = unlist(lapply(df$metricsData$alleles, function(x) { - if (x %in% names(df$metricsData$allele_specific_binding_thresholds)) { - df$metricsData$allele_specific_binding_thresholds[[x]] - } else { - df$metricsData$binding_threshold - } + if (x %in% names(df$metricsData$allele_specific_binding_thresholds)) { + df$metricsData$allele_specific_binding_thresholds[[x]] + } else { + df$metricsData$binding_threshold + } } - ))) + ))) } else { data <- data.frame( "HLA Alleles" = df$metricsData$alleles, @@ -446,28 +469,28 @@ server <- shinyServer(function(input, output, session) { return(datatable(data.frame("Aggregate Report" = character()))) }else { datatable(df$mainTable[, !(colnames(df$mainTable) == "ID") & !(colnames(df$mainTable) == "Evaluation") & !(colnames(df$mainTable) == "Comments")], - escape = FALSE, callback = JS(callback(hla_count(), df$metricsData$mt_top_score_metric)), class = "stripe", - options = list(lengthChange = FALSE, dom = "Bfrtip", pageLength = df$pageLength, - columnDefs = list(list(defaultContent = "NA", targets = c(hla_count() + 10, (hla_count() + 12):(hla_count() + 17))), - list(className = "dt-center", targets = c(0:hla_count() - 1)), list(visible = FALSE, targets = c(1:(hla_count()-1), (hla_count()+2), (hla_count()+4), -1:-12)), - list(orderable = TRUE, targets = 0)), buttons = list(I("colvis")), - initComplete = htmlwidgets::JS( - "function(settings, json) {", - paste("$(this.api().table().header()).css({'font-size': '", "10pt", "'});"), - "}"), - rowCallback = JS(rowcallback(hla_count(), df$selectedRow - 1)), - preDrawCallback = JS("function() { + escape = FALSE, callback = JS(callback(hla_count(), df$metricsData$mt_top_score_metric)), class = "stripe", + options = list(lengthChange = FALSE, dom = "Bfrtip", pageLength = df$pageLength, + columnDefs = list(list(defaultContent = "NA", targets = c(hla_count() + 10, (hla_count() + 12):(hla_count() + 17))), + list(className = "dt-center", targets = c(0:hla_count() - 1)), list(visible = FALSE, targets = c(1:(hla_count()-1), (hla_count()+2), (hla_count()+4), -1:-12)), + list(orderable = TRUE, targets = 0)), buttons = list(I("colvis")), + initComplete = htmlwidgets::JS( + "function(settings, json) {", + paste("$(this.api().table().header()).css({'font-size': '", "10pt", "'});"), + "}"), + rowCallback = JS(rowcallback(hla_count(), df$selectedRow - 1)), + preDrawCallback = JS("function() { Shiny.unbindAll(this.api().table().node()); }"), - drawCallback = JS("function() { + drawCallback = JS("function() { Shiny.bindAll(this.api().table().node()); } ")), - selection = "none", - extensions = c("Buttons")) + selection = "none", + extensions = c("Buttons")) } %>% formatStyle("IC50 MT", "Scaled BA", backgroundColor = styleInterval(c(0.1, 0.2, 0.4, 0.6, 0.8, 1, 1.2, 1.4, 1.6, 1.8, 2), - c("#68F784", "#60E47A", "#58D16F", "#4FBD65", "#47AA5A", "#3F9750", "#F3F171", "#F3E770", "#F3DD6F", "#F0CD5B", "#F1C664", "#FF9999")) - , fontWeight = styleInterval(c(1000), c("normal", "bold")), border = styleInterval(c(1000), c("normal", "2px solid red"))) + c("#68F784", "#60E47A", "#58D16F", "#4FBD65", "#47AA5A", "#3F9750", "#F3F171", "#F3E770", "#F3DD6F", "#F0CD5B", "#F1C664", "#FF9999")) + , fontWeight = styleInterval(c(1000), c("normal", "bold")), border = styleInterval(c(1000), c("normal", "2px solid red"))) %>% formatStyle("%ile MT", "Scaled percentile", backgroundColor = styleInterval(c(0.2, 0.4, 0.6, 0.8, 1, 1.25, 1.5, 1.75, 2), - c("#68F784", "#60E47A", "#58D16F", "#4FBD65", "#47AA5A", "#F3F171", "#F3E770", "#F3DD6F", "#F1C664", "#FF9999"))) + c("#68F784", "#60E47A", "#58D16F", "#4FBD65", "#47AA5A", "#F3F171", "#F3E770", "#F3DD6F", "#F1C664", "#FF9999"))) %>% formatStyle("Tier", color = styleEqual(c("Pass", "Poor", "Anchor", "Subclonal", "LowExpr", "NoExpr"), c("green", "orange", "#b0b002", "#D4AC0D", "salmon", "red"))) %>% formatStyle(c("RNA VAF"), "Col RNA VAF", background = styleColorBar(range(0, 1), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") %>% formatStyle(c("DNA VAF"), "Col DNA VAF", background = styleColorBar(range(0, 1), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") @@ -695,7 +718,7 @@ server <- shinyServer(function(input, output, session) { } df$metricsData[[selectedID()]]$sets[selection] }) - + ##transcripts table displaying transcript id and transcript expression values output$transcriptsTable <- renderDT({ withProgress(message = "Loading Transcripts Table", value = 0, { @@ -714,7 +737,7 @@ server <- shinyServer(function(input, output, session) { datatable(GB_transcripts, options = list(columnDefs = list(list(defaultContent = "N/A", targets = c(3)), list(visible = FALSE, targets = c(-1))))) %>% formatStyle(c("Transcripts in Selected Set"), "Best Transcript", backgroundColor = styleEqual(c(TRUE), c("#98FF98"))) }else { - GB_transcripts <- data.frame("Transcript" = character(), "Expression" = character(), "TSL" = character(), "Biotype" = character(), "Length" = character()) + GB_transcripts <- data.frame("Transcript" = character(), "Expression" = character(), "TSL" = character(), "Biotype" = character(), "Transcript Length (#AA)"= character(), "Length" = character()) incProgress(0.5) names(GB_transcripts) <- c("Transcripts in Selected Set", "Expression", "Transcript Support Level", "Biotype", "Transcript Length (#AA)", "Best Transcript") incProgress(0.5) @@ -722,7 +745,7 @@ server <- shinyServer(function(input, output, session) { } }) }) - + ##display transcript expression output$metricsTextTranscript <- renderText({ if (length(df$metricsData[[selectedID()]]$sets) != 0) { @@ -758,12 +781,12 @@ server <- shinyServer(function(input, output, session) { dtable <- datatable(do.call("rbind", lapply(peptide_names, table_formatting, peptide_data)), options = list( pageLength = 10, columnDefs = list(list(defaultContent = "X", - targets = c(2:hla_count() + 1)), - list(orderable = TRUE, targets = 0), - list(visible = FALSE, targets = c(-1, -2))), + targets = c(2:hla_count() + 1)), + list(orderable = TRUE, targets = 0), + list(visible = FALSE, targets = c(-1, -2))), rowCallback = JS("function(row, data, index, rowId) {", - "if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {", - 'row.style.backgroundColor = "#E0E0E0";', "}", "}") + "if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {", + 'row.style.backgroundColor = "#E0E0E0";', "}", "}") ), selection = list(mode = "single", selected = "1"), style="bootstrap") %>% @@ -982,15 +1005,15 @@ server <- shinyServer(function(input, output, session) { output$bindingDatatable <- renderDT({ withProgress(message = "Loading binding datatable", value = 0, { if (length(df$metricsData[[selectedID()]]$sets) != 0) { - binding_data <- bindingScoreDataIC50() - names(binding_data)[names(binding_data) == "Score"] <- "IC50 Score" - binding_data["% Score"] <- bindingScoreDataPercentile()["Score"] - binding_data["Score"] <- paste(round(as.numeric(binding_data$`IC50 Score`), 2), " (%: ", round(as.numeric(binding_data$`% Score`), 2), ")", sep = "") - binding_data["IC50 Score"] <- NULL - binding_data["% Score"] <- NULL - binding_reformat <- dcast(binding_data, HLA_allele + Mutant ~ algorithms, value.var = "Score") - incProgress(1) - dtable <- datatable(binding_reformat, options = list( + binding_data <- bindingScoreDataIC50() + names(binding_data)[names(binding_data) == "Score"] <- "IC50 Score" + binding_data["% Score"] <- bindingScoreDataPercentile()["Score"] + binding_data["Score"] <- paste(round(as.numeric(binding_data$`IC50 Score`), 2), " (%: ", round(as.numeric(binding_data$`% Score`), 2), ")", sep = "") + binding_data["IC50 Score"] <- NULL + binding_data["% Score"] <- NULL + binding_reformat <- dcast(binding_data, HLA_allele + Mutant ~ algorithms, value.var = "Score") + incProgress(1) + dtable <- datatable(binding_reformat, options = list( pageLength = 10, lengthMenu = c(10), rowCallback = JS("function(row, data, index, rowId) {", @@ -1058,8 +1081,8 @@ server <- shinyServer(function(input, output, session) { pageLength = 10, lengthMenu = c(10), rowCallback = JS("function(row, data, index, rowId) {", - "if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {", - 'row.style.backgroundColor = "#E0E0E0";', "}", "}") + "if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {", + 'row.style.backgroundColor = "#E0E0E0";', "}", "}") )) %>% formatStyle("Mutant", fontWeight = styleEqual("MT", "bold"), color = styleEqual("MT", "#E74C3C")) dtable }else { @@ -1072,13 +1095,13 @@ server <- shinyServer(function(input, output, session) { } }) }) - + ##updating reference matches for selected peptide output$hasReferenceMatchData <- reactive({ if (is.null(df$metricsData[[selectedID()]]$reference_matches)) { - "Reference Similarity not run" + "Reference Similarity not run" } else { - "" + "" } }) referenceMatchData <- reactive({ @@ -1090,34 +1113,34 @@ server <- shinyServer(function(input, output, session) { }) output$referenceMatchHitCount <- reactive({ if (is.null(df$metricsData[[selectedID()]]$reference_matches)) { - "N/A" + "N/A" } else { - df$metricsData[[selectedID()]]$reference_matches$count + df$metricsData[[selectedID()]]$reference_matches$count } }) output$referenceMatchQuerySequence <- reactive({ if (is.null(df$metricsData[[selectedID()]]$reference_matches)) { - "N/A" + "N/A" } else { - df$metricsData[[selectedID()]]$reference_matches$query_peptide + df$metricsData[[selectedID()]]$reference_matches$query_peptide } }) output$referenceMatchDatatable <- renderDT({ withProgress(message = "Loading reference match datatable", value = 0, { - reference_match_data <- referenceMatchData() - if (!is.null(reference_match_data)) { - incProgress(1) - dtable <- datatable(reference_match_data, options = list( - pageLength = 10, - lengthMenu = c(10) - ), - style="bootstrap") %>% - formatStyle("Matched Peptide", fontFamily="monospace") - dtable - } else { - incProgress(1) - datatable(data.frame("Reference Matches Datatable" = character())) - } + reference_match_data <- referenceMatchData() + if (!is.null(reference_match_data)) { + incProgress(1) + dtable <- datatable(reference_match_data, options = list( + pageLength = 10, + lengthMenu = c(10) + ), + style="bootstrap") %>% + formatStyle("Matched Peptide", fontFamily="monospace") + dtable + } else { + incProgress(1) + datatable(data.frame("Reference Matches Datatable" = character())) + } }) }) ##Best Peptide with mutated positions marked @@ -1160,12 +1183,12 @@ server <- shinyServer(function(input, output, session) { print(p2) }) }, height = 20, width = function(){ - selectedPeptide <- if (is.null(df$selectedRow)) { - df$mainTable$`Best Peptide`[1] - }else { - df$mainTable$`Best Peptide`[df$selectedRow] - } - nchar(selectedPeptide) * 20 + selectedPeptide <- if (is.null(df$selectedRow)) { + df$mainTable$`Best Peptide`[1] + }else { + df$mainTable$`Best Peptide`[df$selectedRow] + } + nchar(selectedPeptide) * 20 } ) ##Best Peptide with best peptide highlighted and mutated positions marked output$referenceMatchQueryPlot <- renderPlot({ @@ -1239,7 +1262,7 @@ server <- shinyServer(function(input, output, session) { return(nchar(df$metricsData[[selectedID()]]$reference_matches$query_peptide) * 20) } } ) -##############################EXPORT TAB############################################## + ##############################EXPORT TAB############################################## #evalutation overview table output$checked <- renderTable({ if (is.null(df$mainTable)) { @@ -1257,8 +1280,8 @@ server <- shinyServer(function(input, output, session) { return() } colsToDrop <- colnames(df$mainTable) %in% c("Evaluation", "Eval", "Select", "Scaled BA", "Scaled percentile", "Tier Count", "Bad TSL", - "Comments", "Gene of Interest", "Bad TSL", "Col RNA Expr", "Col RNA VAF", "Col Allele Expr", - "Col RNA Depth", "Col DNA VAF", "Percentile Fail", "Has Prob Pos") + "Comments", "Gene of Interest", "Bad TSL", "Col RNA Expr", "Col RNA VAF", "Col Allele Expr", + "Col RNA Depth", "Col DNA VAF", "Percentile Fail", "Has Prob Pos") data <- df$mainTable[, !(colsToDrop)] col_names <- colnames(data) data <- data.frame(data, Evaluation = shinyValue("selecter_", nrow(df$mainTable), df$mainTable)) @@ -1267,24 +1290,840 @@ server <- shinyServer(function(input, output, session) { data <- join(data, comments) data[is.na(data)] <- "NA" data - }, escape = FALSE, server = FALSE, rownames = FALSE, - options = list(dom = "Bfrtip", - buttons = list( - list(extend = "csvHtml5", - filename = input$exportFileName, - fieldSeparator = "\t", - text = "Download as TSV", - extension = ".tsv"), - list(extend = "excel", - filename = input$exportFileName, - text = "Download as excel") + }, escape = FALSE, server = FALSE, rownames = FALSE, + options = list(dom = "Bfrtip", + buttons = list( + list(extend = "csvHtml5", + filename = input$exportFileName, + fieldSeparator = "\t", + text = "Download as TSV", + extension = ".tsv"), + list(extend = "excel", + filename = input$exportFileName, + text = "Download as excel") ), initComplete = htmlwidgets::JS( "function(settings, json) {", paste0("$(this.api().table().header()).css({'font-size': '", "8pt", "'});"), "}") - ), - selection = "none", - extensions = c("Buttons")) + ), + selection = "none", + extensions = c("Buttons")) + + + ### Other Modules ############################################################ + + + ############### NeoFox Tab ########################## + df_neofox <- reactiveValues( + mainTable_neofox = NULL + ) + observeEvent(input$loadDefaultneofox, { + #session$sendCustomMessage("unbind-DT", "neofoxTable") + data_neofox <- "data/test_pt1_neoantigen_candidates_annotated.tsv" + mainData_neofox <- read.table(data_neofox, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) + colnames(mainData_neofox) <- mainData_neofox[1, ] + mainData_neofox <- mainData_neofox[-1, ] + row.names(mainData_neofox) <- NULL + + # Columns that have been reviewed as most interesting + columns_to_star <- c( + "dnaVariantAlleleFrequency", "rnaExpression", "imputedGeneExpression", + "rnaVariantAlleleFrequency", "NetMHCpan_bestRank_rank", "NetMHCpan_bestAffinity_affinity", + "NetMHCpan_bestAffinity_affinityWT", "NetMHCpan_bestRank_rankWT", "PHBR_I", + "NetMHCIIpan_bestRank_rank", "NetMHCIIpan_bestRank_rankWT", "PHBR_II", "Amplitude_MHCI_bestAffinity", + "Pathogensimiliarity_MHCI_bestAffinity9mer", "DAI_MHCI_bestAffinity", "Tcell_predictor", + "Selfsimilarity_MHCI", "Selfsimilarity_MHCII", "IEDB_Immunogenicity_MHCI", "IEDB_Immunogenicity_MHCII", + "MixMHCpred_bestScore_score", "MixMHCpred_bestScore_rank", "MixMHC2pred_bestRank_peptide", + "MixMHC2pred_bestRank_rank", "Dissimilarity_MHCI", "Dissimilarity_MHCII", "Vaxrank_bindingScore", + "PRIME_bestScore_rank", "PRIME_bestScore_score" + ) + + # Check if each column is present in the dataframe and modify the names + for (col_name in columns_to_star) { + if (col_name %in% names(mainData_neofox)) { + new_col_name <- paste0("*", col_name) + names(mainData_neofox)[names(mainData_neofox) == col_name] <- new_col_name + } + } + + df_neofox$mainTable_neofox <- mainData_neofox + updateTabItems(session, "neofox_tabs", "neofox_explore") + }) + output$neofox_upload_ui <- renderUI({ + fileInput(inputId = "neofox_data", label = "NeoFox output table (tsv required)", + accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) + }) + observeEvent(input$neofox_data$datapath, { + #session$sendCustomMessage("unbind-DT", "neofoxTable") + mainData_neofox <- read.table(input$neofox_data$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) + colnames(mainData_neofox) <- mainData_neofox[1, ] + mainData_neofox <- mainData_neofox[-1, ] + row.names(mainData_neofox) <- NULL + df_neofox$mainTable_neofox <- mainData_neofox + }) + observeEvent(input$visualize_neofox, { + updateTabItems(session, "neofox_tabs", "neofox_explore") + updateSliderInput(session,"xvrbl_scale", value = c(min_value, max_value)) + }) + + observeEvent(input$neofox_page_length, { + if (is.null(df_neofox$mainTable_neofox)) { + return() + } + df$pageLength <- as.numeric(input$neofox_page_length) + }) + + output$neofoxTable <- DT::renderDataTable( + if (is.null(df_neofox$mainTable_neofox)) { + return(datatable(data.frame("Annotated Table" = character()))) + } else { + datatable(df_neofox$mainTable_neofox, + escape = FALSE, class = "stripe", + selection = "multiple", + extensions = c("Buttons") + ) + } + ) + output$neofox_selected <- renderText({ + if (is.null(df_neofox$mainTable_neofox)) { + return() + } + input$neofoxTable_rows_selected + }) + + + # Drop down to select what features to show violin plots for + output$noefox_features_ui <- renderUI({ + df <- df_neofox$mainTable_neofox + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + + features <- names(df)[sapply(df, is.numeric)] + sorted_features <- features[order(!grepl("^\\*", features))] + + + default_selection <- c("*IEDB_Immunogenicity_MHCI", "*IEDB_Immunogenicity_MHCII", "*PHBR_I", + "*MixMHCpred_bestScore_score", "*MixMHCpred_bestScore_rank", "*MixMHC2pred_bestRank_peptide") + + pickerInput(inputId = "neofox_features", + label = "Plots to Display", + choices = sorted_features, + selected = default_selection, + options = list(`live-search` = TRUE, "max-options" = 6), + multiple = TRUE + ) + }) + + # Violin Plots + output$neofox_violin_plots_row1 <- renderPlot({ + withProgress(message = "Loading Violin Plots", value = 0, { + if (length(input$neofoxTable_rows_selected) != 0 & length(input$neofox_features) != 0) { + + plot_cols_neofox <- c("mutatedXmer", input$neofox_features) + plot_data_neofox <- df_neofox$mainTable_neofox[, plot_cols_neofox] + plot_data_neofox <- type.convert(plot_data_neofox, as.is = TRUE) + plot_data_neofox[is.na(plot_data_neofox)] <- 0 + + plot_data_neofox$Selected <- "No" + plot_data_neofox[input$neofoxTable_rows_selected, "Selected"] <- "Yes" + reformat_data_neofox <- plot_data_neofox %>% + gather("Feature", "Value", -c("mutatedXmer", "Selected")) + + + p_neofox <- ggplot(reformat_data_neofox, aes(x = "", y = Value)) + geom_violin() + + geom_jitter(data = reformat_data_neofox[reformat_data_neofox["Selected"] == "No", ], aes(color = Selected), size = 1, alpha = 0.5, stroke = 1, position = position_jitter(0.3)) + + geom_jitter(data = reformat_data_neofox[reformat_data_neofox["Selected"] == "Yes", ], aes(color = Selected), size = 2, alpha = 1, stroke = 1, position = position_jitter(0.3)) + + scale_color_manual(values = c("No" = "#939094", "Yes" = "#f42409")) + + labs(x = NULL) + + facet_wrap(~Feature, scales="free", ncol=6) + + theme(strip.text = element_text(size = 15), axis.text = element_text(size = 10), axis.title = element_text(size = 10), axis.ticks = element_line(size = 3), legend.text = element_text(size = 10), legend.title = element_text(size = 10)) + + incProgress(0.5) + print(p_neofox) + }else { + p_neofox <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + + theme_void() + theme(legend.position = "none", panel.border = element_blank()) + incProgress(1) + print(p_neofox) + } + }) + }) + + + # Dynamic scatter plot + output$xvrbl <- renderUI({ + df <- df_neofox$mainTable_neofox + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + + features <- names(df)[sapply(df, is.numeric)] + sorted_features <- features[order(!grepl("^\\*", features))] + + default_selection <- "*NetMHCpan_bestAffinity_affinity" + + pickerInput(inputId = "xvrbl", + label = "X-Axis Variable", + choices = sorted_features, + selected = default_selection, + options = list(`live-search` = TRUE), + multiple = FALSE + ) + }) + + output$xvrbl_log <- renderUI({ + radioButtons( + inputId = "LogX", + choices = c("none", "ln", "log2", "log10", "sqrt"), + label = "Transform", + inline = TRUE + ) + }) + + output$yvrbl <- renderUI({ + df <- df_neofox$mainTable_neofox + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + + features <- names(df)[sapply(df, is.numeric)] + sorted_features <- features[order(!grepl("^\\*", features))] + default_selection <- "*NetMHCpan_bestAffinity_affinityWT" + + pickerInput(inputId = "yvrbl", + label = "Y-Axis Variable", + choices = sorted_features, + selected = default_selection, + options = list(`live-search` = TRUE), + multiple = FALSE + ) + }) + + output$yvrbl_log <- renderUI({ + radioButtons( + inputId = "LogY", + choices = c("none", "ln", "log2", "log10", "sqrt"), + label = "Transform", + inline = TRUE + ) + }) + + output$xvrbl_scale <- renderUI({ + withProgress(message = "Loading Scale", value = 0, { + req(input$xvrbl, input$LogX) # Use req() to check if inputs are not NULL + df <- df_neofox$mainTable_neofox + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + df <- df[is.finite(df[[input$xvrbl]]),] + + # Apply log or sqrt transformation + if (input$LogX == "ln") { + df[[input$xvrbl]] <- log(ifelse(df[[input$xvrbl]] == 0, 1e-10, df[[input$xvrbl]])) + } else if (input$LogX == "log2") { + df[[input$xvrbl]] <- log2(ifelse(df[[input$xvrbl]] == 0, 1e-10, df[[input$xvrbl]])) + } else if (input$LogX == "log10") { + df[[input$xvrbl]] <- log10(ifelse(df[[input$xvrbl]] == 0, 1e-10, df[[input$xvrbl]])) + } else if (input$LogX == "sqrt") { + df[[input$xvrbl]] <- sqrt(ifelse(df[[input$xvrbl]] < 0, 1e-10, df[[input$xvrbl]])) + } else { + df[[input$xvrbl]] <- df[[input$xvrbl]] + } + + df <- df[is.finite(df[[input$xvrbl]]),] + + xvrbl_values <- df[[input$xvrbl]] + range_values <- range(as.numeric(xvrbl_values), na.rm = TRUE) + min_value <- as.numeric(format(round(range_values[1], 2), nsmall = 2)) + max_value <- as.numeric(format(round(range_values[2], 2), nsmall = 2)) + + + # Check if min_value and max_value are equal, set default values + if (min_value == max_value) { + min_value <- min_value - 1 + max_value <- max_value + 1 + } + + sliderInput( + inputId = "xvrbl_scale", + label = "Min/Max", + min = min_value, + max = max_value, + value = c(min_value, max_value), + step = 0.01, + dragRange = TRUE # Allow users to drag the range handles + ) + }) + }) + + output$yvrbl_scale <- renderUI({ + withProgress(message = "Loading Scale", value = 0, { + req(input$yvrbl) # Use req() to check if inputs are not NULL + df <- df_neofox$mainTable_neofox + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + df <- df[is.finite(df[[input$yvrbl]]),] + + # Apply log or sqrt transformation + if (input$LogY == "ln") { + df[[input$yvrbl]] <- log(ifelse(df[[input$yvrbl]] == 0, 1e-10, df[[input$yvrbl]])) + } else if (input$LogY == "log2") { + df[[input$yvrbl]] <- log2(ifelse(df[[input$yvrbl]] == 0, 1e-10, df[[input$yvrbl]])) + } else if (input$LogY == "log10") { + df[[input$yvrbl]] <- log10(ifelse(df[[input$yvrbl]] == 0, 1e-10, df[[input$yvrbl]])) + } else if (input$LogY == "sqrt") { + df[[input$yvrbl]] <- sqrt(ifelse(df[[input$yvrbl]] < 0, 1e-10, df[[input$yvrbl]])) + } else { + df[[input$yvrbl]] <- df[[input$yvrbl]] + } + + + df <- df[is.finite(df[[input$yvrbl]]),] + + yvrbl_values <- df[[input$yvrbl]] + range_values <- range(as.numeric(yvrbl_values), na.rm = TRUE) + min_value <- as.numeric(format(round(range_values[1], 2), nsmall = 2)) + max_value <- as.numeric(format(round(range_values[2], 2), nsmall = 2)) + + + # Check if min_value and max_value are equal, set default values + if (min_value == max_value) { + min_value <- min_value - 1 + max_value <- max_value + 1 + } + + + sliderInput( + inputId = "yvrbl_scale", + label = "Min/Max", + min = min_value, + max = max_value, + value = c(min_value, max_value), + step = 0.01, + dragRange = TRUE # Allow users to drag the range handles + ) + }) + }) + + output$color_noefox <- renderUI({ + df <- df_neofox$mainTable_neofox + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + + features <- names(df)[sapply(df, is.numeric)] + sorted_features <- features[order(!grepl("^\\*", features))] + + default_selection <- "*Tcell_predictor" + pickerInput(inputId = "color_scatter", + label = "Color", + choices = sorted_features, + selected = default_selection, + options = list(`live-search` = TRUE), + multiple = FALSE + ) + }) + + output$size_neofox <- renderUI({ + df <- df_neofox$mainTable_neofox + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + + features <- names(df)[sapply(df, is.numeric)] + sorted_features <- features[order(!grepl("^\\*", features))] + + default_selection <- "*rnaExpression" + pickerInput(inputId = "size_scatter", + label = "Size", + choices = sorted_features, + selected = default_selection, + options = list(`live-search` = TRUE), + multiple = FALSE + ) + }) + + output$min_color <- renderUI({ + colourInput("min_col", "Select min color", "grey") + }) + + output$max_color <- renderUI({ + colourInput("max_col", "Select max color", "purple") + }) + + output$scatter <- renderPlotly({ + withProgress(message = "Loading Scatter Plots", value = 0, { + incProgress(0.5) + if (!is.null(input$xvrbl) & !(is.null(input$yvrbl))) { + df <- df_neofox$mainTable_neofox + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + + + # For input$xvrbl + if (input$LogX == "ln") { + df[[input$xvrbl]] <- log(ifelse(df[[input$xvrbl]] == 0, 1e-10, df[[input$xvrbl]])) + } else if (input$LogX == "log2") { + df[[input$xvrbl]] <- log2(ifelse(df[[input$xvrbl]] == 0, 1e-10, df[[input$xvrbl]])) + } else if (input$LogX == "log10") { + df[[input$xvrbl]] <- log10(ifelse(df[[input$xvrbl]] == 0, 1e-10, df[[input$xvrbl]])) + } else if (input$LogX == "sqrt") { + df[[input$xvrbl]] <- sqrt(ifelse(df[[input$xvrbl]] < 0, 1e-10, df[[input$xvrbl]])) + } else { + df[[input$xvrbl]] <- df[[input$xvrbl]] + } + + # For input$yvrbl + if (input$LogY == "ln") { + df[[input$yvrbl]] <- log(ifelse(df[[input$yvrbl]] == 0, 1e-10, df[[input$yvrbl]])) + } else if (input$LogY == "log2") { + df[[input$yvrbl]] <- log2(ifelse(df[[input$yvrbl]] == 0, 1e-10, df[[input$yvrbl]])) + } else if (input$LogY == "log10") { + df[[input$yvrbl]] <- log10(ifelse(df[[input$yvrbl]] == 0, 1e-10, df[[input$yvrbl]])) + } else if (input$LogY == "sqrt") { + df[[input$yvrbl]] <- sqrt(ifelse(df[[input$yvrbl]] < 0, 1e-10, df[[input$yvrbl]])) + } else { + df[[input$yvrbl]] <- df[[input$yvrbl]] + } + + + df[is.na(df)] <- 0 + + # Filter data based on the slider range + df <- subset(df, df[[input$xvrbl]] >= input$xvrbl_scale[1] & df[[input$xvrbl]] <= input$xvrbl_scale[2]) + df <- subset(df, df[[input$yvrbl]] >= input$yvrbl_scale[1] & df[[input$yvrbl]] <= input$yvrbl_scale[2]) + + + incProgress(0.5) + + scatter_plot <- ggplot(df , aes(x = .data[[input$xvrbl]], y = .data[[input$yvrbl]], + text = paste("Patient:", .data[["patientIdentifier"]], "
", + "Gene:", .data[["gene"]]))) + + geom_point(aes(color = .data[[input$color_scatter]], size = .data[[input$size_scatter]])) + # Correct placement of aes() here + scale_color_gradient(low = input$min_col, high = input$max_col) + + theme(strip.text = element_text(size = 15), axis.text = element_text(size = 10), axis.title = element_text(size = 15), axis.ticks = element_line(size = 3), legend.text = element_text(size = 15), legend.title = element_text(size = 15)) + + scatter_plot <- ggplotly(scatter_plot) + + print(scatter_plot) + } + else { + p <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + + theme_void() + theme(legend.position = "none", panel.border = element_blank()) + scatter_plot <- ggplotly(p) + incProgress(1) + print(scatter_plot) + } + }) + }) + + ############### Custom Tab ########################## + df_custom <- reactiveValues( + selectedRow = 1, + fullData = NULL, + mainTable = NULL, + group_inds = NULL, + metricsData = NULL, + pageLength = 10, + groupBy = NULL, + orderBy = NULL, + peptide_features = NULL + ) + observeEvent(input$loadDefault_Vaxrank, { + data <- "data/vaxrank_output.tsv" + mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) + colnames(mainData) <- mainData[1, ] + mainData <- mainData[-1, ] + row.names(mainData) <- NULL + df_custom$fullData <- mainData + }) + observeEvent(input$loadDefault_Neopredpipe, { + data <- "data/HCC1395Run.neoantigens.txt" + mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) + colnames(mainData) <- mainData[1, ] + mainData <- mainData[-1, ] + row.names(mainData) <- NULL + df_custom$fullData <- mainData + }) + observeEvent(input$loadDefault_antigengarnish, { + data <- "data/ag_test_antigen.tsv" + mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) + colnames(mainData) <- mainData[1, ] + mainData <- mainData[-1, ] + row.names(mainData) <- NULL + df_custom$fullData <- mainData + }) + output$custom_upload_ui <- renderUI({ + fileInput(inputId = "custom_data", label = "Custom input table (tsv required)", + accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) + }) + observeEvent(input$custom_data$datapath, { + mainData <- read.table(input$custom_data$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) + colnames(mainData) <- mainData[1, ] + mainData <- mainData[-1, ] + row.names(mainData) <- NULL + df_custom$fullData <- mainData + }) + + output$custom_group_by_feature_ui <- renderUI({ + df <- df_custom$fullData + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + + features <- as.list(names(df)) + default_selection <- ifelse(length(features) >= 1, features[[1]], "") + + pickerInput(inputId = "feature_1", + label = "Group peptides by", + choices = features, # a list of strings + selected = default_selection, + options = list(`live-search` = TRUE), + multiple = FALSE) + }) + output$custom_order_by_feature_ui <- renderUI({ + df <- df_custom$fullData + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + + features <- names(df)[sapply(df, is.numeric)] + default_selection <- ifelse(length(features) >= 2, features[[2]], "") + + pickerInput(inputId = "feature_2", + label = "Sort peptides by", + choices = features, # a list of strings + selected = default_selection, + options = list(`live-search` = TRUE), + multiple = FALSE) + }) + + output$custom_peptide_features_ui <- renderUI({ + df <- df_custom$fullData + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + + features <- as.list(names(df)) + default_selection <- features[((features != input$feature_2) & (features != input$feature_1))] + + features <- names(df_custom$fullData) + pickerInput(inputId = "peptide_features", + label = "Features to display for each group of peptides", + selected = default_selection, + options = list(`actions-box` = TRUE,`live-search` = TRUE), + choices = features[((features != input$feature_2) & (features != input$feature_1))], # a list of strings + multiple = TRUE) + }) + + observeEvent(input$visualize_custom, { + #browser() + df_custom$groupBy <- input$feature_1 + df_custom$orderBy <- input$feature_2 + + reformat_data <- df_custom$fullData %>% group_by(across(all_of(df_custom$groupBy))) %>% arrange(across(all_of(df_custom$orderBy))) + df_custom$fullData <- reformat_data + row_ind <- reformat_data %>% group_rows() + row_ind_df <- as.data.frame(row_ind) + df_custom$group_inds <- row_ind_df + row_ind_top <- apply(row_ind_df, 1, function(x) {unlist(x[1])[1]}) + df_custom$mainTable <- as.data.frame(reformat_data[row_ind_top, ]) + df_custom$mainTable <- cbind(Select = shinyInputSelect(actionButton, nrow(df_custom$mainTable), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"custom_select_button\", this.id)'), df_custom$mainTable) + df_custom$metricsData <- get_group_inds(df_custom$fullData, df_custom$group_inds) + df_custom$peptide_features <- input$peptide_features + updateTabItems(session, "custom_tabs", "custom_explore") + }) + + output$customTable <- DT::renderDataTable( + if (is.null(df_custom$mainTable)) { + return(datatable(data.frame("Annotated Table" = character()))) + }else { + datatable(df_custom$mainTable, + escape = FALSE, class = "stripe", + selection = "single", + extensions = c("Buttons") + + ) + }, server = FALSE) + + + observeEvent(input$custom_select_button, { + if (is.null(df_custom$mainTable) | is.null(df_custom$selectedRow)){ + return () + } + #browser() + df_custom$selectedRow <- as.numeric(strsplit(input$custom_select_button, "_")[[1]][2]) + session$sendCustomMessage('unbind-DT', 'customTable') + dataTableProxy("customMainTable") %>% + selectPage((df_custom$selectedRow-1) %/% df_custom$pageLength + 1) + }) + output$customPeptideTable <- renderDT({ + withProgress(message = 'Loading Peptide Table', value = 0, { + incProgress(0.5) + #browser() + if (!is.null(df_custom$selectedRow) & !(is.null(df_custom$mainTable)) & !is.null(df_custom$peptide_features)){ + display_table <- get_current_group_info(df_custom$peptide_features, df_custom$metricsData, df_custom$fullData, df_custom$selectedRow) + incProgress(0.5) + dtable <- datatable(display_table, options =list( + pageLength = 10, + rowCallback = JS('function(row, data, index, rowId) {', + 'console.log(rowId)','if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {', + 'row.style.backgroundColor = "#E0E0E0";','}','}') + ), selection = list(mode='single', selected = '1')) + dtable + } + else{ + incProgress(1) + datatable(data.frame("Peptide Datatable"=character()), selection = list(mode='single', selected = '1')) + }}) + }) + + + # Dynamic Scatter Plot + output$xvrbl_custom <- renderUI({ + df <- df_custom$fullData + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + + features <- as.list(names(df)[sapply(df, is.numeric)]) + default_selection <- ifelse(length(features) >= 1, features[[1]], "") + + pickerInput(inputId = "xvrbl_custom", + label = "X-Axis Variable", + choices = features, + selected = default_selection, + options = list(`live-search` = TRUE), + multiple = FALSE + ) + }) + + output$xvrbl_log_custom <- renderUI({ + radioButtons( + inputId = "LogX_custom", + choices = c("none", "ln", "log2", "log10", "sqrt"), + label = "X Log Transform", + inline = TRUE + ) + }) + + output$xvrbl_scale_custom <- renderUI({ + withProgress(message = "Loading Scale", value = 0, { + req(input$xvrbl_custom) # Use req() to check if inputs are not NULL + df <- df_custom$fullData + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + df <- df[is.finite(df[[input$xvrbl_custom]]),] + + # Apply log or sqrt transformation + if (input$LogX_custom == "ln") { + df[[input$xvrbl_custom]] <- log(ifelse(df[[input$xvrbl_custom]] == 0, 1e-10, df[[input$xvrbl_custom]])) + } else if (input$LogX_custom == "log2") { + df[[input$xvrbl_custom]] <- log2(ifelse(df[[input$xvrbl_custom]] == 0, 1e-10, df[[input$xvrbl_custom]])) + } else if (input$LogX_custom == "log10") { + df[[input$xvrbl_custom]] <- log10(ifelse(df[[input$xvrbl_custom]] == 0, 1e-10, df[[input$xvrbl_custom]])) + } else if (input$LogX_custom == "sqrt") { + df[[input$xvrbl_custom]] <- sqrt(ifelse(df[[input$xvrbl_custom]] < 0, 1e-10, df[[input$xvrbl_custom]])) + } else { + df[[input$xvrbl_custom]] <- df[[input$xvrbl_custom]] + } + + df <- df[is.finite(df[[input$xvrbl_custom]]),] + + xvrbl_values <- df[[input$xvrbl_custom]] + range_values <- range(as.numeric(xvrbl_values), na.rm = TRUE) + min_value <- as.numeric(format(round(range_values[1], 2), nsmall = 2)) + max_value <- as.numeric(format(round(range_values[2], 2), nsmall = 2)) + + + # Check if min_value and max_value are equal, set default values + if (min_value == max_value) { + min_value <- min_value - 1 + max_value <- max_value + 1 + } + + sliderInput( + inputId = "xvrbl_scale_custom", + label = "X Min/Max", + min = min_value, + max = max_value, + value = c(min_value, max_value), + step = 0.01, + dragRange = TRUE # Allow users to drag the range handles + ) + }) + }) + + output$yvrbl_custom <- renderUI({ + df <- df_custom$fullData + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + + features <- as.list(names(df)[sapply(df, is.numeric)]) + default_selection <- ifelse(length(features) >= 2, features[[2]], "") + + pickerInput(inputId = "yvrbl_custom", + label = "Y-Axis Variable", + choices = features, + selected = default_selection, + options = list(`live-search` = TRUE), + multiple = FALSE + ) + }) + + output$yvrbl_log_custom <- renderUI({ + radioButtons( + inputId = "LogY_custom", + choices = c("none", "ln", "log2", "log10", "sqrt"), + label = "Y Log Transform", + inline = TRUE + ) + }) + + output$yvrbl_scale_custom <- renderUI({ + withProgress(message = "Loading Scale", value = 0, { + req(input$yvrbl_custom) # Use req() to check if inputs are not NULL + df <- df_custom$fullData + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + df <- df[is.finite(df[[input$yvrbl_custom]]),] + + # Apply log or sqrt transformation + if (input$LogY_custom == "ln") { + df[[input$yvrbl_custom]] <- log(ifelse(df[[input$yvrbl_custom]] == 0, 1e-10, df[[input$yvrbl_custom]])) + } else if (input$LogY_custom == "log2") { + df[[input$yvrbl_custom]] <- log2(ifelse(df[[input$yvrbl_custom]] == 0, 1e-10, df[[input$yvrbl_custom]])) + } else if (input$LogY_custom == "log10") { + df[[input$yvrbl_custom]] <- log10(ifelse(df[[input$yvrbl_custom]] == 0, 1e-10, df[[input$yvrbl_custom]])) + } else if (input$LogY_custom == "sqrt") { + df[[input$yvrbl_custom]] <- sqrt(ifelse(df[[input$yvrbl_custom]] < 0, 1e-10, df[[input$yvrbl_custom]])) + } else { + df[[input$yvrbl_custom]] <- df[[input$yvrbl_custom]] + } + + df <- df[is.finite(df[[input$yvrbl_custom]]),] + yvrbl_values <- df[[input$yvrbl_custom]] + range_values <- range(as.numeric(yvrbl_values), na.rm = TRUE) + min_value <- as.numeric(format(round(range_values[1], 2), nsmall = 2)) + max_value <- as.numeric(format(round(range_values[2], 2), nsmall = 2)) + + # Check if min_value and max_value are equal, set default values + if (min_value == max_value) { + min_value <- min_value - 1 + max_value <- max_value + 1 + } + + sliderInput( + inputId = "yvrbl_scale_custom", + label = "Y Min/Max", + min = min_value, + max = max_value, + value = c(min_value, max_value), + step = 0.01, + dragRange = TRUE # Allow users to drag the range handles + ) + }) + }) + + + output$color_custom <- renderUI({ + df <- df_custom$fullData + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + + features <- as.list(names(df)[sapply(df, is.numeric)]) + default_selection <- ifelse(length(features) >= 3, features[[3]], "") + + pickerInput(inputId = "color_scatter_custom", + label = "Color", + choices = features, + selected = default_selection, + options = list(`live-search` = TRUE), + multiple = FALSE + ) + }) + + output$min_color_custom <- renderUI({ + colourInput("min_col_custom", "Select min color", "grey") + }) + + output$max_color_custom <- renderUI({ + colourInput("max_col_custom", "Select max color", "purple") + }) + + output$size_custom<- renderUI({ + df <- df_custom$fullData + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + + features <- as.list(names(df)[sapply(df, is.numeric)]) + default_selection <- ifelse(length(features) >= 4, features[[4]], "") + pickerInput(inputId = "size_scatter_custom", + label = "Size", + choices = features, + selected = default_selection, + options = list(`live-search` = TRUE), + multiple = FALSE + ) + }) + + output$scatter_custom <- renderPlotly({ + withProgress(message = "Loading Scatter Plots", value = 0, { + incProgress(0.5) + if (!is.null(input$xvrbl_custom) & !is.null(input$yvrbl_custom) + & !is.null(input$min_col_custom) & !is.null(input$max_col_custom) + & !is.null(input$xvrbl_scale_custom) & !is.null(input$yvrbl_scale_custom) + & !is.null(input$color_scatter_custom) & !is.null(input$size_scatter_custom)) { + + df <- df_custom$fullData + df <- type.convert(df, as.is = TRUE) + df[is.na(df)] <- 0 + + + # For input$xvrbl_custom + if (input$LogX_custom == "ln") { + df[[input$xvrbl_custom]] <- log(ifelse(df[[input$xvrbl_custom]] == 0, 1e-10, df[[input$xvrbl_custom]])) + } else if (input$LogX_custom == "log2") { + df[[input$xvrbl_custom]] <- log2(ifelse(df[[input$xvrbl_custom]] == 0, 1e-10, df[[input$xvrbl_custom]])) + } else if (input$LogX_custom == "log10") { + df[[input$xvrbl_custom]] <- log10(ifelse(df[[input$xvrbl_custom]] == 0, 1e-10, df[[input$xvrbl_custom]])) + } else if (input$LogX_custom == "sqrt") { + df[[input$xvrbl_custom]] <- sqrt(ifelse(df[[input$xvrbl_custom]] < 0, 1e-10, df[[input$xvrbl_custom]])) + } else { + df[[input$xvrbl_custom]] <- df[[input$xvrbl_custom]] + } + # For input$yvrbl_custom + if (input$LogY_custom == "ln") { + df[[input$yvrbl_custom]] <- log(ifelse(df[[input$yvrbl_custom]] == 0, 1e-10, df[[input$yvrbl_custom]])) + } else if (input$LogY_custom == "log2") { + df[[input$yvrbl_custom]] <- log2(ifelse(df[[input$yvrbl_custom]] == 0, 1e-10, df[[input$yvrbl_custom]])) + } else if (input$LogY_custom == "log10") { + df[[input$yvrbl_custom]] <- log10(ifelse(df[[input$yvrbl_custom]] == 0, 1e-10, df[[input$yvrbl_custom]])) + } else if (input$LogY_custom == "sqrt") { + df[[input$yvrbl_custom]] <- sqrt(ifelse(df[[input$yvrbl_custom]] < 0, 1e-10, df[[input$yvrbl_custom]])) + } else { + df[[input$yvrbl_custom]] <- df[[input$yvrbl_custom]] + } + + + df[is.na(df)] <- 0 + + # Filter data based on the slider range + df <- subset(df, df[[input$xvrbl_custom]] >= input$xvrbl_scale_custom[1] & df[[input$xvrbl_custom]] <= input$xvrbl_scale_custom[2]) + df <- subset(df, df[[input$yvrbl_custom]] >= input$yvrbl_scale_custom[1] & df[[input$yvrbl_custom]] <= input$yvrbl_scale_custom[2]) + + incProgress(0.5) + + scatter_plot <- ggplot(df , aes(x = .data[[input$xvrbl_custom]], y = .data[[input$yvrbl_custom]])) + + geom_point(aes(color = .data[[input$color_scatter_custom]], size = .data[[input$size_scatter_custom]])) + # Correct placement of aes() here + scale_color_gradient(low = input$min_col_custom, high = input$max_col_custom) + + theme(strip.text = element_text(size = 15), axis.text = element_text(size = 10), axis.title = element_text(size = 15), axis.ticks = element_line(size = 3), legend.text = element_text(size = 15), legend.title = element_text(size = 15)) + + scatter_plot <- ggplotly(scatter_plot) + + print(scatter_plot) + } + else { + p <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + + theme_void() + theme(legend.position = "none", panel.border = element_blank()) + incProgress(1) + print(p) + } + }) + }) + + }) diff --git a/pvactools/tools/pvacview/styling.R b/pvactools/tools/pvacview/styling.R index 2ebaf199e..336f05f94 100644 --- a/pvactools/tools/pvacview/styling.R +++ b/pvactools/tools/pvacview/styling.R @@ -11,32 +11,31 @@ rowcallback <- function(hla_count, row_num) { callback <- function(hla_count, score_mode) { c( - "var tips = ['Gene - The Ensembl gene name of the affected gene.',", - " 'AA Change - The amino acid change for the mutation. Note that FS indicates a frameshift variant.',", - " 'Num Passing Transcripts - The number of transcripts for this mutation that resulted in at least one well-binding peptide.',", - " 'Best Peptide - The best-binding mutant epitope sequence (lowest mutant binding affinity) prioritizing epitope sequences that resulted from a protein_coding transcript with a TSL below the maximum transcript support level and having no problematic positions.',", - " 'Best Transcript - Transcript corresponding to the best peptide with the lowest TSL and shortest length.',", - " 'TSL - Transcript support level of the best peptide.',", - " 'Allele - HLA allele the best peptide binds well to.',", - " 'Pos - The one-based position of the start of the mutation within the epitope sequence. 0 if the start of the mutation is before the epitope (as can occur downstream of frameshift mutations).',", - " 'Prob Pos - Problematic positions within the best peptide.',", - " 'Num Passing Peptides - The number of unique well-binding peptides for this mutation.',", - gsub("X", score_mode," 'IC50 MT - X IC50 binding affinity of the best-binding mutant epitope across all prediction algorithms used.', "), - " 'IC50 WT - IC50 binding affinity of the corresponding wildtype epitope.',", - gsub("X", score_mode," '%ile MT - X binding affinity percentile rank of the best-binding mutant epitope across all prediction algorithms used (those that provide percentile output).', "), - " '%ile WT - Binding affinity percentile rank of the corresponding wildtype epitope across all prediction algorithms used (those that provide percentile output).', ", - " 'RNA Expr - Gene expression value for the annotated gene containing the variant.',", - " 'RNA VAF - Tumor RNA variant allele frequency (VAF) at this position.',", - " 'Allele Expr - Gene expression value * Tumor RNA VAF. This is used to approximate the expression of the variant allele.',", - " 'RNA Depth - Tumor RNA depth at this position.',", - " 'DNA VAF - Tumor DNA variant allele frequency (VAF) at this position.',", - " 'Tier - A tier suggesting the suitability of variants for use in vaccines.',", - " 'Eval - User-selected evaluation of neoantigen candidate. Options include: Accept, Reject, Review. (Default: Pending)'],", - "header = table.columns().header();", - gsub("7", hla_count, "for (var i = 7; i-7 < tips.length; i++) {"), - gsub("7", hla_count, "$(header[i]).attr('title', tips[i-7]);"), - "}" -) + "var tips = ['Gene - The Ensembl gene name of the affected gene.',", + " 'AA Change - The amino acid change for the mutation. Note that FS indicates a frameshift variant.',", + " 'Num Passing Transcripts - The number of transcripts for this mutation that resulted in at least one well-binding peptide.',", + " 'Best Peptide - The best-binding mutant epitope sequence (lowest mutant binding affinity) prioritizing epitope sequences that resulted from a protein_coding transcript with a TSL below the maximum transcript support level and having no problematic positions.',", + " 'Best Transcript - Transcript corresponding to the best peptide with the lowest TSL and shortest length.',", + " 'TSL - Transcript support level of the best peptide.',", + " 'Pos - The one-based position of the start of the mutation within the epitope sequence. 0 if the start of the mutation is before the epitope (as can occur downstream of frameshift mutations).',", + " 'Prob Pos - Problematic positions within the best peptide.',", + " 'Num Passing Peptides - The number of unique well-binding peptides for this mutation.',", + gsub("X", score_mode," 'IC50 MT - X IC50 binding affinity of the best-binding mutant epitope across all prediction algorithms used.', "), + " 'IC50 WT - IC50 binding affinity of the corresponding wildtype epitope.',", + gsub("X", score_mode," '%ile MT - X binding affinity percentile rank of the best-binding mutant epitope across all prediction algorithms used (those that provide percentile output).', "), + " '%ile WT - Binding affinity percentile rank of the corresponding wildtype epitope across all prediction algorithms used (those that provide percentile output).', ", + " 'RNA Expr - Gene expression value for the annotated gene containing the variant.',", + " 'RNA VAF - Tumor RNA variant allele frequency (VAF) at this position.',", + " 'Allele Expr - Gene expression value * Tumor RNA VAF. This is used to approximate the expression of the variant allele.',", + " 'RNA Depth - Tumor RNA depth at this position.',", + " 'DNA VAF - Tumor DNA variant allele frequency (VAF) at this position.',", + " 'Tier - A tier suggesting the suitability of variants for use in vaccines.',", + " 'Eval - User-selected evaluation of neoantigen candidate. Options include: Accept, Reject, Review. (Default: Pending)'],", + "header = table.columns().header();", + gsub("7", hla_count, "for (var i = 7; i-7 < tips.length; i++) {"), + gsub("7", hla_count, "$(header[i]).attr('title', tips[i-7]);"), + "}" + ) } diff --git a/pvactools/tools/pvacview/ui.R b/pvactools/tools/pvacview/ui.R index 65b61e3dd..cd4307b38 100644 --- a/pvactools/tools/pvacview/ui.R +++ b/pvactools/tools/pvacview/ui.R @@ -7,267 +7,271 @@ library(fresh) library(shinycssloaders) source("styling.R") +source("neofox_ui.R") +source("custom_ui.R") ## UPLOAD TAB ## upload_tab <- tabItem( - "upload", - # infoBoxes - fluidRow( - column(width = 6, - box( - title="Option 1: View demo data", status = "primary", solidHeader = TRUE, width = NULL, - actionButton("loadDefaultmain", "Load demo data", style = "color: #fff; background-color: #c92424; border-color: #691111"), - h5("Please wait a couple seconds after clicking and you should be redirected to the Visualize and Explore tab.") - ), - box( - title = "Option 2: Upload your own data Files", status = "primary", solidHeader = TRUE, width = NULL, - HTML("
(Required) Please upload the aggregate report file. Note that this will be the data displayed in the main table in the Explore tab.
"), - uiOutput("aggregate_report_ui"), - radioButtons("hla_class", "Does this aggregate report file correspond to Class I or Class II prediction data?", - c("Class I data (e.g. HLA-A*02:01) " = "class_i", "Class II data (e.g. DPA1*01:03)" = "class_ii")), - hr(style = "border-color: white"), - HTML("
(Required) Please upload the corresponding metrics file for the main file that you have chosen.
"), - uiOutput("metrics_ui"), - hr(style = "border-color: white"), - HTML("
(Optional) If you would like, you can upload an additional aggregate report file generated with either Class I or Class II results to supplement your main table. (E.g. if you uploaded Class I data as the main table, you can upload your Class II report here as supplemental data)
"), - uiOutput("add_file_ui"), - textInput("add_file_label", "Please provide a label for the additional file uploaded (e.g. Class I data or Class II data)"), - hr(style = "border-color: white"), - HTML("
(Optional) Additionally, you can upload a gene-of-interest list in a tsv format, where each row is a single gene name. These genes (if in your aggregate report) will be highlighted in the Gene Name column.
"), - fileInput(inputId = "gene_list", label = "4. Gene-of-interest List (tsv required)", accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")), - actionButton("visualize", "Visualize") - ) - ), - column(6, - box( - title = "Basic Instructions: How to explore your data using pVACview?", status = "primary", solidHeader = TRUE, width = NULL, - h4("Step 1: Upload your own data / Load demo data", style = "font-weight: bold"), - h5("You can either choose to explore a demo dataset that we have prepared from the HCC1395 cell line, or choose to upload your own datasets."), - HTML("
If you are uploading your own datasets, the two required inputs are output files you obtain after running the pVACseq pipeline. + "upload", + # infoBoxes + fluidRow( + column(width = 6, + box( + title="Option 1: View demo data", status = "primary", solidHeader = TRUE, width = NULL, + actionButton("loadDefaultmain", "Load demo data", style = "color: #fff; background-color: #c92424; border-color: #691111"), + h5("Please wait a couple seconds after clicking and you should be redirected to the Visualize and Explore tab.") + ), + box( + title = "Option 2: Upload your own data Files", status = "primary", solidHeader = TRUE, width = NULL, + HTML("
(Required) Please upload the aggregate report file. Note that this will be the data displayed in the main table in the Explore tab.
"), + uiOutput("aggregate_report_ui"), + radioButtons("hla_class", "Does this aggregate report file correspond to Class I or Class II prediction data?", + c("Class I data (e.g. HLA-A*02:01) " = "class_i", "Class II data (e.g. DPA1*01:03)" = "class_ii")), + hr(style = "border-color: white"), + HTML("
(Required) Please upload the corresponding metrics file for the main file that you have chosen.
"), + uiOutput("metrics_ui"), + hr(style = "border-color: white"), + HTML("
(Optional) If you would like, you can upload an additional aggregate report file generated with either Class I or Class II results to supplement your main table. (E.g. if you uploaded Class I data as the main table, you can upload your Class II report here as supplemental data)
"), + uiOutput("add_file_ui"), + textInput("add_file_label", "Please provide a label for the additional file uploaded (e.g. Class I data or Class II data)"), + hr(style = "border-color: white"), + HTML("
(Optional) Additionally, you can upload a gene-of-interest list in a tsv format, where each row is a single gene name. These genes (if in your aggregate report) will be highlighted in the Gene Name column.
"), + fileInput(inputId = "gene_list", label = "4. Gene-of-interest List (tsv required)", accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")), + actionButton("visualize", "Visualize") + ) + ), + column(6, + box( + title = "Basic Instructions: How to explore your data using pVACview?", status = "primary", solidHeader = TRUE, width = NULL, + h4("Step 1: Upload your own data / Load demo data", style = "font-weight: bold"), + h5("You can either choose to explore a demo dataset that we have prepared from the HCC1395 cell line, or choose to upload your own datasets."), + HTML("
If you are uploading your own datasets, the two required inputs are output files you obtain after running the pVACseq pipeline. The aggregated tsv file is a list of all predicted epitopes and their binding affinity scores with additional variant information and the metrics json file contains additional transcript and peptide level information.
"), - h5("You have the option of uploading an additional file to supplement the data you are exploring. This includes: additional class I or II information and + h5("You have the option of uploading an additional file to supplement the data you are exploring. This includes: additional class I or II information and a gene-of-interest tsv file."), - actionButton("help_doc_upload", "More details", onclick = "window.open('https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#upload', '_blank')"), - h4("Step 2: Exploring your data", style = "font-weight: bold"), - HTML("
To explore the different aspects of your neoantigen candidates, you will need to navigate to the Aggregate Report of Best Candidate by Variant on the visualize and explore tab. + actionButton("help_doc_upload", "More details", onclick = "window.open('https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#upload', '_blank')"), + h4("Step 2: Exploring your data", style = "font-weight: bold"), + HTML("
To explore the different aspects of your neoantigen candidates, you will need to navigate to the Aggregate Report of Best Candidate by Variant on the visualize and explore tab. For detailed variant, transcript and peptide information for each candidate listed, you will need to click on the Investigate button for the specific row of interest. This will prompt both the transcript and peptide table to reload with the matching information.
"), - h5("By hovering over each column header, you will be able to see a brief description of the corresponding column and for more details, you can click on the tooltip located at the top right of the aggregate report table.", br(), + h5("By hovering over each column header, you will be able to see a brief description of the corresponding column and for more details, you can click on the tooltip located at the top right of the aggregate report table.", br(), "After investigating each candidate, you can label the candidate using the dropdown menu located at the second to last column of the table. Choices include: Accept, Reject or Review."), - actionButton("help_doc_explore", "More details", onclick = "window.open('https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#visualize-and-explore', '_blank')"), - h4("Step 3: Exporting your data", style = "font-weight: bold"), - h5("When you have either finished ranking your neoantigen candidates or need to pause and would like to save your current evaluations, + actionButton("help_doc_explore", "More details", onclick = "window.open('https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#visualize-and-explore', '_blank')"), + h4("Step 3: Exporting your data", style = "font-weight: bold"), + h5("When you have either finished ranking your neoantigen candidates or need to pause and would like to save your current evaluations, you can export the current main aggregate report using the export page."), - HTML("
Navigate to the export tab, and you will be able to name your file prior to downloading in either tsv or excel format. + HTML("
Navigate to the export tab, and you will be able to name your file prior to downloading in either tsv or excel format. The excel format is user-friendly for downstream visualization and manipulation. However, if you plan on to continuing editing the aggregate report and would like to load it back in pVACview with the previous evaluations preloaded, you will need to download the file in a tsv format. This serves as a way to save your progress as your evaluations are cleared upon closing or refreshing the pVACview app.
"), - actionButton("help_doc_export", "More details", onclick = "window.open('https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#export', '_blank')") - ) - ), - ) + actionButton("help_doc_export", "More details", onclick = "window.open('https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#export', '_blank')") + ) + ), + ) ) ## EXPLORE TAB ## explore_tab <- tabItem( - "explore", - conditionalPanel( - condition = "output.filesUploaded", - fluidRow( - tags$style( - type = "text/css", - ".modal-dialog { width: fit-content !important; }" - ), - tags$script(HTML("Shiny.addCustomMessageHandler('unbind-DT', function(id) { + "explore", + conditionalPanel( + condition = "output.filesUploaded", + fluidRow( + tags$style( + type = "text/css", + ".modal-dialog { width: fit-content !important; }" + ), + tags$script(HTML("Shiny.addCustomMessageHandler('unbind-DT', function(id) { Shiny.unbindAll($('#'+id).find('table').DataTable().table().node()); })")), - box(width = 6, - title = "Advanced Options: Regenerate Tiering with different parameters", - status = "primary", solidHeader = TRUE, collapsible = TRUE, collapsed = TRUE, - "*Please note that the metrics file is required in order to regenerate tiering information with different parameters", br(), - "Current version of pVACseq results defaults to positions 1, 2, n-1 and n (for a n-mer peptide) when determining anchor positions. + box(width = 6, + title = "Advanced Options: Regenerate Tiering with different parameters", + status = "primary", solidHeader = TRUE, collapsible = TRUE, collapsed = TRUE, + "*Please note that the metrics file is required in order to regenerate tiering information with different parameters", br(), + "Current version of pVACseq results defaults to positions 1, 2, n-1 and n (for a n-mer peptide) when determining anchor positions. If you would like to use our allele specific anchor results and regenerate the tiering results for your variants, please specify your contribution cutoff and submit for recalculation. ", tags$a(href = "https://www.biorxiv.org/content/10.1101/2020.12.08.416271v1", "More details can be found here.", target = "_blank"), br(), - uiOutput("allele_specific_anchors_ui"), - uiOutput("anchor_contribution_ui"), - uiOutput("binding_threshold_ui"), - uiOutput("allele_specific_binding_ui"), - uiOutput("percentile_threshold_ui"), - uiOutput("dna_cutoff_ui"), - uiOutput("allele_expr_ui"), - h5("For further explanations on these inputs, please refer to the ", tags$a(href = "https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#visualize-and-explore", "pVACview documentation.", target = "_blank")), - actionButton("submit", "Recalculate Tiering with new parameters"), - style = "overflow-x: scroll;font-size:100%"), - box(width = 3, - title = "Original Parameters for Tiering", - status = "primary", solidHeader = TRUE, collapsible = TRUE, - column(width = 12, - h5("These are the original parameters used in the tiering calculations extracted from the metrics data file given as input."), - tableOutput("paramTable"), - tableOutput("bindingParamTable"), style = "height:250px; overflow-y: scroll;overflow-x: scroll;"), - actionButton("reset_params", "Reset to original parameters"), - style = "overflow-x: scroll;font-size:100%"), - box(width = 3, - title = "Add Comments for selected variant", - status = "primary", solidHeader = TRUE, collapsible = TRUE, - textAreaInput("comments", "Please add/update your comments for the variant you are currently examining", value = ""), - actionButton("comment", "Update Comment Section"), - h5("Comment:"), htmlOutput("comment_text"), - style = "font-size:100%") - ), - fluidRow( - box(width = 12, - title = "Aggregate Report of Best Candidates by Variant", - status = "primary", solidHeader = TRUE, collapsible = TRUE, - enable_sidebar = TRUE, sidebar_width = 25, sidebar_start_open = TRUE, - dropdownMenu = boxDropdown(boxDropdownItem("Help", id = "help", icon = icon("question-circle"))), - selectInput("page_length", "Number of variants displayed per page:", selected = "10", c("10", "20", "50", "100"), width = "280px"), - DTOutput("mainTable") %>% withSpinner(color = "#8FCCFA"), - span("Currently investigating row: ", verbatimTextOutput("selected")), - style = "overflow-x: scroll;font-size:100%") - ), - - fluidRow( - box(width = 12, title = "Variant Information", status = "primary", solidHeader = TRUE, collapsible = TRUE, - tabBox(width = 6, title = " ", - tabPanel("Transcript Sets of Selected Variant", - DTOutput("transcriptSetsTable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;font-size:100%"), - tabPanel("Reference Matches", - h4("Best Peptide Data"), - column(6, - span("Best Peptide: "), - plotOutput(outputId = "referenceMatchPlot", height="20px") - ), - column(2, - span("AA Change: ", verbatimTextOutput("selectedAAChange")) - ), - column(2, - span("Pos: ", verbatimTextOutput("selectedPos")) - ), - column(2, - span("Gene: ", verbatimTextOutput("selectedGene")) - ), - h4("Query Data"), - h5(uiOutput("hasReferenceMatchData")), - column(10, - span("Query Sequence: "), - plotOutput(outputId = "referenceMatchQueryPlot", height="20px") - ), - column(2, - span("Hits: ", verbatimTextOutput("referenceMatchHitCount")) - ), - h4("Hits"), - DTOutput(outputId = "referenceMatchDatatable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" - ), - tabPanel("Additional Data", - span("Additional Data Type: ", verbatimTextOutput("type_text")), - span("Median MT IC50: ", verbatimTextOutput("addData_IC50")), - span("Median MT Percentile: ", verbatimTextOutput("addData_percentile")), - span("Best Peptide: ", verbatimTextOutput("addData_peptide")), - span("Corresponding HLA allele: ", verbatimTextOutput("addData_allele")), - span("Best Transcript: ", verbatimTextOutput("addData_transcript"))) - ), - box(width = 4, solidHeader = TRUE, title = "Variant & Gene Info", - span("DNA VAF", verbatimTextOutput("metricsTextDNA")), - span("RNA VAF", verbatimTextOutput("metricsTextRNA")), - span("Gene Expression", verbatimTextOutput("metricsTextGene")), - span("Genomic Information (chromosome - start - stop - ref - alt)", verbatimTextOutput("metricsTextGenomicCoord")), - h5("Additional variant information:"), - uiOutput("url"), style = "overflow-x: scroll;font-size:100%"), - box(width = 2, solidHeader = TRUE, title = "Peptide Evalutation Overview", - tableOutput("checked"), style = "overflow-x: scroll;font-size:100%") - ) - ), - fluidRow( - box(width = 12, title = "Transcript and Peptide Set Data", solidHeader = TRUE, collapsible = TRUE, status = "primary", - tabBox(width = 12, title = " ", - tabPanel("Peptide Candidates from Selected Transcript Set", - DTOutput("peptideTable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;font-size:100%"), - tabPanel("Anchor Heatmap", - column(width = 6, - h4("Allele specific anchor prediction heatmap for top 20 candidates in peptide table."), - h5("HLA allele specific anchor predictions overlaying good-binding peptide sequences generated from each specific transcript.", br(), - " Current version supports the first 15 MT/WT peptide sequence pairs (first 30 rows of the peptide table)."), br(), - plotOutput(outputId = "peptideFigureLegend", height = "50px"), - plotOutput(outputId = "anchorPlot", height = "500px") - ) %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;", - column(width = 6, - h4("Anchor vs Mutation position Scenario Guide", - img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/anchor.jpg", - align = "center", height = "500px") - ) - ) - ), - tabPanel("Transcripts in Set", - DTOutput("transcriptsTable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;font-size:100%") - ) - ) - ), - fluidRow( - box(width = 12, title = "Additional Peptide Information", status = "primary", solidHeader = TRUE, collapsible = TRUE, - tabBox(width = 12, title = " ", id = "info", - tabPanel("IC50 Plot", - h4("Violin Plots showing distribution of MHC IC50 predictions for selected peptide pair (MT and WT)."), - h5("Showcases individual binding prediction scores from each algorithm used. A solid line is used to represent the median score."), - plotOutput(outputId = "bindingData_IC50") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" - ), - tabPanel("%ile Plot", - h4("Violin Plots showing distribution of MHC percentile predictions for selected peptide pair (MT and WT)."), - h5("Showcases individual percentile scores from each algorithm used. A solid line is used to represent the median percentile score."), - plotOutput(outputId = "bindingData_percentile") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" - ), - tabPanel("Binding Data", - h4("Prediction score table showing exact MHC binding values for IC50 and percentile calculations."), - DTOutput(outputId = "bindingDatatable"), style = "overflow-x: scroll;" - ), - tabPanel("Elution Table", - h4("Prediction score table showing exact MHC binding values for elution and percentile calculations."), - DTOutput(outputId = "elutionDatatable"), - br(), - strong("MHCflurryEL Processing"), span(': An "antigen processing" predictor that attempts to model MHC allele-independent effects such as proteosomal cleavage. ('), - a(href = "https://www.sciencedirect.com/science/article/pii/S2405471220302398", "Citation"), span(")"), - br(), - strong("MHCflurryEL Presentation"), span(': A predictor that integrates processing predictions with binding affinity predictions to give a composite "presentation score." ('), - a(href = "https://www.sciencedirect.com/science/article/pii/S2405471220302398", "Citation"), span(")"), - br(), - strong("NetMHCpanEL / NetMHCIIpanEL"), span(": A predictor trained on eluted ligand data. ("), - a(href = "https://academic.oup.com/nar/article/48/W1/W449/5837056", "Citation"), span(")"), - style = "overflow-x: scroll;" - ) - ) - ) - ) + uiOutput("allele_specific_anchors_ui"), + uiOutput("anchor_contribution_ui"), + uiOutput("binding_threshold_ui"), + uiOutput("allele_specific_binding_ui"), + uiOutput("percentile_threshold_ui"), + uiOutput("dna_cutoff_ui"), + uiOutput("allele_expr_ui"), + h5("For further explanations on these inputs, please refer to the ", tags$a(href = "https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#visualize-and-explore", "pVACview documentation.", target = "_blank")), + actionButton("submit", "Recalculate Tiering with new parameters"), + style = "overflow-x: scroll;font-size:100%"), + box(width = 3, + title = "Original Parameters for Tiering", + status = "primary", solidHeader = TRUE, collapsible = TRUE, + column(width = 12, + h5("These are the original parameters used in the tiering calculations extracted from the metrics data file given as input."), + tableOutput("paramTable"), + tableOutput("bindingParamTable"), style = "height:250px; overflow-y: scroll;overflow-x: scroll;"), + actionButton("reset_params", "Reset to original parameters"), + style = "overflow-x: scroll;font-size:100%"), + box(width = 3, + title = "Add Comments for selected variant", + status = "primary", solidHeader = TRUE, collapsible = TRUE, + textAreaInput("comments", "Please add/update your comments for the variant you are currently examining", value = ""), + actionButton("comment", "Update Comment Section"), + h5("Comment:"), htmlOutput("comment_text"), + style = "font-size:100%") ), - conditionalPanel( - condition = "output.filesUploaded == false", - h4("Error: Missing required files (both aggregate report and metrics files are required to properly visualize and explore candidates).", style = "font-weight: bold"), + fluidRow( + box(width = 12, + title = "Aggregate Report of Best Candidates by Variant", + status = "primary", solidHeader = TRUE, collapsible = TRUE, + enable_sidebar = TRUE, sidebar_width = 25, sidebar_start_open = TRUE, + dropdownMenu = boxDropdown(boxDropdownItem("Help", id = "help", icon = icon("question-circle"))), + selectInput("page_length", "Number of variants displayed per page:", selected = "10", c("10", "20", "50", "100"), width = "280px"), + DTOutput("mainTable") %>% withSpinner(color = "#8FCCFA"), + span("Currently investigating row: ", verbatimTextOutput("selected")), + style = "overflow-x: scroll;font-size:100%") + ), + + fluidRow( + box(width = 12, title = "Variant Information", status = "primary", solidHeader = TRUE, collapsible = TRUE, + tabBox(width = 6, title = " ", + tabPanel("Transcript Sets of Selected Variant", + DTOutput("transcriptSetsTable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;font-size:100%"), + tabPanel("Reference Matches", + h4("Best Peptide Data"), + column(6, + span("Best Peptide: "), + plotOutput(outputId = "referenceMatchPlot", height="20px") + ), + column(2, + span("AA Change: ", verbatimTextOutput("selectedAAChange")) + ), + column(2, + span("Pos: ", verbatimTextOutput("selectedPos")) + ), + column(2, + span("Gene: ", verbatimTextOutput("selectedGene")) + ), + h4("Query Data"), + h5(uiOutput("hasReferenceMatchData")), + column(10, + span("Query Sequence: "), + plotOutput(outputId = "referenceMatchQueryPlot", height="20px") + ), + column(2, + span("Hits: ", verbatimTextOutput("referenceMatchHitCount")) + ), + h4("Hits"), + DTOutput(outputId = "referenceMatchDatatable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" + ), + tabPanel("Additional Data", + span("Additional Data Type: ", verbatimTextOutput("type_text")), + span("Median MT IC50: ", verbatimTextOutput("addData_IC50")), + span("Median MT Percentile: ", verbatimTextOutput("addData_percentile")), + span("Best Peptide: ", verbatimTextOutput("addData_peptide")), + span("Corresponding HLA allele: ", verbatimTextOutput("addData_allele")), + span("Best Transcript: ", verbatimTextOutput("addData_transcript"))) + ), + box(width = 4, solidHeader = TRUE, title = "Variant & Gene Info", + span("DNA VAF", verbatimTextOutput("metricsTextDNA")), + span("RNA VAF", verbatimTextOutput("metricsTextRNA")), + span("Gene Expression", verbatimTextOutput("metricsTextGene")), + span("Genomic Information (chromosome - start - stop - ref - alt)", verbatimTextOutput("metricsTextGenomicCoord")), + h5("Additional variant information:"), + uiOutput("url"), style = "overflow-x: scroll;font-size:100%"), + box(width = 2, solidHeader = TRUE, title = "Peptide Evalutation Overview", + tableOutput("checked"), style = "overflow-x: scroll;font-size:100%") + ) + ), + fluidRow( + box(width = 12, title = "Transcript Set Detailed Data", solidHeader = TRUE, collapsible = TRUE, status = "primary", + tabBox(width = 12, title = " ", + tabPanel("Peptide Candidates from Selected Transcript Set", + DTOutput("peptideTable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;font-size:100%"), + tabPanel("Transcripts in Set", + DTOutput("transcriptsTable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;font-size:100%") + ) + ) + ), + fluidRow( + box(width = 12, title = "Additional Peptide Information", status = "primary", solidHeader = TRUE, collapsible = TRUE, + tabBox(title = " ", id = "info", + tabPanel("IC50 Plot", + h4("Violin Plots showing distribution of MHC IC50 predictions for selected peptide pair (MT and WT)."), + plotOutput(outputId = "bindingData_IC50") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" + ), + tabPanel("%ile Plot", + h4("Violin Plots showing distribution of MHC percentile predictions for selected peptide pair (MT and WT)."), + plotOutput(outputId = "bindingData_percentile") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" + ), + tabPanel("Binding Data", + h4("Prediction score table showing exact MHC binding values for IC50 and percentile calculations."), + DTOutput(outputId = "bindingDatatable"), style = "overflow-x: scroll;" + ), + tabPanel("Elution Table", + h4("Prediction score table showing exact MHC binding values for elution and percentile calculations."), + DTOutput(outputId = "elutionDatatable"), + br(), + strong("MHCflurryEL Processing"), span(': An "antigen processing" predictor that attempts to model MHC allele-independent effects such as proteosomal cleavage. ('), + a(href = "https://www.sciencedirect.com/science/article/pii/S2405471220302398", "Citation"), span(")"), + br(), + strong("MHCflurryEL Presentation"), span(': A predictor that integrates processing predictions with binding affinity predictions to give a composite "presentation score." ('), + a(href = "https://www.sciencedirect.com/science/article/pii/S2405471220302398", "Citation"), span(")"), + br(), + strong("NetMHCpanEL / NetMHCIIpanEL"), span(": A predictor trained on eluted ligand data. ("), + a(href = "https://academic.oup.com/nar/article/48/W1/W449/5837056", "Citation"), span(")"), + style = "overflow-x: scroll;" + ), + tabPanel("Anchor Heatmap", + h4("Allele specific anchor prediction heatmap for top 20 candidates in peptide table."), + plotOutput(outputId = "peptideFigureLegend", height = "50px"), + plotOutput(outputId = "anchorPlot") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" + ) + ), + box( + column(width = 4, + h4("Allele Specific Anchor Prediction Heatmap"), + h5(" This tab displays HLA allele specific anchor predictions overlaying good-binding peptide sequences generated from each specific transcript.", br(), + " Current version supports the first 15 MT/WT peptide sequence pairs (first 30 rows of the peptide table)."), br(), + h4("MHC Binding Prediction Scores"), + h5(" This tab contains violin plots that showcase individual binding prediction scores from each algorithm used. A solid line is used to represent the median score.") + ), + column(width = 8, + box(title = "Anchor vs Mutation position Scenario Guide", collapsible = TRUE, collapsed = FALSE, width = 12, + img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/anchor.jpg", + align = "center", height = "350px", width = "600px"), style = "overflow-x: scroll;") + ) + ) + ) ) + ), + conditionalPanel( + condition = "output.filesUploaded == false", + h4("Error: Missing required files (both aggregate report and metrics files are required to properly visualize and explore candidates).", style = "font-weight: bold"), + ) ) ## EXPORT TAB ## export_tab <- tabItem( - "export", - fluidRow( - textInput("exportFileName", "Export filename: ", value = "Annotated.Neoantigen_Candidates", width = NULL, placeholder = NULL) - ), - fluidRow( - column(12, - DTOutput("ExportTable") %>% withSpinner(color = "#8FCCFA")) - ) + "export", + fluidRow( + textInput("exportFileName", "Export filename: ", value = "Annotated.Neoantigen_Candidates", width = NULL, placeholder = NULL) + ), + fluidRow( + column(12, + DTOutput("ExportTable") %>% withSpinner(color = "#8FCCFA")) + ) ) ## TUTORIAL TAB ## tutorial_tab <- tabItem("tutorial", - tabsetPanel(type = "tabs", - tabPanel("Variant Level", - ## Aggregate Report Column Descriptions" - h3("Main table full column descriptions"), - p("If using pVACview with pVACtools output, the user is required to provide at least the following two files: ", - code("all_epitopes.aggregated.tsv"), code("all_epitopes.aggregated.metrics.json")), br(), - p("The ", code("all_epitopes.aggregated.tsv"), - "file is an aggregated version of the all_epitopes TSV. + tabsetPanel(type = "tabs", + tabPanel("Variant Level", + ## Aggregate Report Column Descriptions" + h3("Main table full column descriptions"), + p("If using pVACview with pVACtools output, the user is required to provide at least the following two files: ", + code("all_epitopes.aggregated.tsv"), code("all_epitopes.aggregated.metrics.json")), br(), + p("The ", code("all_epitopes.aggregated.tsv"), + "file is an aggregated version of the all_epitopes TSV. It presents the best-scoring (lowest binding affinity) epitope for each variant, along with additional binding affinity, expression, and coverage information for that epitope. It also gives information about the total number of well-scoring epitopes for each variant, @@ -275,315 +279,315 @@ tutorial_tab <- tabItem("tutorial", epitopes are well-binding to. Here, a well-binding or well-scoring epitope is any epitope that has a stronger binding affinity than the ", code("aggregate_inclusion_binding_threshold"), "described below. The report then bins variants into tiers that offer suggestions about the suitability of variants for use in vaccines."), br(), - p("The ", code("all_epitopes.aggregated.metrics.json"), - "complements the ", code("all_epitopes_aggregated.tsv"), "and is required for the tool's proper functioning."), br(), - p(strong("Column Names : Description")), - p(code("ID"), " : ", "A unique identifier for the variant"), - p(code("HLA Alleles"), " : ", "For each HLA allele in the run, the number of this variant’s + p("The ", code("all_epitopes.aggregated.metrics.json"), + "complements the ", code("all_epitopes_aggregated.tsv"), "and is required for the tool's proper functioning."), br(), + p(strong("Column Names : Description")), + p(code("ID"), " : ", "A unique identifier for the variant"), + p(code("HLA Alleles"), " : ", "For each HLA allele in the run, the number of this variant’s epitopes that bound well to the HLA allele (with ", code("lowest"), " or ", code("median"), - " mutant binding affinity < ", code("aggregate_inclusion_binding_threshold"), ")"), - p(code("Gene"), " : ", "The Ensembl gene name of the affected gene"), - p(code("AA Change"), " : ", "The amino acid change for the mutation"), - p(code("Num Passing Transcripts"), " : ", "The number of transcripts + " mutant binding affinity < ", code("aggregate_inclusion_binding_threshold"), ")"), + p(code("Gene"), " : ", "The Ensembl gene name of the affected gene"), + p(code("AA Change"), " : ", "The amino acid change for the mutation"), + p(code("Num Passing Transcripts"), " : ", "The number of transcripts for this mutation that resulted in at least one well-binding peptide (", code("lowest"), " or ", - code("median"), " mutant binding affinity < ", code("aggregate_inclusion_binding_threshold"), ")"), - p(code("Best Peptide"), " : ", "The best-binding mutant epitope sequence (lowest binding affinity) + code("median"), " mutant binding affinity < ", code("aggregate_inclusion_binding_threshold"), ")"), + p(code("Best Peptide"), " : ", "The best-binding mutant epitope sequence (lowest binding affinity) prioritizing epitope sequences that resulted from a protein_coding transcript with a TSL below the maximum transcript support level and having no problematic positions."), - p(code("Best Transcript"), " : ", "Transcript corresponding to the best peptide with the lowest TSL and shortest length."), - p(code("TSL"), " : ", "Transcript support level of the best peptide"), - p(code("Pos"), " : ", "The one-based position of the start of the mutation within the epitope sequence. ", - code("0"), " if the start of the mutation is before the epitope (as can occur downstream of frameshift mutations)"), - p(code("Num Passing Peptides"), " : ", "The number of unique well-binding peptides for this mutation."), - p(code("IC50 MT"), " : ", code("Lowest"), " or ", code("Median"), " ic50 binding affinity of + p(code("Best Transcript"), " : ", "Transcript corresponding to the best peptide with the lowest TSL and shortest length."), + p(code("TSL"), " : ", "Transcript support level of the best peptide"), + p(code("Pos"), " : ", "The one-based position of the start of the mutation within the epitope sequence. ", + code("0"), " if the start of the mutation is before the epitope (as can occur downstream of frameshift mutations)"), + p(code("Num Passing Peptides"), " : ", "The number of unique well-binding peptides for this mutation."), + p(code("IC50 MT"), " : ", code("Lowest"), " or ", code("Median"), " ic50 binding affinity of the best-binding mutant epitope across all prediction algorithms used."), - p(code("IC50 WT"), " : ", code("Lowest"), " or ", code("Median"), " ic50 binding affinity of + p(code("IC50 WT"), " : ", code("Lowest"), " or ", code("Median"), " ic50 binding affinity of the corresponding wildtype epitope across all prediction algorithms used."), - p(code("%ile MT"), " : ", code("Lowest"), " or ", code("Median"), "binding affinity percentile rank + p(code("%ile MT"), " : ", code("Lowest"), " or ", code("Median"), "binding affinity percentile rank of the best-binding mutant epitope across all prediction algorithms used (those that provide percentile output)"), - p(code("%ile WT"), " : ", code("Lowest"), " or ", code("Median"), "binding affinity percentile rank of the + p(code("%ile WT"), " : ", code("Lowest"), " or ", code("Median"), "binding affinity percentile rank of the corresponding wildtype epitope across all prediction algorithms used (those that provide percentile output)"), - p(code("RNA Expr"), " : ", "Gene expression value for the annotated gene containing the variant."), - p(code("RNA VAF"), " : ", "Tumor RNA variant allele frequency (VAF) at this position."), - p(code("Allele Expr"), " : ", "RNA Expr * RNA VAF"), - p(code("RNA Depth"), " : ", "Tumor RNA depth at this position."), - p(code("DNA VAF"), " : ", "Tumor DNA variant allele frequency (VAF) at this position."), - p(code("Tier"), " : ", "A tier suggesting the suitability of variants for use in vaccines."), - p(code("Evaluation"), " : ", "Column to store the evaluation of each variant when evaluating the run in pVACview. + p(code("RNA Expr"), " : ", "Gene expression value for the annotated gene containing the variant."), + p(code("RNA VAF"), " : ", "Tumor RNA variant allele frequency (VAF) at this position."), + p(code("Allele Expr"), " : ", "RNA Expr * RNA VAF"), + p(code("RNA Depth"), " : ", "Tumor RNA depth at this position."), + p(code("DNA VAF"), " : ", "Tumor DNA variant allele frequency (VAF) at this position."), + p(code("Tier"), " : ", "A tier suggesting the suitability of variants for use in vaccines."), + p(code("Evaluation"), " : ", "Column to store the evaluation of each variant when evaluating the run in pVACview. Can be ", code("Accept,"), " ", code("Reject"), " or ", code("Review"), "."), - ## Tiering Explained ## - h3("How is the Tiering column determined / How are the Tiers assigned?"), br(), - p(strong("Tier : Criteria")), - p(code("Pass"), " : ", code(("(MT binding < binding threshold) AND allele expr filter pass AND vaf clonal filter pass + ## Tiering Explained ## + h3("How is the Tiering column determined / How are the Tiers assigned?"), br(), + p(strong("Tier : Criteria")), + p(code("Pass"), " : ", code(("(MT binding < binding threshold) AND allele expr filter pass AND vaf clonal filter pass AND tsl filter pass AND anchor residue filter pass"))), - p(code("Anchor"), " : ", code(("(MT binding < binding threshold) AND allele expr filter pass AND vaf clonal filter pass + p(code("Anchor"), " : ", code(("(MT binding < binding threshold) AND allele expr filter pass AND vaf clonal filter pass AND tsl filter pass AND anchor residue filter fail"))), - p(code("Subclonal"), " : ", code(("(MT binding < binding threshold) AND allele expr filter pass AND vaf clonal filter fail + p(code("Subclonal"), " : ", code(("(MT binding < binding threshold) AND allele expr filter pass AND vaf clonal filter fail AND tsl filter pass AND anchor residue filter pass"))), - p(code("LowExpr"), " : ", code(("(MT binding < binding threshold) AND low expression criteria met AND allele expr filter pass + p(code("LowExpr"), " : ", code(("(MT binding < binding threshold) AND low expression criteria met AND allele expr filter pass AND vaf clonal filter pass AND tsl filter pass AND anchor residue filter pass"))), - p(code("Poor"), " : ", "Best peptide for current variant FAILS in two or more categories"), - p(code("NoExpr"), " : ", code("((gene expr == 0) OR (RNA VAF == 0)) AND low expression criteria not met")), br(), - p("Here we list out the exact criteria for passing each respective filter: "), - p(strong("Allele Expr Filter: "), code("(allele expr >= allele expr cutoff) OR (rna_vaf == 'NA') OR (gene_expr == 'NA')")), - p(strong("VAF Clonal Filter: "), code("(dna vaf < vaf subclonal) OR (dna_vaf == 'NA')")), - p(strong("TSL Filter: "), code("(TSL != 'NA') AND (TSL < maximum transcript support level)")), - p(strong("Anchor Residue Filter: "), br(), - strong("1. "), code("(Mutation(s) is at anchor(s)) AND + p(code("Poor"), " : ", "Best peptide for current variant FAILS in two or more categories"), + p(code("NoExpr"), " : ", code("((gene expr == 0) OR (RNA VAF == 0)) AND low expression criteria not met")), br(), + p("Here we list out the exact criteria for passing each respective filter: "), + p(strong("Allele Expr Filter: "), code("(allele expr >= allele expr cutoff) OR (rna_vaf == 'NA') OR (gene_expr == 'NA')")), + p(strong("VAF Clonal Filter: "), code("(dna vaf < vaf subclonal) OR (dna_vaf == 'NA')")), + p(strong("TSL Filter: "), code("(TSL != 'NA') AND (TSL < maximum transcript support level)")), + p(strong("Anchor Residue Filter: "), br(), + strong("1. "), code("(Mutation(s) is at anchor(s)) AND ((WT binding < binding threshold) OR (WT percentile < percentile threshold))"), br(), - strong(" OR"), br(), strong("2. "), code("Mutation(s) not or not entirely at anchor(s)")), - p(strong("Low Expression Criteria: "), code("(allele expr > 0) OR ((gene expr == 0) AND (RNA Depth > RNA Coverage Cutoff) AND (RNA VAF > RNA vaf cutoff))")),br(), - p("Note that if a percentile threshold has been provided, then the ", code("%ile MT"), " column is also required to be lower than + strong(" OR"), br(), strong("2. "), code("Mutation(s) not or not entirely at anchor(s)")), + p(strong("Low Expression Criteria: "), code("(allele expr > 0) OR ((gene expr == 0) AND (RNA Depth > RNA Coverage Cutoff) AND (RNA VAF > RNA vaf cutoff))")),br(), + p("Note that if a percentile threshold has been provided, then the ", code("%ile MT"), " column is also required to be lower than the given threshold to qualify for tiers, including Pass, Anchor, Subclonal and LowExpr.") - ), - tabPanel("Transcript Level", - h3(" "), - fluidRow( - column(width = 6, - h4("Transcript Set Table", style = "font-weight: bold; text-decoration: underline;"), - p("Upon selecting a variant for investigation, you may have multiple transcripts covering the region.", br(), br(), - "These transcripts are grouped into ", strong("Trancripts Sets"), " , based on the good-binding peptides + ), + tabPanel("Transcript Level", + h3(" "), + fluidRow( + column(width = 6, + h4("Transcript Set Table", style = "font-weight: bold; text-decoration: underline;"), + p("Upon selecting a variant for investigation, you may have multiple transcripts covering the region.", br(), br(), + "These transcripts are grouped into ", strong("Trancripts Sets"), " , based on the good-binding peptides produced. (Transcripts that produce the exact same set of peptides are grouped together.)", br(), br(), - "The table also lists the number of transcripts and corresponding peptides in each set (each pair of WT and MT peptides are considered 1 when + "The table also lists the number of transcripts and corresponding peptides in each set (each pair of WT and MT peptides are considered 1 when counting).", br(), " A sum of the total expression across all transcripts in each set is also shown.", br(), " A light green color is used to highlight the ", strong("Transcript Set"), " producing the Best Peptide for the variant in question.") - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Transcript_Set.png?raw=true", - align = "center", height = "300px", width = "500px"), - ) - ), - fluidRow( - column(width = 3, - h4("Transcript Set Detailed Data", style = "font-weight: bold; text-decoration: underline;"), - p("Upon selecting a specific transcript set, you can see more details about the exact transcripts that are included.", br(), br(), - "The ", strong("Transcripts in Set"), "table lists all information regarding each transcript including:", br(), br(), - "Transcript ID, Gene Name, Amino Acid Change, Mutation Position, individual transcript expression, transcript support level, biotype and transcript length.", br(), br(), - " A light green color is used to highlight the specific", strong("Transcript in Selected Set"), " that produced the Best Peptide for the variant in question.") - ), - column(width = 9, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Transcript_in_Set.png?raw=true", - align = "center", height = "300px", width = "1200px"), - ) - ) - ), - tabPanel("Peptide Level", - h4(" "), - fluidRow( - column(width = 12, - h4("Peptide Table", style = "font-weight: bold; text-decoration: underline;"), - p("Upon selecting a specific transcript set, you can also visualize which good-binding peptides are produced from this set.", br(), br(), - "Both, mutant (", code("MT"), ") and wildtype (", code("WT"), ") sequences are shown, along with either the", code("lowest"), " or ", code("median"), - " binding affinities, depending on how you generated the aggregate report.", br(), br(), - "An ", code("X"), "is marked for binding affinities higher than the ", code("aggregate_inclusion_binding_threshold"), " set when generating the aggregate report.", br(), br(), - "We also include three extra columns, one specifying the mutated position(s) in the peptide, one providing information on any problematic amino acids in the mutant sequence, and one identifying whether the peptide failed the anchor criteria for any of the HLA alleles.", br(), - "Note that if users wish to utlitize the ", strong("problematic positions"), " feature, they should run the standalone command ", code("pvacseq identify_problematic_amino_acids"), - " or run pVACseq with the ", code("--problematic-amino-acids"), " option enabled to generate the needed information." - ) - ) - ), - fluidRow( - column(width = 12, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Peptide_Table.png?raw=true", - align = "center", height = "400px", width = "1500px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h4("Additional Information", style = "font-weight: bold; text-decoration: underline;"), - h5("IC50 Plot", style = "font-weight: bold;"), - p("By clicking on each MT/WT peptide pair, you can then assess the peptides in more detail by navigating to the ", strong("Additional Peptide Information"), " tab.", br(), br(), - "There are five different tabs in this section of the app, providing peptide-level details on the MT/WT peptide pair that you have selected.", br(), - "The ", strong("IC50 Plot"), "tab shows violin plots of the individual IC50-based binding affinity predictions of the MT and WT peptides for HLA + ), + column(width = 6, + img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Transcript_Set.png?raw=true", + align = "center", height = "300px", width = "500px"), + ) + ), + fluidRow( + column(width = 3, + h4("Transcript Set Detailed Data", style = "font-weight: bold; text-decoration: underline;"), + p("Upon selecting a specific transcript set, you can see more details about the exact transcripts that are included.", br(), br(), + "The ", strong("Transcripts in Set"), "table lists all information regarding each transcript including:", br(), br(), + "Transcript ID, Gene Name, Amino Acid Change, Mutation Position, individual transcript expression, transcript support level, biotype and transcript length.", br(), br(), + " A light green color is used to highlight the specific", strong("Transcript in Selected Set"), " that produced the Best Peptide for the variant in question.") + ), + column(width = 9, + img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Transcript_in_Set.png?raw=true", + align = "center", height = "300px", width = "1200px"), + ) + ) + ), + tabPanel("Peptide Level", + h4(" "), + fluidRow( + column(width = 12, + h4("Peptide Table", style = "font-weight: bold; text-decoration: underline;"), + p("Upon selecting a specific transcript set, you can also visualize which good-binding peptides are produced from this set.", br(), br(), + "Both, mutant (", code("MT"), ") and wildtype (", code("WT"), ") sequences are shown, along with either the", code("lowest"), " or ", code("median"), + " binding affinities, depending on how you generated the aggregate report.", br(), br(), + "An ", code("X"), "is marked for binding affinities higher than the ", code("aggregate_inclusion_binding_threshold"), " set when generating the aggregate report.", br(), br(), + "We also include three extra columns, one specifying the mutated position(s) in the peptide, one providing information on any problematic amino acids in the mutant sequence, and one identifying whether the peptide failed the anchor criteria for any of the HLA alleles.", br(), + "Note that if users wish to utlitize the ", strong("problematic positions"), " feature, they should run the standalone command ", code("pvacseq identify_problematic_amino_acids"), + " or run pVACseq with the ", code("--problematic-amino-acids"), " option enabled to generate the needed information." + ) + ) + ), + fluidRow( + column(width = 12, + img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Peptide_Table.png?raw=true", + align = "center", height = "400px", width = "1500px"), br(), br() + ) + ), + fluidRow( + column(width = 4, + h4("Additional Information", style = "font-weight: bold; text-decoration: underline;"), + h5("IC50 Plot", style = "font-weight: bold;"), + p("By clicking on each MT/WT peptide pair, you can then assess the peptides in more detail by navigating to the ", strong("Additional Peptide Information"), " tab.", br(), br(), + "There are five different tabs in this section of the app, providing peptide-level details on the MT/WT peptide pair that you have selected.", br(), + "The ", strong("IC50 Plot"), "tab shows violin plots of the individual IC50-based binding affinity predictions of the MT and WT peptides for HLA alleles that the MT binds well to. These peptides each have up to 8 binding algorithm scores for Class I alleles or up to 4 algorithm scores for Class II alleles.", br()) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_IC50_Plots.png?raw=true", - align = "center", height = "350px", width = "700px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h5("%ile Plot", style = "font-weight: bold;"), - p("The ", strong("%ile Plot"), "tab shows violin plots of the individual percentile-based binding affinity predictions of the MT and WT peptides + ), + column(width = 8, + img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_IC50_Plots.png?raw=true", + align = "center", height = "350px", width = "700px"), br(), br() + ) + ), + fluidRow( + column(width = 4, + h5("%ile Plot", style = "font-weight: bold;"), + p("The ", strong("%ile Plot"), "tab shows violin plots of the individual percentile-based binding affinity predictions of the MT and WT peptides for HLA alleles that the MT binds well to.", br()) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Percentile_Plots.png?raw=true", - align = "center", height = "350px", width = "700px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h5("Binding Data", style = "font-weight: bold;"), - p("The ", strong("Binding Data"), "tab shows the specific IC50 and percentile binding affinity predictions generated from each individual algorithm. + ), + column(width = 8, + img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Percentile_Plots.png?raw=true", + align = "center", height = "350px", width = "700px"), br(), br() + ) + ), + fluidRow( + column(width = 4, + h5("Binding Data", style = "font-weight: bold;"), + p("The ", strong("Binding Data"), "tab shows the specific IC50 and percentile binding affinity predictions generated from each individual algorithm. Each cell shows the IC50 prediction followed by the percentile predictions in parenthesis.", br()) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Binding_Data.png?raw=true", - align = "center", height = "350px", width = "720px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h5("Elution Table", style = "font-weight: bold;"), - p("The ", strong("Elution Table"), "tab shows prediction results based on algorithms trained from peptide elution data. This includes algorithms + ), + column(width = 8, + img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Binding_Data.png?raw=true", + align = "center", height = "350px", width = "720px"), br(), br() + ) + ), + fluidRow( + column(width = 4, + h5("Elution Table", style = "font-weight: bold;"), + p("The ", strong("Elution Table"), "tab shows prediction results based on algorithms trained from peptide elution data. This includes algorithms such as NetMHCpanEL/NetMHCIIpanEL, MHCflurryELProcessing and MHCflurryELPresentation.", br()) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Elution_Data.png?raw=true", - align = "center", height = "350px", width = "720px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h5("Anchor Heatmap", style = "font-weight: bold;"), - p("The ", strong("Anchor Heatmap"), "tab shows the top 30 MT/WT peptide pairs from the peptide table with anchor probabilities overlayed as a heatmap. + ), + column(width = 8, + img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Elution_Data.png?raw=true", + align = "center", height = "350px", width = "720px"), br(), br() + ) + ), + fluidRow( + column(width = 4, + h5("Anchor Heatmap", style = "font-weight: bold;"), + p("The ", strong("Anchor Heatmap"), "tab shows the top 30 MT/WT peptide pairs from the peptide table with anchor probabilities overlayed as a heatmap. The anchor probabilities shown are both allele and peptide length specific. The mutated amino acid is marked in red (for missense mutations) and each MT/WT pair are separated from others using a dotted line. ", br(), - "For peptide sequences with no overlaying heatmap, we currently do not have allele-specific predictions for them in our database.", br(), br(), - "For more details and explanations regarding anchor positions and its influence on neoantigen prediction and prioritization, please refer to the next section: ", - strong("Advanced Options: Anchor Contribution")) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Anchor_Heatmap.png?raw=trueg", - align = "center", height = "350px", width = "720px"), br(), br() - ) - ) - ), - tabPanel("Advanced Options: Anchor Contribution", - h4(" "), - fluidRow( - column(width = 6, - h4("Anchor vs Mutation Posiions", style = "font-weight: bold; text-decoration: underline;"), - p("Neoantigen identification and prioritization relies on correctly predicting whether the presented + "For peptide sequences with no overlaying heatmap, we currently do not have allele-specific predictions for them in our database.", br(), br(), + "For more details and explanations regarding anchor positions and its influence on neoantigen prediction and prioritization, please refer to the next section: ", + strong("Advanced Options: Anchor Contribution")) + ), + column(width = 8, + img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Anchor_Heatmap.png?raw=trueg", + align = "center", height = "350px", width = "720px"), br(), br() + ) + ) + ), + tabPanel("Advanced Options: Anchor Contribution", + h4(" "), + fluidRow( + column(width = 6, + h4("Anchor vs Mutation Posiions", style = "font-weight: bold; text-decoration: underline;"), + p("Neoantigen identification and prioritization relies on correctly predicting whether the presented peptide sequence can successfully induce an immune response. As the majority of somatic mutations are single nucleotide variants, changes between wildtype and mutated peptides are typically subtle and require cautious interpretation. ", br(), br(), - "In the context of neoantigen presentation by specific MHC alleles, researchers have noted that a subset of + "In the context of neoantigen presentation by specific MHC alleles, researchers have noted that a subset of peptide positions are presented to the T-cell receptor for recognition, while others are responsible for anchoring to the MHC, making these positional considerations critical for predicting T-cell responses.", br(), br(), - "Multiple factors should be considered when prioritizing neoantigens, including mutation location, anchor position, predicted MT + "Multiple factors should be considered when prioritizing neoantigens, including mutation location, anchor position, predicted MT and WT binding affinities, and WT/MT fold change, also known as agretopicity.", br(), br(), - "Examples of the four distinct possible scenarios for a predicted strong MHC binding peptide involving these factors are illustrated + "Examples of the four distinct possible scenarios for a predicted strong MHC binding peptide involving these factors are illustrated in the figure on the right. There are other possible scenarios where the MT is a poor binder, however those are not listed as they would not pertain to our goal of neoantigen identification.", br(), br(), - strong("Scenario 1"), "shows the case where the WT is a poor binder and the MT peptide is a strong binder, + strong("Scenario 1"), "shows the case where the WT is a poor binder and the MT peptide is a strong binder, containing a mutation at an anchor location. Here, the mutation results in a tighter binding of the MHC and allows for better presentation and potential for recognition by the TCR. As the WT does not bind (or is a poor binder), this neoantigen remains a good candidate since the sequence presented to the TCR is novel.", br(), br(), - strong("Scenario 2"), " and ", strong("Scenario 3"), " both have strong binding WT and MT peptides. In ", strong("Scenario 2"), - ", the mutation of the peptide is located at a non-anchor location, creating a difference in the sequence participating in TCR + strong("Scenario 2"), " and ", strong("Scenario 3"), " both have strong binding WT and MT peptides. In ", strong("Scenario 2"), + ", the mutation of the peptide is located at a non-anchor location, creating a difference in the sequence participating in TCR recognition compared to the WT sequence. In this case, although the WT is a strong binder, the neoantigen remains a good candidate that should not be subject to central tolerance.", br(), br(), - "However, as shown in ", strong("Scenario 3"), ", there are neoantigen candidates where the mutation is located at the anchor position + "However, as shown in ", strong("Scenario 3"), ", there are neoantigen candidates where the mutation is located at the anchor position and both peptides are strong binders. Although anchor positions can themselves influence TCR recognition, a mutation at a strong anchor location generally implies that both WT and MT peptides will present the same residues for TCR recognition. As the WT peptide is a strong binder, the MT neoantigen, while also a strong binder, will likely be subject to central tolerance and should not be considered for prioritization.", br(), br(), - strong("Scenario 4"), " is similar to the first scenario where the WT is a poor binder. However, in this case, the mutation is + strong("Scenario 4"), " is similar to the first scenario where the WT is a poor binder. However, in this case, the mutation is located at a non-anchor position, likely resulting in a different set of residues presented to the TCR and thus making the neoantigen a good candidate." - ) - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Anchor_Scenarios.png?raw=true", - align = "center", height = "800px", width = "400px"), br(), br() - ) - ), - fluidRow( - column(width = 6, - h4("Anchor Guidance", style = "font-weight: bold; text-decoration: underline;"), - p("To summarize, here are the specific criteria for prioritizing (accept) and not prioritizing (reject) a neoantigen candidate:", br(), - "Note that in all four cases, we are assuming a strong MT binder which means ", - code("(MT IC50 < binding threshold) OR (MT percentile < percentile threshold)"), br(), br()), - p(code("I: WT Weak binder"), " : ", code("(WT IC50 < binding threshold) OR (WT percentile < percentile threshold)")), - p(code("II: WT Strong binder"), " : ", code("(WT IC50 > binding threshold) AND (WT percentile > percentile threshold)")), - p(code("III: Mutation at Anchor"), " : ", code("set(All mutated positions) is a subset of set(Anchor Positions of corresponding HLA allele)")), - p(code("IV: Mutation not at Anchor"), " : ", code("There is at least one mutated position between the WT and MT that is not at an anchor position")), - p(strong("Scenario 1 : "), code(" I + IV"), strong(" -> Accept")), - p(strong("Scenario 2 : "), code(" II + IV"), strong(" -> Accept")), - p(strong("Scenario 3 : "), code(" II + III"), strong(" -> Reject")), - p(strong("Scenario 4 : "), code(" I + III"), strong(" -> Accept")) - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/anchor.jpg", - align = "center", height = "350px", width = "600px"), br(), br() - ) - ) - ), - tabPanel("Advanced Options: Regenerate Tiering", - h4(" "), - fluidRow( - column(width = 6, - h4("Reassigning Tiers for all variants after adjusting parameters", style = "font-weight: bold; text-decoration: underline;"), - p("The Tier column generated by pVACtools is aimed at helping users group and prioritize neoantigens in a more efficient manner. + ) + ), + column(width = 6, + img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Anchor_Scenarios.png?raw=true", + align = "center", height = "800px", width = "400px"), br(), br() + ) + ), + fluidRow( + column(width = 6, + h4("Anchor Guidance", style = "font-weight: bold; text-decoration: underline;"), + p("To summarize, here are the specific criteria for prioritizing (accept) and not prioritizing (reject) a neoantigen candidate:", br(), + "Note that in all four cases, we are assuming a strong MT binder which means ", + code("(MT IC50 < binding threshold) OR (MT percentile < percentile threshold)"), br(), br()), + p(code("I: WT Weak binder"), " : ", code("(WT IC50 < binding threshold) OR (WT percentile < percentile threshold)")), + p(code("II: WT Strong binder"), " : ", code("(WT IC50 > binding threshold) AND (WT percentile > percentile threshold)")), + p(code("III: Mutation at Anchor"), " : ", code("set(All mutated positions) is a subset of set(Anchor Positions of corresponding HLA allele)")), + p(code("IV: Mutation not at Anchor"), " : ", code("There is at least one mutated position between the WT and MT that is not at an anchor position")), + p(strong("Scenario 1 : "), code(" I + IV"), strong(" -> Accept")), + p(strong("Scenario 2 : "), code(" II + IV"), strong(" -> Accept")), + p(strong("Scenario 3 : "), code(" II + III"), strong(" -> Reject")), + p(strong("Scenario 4 : "), code(" I + III"), strong(" -> Accept")) + ), + column(width = 6, + img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/anchor.jpg", + align = "center", height = "350px", width = "600px"), br(), br() + ) + ) + ), + tabPanel("Advanced Options: Regenerate Tiering", + h4(" "), + fluidRow( + column(width = 6, + h4("Reassigning Tiers for all variants after adjusting parameters", style = "font-weight: bold; text-decoration: underline;"), + p("The Tier column generated by pVACtools is aimed at helping users group and prioritize neoantigens in a more efficient manner. For details on how Tiering is done, please refer to the Variant Level tutorial tab where we break down each specific Tier and its criteria.", br(), br(), - "While we try to provide a set of reasonable default parameters, we fully understand the need for flexible changes to the + "While we try to provide a set of reasonable default parameters, we fully understand the need for flexible changes to the parameters used in the underlying Tiering algorithm. Thus, we provide an Advanced Options tab in our app where users can change the following cutoffs custom to their individual analysis: ", br(), br(), - code("Binding Threshold"), p("IC50 cutoff for a peptide to be considered a strong binder. Note that if allele-specific binding thresholds are + code("Binding Threshold"), p("IC50 cutoff for a peptide to be considered a strong binder. Note that if allele-specific binding thresholds are in place, those will stay the same and not overwritten by this parameter value change."), br(), - code("Percentile Threshold"), p("Percentile cutoff for a peptide to be considered a strong binder."), br(), - code("Clonal DNA VAF"), p("VAF cutoff that is taken into account when deciding subclonal variants. Note that variants with a DNA VAF lower + code("Percentile Threshold"), p("Percentile cutoff for a peptide to be considered a strong binder."), br(), + code("Clonal DNA VAF"), p("VAF cutoff that is taken into account when deciding subclonal variants. Note that variants with a DNA VAF lower than half of the clonal VAF cutoff will be considered subclonal (e.g. setting a 0.6 clonal VAF cutoff means anything under 0.3 VAF is subclonal)."), br(), - code("Allele Expr"), p("Allele expression cutoff for a peptide to be considered expressed. Note for each variant, the allele expression + code("Allele Expr"), p("Allele expression cutoff for a peptide to be considered expressed. Note for each variant, the allele expression is calculated by multiplying gene expression and RNA VAF."), br(), - code("Default Anchors vs Allele-specific Anchors"), br(), - "By default, pVACtools considers positions 1, 2, n-1, and n to be anchors for an n-mer allele. However, a recent study has shown that anchors should be + code("Default Anchors vs Allele-specific Anchors"), br(), + "By default, pVACtools considers positions 1, 2, n-1, and n to be anchors for an n-mer allele. However, a recent study has shown that anchors should be considered on an allele-specific basis and different anchor patterns exist among HLA alleles.", - "Here, we provide users with the option to utilize allele-specific anchors when generating the Anchor Tier. However, to objectively determine + "Here, we provide users with the option to utilize allele-specific anchors when generating the Anchor Tier. However, to objectively determine which positions are anchors for each individual allele, the users need to set a contribution percentage threshold (X).", - "Per anchor calculation results from the described computational workflow in the cited paper, each position of the n-mer peptide is assigned a + "Per anchor calculation results from the described computational workflow in the cited paper, each position of the n-mer peptide is assigned a score based on how its binding to a certain HLA allele was influenced by mutations. These scores can then be used to calculate the relative contribution of each position to the overall binding affinity of the peptide. Given the contribution threshold X, we rank the normalized score across the peptide in descending order (e.g. [2,9,1,3,2,8,7,6,5] for a 9-mer peptide) and start summing the scores from top to bottom. Positions that together account for X% of the overall binding affinity change (e.g. 2,9,1) will be assigned as anchor locations for tiering purposes.", br(), br(), - "However, we recommend users also navigating to the Anchor Heatmap Tab in the peptide level description for a less binary approach." - ) - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Regenerate_Tiering.png?raw=true", - align = "center", height = "400px", width = "700px"), br(), br() - ) - ), - fluidRow( - column(width = 6, - h4("Original Parameters", style = "font-weight: bold; text-decoration: underline;"), - p(" In this box, we provide users with the original parameters they had used to generate the currently loaded aggregate report and metrics file.", - "This not only allows users to compare their current parameters (if changed) with the original setting but we also offer a ", strong("reset"), - " button that allows the user to restore the original tiering when desired.", br(), br(), - "Note that the app will keep track of your peptide evaluations and comments accordingly even when changing or reseting the parameters.", br(), br(), - "If you see a parameter in the original parameter box but did not see an option to change it in the advanced options section, it is likely that you + "However, we recommend users also navigating to the Anchor Heatmap Tab in the peptide level description for a less binary approach." + ) + ), + column(width = 6, + img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Regenerate_Tiering.png?raw=true", + align = "center", height = "400px", width = "700px"), br(), br() + ) + ), + fluidRow( + column(width = 6, + h4("Original Parameters", style = "font-weight: bold; text-decoration: underline;"), + p(" In this box, we provide users with the original parameters they had used to generate the currently loaded aggregate report and metrics file.", + "This not only allows users to compare their current parameters (if changed) with the original setting but we also offer a ", strong("reset"), + " button that allows the user to restore the original tiering when desired.", br(), br(), + "Note that the app will keep track of your peptide evaluations and comments accordingly even when changing or reseting the parameters.", br(), br(), + "If you see a parameter in the original parameter box but did not see an option to change it in the advanced options section, it is likely that you will be required to rerun the", code("pvacseq generate-aggregate-report"), " command. This is likely due to the current metrics file not having the necessary peptide information to perform this request." - ) - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Original_Parameters.png?raw=true", - align = "center", height = "400px", width = "300px"), br(), br() - ) - ) - ) - ) + ) + ), + column(width = 6, + img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Original_Parameters.png?raw=true", + align = "center", height = "400px", width = "300px"), br(), br() + ) + ) + ) + ) ) ## CONTACT TAB ## contact_tab <- tabItem("contact", - p("Bug reports or feature requests can be submitted on the ", tags$a(href = "https://github.com/griffithlab/pVACtools", "pVACtools Github page."), - "You may also contact us by email at ", code("help@pvactools.org", ".")) - + p("Bug reports or feature requests can be submitted on the ", tags$a(href = "https://github.com/griffithlab/pVACtools", "pVACtools Github page."), + "You may also contact us by email at ", code("help@pvactools.org", ".")) + ) ui <- dashboardPage( ## HEADER ## header = dashboardHeader( title = tagList(tags$a(class = "logo", - span(class = "logo-mini", tags$img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/pVACview_logo_mini.png")), - span(class = "logo-lg", tags$img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/pVACview_logo.png")) - )), + span(class = "logo-mini", tags$img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/pVACview_logo_mini.png")), + span(class = "logo-lg", tags$img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/pVACview_logo.png")) + )), tags$li(class = "dropdown", tags$a(href = "https://pvactools.readthedocs.io/en/latest/", class = "my_class", "Help", target = "_blank")) - ), + ), ## SIDEBAR ## sidebar = dashboardSidebar( sidebarMenu( @@ -599,6 +603,8 @@ ui <- dashboardPage( br() ), menuItem("Tutorials", tabName = "tutorial", startExpanded = TRUE, icon = icon("fas fa-book-open")), + menuItem("Neofox Data Visualization", tabName = "neofox", startExpanded = TRUE, icon = icon("fas fa-file")), + menuItem("Custom Data Visualization", tabName = "custom", startExpanded = TRUE, icon = icon("fas fa-pen-to-square")), menuItem("pVACview Documentation", icon = icon("fas fa-file-invoice"), href = "https://pvactools.readthedocs.io/en/latest/pvacview.html"), menuItem("Submit Github Issue", tabName = "contact", icon = icon("far fa-question-circle")) ) @@ -621,7 +627,7 @@ ui <- dashboardPage( tags$style(HTML(".box.box-solid.box-primary {border-radius: 12px}")), tags$style(HTML(".box-header.with-border {border-radius: 10px}")) ), - + tabItems( ## UPLOAD TAB ## upload_tab, @@ -631,8 +637,12 @@ ui <- dashboardPage( export_tab, ## TUTORIAL TAB ## tutorial_tab, + ## NEOFOX TAB ## + neofox_tab, + ## CUSTOM TAB ## + custom_tab, ## CONTACT TAB ## contact_tab ) ) -) +) \ No newline at end of file diff --git a/pvactools/tools/pvacview_dev/anchor_and_helper_functions.R b/pvactools/tools/pvacview_dev/anchor_and_helper_functions.R deleted file mode 100644 index e789ddaae..000000000 --- a/pvactools/tools/pvacview_dev/anchor_and_helper_functions.R +++ /dev/null @@ -1,411 +0,0 @@ -library(RCurl) -library(curl) - -## Load Anchor data -anchor_data <- list() -anchor_data[[8]] <- read.table(curl("https://raw.githubusercontent.com/griffithlab/pVACtools/ae938113ddbbe6c6eeecebf94459d449facd2c2f/tools/pvacview/data/Normalized_anchor_predictions_8_mer.tsv"), sep = "\t", header = TRUE, stringsAsFactors = FALSE) -anchor_data[[9]] <- read.table(curl("https://raw.githubusercontent.com/griffithlab/pVACtools/ae938113ddbbe6c6eeecebf94459d449facd2c2f/tools/pvacview/data/Normalized_anchor_predictions_9_mer.tsv"), sep = "\t", header = TRUE, stringsAsFactors = FALSE) -anchor_data[[10]] <- read.table(curl("https://raw.githubusercontent.com/griffithlab/pVACtools/ae938113ddbbe6c6eeecebf94459d449facd2c2f/tools/pvacview/data/Normalized_anchor_predictions_10_mer.tsv"), sep = "\t", header = TRUE, stringsAsFactors = FALSE) -anchor_data[[11]] <- read.table(curl("https://raw.githubusercontent.com/griffithlab/pVACtools/ae938113ddbbe6c6eeecebf94459d449facd2c2f/tools/pvacview/data/Normalized_anchor_predictions_11_mer.tsv"), sep = "\t", header = TRUE, stringsAsFactors = FALSE) - -#get binding affinity colors cutoffs given HLA - -scale_binding_affinity <- function(binding_cutoffs, is_specific, binding_threshold, hla, current_ba) { - if (is_specific[[hla]]) { - threshold <- as.numeric(binding_cutoffs[hla]) - return(as.numeric(current_ba) / threshold) - }else { - threshold <- as.numeric(binding_threshold) - return(as.numeric(current_ba) / threshold) - } -} - -#for custom table formatting -get_group_inds <- function(reformat_data, group_inds){ - group_data <- as.data.frame(group_inds[[1]]) - group_data$group_id <- rownames(group_data) - colnames(group_data)[colnames(group_data) == "group_inds[[1]]"] <- "inds" - rownames(group_data) <- NULL - return(group_data) -} - -get_current_group_info <- function(peptide_features, metricsData, fullData, selectedRow) { - subset_data <- fullData[, peptide_features] - inds <- metricsData[metricsData$group_id == selectedRow, ]$inds - current_peptide_data <- data.frame(subset_data[unlist(inds), ]) - return(current_peptide_data) -} - -#reformat table for display -table_formatting <- function(x, y) { - y[y == "X"] <- NA - peptide_ind <- grepl(x, colnames(y)) - peptide_columns <- y[, peptide_ind] - peptide_columns$Mutant <- x - colnames(peptide_columns) <- gsub(x, "", colnames(peptide_columns)) - colnames(peptide_columns) <- gsub("\\.", "", colnames(peptide_columns)) - peptide_columns_mt <- peptide_columns - peptide_columns_mt$wt_peptide <- NULL - ic50_mt <- dcast(peptide_columns_mt, Mutant ~ hla_types, value.var = "ic50s_MT") - ic50_mt[, !names(ic50_mt) == "Mutant"] <- round(as.numeric(ic50_mt[, !names(ic50_mt) == "Mutant"]), 2) - colnames(ic50_mt)[colnames(ic50_mt) == "Mutant"] <- "Peptide Sequence" - ic50_mt <- add_column(ic50_mt, Type = "MT", .after = "Peptide Sequence") - ic50_mt <- add_column(ic50_mt, `Problematic Positions` = peptide_columns$problematic_positions[[1]]) - peptide_columns_wt <- peptide_columns - peptide_columns_wt$Mutant <- NULL - ic50_wt <- dcast(peptide_columns_wt, wt_peptide ~ hla_types, value.var = "ic50s_WT") - ic50_wt[, !names(ic50_wt) == "wt_peptide"] <- round(as.numeric(ic50_wt[, !names(ic50_wt) == "wt_peptide"]), 2) - colnames(ic50_wt)[colnames(ic50_wt) == "wt_peptide"] <- "Peptide Sequence" - ic50_wt <- add_column(ic50_wt, Type = "WT", .after = "Peptide Sequence") - ic50_wt <- add_column(ic50_wt, `Problematic Positions` = "") - combined_data <- rbind(ic50_mt, ic50_wt) - combined_data$`Mutation Position` <- peptide_columns$mutation_position[[1]] - reordered_data <- combined_data %>% select(-one_of("Problematic Positions"), one_of("Problematic Positions")) - reordered_data$`Has ProbPos` <- apply(reordered_data, 1, function(x) (x["Problematic Positions"] != "") & (x["Problematic Positions"] != "None")) - reordered_data -} -#generate peptide coloring for hla allele -peptide_coloring <- function(hla_allele, peptide_row) { - peptide_length <- as.numeric(peptide_row["length"]) - if (peptide_length < 8) { - return(c("#999999")) - } - position <- as.numeric(peptide_row["x_pos"]) - anchor_score <- as.numeric(anchor_data[[peptide_length]][anchor_data[[peptide_length]]["HLA"] == hla_allele][2:(peptide_length + 1)]) - value_bins <- cut(anchor_score, breaks = seq(0, 1, len = 100), - include.lowest = TRUE) - colors <- colorRampPalette(c("lightblue", "blue"))(99)[value_bins] - return(colors[[position]]) -} -#calculate anchor list for specific peptide length and HLA allele combo given contribution cutoff -calculate_anchor <- function(hla_allele, peptide_length, anchor_contribution) { - result <- tryCatch({ - anchor_raw_data <- as.numeric(anchor_data[[peptide_length]][anchor_data[[peptide_length]]["HLA"] == hla_allele][2:(peptide_length + 1)]) - if (any(is.na(anchor_raw_data))) { - return("NA") - } - names(anchor_raw_data) <- as.character(1:length(anchor_raw_data)) - anchor_raw_data <- anchor_raw_data[order(unlist(anchor_raw_data), decreasing = TRUE)] - count <- 0 - anchor_list <- list() - for (i in 1:length(anchor_raw_data)) { - if (count >= anchor_contribution) { - return(anchor_list) - }else { - count <- count + anchor_raw_data[[i]] - anchor_list <- append(anchor_list, names(anchor_raw_data[i])) - } - } - return(anchor_list) - }, error = function(e) { return("NA") }) -} - -#converts string range (e.g. '2-4', '6') to associated list -range_str_to_seq <- function(mutation_position) { - rnge <- strsplit(mutation_position, "-")[[1]] - if (length(rnge) == 2) { - return(seq(rnge[1], rnge[2])) - }else { - return(c(strtoi(rnge[1]))) - } - return(0) -} - -#get data from metrics file associated with peptide if available -get_mt_peptide_data <- function(metrics_data_row, mt_peptide) { - for (trn in metrics_data_row$sets) { - res <- metrics_data_row$good_binders[[trn]]$peptides[[mt_peptide]] - if (!is.null(res)) { - return(res) - } - } - return(c()) -} - -#calculate the positions different between MT and WT peptide -calculate_mutation_info <- function(metrics_data_row) { - wt_peptide <- metrics_data_row$best_peptide_wt - if (is.na(wt_peptide)) { - return(0) - } - mt_peptide <- metrics_data_row$best_peptide_mt - mt_data <- get_mt_peptide_data(metrics_data_row, mt_peptide) - # if recorded mutation_position range, use it - if (length(mt_data) > 0) { - diff_positions <- range_str_to_seq(mt_data$"mutation_position") - }else { - split_positions <- strsplit(c(wt_peptide, mt_peptide), split = "") - diff_positions <- which(split_positions[[1]] != split_positions[[2]]) - } - return(diff_positions) -} -##Generate Tiering for given variant with specific cutoffs -tier <- function(variant_info, anchor_contribution, dna_cutoff, allele_expr_cutoff, mutation_pos_list, hla_allele, tsl, meta_data, anchor_mode) { - mt_binding <- as.numeric(variant_info["IC50 MT"]) - wt_binding <- as.numeric(variant_info["IC50 WT"]) - mt_percent <- as.numeric(variant_info["%ile MT"]) - wt_percent <- as.numeric(variant_info["%ile WT"]) - gene_expr <- as.numeric(variant_info["RNA Expr"]) - dna_vaf <- as.numeric(variant_info["DNA VAF"]) - rna_vaf <- as.numeric(variant_info["RNA VAF"]) - rna_depth <- as.numeric(variant_info["RNA Depth"]) - allele_expr <- as.numeric(variant_info["Allele Expr"]) - binding_threshold <- as.numeric(meta_data[["binding_cutoffs"]][hla_allele]) - trna_vaf <- as.numeric(meta_data["trna_vaf"]) - trna_cov <- as.numeric(meta_data["trna_cov"]) - percentile_filter <- FALSE - percentile_threshold <- NULL - if (!is.null(meta_data[["percentile_threshold"]])) { - percentile_threshold <- as.numeric(meta_data[["percentile_threshold"]]) - percentile_filter <- TRUE - } - tsl_max <- as.numeric(meta_data["maximum_transcript_support_level"]) - mutation_pos_list <- mutation_pos_list[["Pos"]] - if (anchor_mode == "default") { - anchor_list <- c(1, 2, nchar(variant_info[["Best Peptide"]]), nchar(variant_info[["Best Peptide"]]) - 1) - }else { - anchor_list <- unlist(calculate_anchor(hla_allele, length(unlist(strsplit(variant_info["Best Peptide"][[1]], split = ""))), anchor_contribution)) - if (anchor_list[[1]] == "NA") { - anchor_list <- c(1, 2, nchar(variant_info[["Best Peptide"]]), nchar(variant_info[["Best Peptide"]]) - 1) - } - } - anchor_residue_pass <- TRUE - # if all of mutated positions in anchors - if (grepl("-", mutation_pos_list, fixed = TRUE)) { - range_start <- as.numeric(strsplit(mutation_pos_list, "-")[[1]][1]) - if (range_start == 0) { - range_start <- 1 - } - range_stop <- as.numeric(strsplit(mutation_pos_list, "-")[[1]][2]) - mutation_pos_list <- c(range_start:range_stop) - if (all(mutation_pos_list %in% anchor_list)) { - if (is.na(wt_binding)) { - anchor_residue_pass <- FALSE - }else if (wt_binding < binding_threshold) { - anchor_residue_pass <- FALSE - } - } - }else if (!is.na(mutation_pos_list)) { - if (all(as.numeric(mutation_pos_list) %in% anchor_list)) { - if (is.na(wt_binding)) { - anchor_residue_pass <- FALSE - }else if (wt_binding < binding_threshold) { - anchor_residue_pass <- FALSE - }else if (!is.null(percentile_threshold) && (wt_percent) < percentile_threshold) { - anchor_residue_pass <- FALSE - } - } - } - tsl_pass <- TRUE - if ((tsl == "Not Supported")) { - tsl_pass <- TRUE - } - if ((tsl == "NA") || as.numeric(tsl) > tsl_max) { - tsl_pass <- FALSE - } - allele_expr_pass <- TRUE - if (!is.na(rna_vaf) && !is.na(gene_expr) && allele_expr <= allele_expr_cutoff) { - allele_expr_pass <- FALSE - } - vaf_clonal_pass <- TRUE - if (!is.na(dna_vaf) && dna_vaf < dna_cutoff / 2) { - vaf_clonal_pass <- FALSE - } - ## Assign Tiering - if ((mt_binding < binding_threshold) && allele_expr_pass && vaf_clonal_pass && tsl_pass && anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - return("Pass") - } - }else { - return("Pass") - } - } - - if ((mt_binding < binding_threshold) && allele_expr_pass && vaf_clonal_pass && tsl_pass && !anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - return("Anchor") - } - }else { - return("Anchor") - } - } - if ((mt_binding < binding_threshold) && allele_expr_pass && !vaf_clonal_pass && tsl_pass && anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - return("Subclonal") - } - }else { - return("Subclonal") - } - } - lowexpr <- FALSE - if (!is.na(rna_vaf) && !is.na(gene_expr) && !is.na(rna_depth)) { - if ((allele_expr > 0) || ((gene_expr == 0) && (rna_depth > trna_cov) && (rna_vaf > trna_vaf))) { - lowexpr <- TRUE - } - } - if ((mt_binding < binding_threshold) && lowexpr && vaf_clonal_pass && tsl_pass && anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - return("LowExpr") - } - }else { - return("LowExpr") - } - } - if (!is.na(allele_expr) && ((gene_expr == 0) || (rna_vaf == 0)) && !lowexpr) { - return("NoExpr") - } - return("Poor") -} -#Determine the Tier Count for given variant with specific cutoffs -tier_numbers <- function(variant_info, anchor_contribution, dna_cutoff, allele_expr_cutoff, mutation_pos_list, hla_allele, tsl, meta_data, anchor_mode) { - #browser() - mt_binding <- as.numeric(variant_info["IC50 MT"]) - wt_binding <- as.numeric(variant_info["IC50 WT"]) - mt_percent <- as.numeric(variant_info["%ile MT"]) - wt_percent <- as.numeric(variant_info["%ile WT"]) - gene_expr <- as.numeric(variant_info["RNA Expr"]) - dna_vaf <- as.numeric(variant_info["DNA VAF"]) - rna_vaf <- as.numeric(variant_info["RNA VAF"]) - rna_depth <- as.numeric(variant_info["RNA Depth"]) - allele_expr <- as.numeric(variant_info["Allele Expr"]) - binding_threshold <- as.numeric(meta_data[["binding_cutoffs"]][hla_allele]) - trna_vaf <- as.numeric(meta_data["trna_vaf"]) - trna_cov <- as.numeric(meta_data["trna_cov"]) - percentile_filter <- FALSE - percentile_threshold <- NULL - if (!is.null(meta_data[["percentile_threshold"]])) { - percentile_threshold <- as.numeric(meta_data[["percentile_threshold"]]) - percentile_filter <- TRUE - } - tsl_max <- as.numeric(meta_data["maximum_transcript_support_level"]) - mutation_pos_list <- mutation_pos_list[["Pos"]] - if (anchor_mode == "default") { - anchor_list <- c(1, 2, nchar(variant_info[["Best Peptide"]]), nchar(variant_info[["Best Peptide"]]) - 1) - }else { - anchor_list <- unlist(calculate_anchor(hla_allele, length(unlist(strsplit(variant_info["Best Peptide"][[1]], split = ""))), anchor_contribution)) - if (anchor_list[[1]] == "NA") { - anchor_list <- c(1, 2, nchar(variant_info[["Best Peptide"]]), nchar(variant_info[["Best Peptide"]]) - 1) - } - } - anchor_residue_pass <- TRUE - # if all of mutated positions in anchors - if (grepl("-", mutation_pos_list, fixed = TRUE)) { - range_start <- as.numeric(strsplit(mutation_pos_list, "-")[[1]][1]) - if (range_start == 0) { - range_start <- 1 - } - range_stop <- as.numeric(strsplit(mutation_pos_list, "-")[[1]][2]) - mutation_pos_list <- c(range_start:range_stop) - if (all(mutation_pos_list %in% anchor_list)) { - if (is.na(wt_binding)) { - anchor_residue_pass <- FALSE - }else if (wt_binding < binding_threshold) { - anchor_residue_pass <- FALSE - } - } - }else if (!is.na(mutation_pos_list)) { - if (all(as.numeric(mutation_pos_list) %in% anchor_list)) { - if (is.na(wt_binding)) { - anchor_residue_pass <- FALSE - }else if (wt_binding < binding_threshold) { - anchor_residue_pass <- FALSE - }else if (!is.null(percentile_threshold) && (wt_percent) < percentile_threshold) { - anchor_residue_pass <- FALSE - } - } - } - tsl_pass <- TRUE - if ((tsl == "Not Supported")) { - tsl_pass <- TRUE - } - else if ((tsl == "NA") || as.numeric(tsl) > tsl_max) { - tsl_pass <- FALSE - } - allele_expr_pass <- TRUE - if (!is.na(rna_vaf) && !is.na(gene_expr) && allele_expr <= allele_expr_cutoff) { - allele_expr_pass <- FALSE - } - vaf_clonal_pass <- TRUE - if (!is.na(dna_vaf) && dna_vaf < dna_cutoff / 2) { - vaf_clonal_pass <- FALSE - } - ## Pass - if ((mt_binding < binding_threshold) && allele_expr_pass && vaf_clonal_pass && tsl_pass && anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - return(1) - } - }else { - return(1) - } - } - ## Anchor - if ((mt_binding < binding_threshold) && allele_expr_pass && vaf_clonal_pass && tsl_pass && !anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - return(5) - } - }else { - return(5) - } - } - if ((mt_binding < binding_threshold) && allele_expr_pass && !vaf_clonal_pass && tsl_pass && anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - return(6) - } - }else { - return(6) - } - } - lowexpr <- FALSE - if (!is.na(rna_vaf) && !is.na(gene_expr) && !is.na(rna_depth)) { - if ((allele_expr > 0) || ((gene_expr == 0) && (rna_depth > trna_cov) && (rna_vaf > trna_vaf))) { - lowexpr <- TRUE - } - } - if ((mt_binding < binding_threshold) && (lowexpr) && vaf_clonal_pass && tsl_pass && anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - if (allele_expr > 0) { - return(7) - }else if ((gene_expr == 0) && (rna_depth > trna_cov) && (rna_vaf > trna_vaf)) { - return(8) - } - } - }else { - if (allele_expr > 0) { - return(7) - }else if ((gene_expr == 0) && (rna_depth > trna_cov) && (rna_vaf > trna_vaf)) { - return(8) - } - } - } - if (!is.na(allele_expr) && ((gene_expr == 0) || (rna_vaf == 0)) && !lowexpr) { - if ((gene_expr == 0) && (rna_vaf != 0)) { - return(9) - }else if ((gene_expr != 0) && (rna_vaf == 0)) { - return(10) - }else { - return(11) - } - } - count <- 12 - if (!anchor_residue_pass) { - count <- count + 1 - } - if (!vaf_clonal_pass) { - count <- count + 2 - } - if (!is.na(gene_expr) && !is.na(rna_depth) && !is.na(rna_vaf) && (gene_expr == 0) && (rna_depth > trna_cov) && (rna_vaf > trna_vaf)) { - count <- count + 4 - } - if (!is.na(allele_expr) && allele_expr > 0 && allele_expr < allele_expr_cutoff) { - count <- count + 8 - } - return(count) -} \ No newline at end of file diff --git a/pvactools/tools/pvacview_dev/custom_ui.R b/pvactools/tools/pvacview_dev/custom_ui.R deleted file mode 100644 index a9388f172..000000000 --- a/pvactools/tools/pvacview_dev/custom_ui.R +++ /dev/null @@ -1,74 +0,0 @@ -custom_tab <- tabItem("custom", - tabsetPanel(type = "tabs", id = "custom_tabs", - tabPanel(title = "Upload Data", value = "custom_upload", - fluidRow( - column(width = 6, - box( - title = "Option 1: View Demo data", status = "primary", solidHeader = TRUE, width = NULL, - actionButton("loadDefault_Vaxrank", "Load demo data (VaxRank output)", style = "color: #fff; background-color: #c92424; border-color: #691111"), - h5("Please wait a couple seconds after clicking for the data to load.") - ), - box( - title = "Option 2: View NeoPredPipe demo data", status = "primary", solidHeader = TRUE, width = NULL, - actionButton("loadDefault_Neopredpipe", "Load demo data (NeoPredPipe output)", style = "color: #fff; background-color: #c92424; border-color: #691111"), - h5("Please wait a couple seconds after clicking for the data to load.") - ), - box( - title = "Option 3: View antigen.garnish demo data", status = "primary", solidHeader = TRUE, width = NULL, - actionButton("loadDefault_antigengarnish", "Load demo data (antigen.garnish output)", style = "color: #fff; background-color: #c92424; border-color: #691111"), - h5("Please wait a couple seconds after clicking for the data to load.") - ), - box( - title = "Option 4: Upload your own custom data files", status = "primary", solidHeader = TRUE, width = NULL, - HTML("
(Required) Please upload your neofox output file. This file should be a table generated by NeoFox with the suffix “_neoantigen_candidates_annotated.tsv“"), - br(), br(), - uiOutput("custom_upload_ui") - ), - uiOutput("custom_group_by_feature_ui"), - uiOutput("custom_order_by_feature_ui"), - uiOutput("custom_peptide_features_ui"), - actionButton("visualize_custom", "Visualize") - ), - column(6, - box( - title = "Example Neoantigen Prediction Pipelines", status = "primary", solidHeader = TRUE, width = NULL, - h4("Vaxrank: A computational tool for designing personalized cancer vaccines", style = "font-weight: bold; text-decoration: underline;"), - h5("Therapeutic vaccines targeting mutant tumor antigens (“neoantigens”) are an increasingly popular form of personalized cancer immunotherapy. - Vaxrank is a computational tool for selecting neoantigen vaccine peptides from tumor mutations, tumor RNA data, and patient HLA type. - Vaxrank is freely available at www.github.com/openvax/vaxrank under the Apache 2.0 open source license and can also be installed from the Python Package Index."), - actionButton("vaxrank_help_doc", "Vaxrank Gtihub", onclick = "window.open('https://github.com/openvax/vaxrank', '_blank')"), - hr(style = "border-color: white"), - h4("NeoPredPipe: high-throughput neoantigen prediction and recognition potential pipeline", style = "font-weight: bold; text-decoration: underline;"), - h5("NeoPredPipe (Neoantigen Prediction Pipeline) is offered as a contiguous means of predicting putative neoantigens and their corresponding recognition potentials for - both single and multi-region tumor samples. This tool allows a user to process neoantigens predicted from single- or multi-region vcf files using ANNOVAR and netMHCpan."), - actionButton("neopredpipe_help_doc", "NeoPredPipe Gtihub", onclick = "window.open('https://github.com/MathOnco/NeoPredPipe', '_blank')"), - hr(style = "border-color: white"), - h4("antigen.garnish.2: Tumor neoantigen prediction", style = "font-weight: bold; text-decoration: underline;"), - h5("Human and mouse ensemble tumor neoantigen prediction from SNVs and complex variants. Immunogenicity filtering based on the Tumor Neoantigen Selection Alliance (TESLA)."), - actionButton("antigen_garnish_help_doc", "antigen.garnish Gtihub", onclick = "window.open('https://github.com/andrewrech/antigen.garnish', '_blank')"), - hr(style = "border-color: white") - ) - ) - ) - ), - tabPanel(title = "Explore Data", value = "custom_explore", - fluidRow( - box(width = 12, - title="Overview of Neoantigen Features", - status='primary', solidHeader = TRUE, collapsible = TRUE, - enable_sidebar = TRUE, sidebar_width = 25, sidebar_start_open = TRUE, - DTOutput('customTable')%>% withSpinner(color="#8FCCFA"), - span("Currently investigating row: ", verbatimTextOutput("customSelected")), - style = "overflow-x: scroll;font-size:100%") - ), - fluidRow( - box(width = 12, title = "Detailed Data", solidHeader = TRUE, collapsible = TRUE, status = "primary", - tabBox(width = 12, title = " ", - tabPanel("Peptide candidates grouped by selected feature", - DTOutput('customPeptideTable')%>% withSpinner(color="#8FCCFA"), style = "overflow-x: scroll;font-size:100%") - ) - ) - ) - ) - ) -) \ No newline at end of file diff --git a/pvactools/tools/pvacview_dev/main.py b/pvactools/tools/pvacview_dev/main.py deleted file mode 100644 index 69fdd1245..000000000 --- a/pvactools/tools/pvacview_dev/main.py +++ /dev/null @@ -1,30 +0,0 @@ -import argparse -import sys -from subprocess import call -import os -import pkg_resources -from pvactools.tools.pvacview import * - -def main(): - parser = argparse.ArgumentParser(formatter_class=argparse.ArgumentDefaultsHelpFormatter) - subparsers = parser.add_subparsers() - - #add subcommands - run_main_program_parser = subparsers.add_parser( - "run", - help="Run the pVACview R shiny application", - add_help=False - ) - run_main_program_parser.set_defaults(func=run) - - args = parser.parse_known_args() - try: - args[0].func.main(args[1]) - except AttributeError as e: - parser.print_help() - print("Error: No command specified") - sys.exit(-1) - - -if __name__ == '__main__': - main() diff --git a/pvactools/tools/pvacview_dev/neofox_ui.R b/pvactools/tools/pvacview_dev/neofox_ui.R deleted file mode 100644 index 532ebf41b..000000000 --- a/pvactools/tools/pvacview_dev/neofox_ui.R +++ /dev/null @@ -1,51 +0,0 @@ -neofox_tab <- tabItem("neofox", - tabsetPanel(type = "tabs", id = "neofox_tabs", - tabPanel(title = "Upload Data", value = "neofox_upload", - fluidRow( - column(width = 6, - box( - title = "Option 1: View NeoFox demo data", status = "primary", solidHeader = TRUE, width = NULL, - actionButton("loadDefaultneofox", "Load neofox output data for HCC1395", style = "color: #fff; background-color: #c92424; border-color: #691111"), - h5("Please wait a couple seconds after clicking for the data to load.") - ), - box( - title = "Option 2: Upload your own neofox data files", status = "primary", solidHeader = TRUE, width = NULL, - HTML("
(Required) Please upload your neofox output file. This file should be a table generated by NeoFox with the suffix “_neoantigen_candidates_annotated.tsv“"), - br(), br(), - uiOutput("neofox_upload_ui"), - actionButton("visualize_neofox", "Visualize") - ) - ), - column(6, - box( - title = "NeoFox (NEOantigen Feature toolbOX)", status = "primary", solidHeader = TRUE, width = NULL, - h5("NeoFox (NEOantigen Feature toolbOX) is a python package that annotates a given set of neoantigen candidate sequences with relevant neoantigen features."), - h5("The tool covers neoepitope prediction by MHC binding and ligand prediction, similarity/foreignness of a neoepitope candidate sequence, combinatorial features and machine learning approaches by - running a wide range of published toolsets on the given input data. For more detailed information on the specific neoantigen-related algorithms and how to generate your own NeoFox results, please - refer to the link below: "), br(), - actionButton("neofox_help_doc", "NeoFox Website", onclick = "window.open('https://neofox.readthedocs.io/en/latest/index.html', '_blank')") - ) - ) - ) - ), - tabPanel(title = "Explore Data", value = "neofox_explore", - fluidRow( - box(width = 12, - title = "Annotated Neoantigen Candidates using NeoFox", - status = "primary", solidHeader = TRUE, collapsible = TRUE, - enable_sidebar = TRUE, sidebar_width = 25, sidebar_start_open = TRUE, - selectInput("neofox_page_length", "Number of entries displayed per page:", selected = "10", c("10", "20", "50", "100"), width = "280px"), - DTOutput("neofoxTable") %>% withSpinner(color = "#8FCCFA"), - span("Currently investigating row(s): ", verbatimTextOutput("neofox_selected")), - style = "overflow-x: scroll;font-size:100%") - ), - fluidRow( - box(width = 12, title = "Data Visualization", status = "primary", solidHeader = TRUE, collapsible = TRUE, - h4("Violin Plots showing distribution of various neoantigen features for selected variants."), - plotOutput(outputId = "neofox_violin_plots_row1") %>% withSpinner(color = "#8FCCFA"), - plotOutput(outputId = "neofox_violin_plots_row2") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" - ) - ) - ) - ) -) \ No newline at end of file diff --git a/pvactools/tools/pvacview_dev/run.py b/pvactools/tools/pvacview_dev/run.py deleted file mode 100644 index 080abb4f6..000000000 --- a/pvactools/tools/pvacview_dev/run.py +++ /dev/null @@ -1,23 +0,0 @@ -import argparse -import os -import sys -from subprocess import run, DEVNULL, STDOUT - -def define_parser(): - parser = argparse.ArgumentParser( - "pvacview run", - description="Launch pVACview R shiny application", - formatter_class=argparse.ArgumentDefaultsHelpFormatter - ) - parser.add_argument('pvacseq_dir', help='pVACseq results directory path (e.g. ~/Downloads/pvacseq_run/MHC_Class_I/)') - parser.add_argument('--r_path', default='R', help='Location of R to be used for launching the app (e.g. /usr/local/bin/R)') - return parser - -def main(args_input = sys.argv[1:]): - parser = define_parser() - args = parser.parse_args(args_input) - arguments = ['{}'.format(args.r_path), "-e", "shiny::runApp('{}')".format(args.pvacseq_dir)] - response = run(arguments, check=True) - -if __name__ == '__main__': - main() diff --git a/pvactools/tools/pvacview_dev/server.R b/pvactools/tools/pvacview_dev/server.R deleted file mode 100644 index bc54dc0f4..000000000 --- a/pvactools/tools/pvacview_dev/server.R +++ /dev/null @@ -1,1326 +0,0 @@ -library(shiny) -library(ggplot2) -library(DT) -library(reshape2) -library(jsonlite) -library(tibble) -library(tidyr) -library(plyr) -library(dplyr) -library(grid) -library(gridExtra) -library(shinyWidgets) - -source("anchor_and_helper_functions.R", local = TRUE) -source("styling.R") - -#specify max shiny app upload size (currently 300MB) -options(shiny.maxRequestSize = 300 * 1024^2) -options(shiny.host = '127.0.0.1') -options(shiny.port = 3333) - -server <- shinyServer(function(input, output, session) { - - ##############################DATA UPLOAD TAB################################### - ## helper function defined for generating shinyInputs in mainTable (Evaluation dropdown menus) - shinyInput <- function(data, FUN, len, id, ...) { - inputs <- character(len) - for (i in seq_len(len)) { - inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ..., selected = data[i, "Evaluation"])) - } - inputs - } - ## helper function defined for generating shinyInputs in mainTable (Investigate button) - shinyInputSelect <- function(FUN, len, id, ...) { - inputs <- character(len) - for (i in seq_len(len)) { - inputs[i] <- as.character(FUN(paste0(id, i), ...)) - } - inputs - } - ## helper function defined for getting values of shinyInputs in mainTable (Evaluation dropdown menus) - shinyValue <- function(id, len, data) { - unlist(lapply(seq_len(len), function(i) { - value <- input[[paste0(id, i)]] - if (is.null(value)) { - data[i, "Evaluation"] - } else { - value - } - })) - } - #reactive values defined for row selection, main table, metrics data, additional data, and dna cutoff - df <- reactiveValues( - selectedRow = 1, - mainTable = NULL, - dna_cutoff = NULL, - metricsData = NULL, - additionalData = NULL, - gene_list = NULL, - binding_threshold = NULL, - aggregate_inclusion_binding_threshold = NULL, - percentile_threshold = NULL, - binding_cutoffs = NULL, - is_allele_specific_binding_cutoff = NULL, - allele_expr = NULL, - anchor_mode = NULL, - anchor_contribution = NULL, - comments = data.frame("N/A"), - pageLength = 10 - ) - #Option 1: User uploaded main aggregate report file - observeEvent(input$mainDataInput$datapath, { - #session$sendCustomMessage("unbind-DT", "mainTable") - mainData <- read.table(input$mainDataInput$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - mainData$`Eval` <- shinyInput(mainData, selectInput, nrow(mainData), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - mainData$Select <- shinyInputSelect(actionButton, nrow(mainData), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') - mainData$`IC50 MT` <- as.numeric(mainData$`IC50 MT`) - mainData$`%ile MT` <- as.numeric(mainData$`%ile MT`) - mainData$`RNA Depth` <- as.integer(mainData$`RNA Depth`) - mainData$`TSL`[is.na(mainData$`TSL`)] <- "NA" - df$mainTable <- mainData - df$metricsData <- NULL - }) - #Option 1: User uploaded metrics file - observeEvent(input$metricsDataInput, { - df$metricsData <- fromJSON(input$metricsDataInput$datapath) - df$binding_threshold <- df$metricsData$`binding_threshold` - df$aggregate_inclusion_binding_threshold <- df$metricsData$`aggregate_inclusion_binding_threshold` - df$percentile_threshold <- df$metricsData$`percentile_threshold` - df$binding_cutoffs <- df$metricsData$`binding_cutoffs` - df$is_allele_specific_binding_cutoff <- df$metricsData$`is_allele_specific_binding_cutoff` - df$dna_cutoff <- df$metricsData$vaf_clonal - df$allele_expr <- df$metricsData$allele_expr_threshold - df$anchor_mode <- ifelse(df$metricsData$`allele_specific_anchors`, "allele-specific", "default") - df$anchor_contribution <- df$metricsData$`anchor_contribution_threshold` - hla <- names(df$metricsData$binding_cutoffs) - if (input$hla_class == "class_i"){ - converted_hla_names <- unlist(lapply(hla, function(x) {strsplit(x, "HLA-")[[1]][2]})) - } else if (input$hla_class == "class_ii"){ - converted_hla_names <- hla - } - if (!("Ref Match" %in% colnames(df$mainTable))) { - df$mainTable$`Ref Match` <- "Not Run" - } - columns_needed <- c("ID", converted_hla_names, "Gene", "AA Change", "Num Passing Transcripts", "Best Peptide", "Best Transcript", "TSL", "Allele", - "Pos", "Prob Pos", "Num Passing Peptides", "IC50 MT", "IC50 WT", "%ile MT", "%ile WT", "RNA Expr", "RNA VAF", - "Allele Expr", "RNA Depth", "DNA VAF", "Tier", "Ref Match", "Evaluation", "Eval", "Select") - if ("Comments" %in% colnames(df$mainTable)) { - columns_needed <- c(columns_needed, "Comments") - df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) - }else { - df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) - } - df$mainTable <- df$mainTable[, columns_needed] - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) - if ("Comments" %in% colnames(df$mainTable)) { - df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) - }else { - df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) - } - rownames(df$comments) <- df$mainTable$ID - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$binding_cutoffs, df$is_allele_specific_binding_cutoff, df$binding_threshold, x["Allele"], x["IC50 MT"])) - df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse(is.null(df$percentile_threshold), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) - df$mainTable$`Bad TSL` <- apply(df$mainTable, 1, function(x) {x["TSL"] == "NA" | (x["TSL"] != "NA" & x["TSL"] != "Not Supported" & x["TSL"] > df$metricsData$maximum_transcript_support_level)}) - df$mainTable$`Col RNA Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Expr"]), 0, x["RNA Expr"])}) - df$mainTable$`Col RNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA VAF"]), 0, x["RNA VAF"])}) - df$mainTable$`Col Allele Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["Allele Expr"]), 0, x["Allele Expr"])}) - df$mainTable$`Col RNA Depth` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Depth"]), 0, x["RNA Depth"])}) - df$mainTable$`Col DNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["DNA VAF"]), 0, x["DNA VAF"])}) - if (is.null(df$percentile_threshold)) { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) - }else { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) - } - df$mainTable$`Has Prob Pos` <- apply(df$mainTable, 1, function(x) {ifelse(x["Prob Pos"] != "None", TRUE, FALSE)}) - }) - #Option 1: User uploaded additional data file - observeEvent(input$additionalDataInput, { - addData <- read.table(input$additionalDataInput$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(addData) <- addData[1, ] - addData <- addData[-1, ] - row.names(addData) <- NULL - df$additionalData <- addData - }) - #Option 1: User uploaded additional gene list - observeEvent(input$gene_list, { - gene_list <- read.table(input$gene_list$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - df$gene_list <- gene_list - df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) - }) - #Option 2: Load from HCC1395 demo data from github - observeEvent(input$loadDefaultmain, { - ## Class I demo aggregate report - #session$sendCustomMessage("unbind-DT", "mainTable") - #data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/f83c52c8b8387beae69be8b200a44dcf199d9af2/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_I.all_epitopes.aggregated.tsv") - #mainData <- read.table(text = data, sep = '\t', header = FALSE, stringsAsFactors = FALSE, check.names=FALSE) - #data <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/v11/data/H_NJ-HCC1395-HCC1395.all_epitopes.aggregated.all_parameters.7.1000.tsv" - data <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/debugging/MHC_Class_I/mcdb044-tumor-exome.all_epitopes.aggregated.tsv" - mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - mainData$`Eval` <- shinyInput(mainData, selectInput, nrow(mainData), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - mainData$Select <- shinyInputSelect(actionButton, nrow(mainData), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') - mainData$`IC50 MT` <- as.numeric(mainData$`IC50 MT`) - mainData$`%ile MT` <- as.numeric(mainData$`%ile MT`) - mainData$`RNA Depth` <- as.integer(mainData$`RNA Depth`) - mainData$`TSL`[is.na(mainData$`TSL`)] <- "NA" - df$mainTable <- mainData - ## Class I demo metrics file - #metricsdata <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/f83c52c8b8387beae69be8b200a44dcf199d9af2/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_I.all_epitopes.aggregated.metrics.json") - #metricsdata <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/v11/data/H_NJ-HCC1395-HCC1395.all_epitopes.aggregated.all_parameters.7.1000.metrics.json" - metricsdata <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/debugging/MHC_Class_I/mcdb044-tumor-exome.all_epitopes.aggregated.metrics.json" - df$metricsData <- fromJSON(txt = metricsdata) - df$binding_threshold <- df$metricsData$`binding_threshold` - df$aggregate_inclusion_binding_threshold <- df$metricsData$`aggregate_inclusion_binding_threshold` - df$percentile_threshold <- df$metricsData$`percentile_threshold` - df$binding_cutoffs <- df$metricsData$`binding_cutoffs` - df$is_allele_specific_binding_cutoff <- df$metricsData$`is_allele_specific_binding_cutoff` - df$dna_cutoff <- df$metricsData$vaf_clonal - df$allele_expr <- df$metricsData$allele_expr_threshold - df$anchor_mode <- ifelse(df$metricsData$`allele_specific_anchors`, "allele-specific", "default") - df$anchor_contribution <- df$metricsData$`anchor_contribution_threshold` - hla <- names(df$metricsData$binding_cutoffs) - converted_hla_names <- unlist(lapply(hla, function(x) {strsplit(x, "HLA-")[[1]][2]})) - if (!("Ref Match" %in% colnames(df$mainTable))) { - df$mainTable$`Ref Match` <- "Not Run" - } - columns_needed <- c("ID", converted_hla_names, "Gene", "AA Change", "Num Passing Transcripts", "Best Peptide", "Best Transcript", "TSL", "Allele", - "Pos", "Prob Pos", "Num Passing Peptides", "IC50 MT", "IC50 WT", "%ile MT", "%ile WT", "RNA Expr", "RNA VAF", - "Allele Expr", "RNA Depth", "DNA VAF", "Tier", "Ref Match", "Evaluation", "Eval", "Select") - if ("Comments" %in% colnames(df$mainTable)) { - columns_needed <- c(columns_needed, "Comments") - df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) - }else { - df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) - } - df$mainTable <- df$mainTable[, columns_needed] - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - if ("Comments" %in% colnames(df$mainTable)) { - df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) - }else { - df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) - } - rownames(df$comments) <- df$mainTable$ID - ## Class II additional demo aggregate report - add_data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/6c24091a9276618af422c76cc9f1c23f16c2074d/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_II.all_epitopes.aggregated.tsv") - addData <- read.table(text = add_data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(addData) <- addData[1, ] - addData <- addData[-1, ] - row.names(addData) <- NULL - df$additionalData <- addData - ## Hotspot gene list autoload - gene_data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/7c7b8352d81b44ec7743578e7715c65261f5dab7/pvactools/tools/pvacview/data/cancer_census_hotspot_gene_list.tsv") - gene_list <- read.table(text = gene_data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - df$gene_list <- gene_list - df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$binding_cutoffs, df$is_allele_specific_binding_cutoff, df$binding_threshold, x["Allele"], x["IC50 MT"])) - df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse(is.null(df$percentile_threshold), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) - df$mainTable$`Bad TSL` <- apply(df$mainTable, 1, function(x) {x["TSL"] == "NA" | (x["TSL"] != "NA" & x["TSL"] != "Not Supported" & x["TSL"] > df$metricsData$maximum_transcript_support_level)}) - df$mainTable$`Col RNA Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Expr"]), 0, x["RNA Expr"])}) - df$mainTable$`Col RNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA VAF"]), 0, x["RNA VAF"])}) - df$mainTable$`Col Allele Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["Allele Expr"]), 0, x["Allele Expr"])}) - df$mainTable$`Col RNA Depth` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Depth"]), 0, x["RNA Depth"])}) - df$mainTable$`Col DNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["DNA VAF"]), 0, x["DNA VAF"])}) - if (is.null(df$percentile_threshold)) { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) - }else { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) - } - df$mainTable$`Has Prob Pos` <- apply(df$mainTable, 1, function(x) {ifelse(x["Prob Pos"] != "None", TRUE, FALSE)}) - updateTabItems(session, "tabs", "explore") - }) - ##Clear file inputs if demo data load button is clicked - output$aggregate_report_ui <- renderUI({ - input$loadDefaultmain - fileInput(inputId = "mainDataInput", label = "1. Neoantigen Candidate Aggregate Report (tsv required)", - accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) - }) - output$metrics_ui <- renderUI({ - input$loadDefaultmain - fileInput(inputId = "metricsDataInput", label = "2. Neoantigen Candidate Metrics file (json required)", - accept = c("application/json", ".json")) - }) - output$add_file_ui <- renderUI({ - input$loadDefaultmain - fileInput(inputId = "additionalDataInput", label = "3. Additional Neoantigen Candidate Aggregate Report (tsv required)", - accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) - }) - ##Visualize button - observeEvent(input$visualize, { - updateTabItems(session, "tabs", "explore") - }) - ##Parameter UIs - output$binding_threshold_ui <- renderUI({ - current_binding <- df$binding_threshold - max_cutoff <- df$aggregate_inclusion_binding_threshold - numericInput("binding_threshold", "Binding Threshold", current_binding, min = 0, max = max_cutoff, step = 10, width = 500) - }) - output$percentile_threshold_ui <- renderUI({ - current_percentile <- df$percentile_threshold - numericInput("percentile_threshold", "Percentile Threshold", current_percentile, min = 0, max = 100, step = 0.01, width = 500) - }) - output$dna_cutoff_ui <- renderUI({ - current_dna_cutoff <- df$dna_cutoff - numericInput("dna_cutoff", "Clonal DNA VAF (Anything lower than 1/2 of chosen VAF level will be considered subclonal)", current_dna_cutoff, min = 0, max = 1, step = 0.01, width = 500) - }) - output$allele_expr_ui <- renderUI({ - current_allele_expr <- df$allele_expr - numericInput("allele_expr", "Allele Expression cutoff to be considered a Pass variant. Note that this criteria is also used in determining Anchor and Subclonal variants.", current_allele_expr, min = 0, max = 100, step = 0.1, width = 500) - }) - #reactions for once "regenerate table" command is submitted - observeEvent(input$submit, { - session$sendCustomMessage("unbind-DT", "mainTable") - df$binding_threshold <- input$binding_threshold - df$percentile_threshold <- input$percentile_threshold - df$dna_cutoff <- input$dna_cutoff - df$allele_expr <- input$allele_expr - df$mainTable$`Evaluation` <- shinyValue("selecter_", nrow(df$mainTable), df$mainTable) - if (input$use_anchor) { - df$anchor_mode <- "allele-specific" - df$anchor_contribution <- input$anchor_contribution - df$mainTable$`Tier` <- apply(df$mainTable, 1, function(x) tier(x, df$anchor_contribution, input$dna_cutoff, input$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, input$dna_cutoff, input$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - }else { - df$anchor_mode <- "default" - df$mainTable$`Tier` <- apply(df$mainTable, 1, function(x) tier(x, df$anchor_contribution, input$dna_cutoff, input$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, input$dna_cutoff, input$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - } - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$binding_cutoffs, df$is_allele_specific_binding_cutoff, df$binding_threshold, x["Allele"], x["IC50 MT"])) - df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse((is.null(df$percentile_threshold) || is.na(df$percentile_threshold)), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) - if (is.null(df$percentile_threshold) || is.na(df$percentile_threshold)) { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) - }else { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) - } - tier_sorter <- c("Pass", "LowExpr", "Anchor", "Subclonal", "Poor", "NoExpr") - df$mainTable$`Rank_ic50` <- NA - df$mainTable$`Rank_expr` <- NA - df$mainTable$`Rank_ic50` <- rank(as.numeric(df$mainTable$`IC50 MT`), ties.method = "first") - df$mainTable$`Rank_expr` <- rank(desc(as.numeric(df$mainTable$`Allele Expr`)), ties.method = "first") - df$mainTable$`Rank` <- df$mainTable$`Rank_ic50` + df$mainTable$`Rank_expr` - df$mainTable <- df$mainTable %>% - arrange(factor(Tier, levels = tier_sorter), Rank) - df$mainTable$`Rank` <- NULL - df$mainTable$`Rank_ic50` <- NULL - df$mainTable$`Rank_expr` <- NULL - df$mainTable$Select <- shinyInputSelect(actionButton, nrow(df$mainTable), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') - df$mainTable$`Eval` <- shinyInput(df$mainTable, selectInput, nrow(df$mainTable), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - }) - #reset tier-ing with original parameters - observeEvent(input$reset_params, { - session$sendCustomMessage("unbind-DT", "mainTable") - df$binding_threshold <- df$metricsData$`binding_threshold` - df$percentile_threshold <- df$metricsData$`percentile_threshold` - df$dna_cutoff <- df$metricsData$`vaf_clonal` - df$allele_expr <- df$metricsData$`allele_expr` - df$anchor_mode <- ifelse(df$metricsData$`allele_specific_anchors`, "allele-specific", "default") - df$anchor_contribution <- df$metricsData$`anchor_contribution_threshold` - df$mainTable$`Evaluation` <- shinyValue("selecter_", nrow(df$mainTable), df$mainTable) - df$mainTable$`Tier` <- apply(df$mainTable, 1, function(x) tier(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$binding_cutoffs, df$is_allele_specific_binding_cutoff, df$binding_threshold, x["Allele"], x["IC50 MT"])) - df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse(is.null(df$percentile_threshold), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) - if (is.null(df$percentile_threshold)) { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) - }else { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) - } - tier_sorter <- c("Pass", "LowExpr", "Anchor", "Subclonal", "Poor", "NoExpr") - df$mainTable$`Rank_ic50` <- NA - df$mainTable$`Rank_expr` <- NA - df$mainTable$`Rank_ic50` <- rank(as.numeric(df$mainTable$`IC50 MT`), ties.method = "first") - df$mainTable$`Rank_expr` <- rank(desc(as.numeric(df$mainTable$`Allele Expr`)), ties.method = "first") - df$mainTable$`Rank` <- df$mainTable$`Rank_ic50` + df$mainTable$`Rank_expr` - df$mainTable <- df$mainTable %>% - arrange(factor(Tier, levels = tier_sorter), Rank) - df$mainTable$`Rank` <- NULL - df$mainTable$`Rank_ic50` <- NULL - df$mainTable$`Rank_expr` <- NULL - df$mainTable$Select <- shinyInputSelect(actionButton, nrow(df$mainTable), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') - df$mainTable$`Eval` <- shinyInput(df$mainTable, selectInput, nrow(df$mainTable), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - }) - #determine hla allele count in order to generate column tooltip locations correctly - hla_count <- reactive({ - which(colnames(df$mainTable) == "Gene") - 1 - }) - #class type of user-provided additional file - type <- reactive({ - switch(input$hla_class, - class_i = 1, - class_ii = 2) - }) - output$type_text <- renderText({ - input$add_file_label - }) - output$paramTable <- renderTable( - data <- data.frame( - "Parameter" = c("Tumor Purity", "VAF Clonal", "VAF Subclonal", "Allele Expression for Passing Variants", - "Binding Threshold", "Binding Threshold for Inclusion into Metrics File", "Maximum TSL", - "Percentile Threshold", "Allele Specific Binding Thresholds", - "MT Top Score Metric", "WT Top Score Metric", - "Allele Specific Anchors Used", "Anchor Contribution Threshold"), - "Value" = c(if (is.null(df$metricsData$tumor_purity)) {"NULL"}else {df$metricsData$tumor_purity}, - df$metricsData$`vaf_clonal`, df$metricsData$`vaf_subclonal`, df$metricsData$`allele_expr_threshold`, - df$metricsData$binding_threshold, df$metricsData$`aggregate_inclusion_binding_threshold`, - df$metricsData$maximum_transcript_support_level, - if (is.null(df$metricsData$percentile_threshold)) {"NULL"}else { df$metricsData$percentile_threshold}, - df$metricsData$allele_specific_binding_thresholds, - df$metricsData$mt_top_score_metric, df$metricsData$wt_top_score_metric, - df$metricsData$allele_specific_anchors, df$metricsData$anchor_contribution_threshold) - ), digits = 3 - ) - output$bindingParamTable <- renderTable( - data <- data.frame( - "HLA Alleles" = names(df$metricsData$binding_cutoffs), - "Binding Cutoffs" = unlist(lapply(names(df$metricsData$binding_cutoffs), function(x) df$metricsData$binding_cutoffs[[x]])) - ) - ) - output$comment_text <- renderUI({ - if (is.null(df$mainTable)) { - return(HTML("N/A")) - } - HTML(paste(df$comments[selectedID(), 1])) - }) - observeEvent(input$page_length, { - if (is.null(df$mainTable)) { - return() - } - df$pageLength <- as.numeric(input$page_length) - session$sendCustomMessage("unbind-DT", "mainTable") - df$mainTable$`Evaluation` <- shinyValue("selecter_", nrow(df$mainTable), df$mainTable) - df$mainTable$`Eval` <- shinyInput(df$mainTable, selectInput, nrow(df$mainTable), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - }) - output$filesUploaded <- reactive({ - val <- !(is.null(df$mainTable) | is.null(df$metricsData)) - print(val) - }) - outputOptions(output, "filesUploaded", suspendWhenHidden = FALSE) - ##############################PEPTIDE EXPLORATION TAB################################ - ##main table display with color/background/font/border configurations - output$mainTable <- DT::renderDataTable( - if (is.null(df$mainTable) | is.null(df$metricsData)) { - return(datatable(data.frame("Aggregate Report" = character()))) - }else { - datatable(df$mainTable[, !(colnames(df$mainTable) == "ID") & !(colnames(df$mainTable) == "Evaluation") & !(colnames(df$mainTable) == "Comments")], - escape = FALSE, callback = JS(callback(hla_count(), df$metricsData$mt_top_score_metric)), class = "stripe", - options = list(lengthChange = FALSE, dom = "Bfrtip", pageLength = df$pageLength, - columnDefs = list(list(defaultContent = "NA", targets = c(hla_count() + 10, (hla_count() + 12):(hla_count() + 17))), - list(className = "dt-center", targets = c(0:hla_count() - 1)), list(visible = FALSE, targets = c(-1:-12)), - list(orderable = TRUE, targets = 0)), buttons = list(I("colvis")), - initComplete = htmlwidgets::JS( - "function(settings, json) {", - paste("$(this.api().table().header()).css({'font-size': '", "10pt", "'});"), - "}"), - rowCallback = JS(rowcallback(hla_count(), df$selectedRow - 1)), - preDrawCallback = JS("function() { - Shiny.unbindAll(this.api().table().node()); }"), - drawCallback = JS("function() { - Shiny.bindAll(this.api().table().node()); } ")), - selection = "none", - extensions = c("Buttons")) - } - %>% formatStyle("IC50 MT", "Scaled BA", backgroundColor = styleInterval(c(0.1, 0.2, 0.4, 0.6, 0.8, 1, 1.2, 1.4, 1.6, 1.8, 2), - c("#68F784", "#60E47A", "#58D16F", "#4FBD65", "#47AA5A", "#3F9750", "#F3F171", "#F3E770", "#F3DD6F", "#F0CD5B", "#F1C664", "#FF9999")) - , fontWeight = styleInterval(c(1000), c("normal", "bold")), border = styleInterval(c(1000), c("normal", "2px solid red"))) - %>% formatStyle("%ile MT", "Scaled percentile", backgroundColor = styleInterval(c(0.2, 0.4, 0.6, 0.8, 1, 1.25, 1.5, 1.75, 2), - c("#68F784", "#60E47A", "#58D16F", "#4FBD65", "#47AA5A", "#F3F171", "#F3E770", "#F3DD6F", "#F1C664", "#FF9999"))) - %>% formatStyle("Tier", color = styleEqual(c("Pass", "Poor", "Anchor", "Subclonal", "LowExpr", "NoExpr"), c("green", "orange", "#b0b002", "#D4AC0D", "salmon", "red"))) - %>% formatStyle(c("RNA VAF"), "Col RNA VAF", background = styleColorBar(range(0, 1), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("DNA VAF"), "Col DNA VAF", background = styleColorBar(range(0, 1), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("RNA Expr"), "Col RNA Expr", background = styleColorBar(range(0, 50), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("RNA Depth"), "Col RNA Depth", background = styleColorBar(range(0, 200), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("Allele Expr"), "Col Allele Expr", background = styleColorBar(range(0, (max(as.numeric(as.character(unlist(df$mainTable["Col RNA VAF"]))) * 50))), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("Allele Expr"), "Tier Count", fontWeight = styleEqual(c("2"), c("bold")), border = styleEqual(c("2"), c("2px solid red"))) - %>% formatStyle(c("IC50 MT", "Allele Expr"), "Tier Count", fontWeight = styleEqual(c("3"), c("bold")), border = styleEqual(c("3"), c("2px solid red"))) - %>% formatStyle(c("IC50 MT"), "Tier Count", fontWeight = styleEqual(c("4"), c("bold")), border = styleEqual(c("4"), c("2px solid red"))) - %>% formatStyle(c("Allele Expr", "%ile MT"), "Tier Count", fontWeight = styleEqual(c("102"), c("bold")), border = styleEqual(c("102"), c("2px solid red"))) - %>% formatStyle(c("IC50 MT", "Allele Expr", "%ile MT"), "Tier Count", fontWeight = styleEqual(c("103"), c("bold")), border = styleEqual(c("103"), c("2px solid red"))) - %>% formatStyle(c("%ile MT"), "Tier Count", fontWeight = styleEqual(c("104"), c("bold")), border = styleEqual(c("104"), c("2px solid red"))) - %>% formatStyle(c("IC50 MT", "%ile MT"), "Tier Count", fontWeight = styleEqual(c("105"), c("bold")), border = styleEqual(c("105"), c("2px solid red"))) - %>% formatStyle(c("IC50 WT", "Pos"), "Tier Count", fontWeight = styleEqual(c("5"), c("bold")), border = styleEqual(c("5"), c("2px solid red"))) - %>% formatStyle(c("DNA VAF"), "Tier Count", fontWeight = styleEqual(c("6"), c("bold")), border = styleEqual(c("6"), c("2px solid red"))) - %>% formatStyle(c("Allele Expr"), "Tier Count", fontWeight = styleEqual(c("7"), c("bold")), border = styleEqual(c("7"), c("2px solid red"))) - %>% formatStyle(c("Gene Expression"), "Tier Count", fontWeight = styleEqual(c("8"), c("bold")), border = styleEqual(c("8"), c("2px solid red"))) - %>% formatStyle(c("RNA VAF", "RNA Depth"), "Tier Count", fontWeight = styleEqual(c("8"), c("bold")), border = styleEqual(c("8"), c("2px solid green"))) - %>% formatStyle(c("RNA Expr", "Tier Count"), fontWeight = styleEqual(c("9"), c("bold")), border = styleEqual(c("9"), c("2px solid red"))) - %>% formatStyle(c("RNA VAF"), "Tier Count", fontWeight = styleEqual(c("10"), c("bold")), border = styleEqual(c("10"), c("2px solid red"))) - %>% formatStyle(c("RNA VAF", "RNA Expr"), "Tier Count", fontWeight = styleEqual(c("11"), c("bold")), border = styleEqual(c("11"), c("2px solid red"))) - %>% formatStyle(c("IC50 WT", "Pos"), "Tier Count", fontWeight = styleEqual(c("13"), c("bold")), border = styleEqual(c("13"), c("2px solid red"))) - %>% formatStyle(c("DNA VAF"), "Tier Count", fontWeight = styleEqual(c("14"), c("bold")), border = styleEqual(c("14"), c("2px solid red"))) - %>% formatStyle(c("DNA VAF", "IC50 WT", "Pos"), "Tier Count", fontWeight = styleEqual(c("15"), c("bold")), border = styleEqual(c("15"), c("2px solid red"))) - %>% formatStyle(c("IC50 WT", "Pos", "DNA VAF", "Allele Expr"), "Tier Count", fontWeight = styleEqual(c("23"), c("bold")), border = styleEqual(c("23"), c("2px solid red"))) - %>% formatStyle(c("DNA VAF", "Allele Expr"), "Tier Count", fontWeight = styleEqual(c("22"), c("bold")), border = styleEqual(c("22"), c("2px solid red"))) - %>% formatStyle(c("IC50 WT", "Pos", "Allele Expr"), "Tier Count", fontWeight = styleEqual(c("21"), c("bold")), border = styleEqual(c("21"), c("2px solid red"))) - %>% formatStyle(c("Allele Expr"), "Tier Count", fontWeight = styleEqual(c("20"), c("bold")), border = styleEqual(c("20"), c("2px solid red"))) - %>% formatStyle(c("Gene"), "Gene of Interest", fontWeight = styleEqual(c(TRUE), c("bold")), border = styleEqual(c(TRUE), c("2px solid green"))) - %>% formatStyle(c("TSL"), "Bad TSL", border = styleEqual(c(TRUE), c("2px solid red"))) - %>% formatStyle(c("%ile MT"), "Percentile Fail", border = styleEqual(c(TRUE), c("2px solid red"))) - %>% formatStyle(c("Prob Pos"), "Has Prob Pos", fontWeight = styleEqual(c(TRUE), c("bold")), border = styleEqual(c(TRUE), c("2px solid red"))) - , server = FALSE) - #help menu for main table - observeEvent(input$help, { - showModal(modalDialog( - title = "Aggregate Report of Best Candidates by Mutation", - h5("* Hover over individual column names to see further description of specific columns. (HLA allele columns excluded)"), - h4(" HLA specific columns:", style = "font-weight: bold"), - h5(" Number of good binding peptides for each specific HLA-allele.", br(), - " The same peptide could be counted in multiple columns if it was predicted to be a good binder for multiple HLA alleles."), - h4(" Color scale for IC50 MT column:", style = "font-weight: bold"), - h5(" lightgreen to darkgreen (0nM to 500nM); ", br(), "yellow to orange (500nM to 1000nM);", br(), " red (> 1000nM) "), - h4(" Color scale for %ile MT column:", style = "font-weight: bold"), - h5(" lightgreen to darkgreen (0-0.5%);", br(), " yellow to orange (0.5% to 2 %);", br(), " red (> 2%) "), - h4(" Bar backgrounds:", style = "font-weight: bold"), - h5(" RNA VAF and DNA VAF: Bar graphs range from 0 to 1", br(), - " RNA Depth: Bar graph ranging from 0 to maximum value of RNA depth values across variants", br(), - " RNA Expr: Bar graph ranging from 0 to 50 (this is meant to highlight variants with lower expression values for closer inspection)", br(), - " Allele Expr: Bar graph ranging from 0 to (50 * maximum value of RNA VAF values across variants) "), - h4(" Tier Types:", style = "font-weight: bold"), - h5(" Variants are ordered by their Tiers in the following way: Pass, LowExpr, Anchor, Subclonal, Poor, NoExpr. - Within the same tier, variants are ordered by the sum of their ranking in binding affinity and allele expression (i.e. lower binding - affinity and higher allele expression is prioritized.)"), - h5(" NoExpr: Mutant allele is not expressed ", br(), - " LowExpr: Mutant allele has low expression (Allele Expr < allele expression threshold)", br(), - " Subclonal: Likely not in the founding clone of the tumor (DNA VAF > max(DNA VAF)/2)", br(), - " Anchor: Mutation is at an anchor residue in the shown peptide, and the WT allele has good binding (WT IC50 < binding threshold)", br(), - " Poor: Fails two or more of the above criteria", br(), - " Pass: Passes the above criteria, has strong MT binding (IC50 < 500) and strong expression (Allele Expr > allele expression threshold)" - ), - )) - }) - ##update table upon selecting to investigate each individual row - observeEvent(input$select_button, { - if (is.null(df$mainTable)) { - return() - } - df$selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2]) - session$sendCustomMessage("unbind-DT", "mainTable") - df$mainTable$`Evaluation` <- shinyValue("selecter_", nrow(df$mainTable), df$mainTable) - df$mainTable$`Eval` <- shinyInput(df$mainTable, selectInput, nrow(df$mainTable), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - dataTableProxy("mainTable") %>% - selectPage((df$selectedRow - 1) %/% df$pageLength + 1) - }) - ##selected row text box - output$selected <- renderText({ - if (is.null(df$mainTable)) { - return() - } - df$selectedRow - }) - ##selected id update - selectedID <- reactive({ - if (is.null(df$selectedRow)) { - df$mainTable$ID[1] - }else { - df$mainTable$ID[df$selectedRow] - } - }) - ## Update comments section based on selected row - observeEvent(input$comment, { - if (is.null(df$mainTable)) { - return() - } - df$comments[selectedID(), 1] <- input$comments - }) - ##display of genomic information - output$metricsTextGenomicCoord <- renderText({ - if (is.null(df$metricsData)) { - return() - } - selectedID() - }) - ##display of openCRAVAT link for variant - output$url <- renderUI({ - if (is.null(df$mainTable)) { - return() - } - id <- strsplit(selectedID(), "-") - chromosome <- id[[1]][1] - start <- id[[1]][2] - stop <- id[[1]][3] - ref <- id[[1]][4] - alt <- id[[1]][5] - url <- a("OpenCRAVAT variant report", href = paste("https://run.opencravat.org/webapps/variantreport/index.html?chrom=", chromosome, "&pos=", stop, "&ref_base=", ref, "&alt_base=", alt, sep = ""), target = "_blank") - HTML(paste(url)) - }) - ##display of RNA VAF - output$metricsTextRNA <- renderText({ - if (is.null(df$metricsData)) { - return() - } - df$metricsData[[selectedID()]]$`RNA VAF` - }) - ##display of DNA VAF - output$metricsTextDNA <- renderText({ - if (is.null(df$metricsData)) { - return() - } - df$metricsData[[selectedID()]]$`DNA VAF` - }) - ##display of MT IC50 from additional data file - output$addData_IC50 <- renderText({ - if (is.null(df$additionalData)) { - return() - } - df$additionalData[df$additionalData$ID == selectedID(), ]$`IC50 MT` - }) - ##display of MT percentile from additional data file - output$addData_percentile <- renderText({ - df$additionalData[df$additionalData$ID == selectedID(), ]$`%ile MT` - }) - ##display of Best Peptide from additional data file - output$addData_peptide <- renderText({ - df$additionalData[df$additionalData$ID == selectedID(), ]$`Best Peptide` - }) - ##display of Corresponding HLA allele from additional data file - output$addData_allele <- renderText({ - df$additionalData[df$additionalData$ID == selectedID(), ]$`Allele` - }) - ##display of Best Transcript from additional data file - output$addData_transcript <- renderText({ - df$additionalData[df$additionalData$ID == selectedID(), ]$`Best Transcript` - }) - ##transcripts sets table displaying sets of transcripts with the same consequence - output$transcriptSetsTable <- renderDT({ - withProgress(message = "Loading Transcript Sets Table", value = 0, { - GB_transcripts <- data.frame() - best_transcript <- df$mainTable[df$mainTable$ID == selectedID(), ]$`Best Transcript` - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - GB_transcripts <- data.frame( - "Transcript Sets" = df$metricsData[[selectedID()]]$sets, - "# Transcripts" = df$metricsData[[selectedID()]]$transcript_counts, - "# Peptides" = df$metricsData[[selectedID()]]$peptide_counts, - "Total Expr" = df$metricsData[[selectedID()]]$set_expr - ) - names(GB_transcripts) <- c("Transcripts Sets", "#Transcripts", "# Peptides", "Total Expr") - best_transcript_set <- NULL - incProgress(0.5) - for (i in 1:length(df$metricsData[[selectedID()]]$sets)){ - transcript_set <- df$metricsData[[selectedID()]]$good_binders[[df$metricsData[[selectedID()]]$sets[i]]]$`transcripts` - transcript_set <- lapply(transcript_set, function(x) strsplit(x, "-")[[1]][1]) - if (best_transcript %in% transcript_set) { - best_transcript_set <- df$metricsData[[selectedID()]]$sets[i] - } - } - incProgress(0.5) - datatable(GB_transcripts, selection = list(mode = "single", selected = "1"), style="bootstrap") %>% - formatStyle("Transcripts Sets", backgroundColor = styleEqual(c(best_transcript_set), c("#98FF98"))) - }else { - GB_transcripts <- data.frame("Transcript Sets" = character(), "# Transcripts" = character(), "# Peptides" = character(), "Total Expr" = character()) - names(GB_transcripts) <- c("Transcripts Sets", "#Transcripts", "# Peptides", "Total Expr") - incProgress(0.5) - datatable(GB_transcripts) - incProgress(0.5) - } - }) - }) - ##update selected transcript set id - selectedTranscriptSet <- reactive({ - selection <- input$transcriptSetsTable_rows_selected - if (is.null(selection)) { - selection <- 1 - } - df$metricsData[[selectedID()]]$sets[selection] - }) - - ##transcripts table displaying transcript id and transcript expression values - output$transcriptsTable <- renderDT({ - withProgress(message = "Loading Transcripts Table", value = 0, { - GB_transcripts <- data.frame() - best_transcript <- df$mainTable[df$mainTable$ID == selectedID(), ]$`Best Transcript` - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - GB_transcripts <- data.frame("Transcripts" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`transcripts`, - "Expression" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`transcript_expr`, - "TSL" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`tsl`, - "Biotype" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`biotype`, - "Length" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`transcript_length`) - GB_transcripts$`Best Transcript` <- apply(GB_transcripts, 1, function(x) grepl(best_transcript, x["Transcripts"], fixed = TRUE)) - incProgress(0.5) - names(GB_transcripts) <- c("Transcripts in Selected Set", "Expression", "Transcript Support Level", "Biotype", "Transcript Length (#AA)", "Best Transcript") - incProgress(0.5) - datatable(GB_transcripts, options = list(columnDefs = list(list(defaultContent = "N/A", targets = c(3)), list(visible = FALSE, targets = c(-1))))) %>% - formatStyle(c("Transcripts in Selected Set"), "Best Transcript", backgroundColor = styleEqual(c(TRUE), c("#98FF98"))) - }else { - GB_transcripts <- data.frame("Transcript" = character(), "Expression" = character(), "TSL" = character(), "Biotype" = character(), "Length" = character()) - incProgress(0.5) - names(GB_transcripts) <- c("Transcripts in Selected Set", "Expression", "Transcript Support Level", "Biotype", "Transcript Length (#AA)", "Best Transcript") - incProgress(0.5) - datatable(GB_transcripts) - } - }) - }) - - ##display transcript expression - output$metricsTextTranscript <- renderText({ - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`transcript_expr` - }else { - "N/A" - } - }) - ##display gene expression - output$metricsTextGene <- renderText({ - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - df$metricsData[[selectedID()]]$`gene_expr` - }else { - "N/A" - } - }) - ##display peptide table with coloring - output$peptideTable <- renderDT({ - withProgress(message = "Loading Peptide Table", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0 & !is.null(df$metricsData)) { - peptide_data <- df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`peptides` - best_peptide <- df$mainTable[df$mainTable$ID == selectedID(), ]$`Best Peptide` - peptide_names <- names(peptide_data) - for (i in 1:length(peptide_names)) { - peptide_data[[peptide_names[[i]]]]$individual_ic50_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_percentile_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_el_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_el_percentile_calls <- NULL - } - incProgress(0.5) - peptide_data <- as.data.frame(peptide_data) - incProgress(0.5) - dtable <- datatable(do.call("rbind", lapply(peptide_names, table_formatting, peptide_data)), options = list( - pageLength = 10, - columnDefs = list(list(defaultContent = "X", - targets = c(2:hla_count() + 1)), - list(orderable = TRUE, targets = 0), - list(visible = FALSE, targets = c(-1))), - rowCallback = JS("function(row, data, index, rowId) {", - "console.log(rowId)", - "if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {", - 'row.style.backgroundColor = "#E0E0E0";', "}", "}") - ), - selection = list(mode = "single", selected = "1")) %>% - formatStyle("Type", fontWeight = styleEqual("MT", "bold")) %>% - formatStyle(c("Peptide Sequence"), "Has ProbPos", border = styleEqual(c(TRUE), c("2px solid red"))) %>% - formatStyle(c("Problematic Positions"), "Has ProbPos", border = styleEqual(c(TRUE), c("2px solid red"))) %>% - formatStyle("Peptide Sequence", backgroundColor = styleEqual(c(best_peptide), c("#98FF98"))) - dtable$x$data[[1]] <- as.numeric(dtable$x$data[[1]]) - dtable - }else { - incProgress(1) - datatable(data.frame("Peptide Datatable" = character()), selection = list(mode = "single", selected = "1")) - } - }) - }) - ##update selected peptide data - selectedPeptideData <- reactive({ - selection <- input$peptideTable_rows_selected - if (is.null(selection)) { - selection <- 1 - } - peptide_names <- names(df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`peptides`) - index <- floor((as.numeric(selection) + 1) / 2) - df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$peptides[[peptide_names[index]]] - }) - ##Add legend for anchor heatmap - output$peptideFigureLegend <- renderPlot({ - colors <- colorRampPalette(c("lightblue", "blue"))(99)[seq(1, 99, 7)] - color_pos <- data.frame(d = as.character(seq(1, 99, 7)), x1 = seq(0.1, 1.5, 0.1), x2 = seq(0.2, 1.6, 0.1), y1 = rep(1, 15), y2 = rep(1.1, 15), colors = colors) - color_label <- data.frame(x = c(0.1, 0.8, 1.6), y = rep(0.95, 3), score = c(0, 0.5, 1)) - p1 <- ggplot() + - scale_y_continuous(limits = c(0.90, 1.2), name = "y") + scale_x_continuous(limits = c(0, 1.7), name = "x") + - geom_rect(data = color_pos, aes(xmin = x1, xmax = x2, ymin = y1, ymax = y2, fill = colors), color = "black", alpha = 1) + - scale_fill_identity() - p1 <- p1 + geom_text(data = color_label, aes(x = x, y = y, label = score), size = 4, fontface = 2) + - annotate(geom = "text", x = 0.5, y = 1.18, label = "Normalized Anchor Score", size = 4, fontface = 2) + - coord_fixed() + - theme_void() + theme(legend.position = "none", panel.border = element_blank(), plot.margin = margin(0, 0, 0, 0, "cm")) - print(p1) - }) - ##Anchor Heatmap overlayed on selected peptide sequences - output$anchorPlot <- renderPlot({ - if (is.null(df$metricsData)) { - return() - } - withProgress(message = "Loading Anchor Heatmap", value = 0, { - if (type() == 2) { - p1 <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available for Class II HLA alleles", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p1) - }else if (length(df$metricsData[[selectedID()]]$sets) != 0) { - peptide_data <- df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`peptides` - peptide_names <- names(peptide_data) - for (i in 1:length(peptide_names)) { - peptide_data[[peptide_names[[i]]]]$individual_ic50_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_percentile_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_el_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_el_percentile_calls <- NULL - } - peptide_data <- as.data.frame(peptide_data) - p1 <- ggplot() + scale_x_continuous(limits = c(0, 80)) + scale_y_continuous(limits = c(-31, 1)) - all_peptides <- list() - incProgress(0.1) - for (i in 1:length(peptide_names)) { - #set & constrain mutation_pos' to not exceed length of peptide (may happen if mutation range goes off end) - mutation_pos <- range_str_to_seq(df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$peptides[[peptide_names[i]]]$`mutation_position`) - mt_peptide_length <- nchar(peptide_names[i]) - mutation_pos <- mutation_pos[mutation_pos <= mt_peptide_length] - #set associated wt peptide to current mt peptide - wt_peptide <- as.character(df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$peptides[[peptide_names[i]]]$`wt_peptide`) - #create dataframes for mt/wt pair - df_mt_peptide <- data.frame("aa" = unlist(strsplit(peptide_names[i], "", fixed = TRUE)), "x_pos" = c(1:nchar(peptide_names[i]))) - df_mt_peptide$mutation <- "not_mutated" - df_mt_peptide$type <- "mt" - df_mt_peptide$y_pos <- (i * 2 - 1) * -1 - df_mt_peptide$length <- mt_peptide_length - df_mt_peptide[mutation_pos, "mutation"] <- "mutated" - df_wt_peptide <- data.frame("aa" = unlist(strsplit(wt_peptide, "", fixed = TRUE)), "x_pos" = c(1:nchar(wt_peptide))) - df_wt_peptide$mutation <- "not_mutated" - df_wt_peptide$type <- "wt" - df_wt_peptide$y_pos <- (i * 2) * -1 - df_wt_peptide$length <- nchar(wt_peptide) - all_peptides[[i]] <- rbind(df_mt_peptide, df_wt_peptide) - } - incProgress(0.4) - all_peptides <- do.call(rbind, all_peptides) - peptide_table <- do.call("rbind", lapply(peptide_names, table_formatting, peptide_data)) - peptide_table_filtered <- Filter(function(x) length(unique(x)) != 1, peptide_table) - peptide_table_names <- names(peptide_table_filtered) - hla_list <- peptide_table_names[grepl("^HLA-*", peptide_table_names)] - hla_data <- data.frame(hla = hla_list) - hla_sep <- max(nchar(peptide_table$`Peptide Sequence`)) - hla_data$y_pos <- 1 - hla_data$x_pos <- hla_sep / 2 - pad <- 3 - all_peptides_multiple_hla <- list() - incProgress(0.1) - for (i in 1:length(hla_list)) { - hla_data$x_pos[i] <- hla_data$x_pos[i] + (hla_sep + pad) * (i - 1) - omit_rows <- which(is.na(peptide_table_filtered[names(peptide_table_filtered) == hla_list[[i]]])) * -1 - all_peptides_multiple_hla[[i]] <- all_peptides[!(all_peptides$y_pos %in% omit_rows), ] - all_peptides_multiple_hla[[i]]$color_value <- apply(all_peptides_multiple_hla[[i]], 1, function(x) peptide_coloring(hla_list[[i]], x)) - all_peptides_multiple_hla[[i]]$x_pos <- all_peptides_multiple_hla[[i]]$x_pos + (hla_sep + pad) * (i - 1) - } - incProgress(0.2) - all_peptides_multiple_hla <- do.call(rbind, all_peptides_multiple_hla) - h_line_pos <- data.frame(y_pos = seq(min(all_peptides_multiple_hla["y_pos"]) - 0.5, max(all_peptides_multiple_hla["y_pos"]) - 1.5, 2), x_pos = c(min(all_peptides_multiple_hla["x_pos"]) - 1)) - h_line_pos <- rbind(h_line_pos, data.frame(x_pos = max(all_peptides_multiple_hla["x_pos"]) + 1, y_pos = seq(min(all_peptides_multiple_hla["y_pos"]) - 0.5, max(all_peptides_multiple_hla["y_pos"]) - 1.5, 2))) - incProgress(0.2) - p1 <- p1 + - geom_rect(data = all_peptides_multiple_hla, aes(xmin = x_pos - 0.5, xmax = 1 + x_pos - 0.5, ymin = .5 + y_pos, ymax = -.5 + y_pos), fill = all_peptides_multiple_hla$color_value) + - geom_text(data = all_peptides_multiple_hla, aes(x = x_pos, y = y_pos, label = aa, color = mutation), size = 5) + - geom_text(data = hla_data, aes(x = x_pos, y = y_pos, label = hla), size = 5, fontface = "bold") + - geom_line(data = h_line_pos, (aes(x = x_pos, y = y_pos, group = y_pos)), linetype = "dashed") - p1 <- p1 + scale_color_manual("mutation", values = c("not_mutated" = "#000000", "mutated" = "#e74c3c")) - p1 <- p1 + theme_void() + theme(legend.position = "none", panel.border = element_blank()) - print(p1) - }else { - p1 <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p1) - } - }) - }, height = 500, width = 1000) - ##updating IC50 binding score for selected peptide pair - bindingScoreDataIC50 <- reactive({ - if (is.null(df$metricsData)) { - return() - } - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - algorithm_names <- data.frame(algorithms = selectedPeptideData()$individual_ic50_calls$algorithms) - wt_data <- as.data.frame(selectedPeptideData()$individual_ic50_calls$WT, check.names = FALSE) - colnames(wt_data) <- paste(colnames(wt_data), "_WT_Score", sep = "") - mt_data <- as.data.frame(selectedPeptideData()$individual_ic50_calls$MT, check.names = FALSE) - colnames(mt_data) <- paste(colnames(mt_data), "_MT_Score", sep = "") - full_data <- cbind(algorithm_names, mt_data, wt_data) %>% - gather("col", "val", colnames(mt_data)[1]:tail(colnames(wt_data), n = 1)) %>% - separate(col, c("HLA_allele", "Mutant", "Score"), sep = "\\_") %>% - spread("Score", val) - full_data - }else { - return() - } - }) - ##plotting IC5 binding score violin plot - output$bindingData_IC50 <- renderPlot({ - withProgress(message = "Loading Binding Score Plot (IC50)", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - line.data <- data.frame(yintercept = c(500, 1000), Cutoffs = c("500nM", "1000nM"), color = c("#28B463", "#EC7063")) - hla_allele_count <- length(unique(bindingScoreDataIC50()$HLA_allele)) - incProgress(0.5) - p <- ggplot(data = bindingScoreDataIC50(), aes(x = Mutant, y = Score, color = Mutant), trim = FALSE) + geom_violin() + facet_grid(cols = vars(HLA_allele)) + scale_y_continuous(trans = "log10") + #coord_trans(y = "log10") + - stat_summary(fun.y = mean, fun.ymin = mean, fun.ymax = mean, geom = "crossbar", width = 0.25, position = position_dodge(width = .25)) + - geom_jitter(data = bindingScoreDataIC50(), aes(shape = algorithms), sizes = 5, stroke = 1, position = position_jitter(0.3)) + - scale_shape_manual(values = 0:8) + - geom_hline(aes(yintercept = yintercept, linetype = Cutoffs), line.data, color = rep(line.data$color, hla_allele_count)) + - scale_color_manual(values = rep(c("MT" = "#D2B4DE", "WT" = "#F7DC6F"), hla_allele_count)) + - theme(strip.text = element_text(size = 15), axis.text = element_text(size = 10), axis.title = element_text(size = 15), axis.ticks = element_line(size = 3), legend.text = element_text(size = 15), legend.title = element_text(size = 15)) - incProgress(0.5) - print(p) - }else { - p <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p) - } - }) - }) - ##updating percentile binding score for selected peptide pair - bindingScoreDataPercentile <- reactive({ - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - algorithm_names <- data.frame(algorithms = selectedPeptideData()$individual_percentile_calls$algorithms) - wt_data <- as.data.frame(selectedPeptideData()$individual_percentile_calls$WT, check.names = FALSE) - colnames(wt_data) <- paste(colnames(wt_data), "_WT_Score", sep = "") - mt_data <- as.data.frame(selectedPeptideData()$individual_percentile_calls$MT, check.names = FALSE) - colnames(mt_data) <- paste(colnames(mt_data), "_MT_Score", sep = "") - full_data <- cbind(algorithm_names, mt_data, wt_data) %>% - gather("col", "val", colnames(mt_data)[1]:tail(colnames(wt_data), n = 1)) %>% - separate(col, c("HLA_allele", "Mutant", "Score"), sep = "\\_") %>% - spread("Score", val) - full_data - }else { - return() - } - }) - ##plotting percentile binding score violin plot - output$bindingData_percentile <- renderPlot({ - withProgress(message = "Loading Binding Score Plot (Percentile)", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - line.data <- data.frame(yintercept = c(0.5, 2), Cutoffs = c("0.5%", "2%"), color = c("#28B463", "#EC7063")) - hla_allele_count <- length(unique(bindingScoreDataPercentile()$HLA_allele)) - incProgress(0.5) - p <- ggplot(data = bindingScoreDataPercentile(), aes(x = Mutant, y = Score, color = Mutant), trim = FALSE) + geom_violin() + facet_grid(cols = vars(HLA_allele)) + scale_y_continuous(trans = "log10") + #coord_trans(y = "log10") + - stat_summary(fun.y = mean, fun.ymin = mean, fun.ymax = mean, geom = "crossbar", width = 0.25, position = position_dodge(width = .25)) + - geom_jitter(data = bindingScoreDataPercentile(), aes(shape = algorithms), size = 5, stroke = 1, position = position_jitter(0.3)) + - scale_shape_manual(values = 0:8) + - geom_hline(aes(yintercept = yintercept, linetype = Cutoffs), line.data, color = rep(line.data$color, hla_allele_count)) + - scale_color_manual(values = rep(c("MT" = "#D2B4DE", "WT" = "#F7DC6F"), hla_allele_count)) + - theme(strip.text = element_text(size = 15), axis.text = element_text(size = 10), axis.title = element_text(size = 15), axis.ticks = element_line(size = 3), legend.text = element_text(size = 15), legend.title = element_text(size = 15)) - incProgress(0.5) - print(p) - }else { - p <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p) - } - }) - }) - ##plotting binding data table with IC50 and percentile values - output$bindingDatatable <- renderDT({ - withProgress(message = "Loading binding datatable", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - binding_data <- bindingScoreDataIC50() - names(binding_data)[names(binding_data) == "Score"] <- "IC50 Score" - binding_data["% Score"] <- bindingScoreDataPercentile()["Score"] - binding_data["Score"] <- paste(round(as.numeric(binding_data$`IC50 Score`), 2), " (%: ", round(as.numeric(binding_data$`% Score`), 2), ")", sep = "") - binding_data["IC50 Score"] <- NULL - binding_data["% Score"] <- NULL - binding_reformat <- dcast(binding_data, HLA_allele + Mutant ~ algorithms, value.var = "Score") - incProgress(1) - dtable <- datatable(binding_reformat, options = list( - pageLength = 10, - lengthMenu = c(10), - rowCallback = JS("function(row, data, index, rowId) {", - "console.log(rowId)", - "if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {", - 'row.style.backgroundColor = "#E0E0E0";', "}", "}") - )) %>% formatStyle("Mutant", fontWeight = styleEqual("MT", "bold"), color = styleEqual("MT", "#E74C3C")) - dtable - }else { - incProgress(1) - datatable(data.frame("Binding Predictions Datatable" = character())) - } - }) - }) - ##updating elution score for selected peptide pair - elutionScoreData <- reactive({ - if (is.null(df$metricsData)) { - return() - } - if (length(df$metricsData[[selectedID()]]$sets) != 0 && length(selectedPeptideData()$individual_el_calls$algorithms) > 0) { - algorithm_names <- data.frame(algorithms = selectedPeptideData()$individual_el_calls$algorithms) - wt_data <- as.data.frame(selectedPeptideData()$individual_el_calls$WT, check.names = FALSE) - colnames(wt_data) <- paste(colnames(wt_data), "_WT_Score", sep = "") - mt_data <- as.data.frame(selectedPeptideData()$individual_el_calls$MT, check.names = FALSE) - colnames(mt_data) <- paste(colnames(mt_data), "_MT_Score", sep = "") - full_data <- cbind(algorithm_names, mt_data, wt_data) %>% - gather("col", "val", colnames(mt_data)[1]:tail(colnames(wt_data), n = 1)) %>% - separate(col, c("HLA_allele", "Mutant", "Score"), sep = "\\_") %>% - spread("Score", val) - full_data - }else { - return() - } - }) - ##updating elution percentile for selected peptide pair - elutionPercentileData <- reactive({ - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - algorithm_names <- data.frame(algorithms = selectedPeptideData()$individual_el_percentile_calls$algorithms) - wt_data <- as.data.frame(selectedPeptideData()$individual_el_percentile_calls$WT, check.names = FALSE) - colnames(wt_data) <- paste(colnames(wt_data), "_WT_Score", sep = "") - mt_data <- as.data.frame(selectedPeptideData()$individual_el_percentile_calls$MT, check.names = FALSE) - colnames(mt_data) <- paste(colnames(mt_data), "_MT_Score", sep = "") - full_data <- cbind(algorithm_names, mt_data, wt_data) %>% - gather("col", "val", colnames(mt_data)[1]:tail(colnames(wt_data), n = 1)) %>% - separate(col, c("HLA_allele", "Mutant", "Score"), sep = "\\_") %>% - spread("Score", val) - full_data - }else { - return() - } - }) - ##plotting elution data table - output$elutionDatatable <- renderDT({ - withProgress(message = "Loading elution datatable", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - elution_data <- elutionScoreData() - if (!is.null(elution_data)) { - names(elution_data)[names(elution_data) == "Score"] <- "Elution Score" - elution_data["% Score"] <- elutionPercentileData()["Score"] - elution_data["Score"] <- paste(round(as.numeric(elution_data$`Elution Score`), 2), " (%: ", round(as.numeric(elution_data$`% Score`), 2), ")", sep = "") - elution_data["Elution Score"] <- NULL - elution_data["% Score"] <- NULL - elution_reformat <- dcast(elution_data, HLA_allele + Mutant ~ algorithms, value.var = "Score") - incProgress(1) - dtable <- datatable(elution_reformat, options = list( - pageLength = 10, - lengthMenu = c(10), - rowCallback = JS("function(row, data, index, rowId) {", - "console.log(rowId)","if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {", - 'row.style.backgroundColor = "#E0E0E0";', "}", "}") - )) %>% formatStyle("Mutant", fontWeight = styleEqual("MT", "bold"), color = styleEqual("MT", "#E74C3C")) - dtable - }else { - incProgress(1) - datatable(data.frame("Elution Datatable" = character())) - } - }else { - incProgress(1) - datatable(data.frame("Elution Datatable" = character())) - } - }) - }) - ##############################EXPORT TAB############################################## - #evalutation overview table - output$checked <- renderTable({ - if (is.null(df$mainTable)) { - return() - } - Evaluation <- data.frame(selected = shinyValue("selecter_", nrow(df$mainTable), df$mainTable)) - data <- as.data.frame(table(Evaluation)) - data$Count <- data$Freq - data$Freq <- NULL - data - }) - #export table display with options to download - output$ExportTable <- renderDataTable({ - if (is.null(df$mainTable)) { - return() - } - colsToDrop = colnames(df$mainTable) %in% c("Evaluation", "Eval", "Select", "Scaled BA", "Scaled percentile", "Tier Count", "Bad TSL", - "Comments", "Gene of Interest", "Bad TSL", "Col RNA Expr", "Col RNA VAF", "Col Allele Expr", - "Col RNA Depth", "Col DNA VAF", "Percentile Fail", "Has Prob Pos") - data <- df$mainTable[, !(colsToDrop)] - col_names <- colnames(data) - data <- data.frame(data, Evaluation = shinyValue("selecter_", nrow(df$mainTable), df$mainTable)) - colnames(data) <- c(col_names, "Evaluation") - comments <- data.frame("ID" = row.names(df$comments), Comments = df$comments[, 1]) - data <- join(data, comments) - data - }, escape = FALSE, server = FALSE, rownames = FALSE, - options = list(dom = "Bfrtip", - buttons = list( - list(extend = "csvHtml5", - filename = input$exportFileName, - fieldSeparator = "\t", - text = "Download as TSV", - extension = ".tsv"), - list(extend = "excel", - filename = input$exportFileName, - text = "Download as excel") - ), - initComplete = htmlwidgets::JS( - "function(settings, json) {", - paste0("$(this.api().table().header()).css({'font-size': '", "8pt", "'});"), - "}") - ), - selection = "none", - extensions = c("Buttons")) - ############### NeoFox Tab ########################## - df_neofox <- reactiveValues( - mainTable = NULL - ) - observeEvent(input$loadDefaultneofox, { - #session$sendCustomMessage("unbind-DT", "neofoxTable") - #data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/f83c52c8b8387beae69be8b200a44dcf199d9af2/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_I.all_epitopes.aggregated.tsv") - #mainData <- read.table(text = data, sep = '\t', header = FALSE, stringsAsFactors = FALSE, check.names=FALSE) - data <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/v11/data/test_pt1_neoantigen_candidates_annotated.tsv" - mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_neofox$mainTable <- mainData - updateTabItems(session, "neofox_tabs", "neofox_explore") - }) - output$neofox_upload_ui <- renderUI({ - fileInput(inputId = "neofox_data", label = "NeoFox output table (tsv required)", - accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) - }) - observeEvent(input$neofox_data$datapath, { - #session$sendCustomMessage("unbind-DT", "neofoxTable") - mainData <- read.table(input$neofox_data$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_neofox$mainTable <- mainData - }) - observeEvent(input$visualize_neofox, { - updateTabItems(session, "neofox_tabs", "neofox_explore") - }) - output$neofoxTable <- DT::renderDataTable( - if (is.null(df_neofox$mainTable)) { - return(datatable(data.frame("Annotated Table" = character()))) - }else { - datatable(df_neofox$mainTable, - escape = FALSE, class = "stripe", - options = list(lengthChange = FALSE, dom = "Bfrtip", pageLength = input$neofox_page_length, - columnDefs = list(list(visible = FALSE, targets = c(-1:-12)), - list(orderable = TRUE, targets = 0)), buttons = list(I("colvis")), - initComplete = htmlwidgets::JS( - "function(settings, json) {", - paste("$(this.api().table().header()).css({'font-size': '", "10pt", "'});"), - "}")), - selection = "multiple", - extensions = c("Buttons")) - }, server = FALSE) - output$neofox_selected <- renderText({ - if (is.null(df_neofox$mainTable)) { - return() - } - input$neofoxTable_rows_selected - }) - output$neofox_violin_plots_row1 <- renderPlot({ - withProgress(message = "Loading Violin Plots", value = 0, { - if (length(input$neofoxTable_rows_selected) != 0) { - plot_cols <- c("mutatedXmer", "imputedGeneExpression", "DAI_MHCI_bestAffinity", "IEDB_Immunogenicity_MHCI") - plot_data <- df_neofox$mainTable[, plot_cols] - plot_data[, "imputedGeneExpression"] <- as.numeric(plot_data[, "imputedGeneExpression"]) - plot_data[, "DAI_MHCI_bestAffinity"] <- as.numeric(plot_data[, "DAI_MHCI_bestAffinity"]) - plot_data[, "IEDB_Immunogenicity_MHCI"] <- as.numeric(plot_data[, "IEDB_Immunogenicity_MHCI"]) - plot_data$Selected <- "No" - plot_data[input$neofoxTable_rows_selected, "Selected"] <- "Yes" - reformat_data <- plot_data %>% - gather("Feature", "Value", colnames(plot_data)[2]:tail(colnames(plot_data), n = 2)) - gene_expr_data <- reformat_data[reformat_data["Feature"] == "imputedGeneExpression", ] - gene_expr_plot <- ggplot(data = gene_expr_data, aes(x = Feature, y = Value)) + geom_violin() + - geom_jitter(data = gene_expr_data[gene_expr_data["Selected"] == "No", ], aes(color = Selected), size = 1, alpha = 0.5, stroke = 1, position = position_jitter(0.3)) + - geom_jitter(data = gene_expr_data[gene_expr_data["Selected"] == "Yes", ], aes(color = Selected), size = 2, alpha = 1, stroke = 1, position = position_jitter(0.3)) + - scale_color_manual(values = c("No" = "#939094", "Yes" = "#f42409")) + - theme(legend.position = "none") - DAI_ClassI_data <- reformat_data[reformat_data["Feature"] == "DAI_MHCI_bestAffinity", ] - DAI_ClassI_plot <- ggplot(DAI_ClassI_data, aes(x = Feature, y = Value)) + geom_violin() + - geom_jitter(data = DAI_ClassI_data[DAI_ClassI_data["Selected"] == "No", ], aes(color = Selected), size = 1, alpha = 0.5, stroke = 1, position = position_jitter(0.3)) + - geom_jitter(data = DAI_ClassI_data[DAI_ClassI_data["Selected"] == "Yes", ], aes(color = Selected), size = 2, alpha = 1, stroke = 1, position = position_jitter(0.3)) + - scale_color_manual(values = c("No" = "#939094", "Yes" = "#f42409")) + - theme(legend.position = "none") - IEDB_Immuno_data <- reformat_data[reformat_data["Feature"] == "IEDB_Immunogenicity_MHCI", ] - IEDB_Immuno_plot <- ggplot(IEDB_Immuno_data, aes(x = Feature, y = Value)) + geom_violin() + - geom_jitter(data = IEDB_Immuno_data[IEDB_Immuno_data["Selected"] == "No", ], aes(color = Selected), size = 1, alpha = 0.5, stroke = 1, position = position_jitter(0.3)) + - geom_jitter(data = IEDB_Immuno_data[IEDB_Immuno_data["Selected"] == "Yes", ], aes(color = Selected), size = 2, alpha = 1, stroke = 1, position = position_jitter(0.3)) + - scale_color_manual(values = c("No" = "#939094", "Yes" = "#f42409")) - p <- grid.arrange(gene_expr_plot, DAI_ClassI_plot, IEDB_Immuno_plot, ncol = 3) - incProgress(1) - print(p) - }else { - p <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p) - } - }) - }) - output$neofox_violin_plots_row2 <- renderPlot({ - withProgress(message = "Loading Violin Plots", value = 0, { - if (length(input$neofoxTable_rows_selected) != 0) { - plot_cols <- c("mutatedXmer", "MixMHCpred_bestScore_rank", "HexAlignmentScore_MHCI", "PRIME_best_rank") - plot_data <- df_neofox$mainTable[, plot_cols] - plot_data[, "MixMHCpred_bestScore_rank"] <- as.numeric(plot_data[, "MixMHCpred_bestScore_rank"]) - plot_data[, "HexAlignmentScore_MHCI"] <- as.numeric(plot_data[, "HexAlignmentScore_MHCI"]) - plot_data[, "PRIME_best_rank"] <- as.numeric(plot_data[, "PRIME_best_rank"]) - plot_data$Selected <- "No" - plot_data[input$neofoxTable_rows_selected, "Selected"] <- "Yes" - reformat_data <- plot_data %>% - gather("Feature", "Value", colnames(plot_data)[2]:tail(colnames(plot_data), n = 2)) - mixpred_data <- reformat_data[reformat_data["Feature"] == "MixMHCpred_bestScore_rank", ] - mixpred_plot <- ggplot(data = mixpred_data, aes(x = Feature, y = Value)) + geom_violin() + - geom_jitter(data = mixpred_data[mixpred_data["Selected"] == "No", ], aes(color = Selected), size = 1, alpha = 0.5, stroke = 1, position = position_jitter(0.3)) + - geom_jitter(data = mixpred_data[mixpred_data["Selected"] == "Yes", ], aes(color = Selected), size = 2, alpha = 1, stroke = 1, position = position_jitter(0.3)) + - scale_color_manual(values = c("No" = "#939094", "Yes" = "#f42409")) + - theme(legend.position = "none") - hex_data <- reformat_data[reformat_data["Feature"] == "HexAlignmentScore_MHCI", ] - hex_plot <- ggplot(hex_data, aes(x = Feature, y = Value)) + geom_violin() + - geom_jitter(data = hex_data[hex_data["Selected"] == "No", ], aes(color = Selected), size = 1, alpha = 0.5, stroke = 1, position = position_jitter(0.3)) + - geom_jitter(data = hex_data[hex_data["Selected"] == "Yes", ], aes(color = Selected), size = 2, alpha = 1, stroke = 1, position = position_jitter(0.3)) + - scale_color_manual(values = c("No" = "#939094", "Yes" = "#f42409")) + - theme(legend.position = "none") - prime_data <- reformat_data[reformat_data["Feature"] == "PRIME_best_rank", ] - prime_plot <- ggplot(prime_data, aes(x = Feature, y = Value)) + geom_violin() + - geom_jitter(data = prime_data[prime_data["Selected"] == "No", ], aes(color = Selected), size = 1, alpha = 0.5, stroke = 1, position = position_jitter(0.3)) + - geom_jitter(data = prime_data[prime_data["Selected"] == "Yes", ], aes(color = Selected), size = 2, alpha = 1, stroke = 1, position = position_jitter(0.3)) + - scale_color_manual(values = c("No" = "#939094", "Yes" = "#f42409")) - p <- grid.arrange(mixpred_plot, hex_plot, prime_plot, ncol = 3) - incProgress(1) - print(p) - }else { - p <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p) - } - }) - }) - ############### Custom Tab ########################## - df_custom <- reactiveValues( - selectedRow = 1, - fullData = NULL, - mainTable = NULL, - group_inds = NULL, - metricsData = NULL, - pageLength = 10, - groupBy = NULL, - orderBy = NULL, - peptide_features = NULL - ) - observeEvent(input$loadDefault_Vaxrank, { - data <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/v11/data/vaxrank_output.tsv" - mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_custom$fullData <- mainData - }) - observeEvent(input$loadDefault_Neopredpipe, { - data <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/v11/data/HCC1395Run.neoantigens.txt" - mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_custom$fullData <- mainData - }) - observeEvent(input$loadDefault_antigengarnish, { - data <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/v11/data/ag_test_antigen.tsv" - mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_custom$fullData <- mainData - }) - output$custom_upload_ui <- renderUI({ - fileInput(inputId = "custom_data", label = "Custom input table (tsv required)", - accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) - }) - observeEvent(input$custom_data$datapath, { - mainData <- read.table(input$custom_data$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_custom$fullData <- mainData - }) - - output$custom_group_by_feature_ui <- renderUI({ - feature <- names(df_custom$fullData) - pickerInput(inputId = "feature_1", - label = "Feature to group peptides by", - choices = feature, # a list of strings - #options = list(`actions-box` = TRUE, `live-search` = TRUE), - multiple = FALSE) - }) - output$custom_order_by_feature_ui <- renderUI({ - feature <- names(df_custom$fullData) - pickerInput(inputId = "feature_2", - label = "Feature to sort peptides by", - choices = feature, # a list of strings - #options = list(`actions-box` = TRUE, `live-search` = TRUE), - multiple = FALSE) - }) - output$custom_peptide_features_ui <- renderUI({ - feature <- names(df_custom$fullData) - pickerInput(inputId = "peptide_features", - label = "Subset of features to display in peptide subtable", - choices = feature[((feature != input$feature_2) & (feature != input$feature_1))], # a list of strings - options = list(`actions-box` = TRUE, `live-search` = TRUE), - multiple = TRUE) - }) - observeEvent(input$visualize_custom, { - #browser() - df_custom$groupBy <- input$feature_1 - df_custom$orderBy <- input$feature_2 - reformat_data <- df_custom$fullData %>% group_by(across(all_of(df_custom$groupBy))) %>% arrange(across(all_of(df_custom$orderBy))) - df_custom$fullData <- reformat_data - row_ind <- reformat_data %>% group_rows() - row_ind_df <- as.data.frame(row_ind) - df_custom$group_inds <- row_ind_df - row_ind_top <- apply(row_ind_df, 1, function(x) {unlist(x[1])[1]}) - df_custom$mainTable <- as.data.frame(reformat_data[row_ind_top, ]) - #df_custom$mainTable <- cbind("Eval" = shinyInput(df_custom$mainTable, selectInput, nrow(df_custom$mainTable), "custom_selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px"), df_custom$mainTable) - df_custom$mainTable <- cbind(Select = shinyInputSelect(actionButton, nrow(df_custom$mainTable), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"custom_select_button\", this.id)'), df_custom$mainTable) - #if (is.null(df_custom$mainTable$`Evaluation`)) { - # df_custom$mainTable$`Evaluation` <- rep("Pending", nrow(df_custom$mainTable)) - #} - #gene_data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/7c7b8352d81b44ec7743578e7715c65261f5dab7/pvactools/tools/pvacview/data/cancer_census_hotspot_gene_list.tsv") - #gene_list <- read.table(text = gene_data, sep = '\t', header = FALSE, stringsAsFactors = FALSE, check.names=FALSE) - #df_custom$gene_list <- gene_list - #df_custom$mainTable$`Gene of Interest` <- apply(df_custom$mainTable,1, function(x) {any(x['Gene Name'] == df_custom$gene_list)}) - df_custom$metricsData <- get_group_inds(df_custom$fullData, df_custom$group_inds) - df_custom$peptide_features <- input$peptide_features - updateTabItems(session, "custom_tabs", "custom_explore") - }) - output$customTable <- DT::renderDataTable( - if (is.null(df_custom$mainTable)) { - return(datatable(data.frame("Annotated Table" = character()))) - }else { - datatable(df_custom$mainTable, - escape = FALSE, class = "stripe", - options = list(lengthChange = FALSE, dom = "Bfrtip", pageLength = input$custom_page_length, - columnDefs = list(list(visible = FALSE, targets = c(-1:-12)), - list(orderable = TRUE, targets = 0)), buttons = list(I("colvis")), - initComplete = htmlwidgets::JS( - "function(settings, json) {", - paste("$(this.api().table().header()).css({'font-size': '", "10pt", "'});"), - "}")), - selection = "none", - extensions = c("Buttons")) - }, server = FALSE) - observeEvent(input$custom_select_button, { - if (is.null(df_custom$mainTable) | is.null(df_custom$selectedRow)){ - return () - } - #browser() - df_custom$selectedRow <- as.numeric(strsplit(input$custom_select_button, "_")[[1]][2]) - session$sendCustomMessage('unbind-DT', 'customTable') - dataTableProxy("customMainTable") %>% - selectPage((df_custom$selectedRow-1) %/% df_custom$pageLength + 1) - }) - output$customPeptideTable <- renderDT({ - withProgress(message = 'Loading Peptide Table', value = 0, { - incProgress(0.5) - #browser() - if (!is.null(df_custom$selectedRow) & !(is.null(df_custom$mainTable)) & !is.null(df_custom$peptide_features)){ - display_table <- get_current_group_info(df_custom$peptide_features, df_custom$metricsData, df_custom$fullData, df_custom$selectedRow) - incProgress(0.5) - dtable <- datatable(display_table, options =list( - pageLength = 10, - rowCallback = JS('function(row, data, index, rowId) {', - 'console.log(rowId)','if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {', - 'row.style.backgroundColor = "#E0E0E0";','}','}') - ), selection = list(mode='single', selected = '1')) - dtable - } - else{ - incProgress(1) - datatable(data.frame("Peptide Datatable"=character()), selection = list(mode='single', selected = '1')) - }}) - }) -}) \ No newline at end of file diff --git a/pvactools/tools/pvacview_dev/styling.R b/pvactools/tools/pvacview_dev/styling.R deleted file mode 100644 index 66276b5c3..000000000 --- a/pvactools/tools/pvacview_dev/styling.R +++ /dev/null @@ -1,61 +0,0 @@ -## server side callback functions -rowcallback <- function(hla_count, row_num) { - c( - "function(row, data, displayNum, displayIndex){", - gsub("0", row_num, " if (displayIndex == 0){"), - " $('td',row).css('border-top','3px solid #0390fc');", - " $('td',row).css('border-bottom','3px solid #0390fc');", - " }", - "}") -} - -callback <- function(hla_count, score_mode) { - c( - "var tips = ['Gene - The Ensembl gene name of the affected gene.',", - " 'AA Change - The amino acid change for the mutation. Note that FS indicates a frameshift variant.',", - " 'Num Passing Transcripts - The number of transcripts for this mutation that resulted in at least one well-binding peptide.',", - " 'Best Peptide - The best-binding mutant epitope sequence (lowest mutant binding affinity) prioritizing epitope sequences that resulted from a protein_coding transcript with a TSL below the maximum transcript support level and having no problematic positions.',", - " 'Best Transcript - Transcript corresponding to the best peptide with the lowest TSL and shortest length.',", - " 'TSL - Transcript support level of the best peptide.',", - " 'Pos - The one-based position of the start of the mutation within the epitope sequence. 0 if the start of the mutation is before the epitope (as can occur downstream of frameshift mutations).',", - " 'Prob Pos - Problematic positions within the best peptide.',", - " 'Num Passing Peptides - The number of unique well-binding peptides for this mutation.',", - gsub("X", score_mode, " 'IC50 MT - X IC50 binding affinity of the best-binding mutant epitope across all prediction algorithms used.', "), - " 'IC50 WT - IC50 binding affinity of the corresponding wildtype epitope.',", - gsub("X", score_mode, " '%ile MT - X binding affinity percentile rank of the best-binding mutant epitope across all prediction algorithms used (those that provide percentile output).', "), - " '%ile WT - Binding affinity percentile rank of the corresponding wildtype epitope across all prediction algorithms used (those that provide percentile output).', ", - " 'RNA Expr - Gene expression value for the annotated gene containing the variant.',", - " 'RNA VAF - Tumor RNA variant allele frequency (VAF) at this position.',", - " 'Allele Expr - Gene expression value * Tumor RNA VAF. This is used to approximate the expression of the variant allele.',", - " 'RNA Depth - Tumor RNA depth at this position.',", - " 'DNA VAF - Tumor DNA variant allele frequency (VAF) at this position.',", - " 'Tier - A tier suggesting the suitability of variants for use in vaccines.',", - " 'Eval - User-selected evaluation of neoantigen candidate. Options include: Accept, Reject, Review. (Default: Pending)'],", - "header = table.columns().header();", - gsub("7", hla_count, "for (var i = 7; i-7 < tips.length; i++) {"), - gsub("7", hla_count, "$(header[i]).attr('title', tips[i-7]);"), - "}" -) -} - - -#### ui side styling settings -csscode <- HTML(" -.sidebar-mini.sidebar-collapse .shiny-bound-input.action-button { - margin: 6px 6px 6px 3px; - max-width: 85%; -} -.sidebar-mini.sidebar-collapse .fa { - font-size: initial; -} -.sidebar-mini.sidebar-collapse #tohide { - display: none; -} -") - -# Create the theme -mytheme <- create_theme( - adminlte_color( - light_blue = "#4e635c" - ) -) diff --git a/pvactools/tools/pvacview_dev/ui.R b/pvactools/tools/pvacview_dev/ui.R deleted file mode 100644 index d0bdafc65..000000000 --- a/pvactools/tools/pvacview_dev/ui.R +++ /dev/null @@ -1,619 +0,0 @@ -# load shiny library -library(shiny) -library(shinydashboard) -library(shinydashboardPlus) -library(DT) -library(fresh) -library(shinycssloaders) - -source("styling.R") -source("neofox_ui.R") -source("custom_ui.R") - -## UPLOAD TAB ## -upload_tab <- tabItem( - "upload", - # infoBoxes - fluidRow( - column(width = 6, - box( - title = "Option 1: View demo data", status = "primary", solidHeader = TRUE, width = NULL, - actionButton("loadDefaultmain", "Load demo data", style = "color: #fff; background-color: #c92424; border-color: #691111"), - h5("Please wait a couple seconds after clicking and you should be redirected to the Visualize and Explore tab.") - ), - box( - title = "Option 2: Upload your own data Files", status = "primary", solidHeader = TRUE, width = NULL, - HTML("
(Required) Please upload the aggregate report file. Note that this will be the data displayed in the main table in the Explore tab.
"), - uiOutput("aggregate_report_ui"), - radioButtons("hla_class", "Does this aggregate report file correspond to Class I or Class II prediction data?", - c("Class I data (e.g. HLA-A*02:01) " = "class_i", "Class II data (e.g. DPA1*01:03)" = "class_ii")), - hr(style = "border-color: white"), - HTML("
(Required) Please upload the corresponding metrics file for the main file that you have chosen.
"), - uiOutput("metrics_ui"), - hr(style = "border-color: white"), - HTML("
(Optional) If you would like, you can upload an additional aggregate report file generated with either Class I or Class II results to supplement your main table. (E.g. if you uploaded Class I data as the main table, you can upload your Class II report here as supplemental data)
"), - uiOutput("add_file_ui"), - textInput("add_file_label", "Please provide a label for the additional file uploaded (e.g. Class I data or Class II data)"), - hr(style = "border-color: white"), - HTML("
(Optional) Additionally, you can upload a gene-of-interest list in a tsv format, where each row is a single gene name. These genes (if in your aggregate report) will be highlighted in the Gene Name column.
"), - fileInput(inputId = "gene_list", label = "4. Gene-of-interest List (tsv required)", accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")), - actionButton("visualize", "Visualize") - ) - ), - column(6, - box( - title = "Basic Instructions: How to explore your data using pVACview?", status = "primary", solidHeader = TRUE, width = NULL, - h4("Step 1: Upload your own data / Load demo data", style = "font-weight: bold"), - h5("You can either choose to explore a demo dataset that we have prepared from the HCC1395 cell line, or choose to upload your own datasets."), - HTML("
If you are uploading your own datasets, the two required inputs are output files you obtain after running the pVACseq pipeline. - The aggregated tsv file is a list of all predicted epitopes and their binding affinity scores with additional variant information - and the metrics json file contains additional transcript and peptide level information.
"), - h5("You have the option of uploading an additional file to supplement the data you are exploring. This includes: additional class I or II information and - a gene-of-interest tsv file."), - actionButton("help_doc_upload", "More details", onclick = "window.open('https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#upload', '_blank')"), - h4("Step 2: Exploring your data", style = "font-weight: bold"), - HTML("
To explore the different aspects of your neoantigen candidates, you will need to navigate to the Aggregate Report of Best Candidate by Variant on the visualize and explore tab. - For detailed variant, transcript and peptide information for each candidate listed, you will need to click on the Investigate button for the specific row of interest. - This will prompt both the transcript and peptide table to reload with the matching information.
"), - h5("By hovering over each column header, you will be able to see a brief description of the corresponding column and for more details, you can click on the tooltip located at the top right of the aggregate report table.", br(), - "After investigating each candidate, you can label the candidate using the dropdown menu located at the second to last column of the table. Choices include: - Accept, Reject or Review."), - actionButton("help_doc_explore", "More details", onclick = "window.open('https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#visualize-and-explore', '_blank')"), - h4("Step 3: Exporting your data", style = "font-weight: bold"), - h5("When you have either finished ranking your neoantigen candidates or need to pause and would like to save your current evaluations, - you can export the current main aggregate report using the export page."), - HTML("
Navigate to the export tab, and you will be able to name your file prior to downloading in either tsv or excel format. - The excel format is user-friendly for downstream visualization and manipulation. However, if you plan on to continuing editing the aggregate report - and would like to load it back in pVACview with the previous evaluations preloaded, you will need to download the file in a tsv format. - This serves as a way to save your progress as your evaluations are cleared upon closing or refreshing the pVACview app.
"), - actionButton("help_doc_export", "More details", onclick = "window.open('https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#export', '_blank')") - ) - ), - ) -) - -## EXPLORE TAB ## -explore_tab <- tabItem( - "explore", - conditionalPanel( - condition = "output.filesUploaded", - fluidRow( - tags$style( - type = "text/css", - ".modal-dialog { width: fit-content !important; }" - ), - tags$script(HTML("Shiny.addCustomMessageHandler('unbind-DT', function(id) { - Shiny.unbindAll($('#'+id).find('table').DataTable().table().node()); - })")), - box(width = 6, - title = "Advanced Options: Regenerate Tiering with different parameters", - status = "primary", solidHeader = TRUE, collapsible = TRUE, collapsed = TRUE, - "*Please note that the metrics file is required in order to regenerate tiering information with different parameters", br(), - "Current version of pVACseq results defaults to positions 1, 2, n-1 and n (for a n-mer peptide) when determining anchor positions. - If you would like to use our allele specific anchor results and regenerate the tiering results for your variants, - please specify your contribution cutoff and submit for recalculation. ", tags$a(href = "https://www.biorxiv.org/content/10.1101/2020.12.08.416271v1", "More details can be found here.", target = "_blank"), br(), - checkboxInput("use_anchor", "If you want to use allele-specific anchor calculations, please check this box. Otherwise anchors will be calculated as 1,2 and n-1,n for n-mer peptides.", value = FALSE, width = NULL), - sliderInput("anchor_contribution", "Contribution cutoff for determining anchor locations", 0.5, 0.9, 0.8, step = 0.1, width = 400), - uiOutput("binding_threshold_ui"), - checkboxInput("allele_specific_binding", "If you want to use allele-specific binding thresholds for tiering purposes please check this box.", value = FALSE, width = NULL), - uiOutput("percentile_threshold_ui"), - uiOutput("dna_cutoff_ui"), - uiOutput("allele_expr_ui"), - h5("For further explanations on these inputs, please refer to the ", tags$a(href = "https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#visualize-and-explore", "pVACview documentation.", target = "_blank")), - actionButton("submit", "Recalculate Tiering with new parameters"), - style = "overflow-x: scroll;font-size:100%"), - box(width = 3, - title = "Original Parameters for Tiering", - status = "primary", solidHeader = TRUE, collapsible = TRUE, - column(width = 12, - h5("These are the original parameters used in the tiering calculations extracted from the metrics data file given as input."), - tableOutput("paramTable"), - tableOutput("bindingParamTable"), style = "height:250px; overflow-y: scroll;overflow-x: scroll;"), - actionButton("reset_params", "Reset to original parameters"), - style = "overflow-x: scroll;font-size:100%"), - box(width = 3, - title = "Add Comments for selected variant", - status = "primary", solidHeader = TRUE, collapsible = TRUE, - textAreaInput("comments", "Please add/update your comments for the variant you are currently examining", value = ""), - actionButton("comment", "Update Comment Section"), - h5("Comment:"), htmlOutput("comment_text"), - style = "font-size:100%") - ), - fluidRow( - box(width = 12, - title = "Aggregate Report of Best Candidates by Variant", - status = "primary", solidHeader = TRUE, collapsible = TRUE, - enable_sidebar = TRUE, sidebar_width = 25, sidebar_start_open = TRUE, - dropdownMenu = boxDropdown(boxDropdownItem("Help", id = "help", icon = icon("question-circle"))), - selectInput("page_length", "Number of variants displayed per page:", selected = "10", c("10", "20", "50", "100"), width = "280px"), - DTOutput("mainTable") %>% withSpinner(color = "#8FCCFA"), - span("Currently investigating row: ", verbatimTextOutput("selected")), - style = "overflow-x: scroll;font-size:100%") - ), - - fluidRow( - box(width = 12, title = "Variant Information", status = "primary", solidHeader = TRUE, collapsible = TRUE, - tabBox(width = 6, title = " ", - tabPanel("Transcript Sets of Selected Variant", - DTOutput("transcriptSetsTable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;font-size:100%"), - tabPanel("Additional Data", - span("Additional Data Type: ", verbatimTextOutput("type_text")), - span("Median MT IC50: ", verbatimTextOutput("addData_IC50")), - span("Median MT Percentile: ", verbatimTextOutput("addData_percentile")), - span("Best Peptide: ", verbatimTextOutput("addData_peptide")), - span("Corresponding HLA allele: ", verbatimTextOutput("addData_allele")), - span("Best Transcript: ", verbatimTextOutput("addData_transcript"))) - ), - box(width = 4, solidHeader = TRUE, title = "Variant & Gene Info", - span("DNA VAF", verbatimTextOutput("metricsTextDNA")), - span("RNA VAF", verbatimTextOutput("metricsTextRNA")), - span("Gene Expression", verbatimTextOutput("metricsTextGene")), - span("Genomic Information (chromosome - start - stop - ref - alt)", verbatimTextOutput("metricsTextGenomicCoord")), - h5("Additional variant information:"), - uiOutput("url"), style = "overflow-x: scroll;font-size:100%"), - box(width = 2, solidHeader = TRUE, title = "Peptide Evalutation Overview", - tableOutput("checked"), style = "overflow-x: scroll;font-size:100%") - ) - ), - fluidRow( - box(width = 12, title = "Transcript Set Detailed Data", solidHeader = TRUE, collapsible = TRUE, status = "primary", - tabBox(width = 12, title = " ", - tabPanel("Peptide Candidates from Selected Transcript Set", - DTOutput("peptideTable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;font-size:100%"), - tabPanel("Transcripts in Set", - DTOutput("transcriptsTable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;font-size:100%") - ) - ) - ), - fluidRow( - box(width = 12, title = "Additional Peptide Information", status = "primary", solidHeader = TRUE, collapsible = TRUE, - tabBox(title = " ", id = "info", - tabPanel("IC50 Plot", - h4("Violin Plots showing distribution of MHC IC50 predictions for selected peptide pair (MT and WT)."), - plotOutput(outputId = "bindingData_IC50") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" - ), - tabPanel("%ile Plot", - h4("Violin Plots showing distribution of MHC percentile predictions for selected peptide pair (MT and WT)."), - plotOutput(outputId = "bindingData_percentile") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" - ), - tabPanel("Binding Data", - h4("Prediction score table showing exact MHC binding values for IC50 and percentile calculations."), - DTOutput(outputId = "bindingDatatable"), style = "overflow-x: scroll;" - ), - tabPanel("Elution Table", - h4("Prediction score table showing exact MHC binding values for elution and percentile calculations."), - DTOutput(outputId = "elutionDatatable"), - br(), - strong("MHCflurryEL Processing"), span(': An "antigen processing" predictor that attempts to model MHC allele-independent effects such as proteosomal cleavage. ('), - a(href = "https://www.sciencedirect.com/science/article/pii/S2405471220302398", "Citation"), span(")"), - br(), - strong("MHCflurryEL Presentation"), span(': A predictor that integrates processing predictions with binding affinity predictions to give a composite "presentation score." ('), - a(href = "https://www.sciencedirect.com/science/article/pii/S2405471220302398", "Citation"), span(")"), - br(), - strong("NetMHCpanEL / NetMHCIIpanEL"), span(": A predictor trained on eluted ligand data. ("), - a(href = "https://academic.oup.com/nar/article/48/W1/W449/5837056", "Citation"), span(")"), - style = "overflow-x: scroll;" - ), - tabPanel("Anchor Heatmap", - h4("Allele specific anchor prediction heatmap for top 20 candidates in peptide table."), - plotOutput(outputId = "peptideFigureLegend", height = "50px"), - plotOutput(outputId = "anchorPlot") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" - ) - ), - box( - column(width = 4, - h4("Allele Specific Anchor Prediction Heatmap"), - h5(" This tab displays HLA allele specific anchor predictions overlaying good-binding peptide sequences generated from each specific transcript.", br(), - " Current version supports the first 15 MT/WT peptide sequence pairs (first 30 rows of the peptide table)."), br(), - h4("MHC Binding Prediction Scores"), - h5(" This tab contains violin plots that showcase individual binding prediction scores from each algorithm used. A solid line is used to represent the median score.") - ), - column(width = 8, - box(title = "Anchor vs Mutation position Scenario Guide", collapsible = TRUE, collapsed = FALSE, width = 12, - img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/anchor.jpg", - align = "center", height = "350px", width = "600px"), style = "overflow-x: scroll;") - ) - ) - ) - ) - ), - conditionalPanel( - condition = "output.filesUploaded == false", - h4("Error: Missing required files (both aggregate report and metrics files are required to properly visualize and explore candidates).", style = "font-weight: bold"), - ) -) - -## EXPORT TAB ## -export_tab <- tabItem( - "export", - fluidRow( - textInput("exportFileName", "Export filename: ", value = "Annotated.Neoantigen_Candidates", width = NULL, placeholder = NULL) - ), - fluidRow( - column(12, - DTOutput("ExportTable") %>% withSpinner(color = "#8FCCFA")) - ) -) - -## TUTORIAL TAB ## -tutorial_tab <- tabItem("tutorial", - tabsetPanel(type = "tabs", - tabPanel("Variant Level", - ## Aggregate Report Column Descriptions" - h3("Main table full column descriptions"), - p("If using pVACview with pVACtools output, the user is required to at least provide two files: ", - code("all_epitopes.aggregated.tsv"), code("all_epitopes.aggregated.metrics.json")), br(), - p("The ", code("all_epitopes.aggregated.tsv"), - "file is an aggregated version of the all_epitopes TSV. - It presents the best-scoring (lowest binding affinity) epitope for each variant, and outputs - additional binding affinity, expression, and coverage information for that epitope. - It also gives information about the total number of well-scoring epitopes for each variant, - the number of transcripts covered by those epitopes, as well as the HLA alleles that those - epitopes are well-binding to. Lastly, the report will bin variants into tiers that offer - suggestions as to the suitability of variants for use in vaccines."), br(), - p(strong("Column Names : Description")), - p(code("ID"), " : ", "A unique identifier for the variant"), - p(code("HLA Alleles"), " : ", "For each HLA allele in the run, the number of this variant’s - epitopes that bound well to the HLA allele (with ", code("lowest"), " or ", code("median"), - " mutant binding affinity < ", code("aggregate_inclusion_binding_threshold"), ")"), - p(code("Gene"), " : ", "The Ensembl gene name of the affected gene"), - p(code("AA Change"), " : ", "The amino acid change for the mutation"), - p(code("Num Passing Transcripts"), " : ", "The number of transcripts - for this mutation that resulted in at least one well-binding peptide (", code("lowest"), " or ", - code("median"), " mutant binding affinity < ", code("aggregate_inclusion_binding_threshold"), ")"), - p(code("Best Peptide"), " : ", "The best-binding mutant epitope sequence (lowest mutant binding affinity) - prioritizing epitope sequences that resulted from a protein_coding transcript with a TSL below the - maximum transcript support level and having no problematic positions."), - p(code("Best Transcript"), " : ", "Transcript corresponding to the best peptide with the lowest TSL and shortest length."), - p(code("TSL"), " : ", "Transcript support level of the best peptide"), - p(code("Pos"), " : ", "The one-based position of the start of the mutation within the epitope sequence. ", - code("0"), " if the start of the mutation is before the epitope (as can occur downstream of frameshift mutations)"), - p(code("Num Passing Peptides"), " : ", "The number of unique well-binding peptides for this mutation."), - p(code("IC50 MT"), " : ", code("Lowest"), " or ", code("Median"), " ic50 binding affinity of - the best-binding mutant epitope across all prediction algorithms used."), - p(code("IC50 WT"), " : ", code("Lowest"), " or ", code("Median"), " ic50 binding affinity of - the corresponding wildtype epitope across all prediction algorithms used."), - p(code("%ile MT"), " : ", code("Lowest"), " or ", code("Median"), "binding affinity percentile rank - of the best-binding mutant epitope across all prediction algorithms used (those that provide percentile output)"), - p(code("%ile WT"), " : ", code("Lowest"), " or ", code("Median"), "binding affinity percentile rank of the - corresponding wildtype epitope across all prediction algorithms used (those that provide percentile output)"), - p(code("RNA Expr"), " : ", "Gene expression value for the annotated gene containing the variant."), - p(code("RNA VAF"), " : ", "Tumor RNA variant allele frequency (VAF) at this position."), - p(code("Allele Expr"), " : ", "RNA Expr * RNA VAF"), - p(code("RNA Depth"), " : ", "Tumor RNA depth at this position."), - p(code("DNA VAF"), " : ", "Tumor DNA variant allele frequency (VAF) at this position."), - p(code("Tier"), " : ", "A tier suggesting the suitability of variants for use in vaccines."), - p(code("Evaluation"), " : ", "Column to store the evaluation of each variant when evaluating the run in pVACview. - Either ", code("Accept"), " ", code("Reject"), " or ", code("Review"), "."), - ## Tiering Explained ## - h3("How is the Tiering column determined / How are the Tiers assigned?"), br(), - p("Note that if a percentile threshold has been provided, then the ", code("%ile MT"), " column is also required to be lower than - the given threshold to qualify for tiers, including Pass, Anchor, Subclonal and LowExpr."), br(), - p(strong("Tier : Criteria")), - p(code("Pass"), " : ", code(("(MT binding < binding threshold) AND allele expr filter pass AND vaf clonal filter pass - AND tsl filter pass AND anchor residue filter pass"))), - p(code("Anchor"), " : ", code(("(MT binding < binding threshold) AND allele expr filter pass AND vaf clonal filter pass - AND tsl filter pass AND anchor residue filter fail"))), - p(code("Subclonal"), " : ", code(("(MT binding < binding threshold) AND allele expr filter pass AND vaf clonal filter fail - AND tsl filter pass AND anchor residue filter pass"))), - p(code("LowExpr"), " : ", code(("(MT binding < binding threshold) AND low expression criteria met AND allele expr filter pass - AND vaf clonal filter pass AND tsl filter pass AND anchor residue filter pass"))), - p(code("Poor"), " : ", "Best peptide for current variant FAILS in two or more categories"), - p(code("NoExpr"), " : ", code("((gene expr == 0) OR (RNA VAF == 0)) AND low expression criteria not met")), br(), - p("Here we list out the exact criteria for passing each respective filter: "), - p(strong("Allele Expr Filter: "), code("(allele expr >= allele expr cutoff) OR (rna_vaf == 'NA') OR (gene_expr == 'NA')")), - p(strong("VAF Clonal Filter: "), code("(dna vaf < vaf subclonal) OR (dna_vaf == 'NA')")), - p(strong("TSL Filter: "), code("(TSL != 'NA') AND (TSL < maximum transcript support level)")), - p(strong("Anchor Residue Filter: "), br(), - strong("1. "), code("(Mutation(s) is at anchor(s)) AND - ((WT binding < binding threshold) OR (WT percentile < percentile threshold))"), br(), - strong(" OR"), br(), strong("2. "), code("Mutation(s) not or not entirely at anchor(s)")), - p(strong("Low Expression Criteria: "), code("(allele expr > 0) OR ((gene expr == 0) AND (RNA Depth > RNA Coverage Cutoff) AND (RNA VAF > RNA vaf cutoff))")) - ), - tabPanel("Transcript Level", - h3(" "), - fluidRow( - column(width = 6, - h4("Transcript Set Table", style = "font-weight: bold; text-decoration: underline;"), - p("Upon selecting a variant for investigation, you may have multiple transcripts covering the region.", br(), br(), - "These transcripts are first grouped into ", strong("Trancripts Sets"), " , which is based on the good binding peptides - produced. Transcripts that produce the exact same set of peptides are put into the same group.", br(), br(), - "The table also lists the number of transcripts and corresponding peptides in each set (each pair of WT and MT peptides are considered 1 when - counting).", br(), " A sum of the total expression across all transcripts in each set is also shown.", br(), " A light green color is used to - highlight the ", strong("Transcript Set"), " producing the Best Peptide for the variant in question.") - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Transcript_Set.png?raw=true", - align = "center", height = "300px", width = "500px"), - ) - ), - fluidRow( - column(width = 3, - h4("Transcript Set Detailed Data", style = "font-weight: bold; text-decoration: underline;"), - p("Upon selecting a specific transcript set, you can now look in more detail which exact transcripts are included.", br(), br(), - "The ", strong("Transcripts in Set"), "table lists all information regarding each transcript including:", br(), br(), - "Transcript ID, Gene Name, Amino Acid Change, Mutation Position, individual transcript expression, transcript support level, biotype and transcript length.", br(), br(), - " A light green color is used to highlight the ", strong("Transcript in Selected Set"), " that produced the Best Peptide for the variant in question.") - ), - column(width = 9, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Transcript_in_Set.png?raw=true", - align = "center", height = "300px", width = "1200px"), - ) - ) - ), - tabPanel("Peptide Level", - h4(" "), - fluidRow( - column(width = 12, - h4("Peptide Table", style = "font-weight: bold; text-decoration: underline;"), - p("Upon selecting a specific transcript set, you can also now look in detail which good-binding peptides are produced from this set.", br(), br(), - "Both mutant (", code("MT"), ") and wildtype (", code("WT"), ") sequences are shown, along with ", code("lowest"), " or ", code("median"), - " binding affinities, depending on how you generated the aggregate report.", br(), br(), - "An ", code("X"), "is marked for binding affinities higher than the ", code("aggregate_inclusion_binding_threshold"), " set when generating the aggregate report.", br(), br(), - "We also include two extra columns, one specifying the mutation and position and another providing information on any problematic amino acids.", br(), - "Note that if users wish to utlitize the ", strong("problematic positions"), " feature, they should run the standalone command ", code("pvacseq identify_problematic_amino_acids"), - " or run pVACseq with the ", code("--problematic-amino-acids"), " option enabled to generate the needed information." - ) - ) - ), - fluidRow( - column(width = 12, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Peptide_Table.png?raw=true", - align = "center", height = "400px", width = "1500px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h4("Additional Information", style = "font-weight: bold; text-decoration: underline;"), - h5("IC50 Plot", style = "font-weight: bold;"), - p("By clicking on each MT/WT peptide pair, you can then assess the peptides in more detail by navigating to the ", strong("Additional Peptide Information"), " tab.", br(), br(), - "There’s five different tabs in this section of the app, providing peptide-level details on the MT/WT peptide pair that you have selected", br(), - "The ", strong("IC50 Plot"), "tab shows violin plots of the individual IC50-based binding affinity predictions of the MT and WT peptides for HLA - alleles were the MT binds well to. These peptides each have up to 8 binding algorithm scores (for Class I alleles with pVACseq version 3.0) or up - to 4 algorithm scores (for Class II alleles with pvacseq version 3.0).", br()) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_IC50_Plots.png?raw=true", - align = "center", height = "350px", width = "700px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h5("%ile Plot", style = "font-weight: bold;"), - p("The ", strong("%ile Plot"), "tab shows violin plots of the individual percentile-based binding affinity predictions of the MT and WT peptides - for HLA alleles were the MT binds well to.", br()) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Percentile_Plots.png?raw=true", - align = "center", height = "350px", width = "700px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h5("Binding Data", style = "font-weight: bold;"), - p("The ", strong("Binding Data"), "tab shows the specific IC50 and percentile binding affinity predictions generated from each individual algorithm. - Each cell shows the IC50 prediction followed by the percentile predictions in parenthesis.", br()) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Binding_Data.png?raw=true", - align = "center", height = "350px", width = "720px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h5("Elution Table", style = "font-weight: bold;"), - p("The ", strong("Elution Table"), "tab shows prediction results based on algorithms trained from peptide elution data. This includes algorithms - such as NetMHCpanEL/NetMHCIIpanEL, MHCflurryELProcessing and MHCflurryELPresentation.", br()) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Elution_Data.png?raw=true", - align = "center", height = "350px", width = "720px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h5("Anchor Heatmap", style = "font-weight: bold;"), - p("The ", strong("Anchor Heatmap"), "tab shows the top 30 MT/WT peptide pairs from the peptide table with anchor probabilities overlaying as a heatmap. - The anchor probabilities shown are both allele and peptide length specific. The mutated amino acid is marked in red (for missense mutations) and each - MT/WT pair are separated from others using a dotted line. ", br(), - "For peptide sequences with no overlaying heatmap, we currently do not have allele-specific predictions for them in our database.", br(), br(), - "For more details and explanations regarding anchor positions and its influence on neoantigen prediction and prioritization, please refer to the next section: ", - strong("Advanced Options: Anchor Contribution")) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Anchor_Heatmap.png?raw=trueg", - align = "center", height = "350px", width = "720px"), br(), br() - ) - ) - ), - tabPanel("Advanced Options: Anchor Contribution", - h4(" "), - fluidRow( - column(width = 6, - h4("Anchor vs Mutation Posiions", style = "font-weight: bold; text-decoration: underline;"), - p("Neoantigen identification and prioritization relies on correctly predicting whether the presenting - peptide sequence can successfully induce an immune response. As the majority of somatic mutations are single nucleotide variants, - changes between wildtype and mutated peptides are typically subtle and require cautious interpretation. ", br(), br(), - "In the context of neoantigen presentation by specific MHC alleles, researchers have noted that a subset of - peptide positions are presented to the T-cell receptor for recognition, while others are responsible for anchoring - to the MHC, making these positional considerations critical for predicting T-cell responses.", br(), br(), - "Multiple factors should be considered when prioritizing neoantigens, including mutation location, anchor position, predicted MT - and WT binding affinities, and WT/MT fold change, also known as agretopicity.", br(), br(), - "Examples of the four distinct possible scenarios for a predicted strong MHC binding peptide involving these factors are illustrated - in the figure on the right. There are other possible scenarios where the MT is a poor binder, however those are not listed as - they would not pertain to our goal of neoantigen identification.", br(), br(), - strong("Scenario 1"), "shows the cases where the WT is a poor binder and the MT peptide, a strong binder, - contains a mutation at an anchor location. Here, the mutation results in a tighter binding of the MHC and allows for - better presentation and potential for recognition by the TCR. As the WT does not bind (or is a poor binder), this neoantigen - remains a good candidate since the sequence presented to the TCR is novel.", br(), br(), - strong("Scenario 2"), " and ", strong("Scenario 3"), " both have strong binding WT and MT peptides. In ", strong("Scenario 2"), - ", the mutation of the peptide is located at a non-anchor location, creating a difference in the sequence participating in TCR - recognition compared to the WT sequence. In this case, although the WT is a strong binder, the neoantigen remains a good candidate - that should not be subject to central tolerance.", br(), br(), - "However, as shown in ", strong("Scenario 3"), ", there are neoantigen candidates where the mutation is located at the anchor position - and both peptides are strong binders. Although anchor positions can themselves influence TCR recognition, a mutation at a strong - anchor location generally implies that both WT and MT peptides will present the same residues for TCR recognition. As the WT peptide - is a strong binder, the MT neoantigen, while also a strong binder, will likely be subject to central tolerance and should not be - considered for prioritization.", br(), br(), - strong("Scenario 4"), " is similar to the first scenario where the WT is a poor binder. However, in this case, the mutation is - located at a non-anchor position, likely resulting in a different set of residues presented to the TCR and thus making the neoantigen a good candidate." - ) - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Anchor_Scenarios.png?raw=true", - align = "center", height = "800px", width = "400px"), br(), br() - ) - ), - fluidRow( - column(width = 6, - h4("Anchor Guidance", style = "font-weight: bold; text-decoration: underline;"), - p("To summarize, here are the specific criteria for prioritizing (accept) and not prioritizing (reject) a neoantigen candidate:", br(), - "Note that in all four cases, we are assuming a strong MT binder which means ", - code("(MT IC50 < binding threshold) OR (MT percentile < percentile threshold)"), br(), br()), - p(code("I: WT Weak binder"), " : ", code("(WT IC50 < binding threshold) OR (WT percentile < percentile threshold)")), - p(code("II: WT Strong binder"), " : ", code("(WT IC50 > binding threshold) AND (WT percentile > percentile threshold)")), - p(code("III: Mutation at Anchor"), " : ", code("set(All mutated positions) is a subset of set(Anchor Positions of corresponding HLA allele)")), - p(code("IV: Mutation not at Anchor"), " : ", code("There is at least one mutated position between the WT and MT that is not at an anchor position")), - p(strong("Scenario 1 : "), code(" I + IV"), strong(" -> Accept")), - p(strong("Scenario 2 : "), code(" II + IV"), strong(" -> Accept")), - p(strong("Scenario 3 : "), code(" II + III"), strong(" -> Reject")), - p(strong("Scenario 4 : "), code(" I + III"), strong(" -> Accept")) - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/anchor.jpg", - align = "center", height = "350px", width = "600px"), br(), br() - ) - ) - ), - tabPanel("Advanced Options: Regenerate Tiering", - h4(" "), - fluidRow( - column(width = 6, - h4("Reassigning Tiers for all variants after adjusting parameters", style = "font-weight: bold; text-decoration: underline;"), - p("The Tier column generated by pVACtools is aimed at helping users group and prioritize neoantigens in a more efficient manner. - If you would like to first understand how Tiering is done, please refer to the Variant Level tutorial tab where we break down each - specific Tier and its criteria.", br(), br(), - "While we try to provide a set of reasonable default parameters, we fully understand the need for flexible changes to the - parameters used in the underlying Tiering algorithm. Thus, we provide an Advanced Options tab in our app where users can change the following - cutoffs custom to their individual analysis: ", br(), br(), - code("Binding Threshold"), p("IC50 cutoff for a peptide to be considered a strong binder. Note that if allele-specific binding thresholds are - in place, those will stay the same and not overwritten by this parameter value change."), br(), - code("Percentile Threshold"), p("Percentile cutoff for a peptide to be considered a strong binder."), br(), - code("Clonal DNA VAF"), p("VAF cutoff that is taken into account when deciding subclonal variants. Note that variants with a DNA VAF lower - than half of the clonal vaf cutoff will be considered subclonal (e.g. setting a 0.6 clonal vaf cutoff means anything under 0.3 vaf is subclonal)."), br(), - code("Allele Expr"), p("Allele expression cutoff for a peptide to be considered expressed. Note for each variant, the allele expression - is calculated by multiplying gene expression and RNA VAF."), br(), - code("Default Anchors vs Allele-specific Anchors"), br(), - "By default, pVACtools considers positions 1, 2, n-1, and n to be anchors for an n-mer allele. However, recent study has shown that anchors should be - considered on an allele-specific basis and different anchor patterns exist among HLA alleles.", - "Here, we provide users with the option to utilize allele-specific anchors when generating the Anchor Tier. However, to objectively determine - which positions are anchors for each individual allele, the users need to set a contribution percentage threshold X.", - "Per anchor calculation results from the described computational workflow in the cited paper, each position of the n-mer peptide is assigned a - score based on how binding to a certain HLA allele was influenced by mutations. These scores can then be used to calculate the relative - contribution of each position to the overall binding affinity of the peptide. Given the contribution threshold X, we rank the normalized score - across the peptide in descending order (e.g. [2,9,1,3,2,8,7,6,5] for a 9-mer peptide) and start summing the scores from top to bottom. - Positions that together account for X% of the overall binding affinity change (e.g. 2,9,1) will be assigned as anchor locations for tiering purposes.", br(), br(), - "However, we recommend users also navigating to the Anchor Heatmap Tab in the peptide level description for a less binary approach." - ) - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Regenerate_Tiering.png?raw=true", - align = "center", height = "400px", width = "700px"), br(), br() - ) - ), - fluidRow( - column(width = 6, - h4("Original Parameters", style = "font-weight: bold; text-decoration: underline;"), - p(" In this box, we provide users with the original parameters they had used to generate the currently loaded aggregate report and metrics file.", - "This not only allows users to compare their current parameters (if changed) with the original setting but we also offer a ", strong("reset"), - " button that allows the user to restore the original tiering when desired.", br(), br(), - "Note that the app will keep track of your peptide evaluations and comments accordingly even when changing or reseting the parameters.", br(), br(), - "If you see a parameter in the original parameter box but did not see an option to change it in the advanced options section, it is likely that you - will be required to rerun the", code("pvacseq generate-aggregate-report"), " command. This is likely due to the current metrics file not - having the necessary peptide information to perform this request." - ) - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Original_Parameters.png?raw=true", - align = "center", height = "400px", width = "300px"), br(), br() - ) - ) - ) - ) -) - -## CONTACT TAB ## -contact_tab <- tabItem("contact", - p("Bug reports or feature requests can be submitted on the ", tags$a(href = "https://github.com/griffithlab/pVACtools", "pVACtools Github page."), - "You may also contact us by email at ", code("help@pvactools.org", ".")) - -) - -ui <- dashboardPage( - ## HEADER ## - header = dashboardHeader( - title = tagList(tags$a(class = "logo", - span(class = "logo-mini", tags$img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/pVACview_logo_mini.png")), - span(class = "logo-lg", tags$img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/pVACview_logo.png")) - )), - tags$li(class = "dropdown", tags$a(href = "https://pvactools.readthedocs.io/en/latest/", class = "my_class", "Help", target = "_blank")) - ), - ## SIDEBAR ## - sidebar = dashboardSidebar( - sidebarMenu( - tags$head(tags$style(csscode)), - id = "tabs", - menuItem("pVACtools Output", tabName = "pvactools", startExpanded = TRUE, icon = icon("far fa-chart-bar"), - br(), - menuSubItem("Upload", tabName = "upload", icon = icon("upload")), - br(), - menuSubItem("Visualize and Explore", tabName = "explore", icon = icon("digital-tachograph")), - br(), - menuSubItem("Export", tabName = "export", icon = icon("file-export")), - br() - ), - menuItem("Tutorials", tabName = "tutorial", startExpanded = TRUE, icon = icon("fas fa-book-open")), - menuItem("Neofox Data Visualization", tabName = "neofox", startExpanded = TRUE, icon = icon("fa-solid fa-file")), - menuItem("Custom Data Visualization", tabName = "custom", startExpanded = TRUE, icon = icon("fa-solid fa-pen-to-square")), - menuItem("pVACview Documentation", icon = icon("fas fa-file-invoice"), href = "https://pvactools.readthedocs.io/en/latest/pvacview.html"), - menuItem("Submit Github Issue", tabName = "contact", icon = icon("far fa-question-circle")) - ) - ), - body = dashboardBody( - use_theme(mytheme), - tags$head( - #tags$style(HTML(css)), - tags$style(HTML("table.dataTable tr.selected td, table.dataTable td.hover {background-color: #EAF2F8 !important;}")), - tags$style(HTML("table.dataTable { border-collapse: collapse;}")), - tags$style(HTML("table.dataTable.hover tbody tr:hover, table.dataTable.display tbody tr:hover { - background-color: #92c8f0 !important; } ")), - tags$style(HTML(".skin-blue .main-header .logo {background-color: #dff5ee;}")), - tags$style(HTML(".skin-blue .main-header .navbar { background-color: #739187;}")), - tags$style(HTML("element.style {}.skin-blue .wrapper, .skin-blue .main-sidebar, .skin-blue .left-side {background-color: #739187;}")), - tags$style(HTML(".main-header .sidebar-toggle {background-color: #b6d1c8}")), - tags$style(HTML(".box-header.with-border {border-bottom: 1px solid #f4f4f4;}")), - tags$style(HTML(".skin-blue .main-header .navbar .sidebar-toggle {color: #4e635c;}")), - tags$style(HTML(".content-wrapper {background-color: #ecf0f5;}")), - tags$style(HTML(".main-header .logo {padding-right : 5px; padding-left : 5px;}")), - tags$style(HTML(".box.box-solid.box-primary {border-radius: 12px}")), - tags$style(HTML(".box-header.with-border {border-radius: 10px}")) - ), - - tabItems( - ## UPLOAD TAB ## - upload_tab, - ## EXPLORE TAB ## - explore_tab, - ## EXPORT TAB ## - export_tab, - ## TUTORIAL TAB ## - tutorial_tab, - ## NEOFOX TAB ## - neofox_tab, - ## CUSTOM TAB ## - custom_tab, - ## CONTACT TAB ## - contact_tab - ) - ) -) \ No newline at end of file diff --git a/pvactools/tools/pvacview_dev_eve/__init__.py b/pvactools/tools/pvacview_dev_eve/__init__.py deleted file mode 100644 index 6a7ed93a9..000000000 --- a/pvactools/tools/pvacview_dev_eve/__init__.py +++ /dev/null @@ -1,5 +0,0 @@ -__all__ = [ - 'run', -] - -from . import * diff --git a/pvactools/tools/pvacview_dev_eve/anchor_and_helper_functions.R b/pvactools/tools/pvacview_dev_eve/anchor_and_helper_functions.R deleted file mode 100755 index d17feb751..000000000 --- a/pvactools/tools/pvacview_dev_eve/anchor_and_helper_functions.R +++ /dev/null @@ -1,415 +0,0 @@ -library(RCurl) -library(curl) - -## Load Anchor data -anchor_data <- list() -anchor_data[[8]] <- read.table(curl("https://raw.githubusercontent.com/griffithlab/pVACtools/ae938113ddbbe6c6eeecebf94459d449facd2c2f/tools/pvacview/data/Normalized_anchor_predictions_8_mer.tsv"), sep = "\t", header = TRUE, stringsAsFactors = FALSE) -anchor_data[[9]] <- read.table(curl("https://raw.githubusercontent.com/griffithlab/pVACtools/ae938113ddbbe6c6eeecebf94459d449facd2c2f/tools/pvacview/data/Normalized_anchor_predictions_9_mer.tsv"), sep = "\t", header = TRUE, stringsAsFactors = FALSE) -anchor_data[[10]] <- read.table(curl("https://raw.githubusercontent.com/griffithlab/pVACtools/ae938113ddbbe6c6eeecebf94459d449facd2c2f/tools/pvacview/data/Normalized_anchor_predictions_10_mer.tsv"), sep = "\t", header = TRUE, stringsAsFactors = FALSE) -anchor_data[[11]] <- read.table(curl("https://raw.githubusercontent.com/griffithlab/pVACtools/ae938113ddbbe6c6eeecebf94459d449facd2c2f/tools/pvacview/data/Normalized_anchor_predictions_11_mer.tsv"), sep = "\t", header = TRUE, stringsAsFactors = FALSE) - -#get binding affinity colors cutoffs given HLA - -scale_binding_affinity <- function(allele_specific_binding_thresholds, use_allele_specific_binding_thresholds, binding_threshold, hla, current_ba) { - if (use_allele_specific_binding_thresholds && hla %in% names(allele_specific_binding_thresholds[hla])) { - threshold <- as.numeric(allele_specific_binding_thresholds[hla]) - return(as.numeric(current_ba) / threshold) - }else { - threshold <- as.numeric(binding_threshold) - return(as.numeric(current_ba) / threshold) - } -} - -#for custom table formatting -get_group_inds <- function(reformat_data, group_inds){ - group_data <- as.data.frame(group_inds[[1]]) - group_data$group_id <- rownames(group_data) - colnames(group_data)[colnames(group_data) == 'group_inds[[1]]'] <- 'inds' - rownames(group_data) <- NULL - return(group_data) -} - -get_current_group_info <- function(peptide_features, metricsData, fullData, selectedRow){ - subset_data <- fullData[ ,peptide_features] - inds <- metricsData[metricsData$group_id == selectedRow, ]$inds - current_peptide_data <- data.frame(subset_data[unlist(inds), ]) - return(current_peptide_data) -} - -#reformat table for display -table_formatting <- function(x, y) { - y[y == "X"] <- NA - peptide_ind <- grepl(x, colnames(y)) - peptide_columns <- y[, peptide_ind] - peptide_columns$Mutant <- x - colnames(peptide_columns) <- gsub(x, "", colnames(peptide_columns)) - colnames(peptide_columns) <- gsub("\\.", "", colnames(peptide_columns)) - peptide_columns_mt <- peptide_columns - peptide_columns_mt$wt_peptide <- NULL - ic50_mt <- dcast(peptide_columns_mt, Mutant ~ hla_types, value.var = "ic50s_MT") - ic50_mt[, !names(ic50_mt) == "Mutant"] <- round(as.numeric(ic50_mt[, !names(ic50_mt) == "Mutant"]), 2) - colnames(ic50_mt)[colnames(ic50_mt) == "Mutant"] <- "Peptide Sequence" - ic50_mt <- add_column(ic50_mt, Type = "MT", .after = "Peptide Sequence") - ic50_mt <- add_column(ic50_mt, `Problematic Positions` = peptide_columns$problematic_positions[[1]]) - ic50_mt <- add_column(ic50_mt, `Anchor Residue Fail` = peptide_columns$anchor_fails[[1]]) - peptide_columns_wt <- peptide_columns - peptide_columns_wt$Mutant <- NULL - ic50_wt <- dcast(peptide_columns_wt, wt_peptide ~ hla_types, value.var = "ic50s_WT") - ic50_wt[, !names(ic50_wt) == "wt_peptide"] <- round(as.numeric(ic50_wt[, !names(ic50_wt) == "wt_peptide"]), 2) - colnames(ic50_wt)[colnames(ic50_wt) == "wt_peptide"] <- "Peptide Sequence" - ic50_wt <- add_column(ic50_wt, Type = "WT", .after = "Peptide Sequence") - ic50_wt <- add_column(ic50_wt, `Problematic Positions` = "") - ic50_wt <- add_column(ic50_wt, `Anchor Residue Fail` = "") - combined_data <- rbind(ic50_mt, ic50_wt) - combined_data$`Mutation Position` <- peptide_columns$mutation_position[[1]] - reordered_data <- combined_data %>% select(-one_of("Problematic Positions"), -one_of("Anchor Residue Fail"), one_of("Problematic Positions"), one_of("Anchor Residue Fail")) - reordered_data$`Has ProbPos` <- apply(reordered_data, 1, function(x) (x["Problematic Positions"] != "") & (x["Problematic Positions"] != "None")) - reordered_data$`Has AnchorResidueFail` <- apply(reordered_data, 1, function(x) (x["Anchor Residue Fail"] != "") & (x["Anchor Residue Fail"] != "None")) - reordered_data -} -#generate peptide coloring for hla allele -peptide_coloring <- function(hla_allele, peptide_row) { - peptide_length <- as.numeric(peptide_row["length"]) - if (peptide_length < 8) { - return(c("#999999")) - } - position <- as.numeric(peptide_row["x_pos"]) - anchor_score <- as.numeric(anchor_data[[peptide_length]][anchor_data[[peptide_length]]["HLA"] == hla_allele][2:(peptide_length + 1)]) - value_bins <- cut(anchor_score, breaks = seq(0, 1, len = 100), - include.lowest = TRUE) - colors <- colorRampPalette(c("lightblue", "blue"))(99)[value_bins] - return(colors[[position]]) -} -#calculate anchor list for specific peptide length and HLA allele combo given contribution cutoff -calculate_anchor <- function(hla_allele, peptide_length, anchor_contribution) { - result <- tryCatch({ - anchor_raw_data <- as.numeric(anchor_data[[peptide_length]][anchor_data[[peptide_length]]["HLA"] == hla_allele][2:(peptide_length + 1)]) - if (any(is.na(anchor_raw_data))) { - return("NA") - } - names(anchor_raw_data) <- as.character(1:length(anchor_raw_data)) - anchor_raw_data <- anchor_raw_data[order(unlist(anchor_raw_data), decreasing = TRUE)] - count <- 0 - anchor_list <- list() - for (i in 1:length(anchor_raw_data)) { - if (count >= anchor_contribution) { - return(anchor_list) - }else { - count <- count + anchor_raw_data[[i]] - anchor_list <- append(anchor_list, names(anchor_raw_data[i])) - } - } - return(anchor_list) - }, error = function(e) { return("NA") }) -} - -#converts string range (e.g. '2-4', '6') to associated list -range_str_to_seq <- function(mutation_position) { - rnge <- strsplit(mutation_position, "-")[[1]] - if (length(rnge) == 2) { - return(seq(rnge[1], rnge[2])) - }else { - return(c(strtoi(rnge[1]))) - } - return(0) -} - -#get data from metrics file associated with peptide if available -get_mt_peptide_data <- function(metrics_data_row, mt_peptide) { - for (trn in metrics_data_row$sets) { - res <- metrics_data_row$good_binders[[trn]]$peptides[[mt_peptide]] - if (!is.null(res)) { - return(res) - } - } - return(c()) -} - -#calculate the positions different between MT and WT peptide -calculate_mutation_info <- function(metrics_data_row) { - wt_peptide <- metrics_data_row$best_peptide_wt - if (is.na(wt_peptide)) { - return(0) - } - mt_peptide <- metrics_data_row$best_peptide_mt - mt_data <- get_mt_peptide_data(metrics_data_row, mt_peptide) - # if recorded mutation_position range, use it - if (length(mt_data) > 0) { - diff_positions <- range_str_to_seq(mt_data$"mutation_position") - }else { - split_positions <- strsplit(c(wt_peptide, mt_peptide), split = "") - diff_positions <- which(split_positions[[1]] != split_positions[[2]]) - } - return(diff_positions) -} -##Generate Tiering for given variant with specific cutoffs -tier <- function(variant_info, anchor_contribution, dna_cutoff, allele_expr_cutoff, mutation_pos_list, hla_allele, tsl, meta_data, anchor_mode, use_allele_specific_binding_thresholds, binding_threshold) { - mt_binding <- as.numeric(variant_info["IC50 MT"]) - wt_binding <- as.numeric(variant_info["IC50 WT"]) - mt_percent <- as.numeric(variant_info["%ile MT"]) - wt_percent <- as.numeric(variant_info["%ile WT"]) - gene_expr <- as.numeric(variant_info["RNA Expr"]) - dna_vaf <- as.numeric(variant_info["DNA VAF"]) - rna_vaf <- as.numeric(variant_info["RNA VAF"]) - rna_depth <- as.numeric(variant_info["RNA Depth"]) - allele_expr <- as.numeric(variant_info["Allele Expr"]) - if (use_allele_specific_binding_thresholds && hla_allele %in% names(meta_data[["allele_specific_binding_thresholds"]][hla_allele])) { - binding_threshold <- as.numeric(meta_data[["allele_specific_binding_thresholds"]][hla_allele]) - } - trna_vaf <- as.numeric(meta_data["trna_vaf"]) - trna_cov <- as.numeric(meta_data["trna_cov"]) - percentile_filter <- FALSE - percentile_threshold <- NULL - if (!is.null(meta_data[["percentile_threshold"]])) { - percentile_threshold <- as.numeric(meta_data[["percentile_threshold"]]) - percentile_filter <- TRUE - } - tsl_max <- as.numeric(meta_data["maximum_transcript_support_level"]) - mutation_pos_list <- mutation_pos_list[["Pos"]] - if (anchor_mode == "default") { - anchor_list <- c(1, 2, nchar(variant_info[["Best Peptide"]]), nchar(variant_info[["Best Peptide"]]) - 1) - }else { - anchor_list <- unlist(calculate_anchor(hla_allele, length(unlist(strsplit(variant_info["Best Peptide"][[1]], split = ""))), anchor_contribution)) - if (anchor_list[[1]] == "NA") { - anchor_list <- c(1, 2, nchar(variant_info[["Best Peptide"]]), nchar(variant_info[["Best Peptide"]]) - 1) - } - } - anchor_residue_pass <- TRUE - # if all of mutated positions in anchors - if (grepl("-", mutation_pos_list, fixed = TRUE)) { - range_start <- as.numeric(strsplit(mutation_pos_list, "-")[[1]][1]) - if (range_start == 0) { - range_start <- 1 - } - range_stop <- as.numeric(strsplit(mutation_pos_list, "-")[[1]][2]) - mutation_pos_list <- c(range_start:range_stop) - if (all(mutation_pos_list %in% anchor_list)) { - if (is.na(wt_binding)) { - anchor_residue_pass <- FALSE - }else if (wt_binding < binding_threshold) { - anchor_residue_pass <- FALSE - } - } - }else if (!is.na(mutation_pos_list)) { - if (all(as.numeric(mutation_pos_list) %in% anchor_list)) { - if (is.na(wt_binding)) { - anchor_residue_pass <- FALSE - }else if (wt_binding < binding_threshold) { - anchor_residue_pass <- FALSE - } - } - } - tsl_pass <- TRUE - if ((tsl == "Not Supported")) { - tsl_pass <- TRUE - } - else if ((tsl == "NA") || as.numeric(tsl) > tsl_max) { - tsl_pass <- FALSE - } - allele_expr_pass <- TRUE - if (!is.na(rna_vaf) && !is.na(gene_expr) && allele_expr <= allele_expr_cutoff) { - allele_expr_pass <- FALSE - } - vaf_clonal_pass <- TRUE - if (!is.na(dna_vaf) && dna_vaf < dna_cutoff / 2) { - vaf_clonal_pass <- FALSE - } - ## Assign Tiering - if ((mt_binding < binding_threshold) && allele_expr_pass && vaf_clonal_pass && tsl_pass && anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - return("Pass") - } - }else { - return("Pass") - } - } - - if ((mt_binding < binding_threshold) && allele_expr_pass && vaf_clonal_pass && tsl_pass && !anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - return("Anchor") - } - }else { - return("Anchor") - } - } - if ((mt_binding < binding_threshold) && allele_expr_pass && !vaf_clonal_pass && tsl_pass && anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - return("Subclonal") - } - }else { - return("Subclonal") - } - } - lowexpr <- FALSE - if (!is.na(rna_vaf) && !is.na(gene_expr) && !is.na(rna_depth)) { - if ((allele_expr > 0) || ((gene_expr == 0) && (rna_depth > trna_cov) && (rna_vaf > trna_vaf))) { - lowexpr <- TRUE - } - } - if ((mt_binding < binding_threshold) && lowexpr && vaf_clonal_pass && tsl_pass && anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - return("LowExpr") - } - }else { - return("LowExpr") - } - } - if (!is.na(allele_expr) && ((gene_expr == 0) || (rna_vaf == 0)) && !lowexpr) { - return("NoExpr") - } - return("Poor") -} -#Determine the Tier Count for given variant with specific cutoffs -tier_numbers <- function(variant_info, anchor_contribution, dna_cutoff, allele_expr_cutoff, mutation_pos_list, hla_allele, tsl, meta_data, anchor_mode, allele_specific_binding_thresholds, use_allele_specific_binding_thresholds, binding_threshold) { - mt_binding <- as.numeric(variant_info["IC50 MT"]) - wt_binding <- as.numeric(variant_info["IC50 WT"]) - mt_percent <- as.numeric(variant_info["%ile MT"]) - wt_percent <- as.numeric(variant_info["%ile WT"]) - gene_expr <- as.numeric(variant_info["RNA Expr"]) - dna_vaf <- as.numeric(variant_info["DNA VAF"]) - rna_vaf <- as.numeric(variant_info["RNA VAF"]) - rna_depth <- as.numeric(variant_info["RNA Depth"]) - allele_expr <- as.numeric(variant_info["Allele Expr"]) - if (use_allele_specific_binding_thresholds && hla_allele %in% names(meta_data[["allele_specific_binding_thresholds"]][hla_allele])) { - binding_threshold <- as.numeric(meta_data[["allele_specific_binding_thresholds"]][hla_allele]) - } - trna_vaf <- as.numeric(meta_data["trna_vaf"]) - trna_cov <- as.numeric(meta_data["trna_cov"]) - percentile_filter <- FALSE - percentile_threshold <- NULL - if (!is.null(meta_data[["percentile_threshold"]])) { - percentile_threshold <- as.numeric(meta_data[["percentile_threshold"]]) - percentile_filter <- TRUE - } - tsl_max <- as.numeric(meta_data["maximum_transcript_support_level"]) - mutation_pos_list <- mutation_pos_list[["Pos"]] - if (anchor_mode == "default") { - anchor_list <- c(1, 2, nchar(variant_info[["Best Peptide"]]), nchar(variant_info[["Best Peptide"]]) - 1) - }else { - anchor_list <- unlist(calculate_anchor(hla_allele, length(unlist(strsplit(variant_info["Best Peptide"][[1]], split = ""))), anchor_contribution)) - if (anchor_list[[1]] == "NA") { - anchor_list <- c(1, 2, nchar(variant_info[["Best Peptide"]]), nchar(variant_info[["Best Peptide"]]) - 1) - } - } - anchor_residue_pass <- TRUE - # if all of mutated positions in anchors - if (grepl("-", mutation_pos_list, fixed = TRUE)) { - range_start <- as.numeric(strsplit(mutation_pos_list, "-")[[1]][1]) - if (range_start == 0) { - range_start <- 1 - } - range_stop <- as.numeric(strsplit(mutation_pos_list, "-")[[1]][2]) - mutation_pos_list <- c(range_start:range_stop) - if (all(mutation_pos_list %in% anchor_list)) { - if (is.na(wt_binding)) { - anchor_residue_pass <- FALSE - }else if (wt_binding < binding_threshold) { - anchor_residue_pass <- FALSE - } - } - }else if (!is.na(mutation_pos_list)) { - if (all(as.numeric(mutation_pos_list) %in% anchor_list)) { - if (is.na(wt_binding)) { - anchor_residue_pass <- FALSE - }else if (wt_binding < binding_threshold) { - anchor_residue_pass <- FALSE - }else if (!is.null(percentile_threshold) && (wt_percent) < percentile_threshold) { - anchor_residue_pass <- FALSE - } - } - } - tsl_pass <- TRUE - if ((tsl == "Not Supported")) { - tsl_pass <- TRUE - } - else if ((tsl == "NA") || as.numeric(tsl) > tsl_max) { - tsl_pass <- FALSE - } - allele_expr_pass <- TRUE - if (!is.na(rna_vaf) && !is.na(gene_expr) && allele_expr <= allele_expr_cutoff) { - allele_expr_pass <- FALSE - } - vaf_clonal_pass <- TRUE - if (!is.na(dna_vaf) && dna_vaf < dna_cutoff / 2) { - vaf_clonal_pass <- FALSE - } - ## Pass - if ((mt_binding < binding_threshold) && allele_expr_pass && vaf_clonal_pass && tsl_pass && anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - return(1) - } - }else { - return(1) - } - } - ## Anchor - if ((mt_binding < binding_threshold) && allele_expr_pass && vaf_clonal_pass && tsl_pass && !anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - return(5) - } - }else { - return(5) - } - } - if ((mt_binding < binding_threshold) && allele_expr_pass && !vaf_clonal_pass && tsl_pass && anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - return(6) - } - }else { - return(6) - } - } - lowexpr <- FALSE - if (!is.na(rna_vaf) && !is.na(gene_expr) && !is.na(rna_depth)) { - if ((allele_expr > 0) || ((gene_expr == 0) && (rna_depth > trna_cov) && (rna_vaf > trna_vaf))) { - lowexpr <- TRUE - } - } - if ((mt_binding < binding_threshold) && (lowexpr) && vaf_clonal_pass && tsl_pass && anchor_residue_pass) { - if (percentile_filter) { - if (mt_percent <= percentile_threshold) { - if (allele_expr > 0) { - return(7) - }else if ((gene_expr == 0) && (rna_depth > trna_cov) && (rna_vaf > trna_vaf)) { - return(8) - } - } - }else { - if (allele_expr > 0) { - return(7) - }else if ((gene_expr == 0) && (rna_depth > trna_cov) && (rna_vaf > trna_vaf)) { - return(8) - } - } - } - if (!is.na(allele_expr) && ((gene_expr == 0) || (rna_vaf == 0)) && !lowexpr) { - if ((gene_expr == 0) && (rna_vaf != 0)) { - return(9) - }else if ((gene_expr != 0) && (rna_vaf == 0)) { - return(10) - }else { - return(11) - } - } - count <- 12 - if (!anchor_residue_pass) { - count <- count + 1 - } - if (!vaf_clonal_pass) { - count <- count + 2 - } - if (!is.na(gene_expr) && !is.na(rna_depth) && !is.na(rna_vaf) && (gene_expr == 0) && (rna_depth > trna_cov) && (rna_vaf > trna_vaf)) { - count <- count + 4 - } - if (!is.na(allele_expr) && allele_expr > 0 && allele_expr < allele_expr_cutoff) { - count <- count + 8 - } - return(count) -} diff --git a/pvactools/tools/pvacview_dev_eve/app.R b/pvactools/tools/pvacview_dev_eve/app.R deleted file mode 100644 index e705e9d9e..000000000 --- a/pvactools/tools/pvacview_dev_eve/app.R +++ /dev/null @@ -1,9 +0,0 @@ -library(shiny) - -source(server.R) -source(ui.R) - -options(shiny.host = '127.0.0.1') -options(shiny.port = 3333) - -shinyApp(ui, server) diff --git a/pvactools/tools/pvacview_dev_eve/main.py b/pvactools/tools/pvacview_dev_eve/main.py deleted file mode 100755 index 69fdd1245..000000000 --- a/pvactools/tools/pvacview_dev_eve/main.py +++ /dev/null @@ -1,30 +0,0 @@ -import argparse -import sys -from subprocess import call -import os -import pkg_resources -from pvactools.tools.pvacview import * - -def main(): - parser = argparse.ArgumentParser(formatter_class=argparse.ArgumentDefaultsHelpFormatter) - subparsers = parser.add_subparsers() - - #add subcommands - run_main_program_parser = subparsers.add_parser( - "run", - help="Run the pVACview R shiny application", - add_help=False - ) - run_main_program_parser.set_defaults(func=run) - - args = parser.parse_known_args() - try: - args[0].func.main(args[1]) - except AttributeError as e: - parser.print_help() - print("Error: No command specified") - sys.exit(-1) - - -if __name__ == '__main__': - main() diff --git a/pvactools/tools/pvacview_dev_eve/neoantigens_10patients_10neoantigens.4.tsv b/pvactools/tools/pvacview_dev_eve/neoantigens_10patients_10neoantigens.4.tsv deleted file mode 100644 index 62b281480..000000000 --- a/pvactools/tools/pvacview_dev_eve/neoantigens_10patients_10neoantigens.4.tsv +++ /dev/null @@ -1,101 +0,0 @@ -identifier patientIdentifier gene rnaExpression imputedGeneExpression dnaVariantAlleleFrequency rnaVariantAlleleFrequency mutation.position mutation.wildTypeXmer mutation.mutatedXmer -sG2QcgYOHTmBufPXvC1j8Q== 7aec4161-13f8-4824-973f-576549224705 BRCA2 72.1 0.0 0.341 0.124 14 IGSYPPSKKCVTCHLRKERCQYYTASF IGSYPPSKKCVTCELRKERCQYYTASF -LlSfEE1WMtgVHc4jNb6F2g== 7aec4161-13f8-4824-973f-576549224705 BRCA2 59.88 0.0 0.81 0.492 14 IDPIKEPELMWLAREGIVAPLPGEWKP IDPIKEPELMWLAKEGIVAPLPGEWKP -h2vRplPI4IA2W38G6CDAVg== 7aec4161-13f8-4824-973f-576549224705 BRCA2 50.88 0.0 0.772 0.618 14 VIRPKNTASLNSREYRAKSYEILLHEV VIRPKNTASLNSRKYRAKSYEILLHEV -V+dPlQG/P/xgjeVPCfnHyw== 7aec4161-13f8-4824-973f-576549224705 BRCA2 69.52 0.0 0.435 0.493 14 GQIVSQTKVTKPLLLKNGKTAGKSTIT GQIVSQTKVTKPLNLKNGKTAGKSTIT -zcPXZ6Id7U7sPQpj9hjujA== 7aec4161-13f8-4824-973f-576549224705 BRCA2 15.62 0.0 0.617 0.937 14 SMYSRKAAEEVKRELIKLKVNYYILEE SMYSRKAAEEVKRILIKLKVNYYILEE -nPheCV0vCwAMJZi6i/FEFQ== 7aec4161-13f8-4824-973f-576549224705 BRCA2 69.01 0.0 0.382 0.44 14 SHCPREAVIFKTKLDKEICADPTQKWV SHCPREAVIFKTKEDKEICADPTQKWV -kNMHybim9x0h06pmJcLceQ== 7aec4161-13f8-4824-973f-576549224705 BRCA2 44.92 0.0 0.117 0.701 14 MMGRHTYPILREDAPAEHVERFFEKMD MMGRHTYPILREDLPAEHVERFFEKMD -RMp50X6iDYXB+P7sIJu7Jg== 7aec4161-13f8-4824-973f-576549224705 BRCA2 44.68 0.0 0.433 0.271 14 LFMRGFSHYDRQLRNDILVITTIIAQN LFMRGFSHYDRQLTNDILVITTIIAQN -/AHh3jxWVOVA/rY/3IFEqw== 7aec4161-13f8-4824-973f-576549224705 BRCA2 97.32 0.0 0.881 0.644 14 VWRLVLLALWVWPSTQAGHQDKDTTFD VWRLVLLALWVWPFTQAGHQDKDTTFD -3y1pppmfHSH95aSsHrEe1g== 7aec4161-13f8-4824-973f-576549224705 BRCA2 97.34 0.0 0.704 0.747 14 NAAYYALAIVHGAAAYLPDFLDYFAFN NAAYYALAIVHGATAYLPDFLDYFAFN -nVtAIBFCJV4JkJKELv+sIg== ea9658f7-3b06-4102-937d-ca111ea66758 BRCA2 44.2 0.0 0.882 0.875 14 GLPPLPLHPGGDQGGPPVGPLSLGLAT GLPPLPLHPGGDQYGPPVGPLSLGLAT -fO47L6vf4B8Td4J98r6CmA== ea9658f7-3b06-4102-937d-ca111ea66758 BRCA2 78.07 0.0 0.509 0.258 14 VAAYKDAYERDLEADIIGDTSGHFQKM VAAYKDAYERDLEEDIIGDTSGHFQKM -WYSkBM/hV85F0+FQwh1qsw== ea9658f7-3b06-4102-937d-ca111ea66758 BRCA2 73.8 0.0 0.966 0.106 14 KAFRYHPSLRTQERDHTGKKPYACKEC KAFRYHPSLRTQEIDHTGKKPYACKEC -+9vhM1Ay/MsmYwCNEtyYkQ== ea9658f7-3b06-4102-937d-ca111ea66758 BRCA2 76.71 0.0 0.333 0.667 14 TEVNPAEHTQCSPSMNAEENSRISITF TEVNPAEHTQCSPWMNAEENSRISITF -+4dbiV35y7bUA2zGvoC9cQ== ea9658f7-3b06-4102-937d-ca111ea66758 BRCA2 48.41 0.0 0.776 0.289 14 LRIRTSEGRHRAFQTCASHCIVVLCFF LRIRTSEGRHRAFATCASHCIVVLCFF -1tlgMf8SOAC3qQvoMzz8tA== ea9658f7-3b06-4102-937d-ca111ea66758 BRCA2 29.14 0.0 0.359 0.88 14 KEMVTTVKGVIKAVLDGVKELVRLTIE KEMVTTVKGVIKAFLDGVKELVRLTIE -HYuRThHOTcX/cF3T74Xsfw== ea9658f7-3b06-4102-937d-ca111ea66758 BRCA2 98.77 0.0 0.738 0.886 14 WKLGADKEVWVWVMGEHHLDKPYDVLC WKLGADKEVWVWVFGEHHLDKPYDVLC -2aLRIwuhRw7yeqwrMU5GQQ== ea9658f7-3b06-4102-937d-ca111ea66758 BRCA2 47.4 0.0 0.929 0.514 14 GRILSGGGDSSPRGNLPLLLPKARLGA GRILSGGGDSSPRTNLPLLLPKARLGA -8lMD0H+bWR0z32FRNL8OWg== ea9658f7-3b06-4102-937d-ca111ea66758 BRCA2 21.91 0.0 0.427 0.323 14 LTRKLQDLIKDVLRYGEEQLKTHKKCK LTRKLQDLIKDVLSYGEEQLKTHKKCK -lWDb8xds2IJQAUQ3aJeJ8A== ea9658f7-3b06-4102-937d-ca111ea66758 BRCA2 86.22 0.0 0.968 0.377 14 AADGKGVVVASGSLPPPMCGPPSTRML AADGKGVVVASGSPPPPMCGPPSTRML -rc9pOd95ieTIo4EKdb7I6w== fea84c0b-e2e8-40b5-8818-e6a74dd4a3d7 BRCA2 25.64 0.0 0.658 0.743 14 VILTLLGLAILAILLTRWARRKQSEMH VILTLLGLAILAIQLTRWARRKQSEMH -gBfu3aplqs9s8a85fxB0DQ== fea84c0b-e2e8-40b5-8818-e6a74dd4a3d7 BRCA2 29.86 0.0 0.466 0.723 14 EGMTNGRKAINLCTVPFSVDLQSSRVG EGMTNGRKAINLCPVPFSVDLQSSRVG -mw62hxiOWza45Eed3tukmw== fea84c0b-e2e8-40b5-8818-e6a74dd4a3d7 BRCA2 40.36 0.0 0.941 0.652 14 AQLSEVLWTMVIHIGLSVKSLAGGLVL AQLSEVLWTMVIHQGLSVKSLAGGLVL -bWA4nTzB4hRZROXbPKEqTw== fea84c0b-e2e8-40b5-8818-e6a74dd4a3d7 BRCA2 14.92 0.0 0.663 0.621 14 GIQQHYKHAVRQSFRVHSDEDNPERIQ GIQQHYKHAVRQSTRVHSDEDNPERIQ -nPfEUr+MEfBX2rbkAvBNWA== fea84c0b-e2e8-40b5-8818-e6a74dd4a3d7 BRCA2 97.29 0.0 0.551 0.917 14 RVHCCLYFISPTGHSLRPLDLEFMKHL RVHCCLYFISPTGYSLRPLDLEFMKHL -8L4T6JAlpPDQNocb9qqPvA== fea84c0b-e2e8-40b5-8818-e6a74dd4a3d7 BRCA2 41.14 0.0 0.343 0.55 14 EWYFGKLGRKDAERQLLSFGNPRGTFL EWYFGKLGRKDAELQLLSFGNPRGTFL -NZXDGcJlQKzrSqIZSjEYNQ== fea84c0b-e2e8-40b5-8818-e6a74dd4a3d7 BRCA2 16.16 0.0 0.663 0.725 14 ENGKEMLQRADPPKTHVTHHPVFDYEA ENGKEMLQRADPPDTHVTHHPVFDYEA -QY9kYuiYNtzN1rRuNYHk1g== fea84c0b-e2e8-40b5-8818-e6a74dd4a3d7 BRCA2 70.65 0.0 0.484 0.39 14 LAVVVFCSLKVVTALAQRPPTDVGQAE LAVVVFCSLKVVTSLAQRPPTDVGQAE -D95K2asWDm3LrsQ2VtkUDQ== fea84c0b-e2e8-40b5-8818-e6a74dd4a3d7 BRCA2 52.59 0.0 0.542 0.983 14 ASEGHSHPRVVELPKTEEGLGFNIMGG ASEGHSHPRVVELIKTEEGLGFNIMGG -OT+9SZW7n2vpqNx5HnYpbg== fea84c0b-e2e8-40b5-8818-e6a74dd4a3d7 BRCA2 81.55 0.0 0.116 0.303 14 PVDFGYVGIDSILEQMRRKAMKQGFEF PVDFGYVGIDSILVQMRRKAMKQGFEF -g4YS99xRJWhjtuiTewhR8Q== f23397dc-fec2-4cc4-9bef-010e6abf4738 BRCA2 49.51 0.0 0.744 0.305 14 NPKKKVRQPQLNSLGPISADPLEMDAN NPKKKVRQPQLNSCGPISADPLEMDAN -pjogHwX4C1d1PFZH5+CdFw== f23397dc-fec2-4cc4-9bef-010e6abf4738 BRCA2 89.68 0.0 0.101 0.129 14 LIENHEKIFNTVPDMPLTNAQLHLSRK LIENHEKIFNTVPLMPLTNAQLHLSRK -FcuHmX0c9JVAp98SGpLKIg== f23397dc-fec2-4cc4-9bef-010e6abf4738 BRCA2 48.46 0.0 0.12 0.148 14 TEAVSQAEGVSQTNAVAWPLATAESGS TEAVSQAEGVSQTVAVAWPLATAESGS -/rrYdhF+HFP5IIWnB6ElJg== f23397dc-fec2-4cc4-9bef-010e6abf4738 BRCA2 13.91 0.0 0.942 0.903 14 ESNWNEIVDSFDDMNLSESLLRGIYAY ESNWNEIVDSFDDINLSESLLRGIYAY -6paw1wZI3HETf0Do+GMHNw== f23397dc-fec2-4cc4-9bef-010e6abf4738 BRCA2 22.72 0.0 0.501 0.515 14 LWYLSLEEVWKCRDQLDKYQENPERHL LWYLSLEEVWKCRYQLDKYQENPERHL -T3baIvuf2AilW92fCjm4og== f23397dc-fec2-4cc4-9bef-010e6abf4738 BRCA2 34.13 0.0 0.759 0.976 14 RRIREDYPQKEILRALKAKCCEEELDF RRIREDYPQKEILLALKAKCCEEELDF -AKqmGKQ9I563FPT7aTba7Q== f23397dc-fec2-4cc4-9bef-010e6abf4738 BRCA2 58.06 0.0 0.988 0.873 14 TVIYICASSRWRRHQEGIPQAQQAETG TVIYICASSRWRRTQEGIPQAQQAETG -xt/DMSXB7OtH9gAbBcX+kg== f23397dc-fec2-4cc4-9bef-010e6abf4738 BRCA2 79.9 0.0 0.461 0.227 14 TSSLQSHMQAHKKNKEHLAKSEKEAKK TSSLQSHMQAHKKDKEHLAKSEKEAKK -Akqk7+bSyCz4w+Zs51Si3Q== f23397dc-fec2-4cc4-9bef-010e6abf4738 BRCA2 21.66 0.0 0.264 0.945 14 LHLQEQGSGIDWCLSPADVEAQTTNDQ LHLQEQGSGIDWCHSPADVEAQTTNDQ -E8sdGRoFotVN4tJxUnjLeQ== f23397dc-fec2-4cc4-9bef-010e6abf4738 BRCA2 46.13 0.0 0.942 0.837 14 SQDITIPQCPLGWRSLWIGYSFLMHTA SQDITIPQCPLGWYSLWIGYSFLMHTA -2n+5PtWFEBeT1HCf4LOVPg== 9fe73f77-6cad-4887-a1f5-e4c55aa06c00 BRCA2 56.2 0.0 0.183 0.437 14 YLQLVFGIEVVEVVPISHLYILVTCLG YLQLVFGIEVVEVEPISHLYILVTCLG -D4w+2btaEwNLyn5fbaquSg== 9fe73f77-6cad-4887-a1f5-e4c55aa06c00 BRCA2 73.23 0.0 0.924 0.589 14 RATWKSNYFLKIIQLLDDYPKCFIVGA RATWKSNYFLKIIALLDDYPKCFIVGA -dPnWUorJ+YPdiZf9wnFWZA== 9fe73f77-6cad-4887-a1f5-e4c55aa06c00 BRCA2 37.87 0.0 0.396 0.471 14 LSFILIHLVLSSVSGPRHWWPPRGIIK LSFILIHLVLSSVIGPRHWWPPRGIIK -ByrH+yp8jJ+z8Q9F5/pxUA== 9fe73f77-6cad-4887-a1f5-e4c55aa06c00 BRCA2 48.47 0.0 0.111 0.414 14 KIFRETKENEIQDLLRAKRELESKLQR KIFRETKENEIQDYLRAKRELESKLQR -Q0PuSq666TK9JDuXO/ITIQ== 9fe73f77-6cad-4887-a1f5-e4c55aa06c00 BRCA2 50.54 0.0 0.548 0.854 14 IPDEISILLLGVAHFKGQWVTKFDSRK IPDEISILLLGVAWFKGQWVTKFDSRK -sO3IAKdZh1m3UQn+oveB6w== 9fe73f77-6cad-4887-a1f5-e4c55aa06c00 BRCA2 31.34 0.0 0.983 0.251 14 QISLPAKLINGGIAGLIGVTCVFPIDL QISLPAKLINGGIHGLIGVTCVFPIDL -FlqPWECzMPkQH2pCieUocA== 9fe73f77-6cad-4887-a1f5-e4c55aa06c00 BRCA2 41.94 0.0 0.962 0.518 14 PRIDINMSGFNETDDLKRAESMLQQAD PRIDINMSGFNETQDLKRAESMLQQAD -ApgJXXNdOX/asVZypBIJ8g== 9fe73f77-6cad-4887-a1f5-e4c55aa06c00 BRCA2 13.69 0.0 0.99 0.355 14 EKFFKVLYDRMKAAQKEIRSTVTVNTI EKFFKVLYDRMKAPQKEIRSTVTVNTI -RgtuynVL0VtVGgtDXYukiQ== 9fe73f77-6cad-4887-a1f5-e4c55aa06c00 BRCA2 90.01 0.0 0.493 0.31 14 VLQRPNLQKYVREQILLAVAVIVKRGS VLQRPNLQKYVREHILLAVAVIVKRGS -usN9KyJPlFunFcC9O6HukQ== 9fe73f77-6cad-4887-a1f5-e4c55aa06c00 BRCA2 48.74 0.0 0.809 0.863 14 YSLTETASQEAMGLFTKWSRSLGFLSQ YSLTETASQEAMGKFTKWSRSLGFLSQ -+yPZTf/Ut2tGnnbd5D2vOg== 2ef1c406-166e-4cbb-9a3e-8d82ae243770 BRCA2 52.07 0.0 0.556 0.785 14 GTRGRGRGQGQNWNQGFNNYYDQGYGN GTRGRGRGQGQNWRQGFNNYYDQGYGN -drxedrMWuPZWe894qPiEkg== 2ef1c406-166e-4cbb-9a3e-8d82ae243770 BRCA2 74.59 0.0 0.208 0.921 14 EHEGFLRAKMDLEERRMRQINEVMREW EHEGFLRAKMDLENRRMRQINEVMREW -10VFSHS1atu+QhIjQXkqLw== 2ef1c406-166e-4cbb-9a3e-8d82ae243770 BRCA2 95.73 0.0 0.37 0.245 14 PWSAHPDASSARPTRMLFVTPRRQHES PWSAHPDASSARPERMLFVTPRRQHES -FocNgSUrGW+g+0gmpKfxwQ== 2ef1c406-166e-4cbb-9a3e-8d82ae243770 BRCA2 89.99 0.0 0.801 0.994 14 IGMGTGAGAYILTRFALNNPEMVEGLV IGMGTGAGAYILTNFALNNPEMVEGLV -ZC1CPJ9NNjwOwan82jxKiA== 2ef1c406-166e-4cbb-9a3e-8d82ae243770 BRCA2 49.27 0.0 0.559 0.871 14 LNPRYNLPLDIQNRILNFIKTWSQGFP LNPRYNLPLDIQNKILNFIKTWSQGFP -wTwSasKY91HTx5FyKrlTAg== 2ef1c406-166e-4cbb-9a3e-8d82ae243770 BRCA2 95.77 0.0 0.549 0.592 14 SPETSVAQVAPVDLDGMQQDIEQVWEE SPETSVAQVAPVDEDGMQQDIEQVWEE -IKPSoVtsyzB1l2NQVc64BQ== 2ef1c406-166e-4cbb-9a3e-8d82ae243770 BRCA2 63.04 0.0 0.332 0.524 14 IFFIEFIMCSANCAILLFINELELWLA IFFIEFIMCSANCSILLFINELELWLA -Ff+6mkNdMnPVI25iIEco2g== 2ef1c406-166e-4cbb-9a3e-8d82ae243770 BRCA2 75.51 0.0 0.761 0.302 14 IIAIREHVYNGQVMETFVDPTYIGNIG IIAIREHVYNGQVRETFVDPTYIGNIG -YZYlLs6rPNaBUMVHyx1Q+w== 2ef1c406-166e-4cbb-9a3e-8d82ae243770 BRCA2 56.12 0.0 0.138 0.634 14 STPKRFPRQPRREKGPVKEVPGTKGSP STPKRFPRQPRRENGPVKEVPGTKGSP -SdQJ5FzMaZEP4RZpxWzpEQ== 2ef1c406-166e-4cbb-9a3e-8d82ae243770 BRCA2 33.13 0.0 0.799 0.571 14 SSRLSEAWKWRLSPGETPERSLRLAES SSRLSEAWKWRLSGGETPERSLRLAES -UDrwEADtuAnO2IolCPGgMw== 463d8182-c1bf-4814-87da-0c0978e4682a BRCA2 62.11 0.0 0.69 0.515 14 LFYSSVIAVYLQPKNPYAQGRGKFFGL LFYSSVIAVYLQPQNPYAQGRGKFFGL -lpJtl1hnJ9IT8+scf3Mq6A== 463d8182-c1bf-4814-87da-0c0978e4682a BRCA2 39.48 0.0 0.342 0.274 14 GIYGCRWKRYQRSHDDTTPWERLWFLL GIYGCRWKRYQRSKDDTTPWERLWFLL -i0hlPlFmtHX2LtgliqQd0w== 463d8182-c1bf-4814-87da-0c0978e4682a BRCA2 96.79 0.0 0.691 0.116 14 LSPFKKRIQPTIRRTGLAALRHYLFGP LSPFKKRIQPTIRVTGLAALRHYLFGP -eMFmpSRSgTbbBUsqKnWDbA== 463d8182-c1bf-4814-87da-0c0978e4682a BRCA2 98.48 0.0 0.599 0.624 14 ALRPTAGSGPDTRTPGTVEDGSAPCPA ALRPTAGSGPDTRIPGTVEDGSAPCPA -p0cxMfZYfrgZKvdSL4o6SQ== 463d8182-c1bf-4814-87da-0c0978e4682a BRCA2 19.5 0.0 0.985 0.932 14 AQVGKTSLILSLVGEEFPEEKPSRRTR AQVGKTSLILSLVYEEFPEEKPSRRTR -699nGhzcPmk3178UphjMbQ== 463d8182-c1bf-4814-87da-0c0978e4682a BRCA2 77.49 0.0 0.521 0.9 14 QGGCMSSFRWNRGGDFKGRKWDTDLPT QGGCMSSFRWNRGWDFKGRKWDTDLPT -ggGk+S7Ee5XUQdYBJKvNWQ== 463d8182-c1bf-4814-87da-0c0978e4682a BRCA2 31.26 0.0 0.584 0.992 14 FNLTALVGTFTSALTYAYSNASGRARN FNLTALVGTFTSATTYAYSNASGRARN -POOK7VPJwb4wJERk8ticQg== 463d8182-c1bf-4814-87da-0c0978e4682a BRCA2 71.88 0.0 0.309 0.577 14 RVVSNLLYYQTNYLVVAAMMISIVGLE RVVSNLLYYQTNYRVVAAMMISIVGLE -acDzRqy3HdhZS+DKKkOiRw== 463d8182-c1bf-4814-87da-0c0978e4682a BRCA2 20.24 0.0 0.95 0.464 14 SIVFVPCGHLVCAECAPGLQLCPICRA SIVFVPCGHLVCAGCAPGLQLCPICRA -OP4CiNbKK5QpQqnvrhbTKA== 463d8182-c1bf-4814-87da-0c0978e4682a BRCA2 83.48 0.0 0.677 0.368 14 LMRFSMMFGYCLIMTIFSGKEQPMHLH LMRFSMMFGYCLIDTIFSGKEQPMHLH -Nc38049ST0QeMgTxHG95fQ== 0e5cf4fc-fd3f-42a4-b708-bdec3ed6d4ea BRCA2 31.94 0.0 0.644 0.867 14 AAWPVGGDSRFVFRKNFAKYELFKSSP AAWPVGGDSRFVFGKNFAKYELFKSSP -A6kAzONetPcYW6jVPc87pA== 0e5cf4fc-fd3f-42a4-b708-bdec3ed6d4ea BRCA2 98.97 0.0 0.496 0.904 14 TAVAVITVQLRRQYVRKYEGEAEERKK TAVAVITVQLRRQDVRKYEGEAEERKK -TK/CkFQG9yZVHICJgvkltg== 0e5cf4fc-fd3f-42a4-b708-bdec3ed6d4ea BRCA2 49.88 0.0 0.254 0.746 14 LVTVLGNLLIILATISDSHLHTPMYFF LVTVLGNLLIILAHISDSHLHTPMYFF -aXDFONYv7Ux0CuzS/tcK2Q== 0e5cf4fc-fd3f-42a4-b708-bdec3ed6d4ea BRCA2 96.79 0.0 0.73 0.912 14 RHRALRTAPIQPRVWEPVPLEEVQLVV RHRALRTAPIQPRSWEPVPLEEVQLVV -wpTXBjS6IZFgXMsRB0+ZTw== 0e5cf4fc-fd3f-42a4-b708-bdec3ed6d4ea BRCA2 52.95 0.0 0.507 0.856 14 SEHAETSTEVICPICAALPGGDPNHVT SEHAETSTEVICPPCAALPGGDPNHVT -uVZeORNaxhxFYLTjtGy3Pw== 0e5cf4fc-fd3f-42a4-b708-bdec3ed6d4ea BRCA2 63.55 0.0 0.966 0.177 14 IEISQHAKYTCSFCGKTKMKRRAVGIW IEISQHAKYTCSFIGKTKMKRRAVGIW -d1PzoJVQlVbztdUA7GBHaw== 0e5cf4fc-fd3f-42a4-b708-bdec3ed6d4ea BRCA2 24.63 0.0 0.679 0.68 14 VYSAHDTTLVALQMALDVYNGEQAPYA VYSAHDTTLVALQWALDVYNGEQAPYA -E/h1T9UEk3qE+mw4IGv5JA== 0e5cf4fc-fd3f-42a4-b708-bdec3ed6d4ea BRCA2 53.46 0.0 0.702 0.922 14 LYVLGSVLALFGVVLGLMETVCSPFTA LYVLGSVLALFGVDLGLMETVCSPFTA -AJP+V9+SlAkbDVjiyEU7Tg== 0e5cf4fc-fd3f-42a4-b708-bdec3ed6d4ea BRCA2 87.49 0.0 0.375 0.116 14 AFFGKTNEQVVEVCTNTSSPHAGLFPK AFFGKTNEQVVEVQTNTSSPHAGLFPK -ENmU++9SgcXge/F7aoctxg== 0e5cf4fc-fd3f-42a4-b708-bdec3ed6d4ea BRCA2 57.35 0.0 0.342 0.473 14 TLPLLCAGAWLLGVPVCGAAELCVNSL TLPLLCAGAWLLGWPVCGAAELCVNSL -xy193oA44oO2TgUEqFpclQ== a54a8b53-888f-4403-97f2-c38198c74f4d BRCA2 68.59 0.0 0.417 0.244 14 AQNQMQVPSGYGLHHQNYIAPSGHYSQ AQNQMQVPSGYGLYHQNYIAPSGHYSQ -fuLUzUAWVeJQ16h+M+gsCA== a54a8b53-888f-4403-97f2-c38198c74f4d BRCA2 19.6 0.0 0.961 0.192 14 NLHTKNKREEKVKKQRSADKEKSKGSL NLHTKNKREEKVKYQRSADKEKSKGSL -4yIvijzlwEEa03xWBqEAPQ== a54a8b53-888f-4403-97f2-c38198c74f4d BRCA2 28.06 0.0 0.711 0.406 14 DGKVDPAGRYFAANRRSVYKLEKEEQI DGKVDPAGRYFAAYRRSVYKLEKEEQI -eUSMEPzWUWAWDLr8eXwTBg== a54a8b53-888f-4403-97f2-c38198c74f4d BRCA2 94.29 0.0 0.896 0.634 14 HLVFVAPGAFAGLAKLSTLTLERCNLS HLVFVAPGAFAGLVKLSTLTLERCNLS -BcajV1hc1GSTjAREDCN//w== a54a8b53-888f-4403-97f2-c38198c74f4d BRCA2 66.9 0.0 0.213 0.121 14 LPEKGCGLAPPHYPTLLTVPASVSLPS LPEKGCGLAPPHYYTLLTVPASVSLPS -pmZOGs5xrnInR6cLVobzbA== a54a8b53-888f-4403-97f2-c38198c74f4d BRCA2 37.19 0.0 0.542 0.558 14 VKLSQEINYAKSLYYEQQLMLRLSENR VKLSQEINYAKSLIYEQQLMLRLSENR -zJLJAJivfA4wcp8fzGOk/A== a54a8b53-888f-4403-97f2-c38198c74f4d BRCA2 65.62 0.0 0.329 0.807 14 PRPLLTGARGLIGRRPAPPLTPGRLPS PRPLLTGARGLIGKRPAPPLTPGRLPS -ME7KaWBkh13tiM5A01SIXg== a54a8b53-888f-4403-97f2-c38198c74f4d BRCA2 94.07 0.0 0.532 0.944 14 TIALHGKLEYYTSIMKELLVDLIDASA TIALHGKLEYYTSFMKELLVDLIDASA -b+busUAmMVGJu3JsYU8T6A== a54a8b53-888f-4403-97f2-c38198c74f4d BRCA2 41.91 0.0 0.625 0.762 14 YWNRSNPRFHAGAGDDGGGYTVEVSIN YWNRSNPRFHAGAYDDGGGYTVEVSIN -m2zWkcV2lrMnRDAd1OYHVg== a54a8b53-888f-4403-97f2-c38198c74f4d BRCA2 18.43 0.0 0.153 0.784 14 DGSMTIPPCYETASWIIMNKPVYITRM DGSMTIPPCYETANWIIMNKPVYITRM -QUqi66FmMkpvTn+Fo7DHCw== c83b144d-cef8-4ef2-ac3a-af7822804123 BRCA2 24.25 0.0 0.881 0.302 14 RLVQVLRKQAGLLLEGGPFSGFGEVLF RLVQVLRKQAGLLGEGGPFSGFGEVLF -fOsxKWcj4dPOkgVZS/vTWA== c83b144d-cef8-4ef2-ac3a-af7822804123 BRCA2 63.21 0.0 0.409 0.834 14 GSFMNNFMTFPTGYIFDRFKTTVARLI GSFMNNFMTFPTGLIFDRFKTTVARLI -Trh+nwT+Tyo6XmFvMF4RlQ== c83b144d-cef8-4ef2-ac3a-af7822804123 BRCA2 45.1 0.0 0.224 0.646 14 CLLLRLGADPAHQDRHGDTALHAAARQ CLLLRLGADPAHQPRHGDTALHAAARQ -w+hshZHpbrXkudRWGL1avQ== c83b144d-cef8-4ef2-ac3a-af7822804123 BRCA2 41.25 0.0 0.747 0.912 14 CGFAQDLGGRPTVVYGPSSGGSFQHPS CGFAQDLGGRPTVKYGPSSGGSFQHPS -K9wBByuQbf70Myj3ttrBNA== c83b144d-cef8-4ef2-ac3a-af7822804123 BRCA2 79.48 0.0 0.618 0.676 14 PPGRCSNHLQDKIQKLYERKIKEGMDM PPGRCSNHLQDKIEKLYERKIKEGMDM -M8cS4MWwsd8N/jVomn2+EQ== c83b144d-cef8-4ef2-ac3a-af7822804123 BRCA2 47.58 0.0 0.813 0.813 14 NWSPALTISKVLLSICSLLTDCNPADP NWSPALTISKVLLMICSLLTDCNPADP -7Le2HN7AMsvLMIN2HIRMOA== c83b144d-cef8-4ef2-ac3a-af7822804123 BRCA2 75.28 0.0 0.417 0.447 14 TSKELQRQFHVYQLQQLDQELLKLEDT TSKELQRQFHVYQQQQLDQELLKLEDT -7kzYaJCM9BHf4LRyaQx9XQ== c83b144d-cef8-4ef2-ac3a-af7822804123 BRCA2 52.75 0.0 0.106 0.717 14 NPEVGKGTHVIIPVGKGGSGGWKAQVV NPEVGKGTHVIIPHGKGGSGGWKAQVV -MzkIDiEUho0i7XN+EDHhxA== c83b144d-cef8-4ef2-ac3a-af7822804123 BRCA2 53.65 0.0 0.898 0.137 14 NLKFILMDCMEGRVAITRVANLLLCMY NLKFILMDCMEGRHAITRVANLLLCMY -QeAqUNnQucd9l2gEWMCUbA== c83b144d-cef8-4ef2-ac3a-af7822804123 BRCA2 11.46 0.0 0.815 0.905 14 RELTESEARALAKERQKKDNHNLIERR RELTESEARALAKKRQKKDNHNLIERR diff --git a/pvactools/tools/pvacview_dev_eve/neoantigens_candidates.json b/pvactools/tools/pvacview_dev_eve/neoantigens_candidates.json deleted file mode 100644 index 8a7284509..000000000 --- a/pvactools/tools/pvacview_dev_eve/neoantigens_candidates.json +++ /dev/null @@ -1,9 +0,0 @@ -[{ - "patientIdentifier": "Ptx", - "gene": "BRCA2", - "mutation": { - "wildTypeXmer": "AAAAAAAAAAAAALAAAAAAAAAAAAA", - "mutatedXmer": "AAAAAAAAAAAAAFAAAAAAAAAAAAA" - } -}] - diff --git a/pvactools/tools/pvacview_dev_eve/neoantigens_candidates.tab b/pvactools/tools/pvacview_dev_eve/neoantigens_candidates.tab deleted file mode 100644 index 23d4adad0..000000000 --- a/pvactools/tools/pvacview_dev_eve/neoantigens_candidates.tab +++ /dev/null @@ -1,6 +0,0 @@ -gene wildTypeXmer mutatedXmer patientIdentifier rnaExpression rnaVariantAlleleFrequency dnaVariantAlleleFrequency external_annotation_1 external_annotation_2 -BRCA2 AAAAAAAAAAAAALAAAAAAAAAAAAA AAAAAAAAAAAAAFAAAAAAAAAAAAA Ptx 7.942 0.85 0.34 some_value some_value -BRCA2 AAAAAAAAAAAAAMAAAAAAAAAAAAA AAAAAAAAAAAAARAAAAAAAAAAAAA Ptx 7.942 0.85 0.34 some_value some_value -BRCA2 AAAAAAAAAAAAAGAAAAAAAAAAAAA AAAAAAAAAAAAAKAAAAAAAAAAAAA Ptx 7.942 0.85 0.34 some_value some_value -BRCA2 AAAAAAAAAAAAACAAAAAAAAAAAAA AAAAAAAAAAAAAEAAAAAAAAAAAAA Ptx 7.942 0.85 0.34 some_value some_value -BRCA2 AAAAAAAAAAAAAKAAAAAAAAAAAAA AAAAAAAAAAAAACAAAAAAAAAAAAA Ptx 7.942 0.85 0.34 some_value some_value diff --git a/pvactools/tools/pvacview_dev_eve/patient_data.txt b/pvactools/tools/pvacview_dev_eve/patient_data.txt deleted file mode 100644 index 482e8241b..000000000 --- a/pvactools/tools/pvacview_dev_eve/patient_data.txt +++ /dev/null @@ -1,3 +0,0 @@ -identifier mhcIAlleles mhcIIAlleles tumorType -Ptx HLA-A*03:01,HLA-A*29:02,HLA-B*07:02,HLA-B*44:03,HLA-C*07:02,HLA-C*16:01 HLA-DRB1*03:01,HLA-DRB1*08:01,HLA-DQA1*03:01,HLA-DQA1*05:01,HLA-DQB1*01:01,HLA-DQB1*04:02,HLA-DPA1*01:03,HLA-DPA1*03:01,HLA-DPB1*13:01,HLA-DPB1*04:02 HNSC -Pty HLA-A*02:01,HLA-A*30:01,HLA-B*07:34,HLA-B*44:03,HLA-C*07:02,HLA-C*07:02 HLA-DRB1*04:02,HLA-DRB1*08:01,HLA-DQA1*03:01,HLA-DQA1*04:01,HLA-DQB1*03:02,HLA-DQB1*14:01,HLA-DPA1*01:03,HLA-DPA1*02:01,HLA-DPB1*02:01,HLA-DPB1*04:01 HNSC diff --git a/pvactools/tools/pvacview_dev_eve/run.py b/pvactools/tools/pvacview_dev_eve/run.py deleted file mode 100755 index 080abb4f6..000000000 --- a/pvactools/tools/pvacview_dev_eve/run.py +++ /dev/null @@ -1,23 +0,0 @@ -import argparse -import os -import sys -from subprocess import run, DEVNULL, STDOUT - -def define_parser(): - parser = argparse.ArgumentParser( - "pvacview run", - description="Launch pVACview R shiny application", - formatter_class=argparse.ArgumentDefaultsHelpFormatter - ) - parser.add_argument('pvacseq_dir', help='pVACseq results directory path (e.g. ~/Downloads/pvacseq_run/MHC_Class_I/)') - parser.add_argument('--r_path', default='R', help='Location of R to be used for launching the app (e.g. /usr/local/bin/R)') - return parser - -def main(args_input = sys.argv[1:]): - parser = define_parser() - args = parser.parse_args(args_input) - arguments = ['{}'.format(args.r_path), "-e", "shiny::runApp('{}')".format(args.pvacseq_dir)] - response = run(arguments, check=True) - -if __name__ == '__main__': - main() diff --git a/pvactools/tools/pvacview_dev_eve/server.R b/pvactools/tools/pvacview_dev_eve/server.R deleted file mode 100755 index 7cb976e09..000000000 --- a/pvactools/tools/pvacview_dev_eve/server.R +++ /dev/null @@ -1,1707 +0,0 @@ -# Developement -library(shiny) -library(ggplot2) -library(DT) -library(reshape2) -library(jsonlite) -library(tibble) -library(tidyr) -library(plyr) -library(dplyr) -library("stringr") # ADDED -library(grid) -library(gridExtra) -library(shinyWidgets) - -source("anchor_and_helper_functions.R", local = TRUE) -source("styling.R") - -#specify max shiny app upload size (currently 300MB) -options(shiny.maxRequestSize = 300 * 1024^2) -options(shiny.host = '127.0.0.1') -options(shiny.port = 3333) - -server <- shinyServer(function(input, output, session) { - - ##############################DATA UPLOAD TAB################################### - ## helper function defined for generating shinyInputs in mainTable (Evaluation dropdown menus) - shinyInput <- function(data, FUN, len, id, ...) { - inputs <- character(len) - for (i in seq_len(len)) { - inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ..., selected = data[i, "Evaluation"])) - } - inputs - } - ## helper function defined for generating shinyInputs in mainTable (Investigate button) - shinyInputSelect <- function(FUN, len, id, ...) { - inputs <- character(len) - for (i in seq_len(len)) { - inputs[i] <- as.character(FUN(paste0(id, i), ...)) - } - inputs - } - ## helper function defined for getting values of shinyInputs in mainTable (Evaluation dropdown menus) - shinyValue <- function(id, len, data) { - unlist(lapply(seq_len(len), function(i) { - value <- input[[paste0(id, i)]] - if (is.null(value)) { - data[i, "Evaluation"] - } else { - value - } - })) - } - #reactive values defined for row selection, main table, metrics data, additional data, and dna cutoff - df <- reactiveValues( - selectedRow = 1, - mainTable = NULL, - dna_cutoff = NULL, - metricsData = NULL, - additionalData = NULL, - gene_list = NULL, - binding_threshold = NULL, - use_allele_specific_binding_thresholds = NULL, - aggregate_inclusion_binding_threshold = NULL, - percentile_threshold = NULL, - allele_specific_binding_thresholds = NULL, # ADDED - #binding_cutoffs = NULL, # REMOVED - #is_allele_specific_binding_cutoff = NULL, # REMOVED - allele_expr = NULL, - anchor_mode = NULL, - anchor_contribution = NULL, - comments = data.frame("N/A"), - pageLength = 10 - ) - #Option 1: User uploaded main aggregate report file - observeEvent(input$mainDataInput$datapath, { - # session$sendCustomMessage("unbind-DT", "mainTable") # KEPT COMMENTED DESPITE BEING IN NEWER VERSION OF PVACVIEW - mainData <- read.table(input$mainDataInput$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - mainData$`Eval` <- shinyInput(mainData, selectInput, nrow(mainData), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - mainData$Select <- shinyInputSelect(actionButton, nrow(mainData), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') - mainData$`IC50 MT` <- as.numeric(mainData$`IC50 MT`) - mainData$`%ile MT` <- as.numeric(mainData$`%ile MT`) - mainData$`RNA Depth` <- as.integer(mainData$`RNA Depth`) - mainData$`TSL`[is.na(mainData$`TSL`)] <- "NA" - df$mainTable <- mainData - df$metricsData <- NULL - }) - #Option 1: User uploaded metrics file - observeEvent(input$metricsDataInput, { - df$metricsData <- fromJSON(input$metricsDataInput$datapath) - df$binding_threshold <- df$metricsData$`binding_threshold` - df$use_allele_specific_binding_thresholds <- df$metricsData$`use_allele_specific_binding_thresholds` # ADDED - df$allele_specific_binding_thresholds <- df$metricsData$`allele_specific_binding_thresholds` # ADDED - df$aggregate_inclusion_binding_threshold <- df$metricsData$`aggregate_inclusion_binding_threshold` - df$percentile_threshold <- df$metricsData$`percentile_threshold` - #df$binding_cutoffs <- df$metricsData$`binding_cutoffs` # REMOVED - #df$is_allele_specific_binding_cutoff <- df$metricsData$`is_allele_specific_binding_cutoff # REMOVED - df$dna_cutoff <- df$metricsData$vaf_clonal - df$allele_expr <- df$metricsData$allele_expr_threshold - df$anchor_mode <- ifelse(df$metricsData$`allele_specific_anchors`, "allele-specific", "default") - df$allele_specific_anchors <- df$metricsData$`allele_specific_anchors` - df$anchor_contribution <- df$metricsData$`anchor_contribution_threshold` - - hla <- df$metricsData$alleles # ADDED - converted_hla_names <- unlist(lapply(hla, function(x) { - if (grepl("HLA-", x)) { - strsplit(x, "HLA-")[[1]][2] - } else { - x - } - })) - - #hla <- names(df$metricsData$binding_cutoffs) # REMOVED - #if (input$hla_class == "class_i"){ - #converted_hla_names <- unlist(lapply(hla, function(x) {strsplit(x, "HLA-")[[1]][2]})) - #} else if (input$hla_class == "class_ii"){ - #converted_hla_names <- hla - #} - - - - if (!("Ref Match" %in% colnames(df$mainTable))) { - df$mainTable$`Ref Match` <- "Not Run" - } - columns_needed <- c("ID", converted_hla_names, "Gene", "AA Change", "Num Passing Transcripts", "Best Peptide", "Best Transcript", "TSL", "Allele", - "Pos", "Prob Pos", "Num Passing Peptides", "IC50 MT", "IC50 WT", "%ile MT", "%ile WT", "RNA Expr", "RNA VAF", - "Allele Expr", "RNA Depth", "DNA VAF", "Tier", "Ref Match", "Evaluation", "Eval", "Select") - if ("Comments" %in% colnames(df$mainTable)) { - columns_needed <- c(columns_needed, "Comments") - df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) - }else { - df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) - } - df$mainTable <- df$mainTable[, columns_needed] - - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) # ADDED - tier_numbers(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, - x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], - df$anchor_mode, df$allele_specific_binding_thresholds, - df$use_allele_specific_binding_thresholds, df$binding_threshold)) - - #df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) # REMOVED - #tier_numbers(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, - #x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], - #df$anchor_mode)) - - df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) - rownames(df$comments) <- df$mainTable$ID - - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) # ADDED - scale_binding_affinity(df$allele_specific_binding_thresholds, - df$use_allele_specific_binding_thresholds, - df$binding_threshold, x["Allele"], x["IC50 MT"])) - #df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) # REMOVED - # scale_binding_affinity(df$binding_cutoffs, - #df$is_allele_specific_binding_cutoff, - #df$binding_threshold, x["Allele"], x["IC50 MT"])) - - df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse(is.null(df$percentile_threshold), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) - df$mainTable$`Bad TSL` <- apply(df$mainTable, 1, function(x) {x["TSL"] == "NA" | (x["TSL"] != "NA" & x["TSL"] != "Not Supported" & x["TSL"] > df$metricsData$maximum_transcript_support_level)}) - df$mainTable$`Col RNA Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Expr"]), 0, x["RNA Expr"])}) - df$mainTable$`Col RNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA VAF"]), 0, x["RNA VAF"])}) - df$mainTable$`Col Allele Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["Allele Expr"]), 0, x["Allele Expr"])}) - df$mainTable$`Col RNA Depth` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Depth"]), 0, x["RNA Depth"])}) - df$mainTable$`Col DNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["DNA VAF"]), 0, x["DNA VAF"])}) - if (is.null(df$percentile_threshold)) { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) - }else { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) - } - df$mainTable$`Has Prob Pos` <- apply(df$mainTable, 1, function(x) {ifelse(x["Prob Pos"] != "None", TRUE, FALSE)}) - }) - #Option 1: User uploaded additional data file - observeEvent(input$additionalDataInput, { - addData <- read.table(input$additionalDataInput$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(addData) <- addData[1, ] - addData <- addData[-1, ] - row.names(addData) <- NULL - df$additionalData <- addData - }) - #Option 1: User uploaded additional gene list - observeEvent(input$gene_list, { - gene_list <- read.table(input$gene_list$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - df$gene_list <- gene_list - df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) - }) - #Option 2: Load from HCC1395 demo data from github - observeEvent(input$loadDefaultmain, { - ## Class I demo aggregate report - # session$sendCustomMessage("unbind-DT", "mainTable") # THIS LINE IS IN THE MOST UPDATED VERSION OF PVACVIEW BUT PREVENTS NEOFOX/PVAC TO BEING LOADED AT THE SAME TIME - data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/4ab3139a92d314da7b207e009fd8a1e4715a8166/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_I.all_epitopes.aggregated.tsv") - mainData <- read.table(text = data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - mainData$`Eval` <- shinyInput(mainData, selectInput, nrow(mainData), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - mainData$Select <- shinyInputSelect(actionButton, nrow(mainData), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') - mainData$`IC50 MT` <- as.numeric(mainData$`IC50 MT`) - mainData$`%ile MT` <- as.numeric(mainData$`%ile MT`) - mainData$`RNA Depth` <- as.integer(mainData$`RNA Depth`) - mainData$`TSL`[is.na(mainData$`TSL`)] <- "NA" - df$mainTable <- mainData - ## Class I demo metrics file - metricsdata <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/4ab3139a92d314da7b207e009fd8a1e4715a8166/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_I.all_epitopes.aggregated.metrics.json") - df$metricsData <- fromJSON(txt = metricsdata) - df$binding_threshold <- df$metricsData$`binding_threshold` - df$allele_specific_binding_thresholds <- df$metricsData$`allele_specific_binding_thresholds` - df$use_allele_specific_binding_thresholds <- df$metricsData$`use_allele_specific_binding_thresholds` - df$aggregate_inclusion_binding_threshold <- df$metricsData$`aggregate_inclusion_binding_threshold` - df$percentile_threshold <- df$metricsData$`percentile_threshold` - df$dna_cutoff <- df$metricsData$vaf_clonal - df$allele_expr <- df$metricsData$allele_expr_threshold - df$anchor_mode <- ifelse(df$metricsData$`allele_specific_anchors`, "allele-specific", "default") - df$allele_specific_anchors <- df$metricsData$`allele_specific_anchors` - df$anchor_contribution <- df$metricsData$`anchor_contribution_threshold` - hla <- df$metricsData$alleles - converted_hla_names <- unlist(lapply(hla, function(x) { - if (grepl("HLA-", x)) { - strsplit(x, "HLA-")[[1]][2] - } else { - x - } - })) - if (!("Ref Match" %in% colnames(df$mainTable))) { - df$mainTable$`Ref Match` <- "Not Run" - } - columns_needed <- c("ID", converted_hla_names, "Gene", "AA Change", "Num Passing Transcripts", "Best Peptide", "Best Transcript", "TSL", "Allele", - "Pos", "Prob Pos", "Num Passing Peptides", "IC50 MT", "IC50 WT", "%ile MT", "%ile WT", "RNA Expr", "RNA VAF", - "Allele Expr", "RNA Depth", "DNA VAF", "Tier", "Ref Match", "Evaluation", "Eval", "Select") - if ("Comments" %in% colnames(df$mainTable)) { - columns_needed <- c(columns_needed, "Comments") - df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) - }else { - df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) - } - df$mainTable <- df$mainTable[, columns_needed] - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode, df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold)) - df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) - if ("Comments" %in% colnames(df$mainTable)) { - df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) - }else { - df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) - } - rownames(df$comments) <- df$mainTable$ID - ## Class II additional demo aggregate report - add_data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/4ab3139a92d314da7b207e009fd8a1e4715a8166/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_II.all_epitopes.aggregated.tsv") - addData <- read.table(text = add_data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(addData) <- addData[1, ] - addData <- addData[-1, ] - row.names(addData) <- NULL - df$additionalData <- addData - ## Hotspot gene list autoload - gene_data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/4ab3139a92d314da7b207e009fd8a1e4715a8166/pvactools/tools/pvacview/data/cancer_census_hotspot_gene_list.tsv") - gene_list <- read.table(text = gene_data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - df$gene_list <- gene_list - df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold, x["Allele"], x["IC50 MT"])) - df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse(is.null(df$percentile_threshold), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) - df$mainTable$`Bad TSL` <- apply(df$mainTable, 1, function(x) {x["TSL"] == "NA" | (x["TSL"] != "NA" & x["TSL"] != "Not Supported" & x["TSL"] > df$metricsData$maximum_transcript_support_level)}) - df$mainTable$`Col RNA Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Expr"]), 0, x["RNA Expr"])}) - df$mainTable$`Col RNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA VAF"]), 0, x["RNA VAF"])}) - df$mainTable$`Col Allele Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["Allele Expr"]), 0, x["Allele Expr"])}) - df$mainTable$`Col RNA Depth` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Depth"]), 0, x["RNA Depth"])}) - df$mainTable$`Col DNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["DNA VAF"]), 0, x["DNA VAF"])}) - if (is.null(df$percentile_threshold)) { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) - }else { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) - } - df$mainTable$`Has Prob Pos` <- apply(df$mainTable, 1, function(x) {ifelse(x["Prob Pos"] != "None", TRUE, FALSE)}) - updateTabItems(session, "tabs", "explore") - }) - ##Clear file inputs if demo data load button is clicked - output$aggregate_report_ui <- renderUI({ - input$loadDefaultmain - fileInput(inputId = "mainDataInput", label = "1. Neoantigen Candidate Aggregate Report (tsv required)", - accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) - }) - output$metrics_ui <- renderUI({ - input$loadDefaultmain - fileInput(inputId = "metricsDataInput", label = "2. Neoantigen Candidate Metrics file (json required)", - accept = c("application/json", ".json")) - }) - output$add_file_ui <- renderUI({ - input$loadDefaultmain - fileInput(inputId = "additionalDataInput", label = "3. Additional Neoantigen Candidate Aggregate Report (tsv required)", - accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) - }) - ##Visualize button - observeEvent(input$visualize, { - updateTabItems(session, "tabs", "explore") - }) - ##Parameter UIs - output$allele_specific_anchors_ui <- renderUI({ - current_is_allele_specific_anchors_set <- df$allele_specific_anchors - checkboxInput( - "use_anchor", - "If you want to use allele-specific anchor calculations, please check this box. Otherwise anchors will be calculated as 1,2 and n-1,n for n-mer peptides.", - value = current_is_allele_specific_anchors_set, - width = NULL - ) - }) - output$anchor_contribution_ui <- renderUI({ - current_anchor_contribution_threshold <- df$anchor_contribution - sliderInput("anchor_contribution", "Contribution cutoff for determining anchor locations", 0.5, 0.9, current_anchor_contribution_threshold, step = 0.1, width = 400) - }) - output$binding_threshold_ui <- renderUI({ - current_binding <- df$binding_threshold - max_cutoff <- df$aggregate_inclusion_binding_threshold - numericInput("binding_threshold", "Binding Threshold", current_binding, min = 0, max = max_cutoff, step = 10, width = 500) - }) - output$allele_specific_binding_ui <- renderUI({ - current_is_allele_specific_binding_set <- df$use_allele_specific_binding_thresholds - checkboxInput( - "allele_specific_binding", - "If you want to use allele-specific binding thresholds for tiering purposes please check this box.", - value = current_is_allele_specific_binding_set, - width = NULL - ) - }) - output$percentile_threshold_ui <- renderUI({ - current_percentile <- df$percentile_threshold - numericInput("percentile_threshold", "Percentile Threshold", current_percentile, min = 0, max = 100, step = 0.01, width = 500) - }) - output$dna_cutoff_ui <- renderUI({ - current_dna_cutoff <- df$dna_cutoff - numericInput("dna_cutoff", "Clonal DNA VAF (Anything lower than 1/2 of chosen VAF level will be considered subclonal)", current_dna_cutoff, min = 0, max = 1, step = 0.01, width = 500) - }) - output$allele_expr_ui <- renderUI({ - current_allele_expr <- df$allele_expr - numericInput("allele_expr", "Allele Expression cutoff to be considered a Pass variant. Note that this criteria is also used in determining Anchor and Subclonal variants.", current_allele_expr, min = 0, max = 100, step = 0.1, width = 500) - }) - #reactions for once "regenerate table" command is submitted - observeEvent(input$submit, { - session$sendCustomMessage("unbind-DT", "mainTable") - df$binding_threshold <- input$binding_threshold - df$use_allele_specific_binding_thresholds <- input$allele_specific_binding - df$percentile_threshold <- input$percentile_threshold - df$dna_cutoff <- input$dna_cutoff - df$allele_expr <- input$allele_expr - df$allele_specific_anchors <- input$use_anchor - df$anchor_contribution <- input$anchor_contribution - df$mainTable$`Evaluation` <- shinyValue("selecter_", nrow(df$mainTable), df$mainTable) - if (input$use_anchor) { - df$anchor_mode <- "allele-specific" - df$anchor_contribution <- input$anchor_contribution - }else { - df$anchor_mode <- "default" - } - df$mainTable$`Tier` <- apply(df$mainTable, 1, function(x) tier(x, df$anchor_contribution, input$dna_cutoff, input$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode, df$use_allele_specific_binding_thresholds, df$binding_threshold)) - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, input$dna_cutoff, input$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode, df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold)) - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold, x["Allele"], x["IC50 MT"])) - df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse((is.null(df$percentile_threshold) || is.na(df$percentile_threshold)), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) - if (is.null(df$percentile_threshold) || is.na(df$percentile_threshold)) { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) - }else { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) - } - tier_sorter <- c("Pass", "LowExpr", "Anchor", "Subclonal", "Poor", "NoExpr") - df$mainTable$`Rank_ic50` <- NA - df$mainTable$`Rank_expr` <- NA - df$mainTable$`Rank_ic50` <- rank(as.numeric(df$mainTable$`IC50 MT`), ties.method = "first") - df$mainTable$`Rank_expr` <- rank(desc(as.numeric(df$mainTable$`Allele Expr`)), ties.method = "first") - df$mainTable$`Rank` <- df$mainTable$`Rank_ic50` + df$mainTable$`Rank_expr` - df$mainTable <- df$mainTable %>% - arrange(factor(Tier, levels = tier_sorter), Rank) - df$mainTable$`Rank` <- NULL - df$mainTable$`Rank_ic50` <- NULL - df$mainTable$`Rank_expr` <- NULL - df$mainTable$Select <- shinyInputSelect(actionButton, nrow(df$mainTable), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') - df$mainTable$`Eval` <- shinyInput(df$mainTable, selectInput, nrow(df$mainTable), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - }) - #reset tier-ing with original parameters - observeEvent(input$reset_params, { - session$sendCustomMessage("unbind-DT", "mainTable") - df$binding_threshold <- df$metricsData$`binding_threshold` - df$allele_specific_binding_thresholds <- df$metricsData$`allele_specific_binding_thresholds` - df$use_allele_specific_binding_thresholds <- df$metricsData$`use_allele_specific_binding_thresholds` - df$percentile_threshold <- df$metricsData$`percentile_threshold` - df$dna_cutoff <- df$metricsData$`vaf_clonal` - df$allele_expr <- df$metricsData$`allele_expr` - df$anchor_mode <- ifelse(df$metricsData$`allele_specific_anchors`, "allele-specific", "default") - df$allele_specific_anchors <- df$metricsData$`allele_specific_anchors` - df$anchor_contribution <- df$metricsData$`anchor_contribution_threshold` - df$mainTable$`Evaluation` <- shinyValue("selecter_", nrow(df$mainTable), df$mainTable) - df$mainTable$`Tier` <- apply(df$mainTable, 1, function(x) tier(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode, df$use_allele_specific_binding_thresholds, df$binding_threshold)) - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode, df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold)) - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$allele_specific_binding_thresholds, df$use_allele_specific_binding_thresholds, df$binding_threshold, x["Allele"], x["IC50 MT"])) - df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse(is.null(df$percentile_threshold), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) - if (is.null(df$percentile_threshold)) { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) - }else { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) - } - tier_sorter <- c("Pass", "LowExpr", "Anchor", "Subclonal", "Poor", "NoExpr") - df$mainTable$`Rank_ic50` <- NA - df$mainTable$`Rank_expr` <- NA - df$mainTable$`Rank_ic50` <- rank(as.numeric(df$mainTable$`IC50 MT`), ties.method = "first") - df$mainTable$`Rank_expr` <- rank(desc(as.numeric(df$mainTable$`Allele Expr`)), ties.method = "first") - df$mainTable$`Rank` <- df$mainTable$`Rank_ic50` + df$mainTable$`Rank_expr` - df$mainTable <- df$mainTable %>% - arrange(factor(Tier, levels = tier_sorter), Rank) - df$mainTable$`Rank` <- NULL - df$mainTable$`Rank_ic50` <- NULL - df$mainTable$`Rank_expr` <- NULL - df$mainTable$Select <- shinyInputSelect(actionButton, nrow(df$mainTable), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') - df$mainTable$`Eval` <- shinyInput(df$mainTable, selectInput, nrow(df$mainTable), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - }) - #determine hla allele count in order to generate column tooltip locations correctly - hla_count <- reactive({ - which(colnames(df$mainTable) == "Gene") - 1 - }) - #class type of user-provided additional file - type <- reactive({ - switch(input$hla_class, - class_i = 1, - class_ii = 2) - }) - output$type_text <- renderText({ - input$add_file_label - }) - output$paramTable <- renderTable( - data <- data.frame( - "Parameter" = c("Tumor Purity", "VAF Clonal", "VAF Subclonal", "Allele Expression for Passing Variants", - "Binding Threshold", "Binding Threshold for Inclusion into Metrics File", "Maximum TSL", - "Percentile Threshold", "Allele Specific Binding Thresholds", - "MT Top Score Metric", "WT Top Score Metric", - "Allele Specific Anchors Used", "Anchor Contribution Threshold"), - "Value" = c(if (is.null(df$metricsData$tumor_purity)) {"NULL"}else {df$metricsData$tumor_purity}, - df$metricsData$`vaf_clonal`, df$metricsData$`vaf_subclonal`, df$metricsData$`allele_expr_threshold`, - df$metricsData$binding_threshold, df$metricsData$`aggregate_inclusion_binding_threshold`, - df$metricsData$maximum_transcript_support_level, - if (is.null(df$metricsData$percentile_threshold)) {"NULL"}else { df$metricsData$percentile_threshold}, - df$metricsData$use_allele_specific_binding_thresholds, - df$metricsData$mt_top_score_metric, df$metricsData$wt_top_score_metric, - df$metricsData$allele_specific_anchors, df$metricsData$anchor_contribution_threshold) - ), digits = 3 - ) - output$bindingParamTable <- renderTable( - if (df$metricsData$use_allele_specific_binding_thresholds) { - data <- data.frame( - "HLA Alleles" = df$metricsData$alleles, - "Binding Cutoffs" = unlist(lapply(df$metricsData$alleles, function(x) { - if (x %in% names(df$metricsData$allele_specific_binding_thresholds)) { - df$metricsData$allele_specific_binding_thresholds[[x]] - } else { - df$metricsData$binding_threshold - } - } - ))) - } else { - data <- data.frame( - "HLA Alleles" = df$metricsData$alleles, - "Binding Cutoffs" = unlist(lapply(df$metricsData$alleles, function(x) df$metricsData$binding_threshold)) - ) - } - ) - output$comment_text <- renderUI({ - if (is.null(df$mainTable)) { - return(HTML("N/A")) - } - HTML(paste(df$comments[selectedID(), 1])) - }) - observeEvent(input$page_length, { - if (is.null(df$mainTable)) { - return() - } - df$pageLength <- as.numeric(input$page_length) - session$sendCustomMessage("unbind-DT", "mainTable") - df$mainTable$`Evaluation` <- shinyValue("selecter_", nrow(df$mainTable), df$mainTable) - df$mainTable$`Eval` <- shinyInput(df$mainTable, selectInput, nrow(df$mainTable), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - }) - output$filesUploaded <- reactive({ - val <- !(is.null(df$mainTable) | is.null(df$metricsData)) - print(val) - }) - outputOptions(output, "filesUploaded", suspendWhenHidden = FALSE) - ##############################PEPTIDE EXPLORATION TAB################################ - ##main table display with color/background/font/border configurations - output$mainTable <- DT::renderDataTable( - if (is.null(df$mainTable) | is.null(df$metricsData)) { - return(datatable(data.frame("Aggregate Report" = character()))) - }else { - datatable(df$mainTable[, !(colnames(df$mainTable) == "ID") & !(colnames(df$mainTable) == "Evaluation") & !(colnames(df$mainTable) == "Comments")], - escape = FALSE, callback = JS(callback(hla_count(), df$metricsData$mt_top_score_metric)), class = "stripe", - options = list(lengthChange = FALSE, dom = "Bfrtip", pageLength = df$pageLength, - columnDefs = list(list(defaultContent = "NA", targets = c(hla_count() + 10, (hla_count() + 12):(hla_count() + 17))), - list(className = "dt-center", targets = c(0:hla_count() - 1)), list(visible = FALSE, targets = c(1:(hla_count()-1), (hla_count()+2), (hla_count()+4), -1:-12)), - list(orderable = TRUE, targets = 0)), buttons = list(I("colvis")), - initComplete = htmlwidgets::JS( - "function(settings, json) {", - paste("$(this.api().table().header()).css({'font-size': '", "10pt", "'});"), - "}"), - rowCallback = JS(rowcallback(hla_count(), df$selectedRow - 1)), - preDrawCallback = JS("function() { - Shiny.unbindAll(this.api().table().node()); }"), - drawCallback = JS("function() { - Shiny.bindAll(this.api().table().node()); } ")), - selection = "none", - extensions = c("Buttons")) - } - %>% formatStyle("IC50 MT", "Scaled BA", backgroundColor = styleInterval(c(0.1, 0.2, 0.4, 0.6, 0.8, 1, 1.2, 1.4, 1.6, 1.8, 2), - c("#68F784", "#60E47A", "#58D16F", "#4FBD65", "#47AA5A", "#3F9750", "#F3F171", "#F3E770", "#F3DD6F", "#F0CD5B", "#F1C664", "#FF9999")) - , fontWeight = styleInterval(c(1000), c("normal", "bold")), border = styleInterval(c(1000), c("normal", "2px solid red"))) - %>% formatStyle("%ile MT", "Scaled percentile", backgroundColor = styleInterval(c(0.2, 0.4, 0.6, 0.8, 1, 1.25, 1.5, 1.75, 2), - c("#68F784", "#60E47A", "#58D16F", "#4FBD65", "#47AA5A", "#F3F171", "#F3E770", "#F3DD6F", "#F1C664", "#FF9999"))) - %>% formatStyle("Tier", color = styleEqual(c("Pass", "Poor", "Anchor", "Subclonal", "LowExpr", "NoExpr"), c("green", "orange", "#b0b002", "#D4AC0D", "salmon", "red"))) - %>% formatStyle(c("RNA VAF"), "Col RNA VAF", background = styleColorBar(range(0, 1), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("DNA VAF"), "Col DNA VAF", background = styleColorBar(range(0, 1), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("RNA Expr"), "Col RNA Expr", background = styleColorBar(range(0, 50), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("RNA Depth"), "Col RNA Depth", background = styleColorBar(range(0, 200), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("Allele Expr"), "Col Allele Expr", background = styleColorBar(range(0, (max(as.numeric(as.character(unlist(df$mainTable["Col RNA VAF"]))) * 50))), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("Allele Expr"), "Tier Count", fontWeight = styleEqual(c("2"), c("bold")), border = styleEqual(c("2"), c("2px solid red"))) - %>% formatStyle(c("IC50 MT", "Allele Expr"), "Tier Count", fontWeight = styleEqual(c("3"), c("bold")), border = styleEqual(c("3"), c("2px solid red"))) - %>% formatStyle(c("IC50 MT"), "Tier Count", fontWeight = styleEqual(c("4"), c("bold")), border = styleEqual(c("4"), c("2px solid red"))) - %>% formatStyle(c("Allele Expr", "%ile MT"), "Tier Count", fontWeight = styleEqual(c("102"), c("bold")), border = styleEqual(c("102"), c("2px solid red"))) - %>% formatStyle(c("IC50 MT", "Allele Expr", "%ile MT"), "Tier Count", fontWeight = styleEqual(c("103"), c("bold")), border = styleEqual(c("103"), c("2px solid red"))) - %>% formatStyle(c("%ile MT"), "Tier Count", fontWeight = styleEqual(c("104"), c("bold")), border = styleEqual(c("104"), c("2px solid red"))) - %>% formatStyle(c("IC50 MT", "%ile MT"), "Tier Count", fontWeight = styleEqual(c("105"), c("bold")), border = styleEqual(c("105"), c("2px solid red"))) - %>% formatStyle(c("IC50 WT", "Pos"), "Tier Count", fontWeight = styleEqual(c("5"), c("bold")), border = styleEqual(c("5"), c("2px solid red"))) - %>% formatStyle(c("DNA VAF"), "Tier Count", fontWeight = styleEqual(c("6"), c("bold")), border = styleEqual(c("6"), c("2px solid red"))) - %>% formatStyle(c("Allele Expr"), "Tier Count", fontWeight = styleEqual(c("7"), c("bold")), border = styleEqual(c("7"), c("2px solid red"))) - %>% formatStyle(c("Gene Expression"), "Tier Count", fontWeight = styleEqual(c("8"), c("bold")), border = styleEqual(c("8"), c("2px solid red"))) - %>% formatStyle(c("RNA VAF", "RNA Depth"), "Tier Count", fontWeight = styleEqual(c("8"), c("bold")), border = styleEqual(c("8"), c("2px solid green"))) - %>% formatStyle(c("RNA Expr", "Tier Count"), fontWeight = styleEqual(c("9"), c("bold")), border = styleEqual(c("9"), c("2px solid red"))) - %>% formatStyle(c("RNA VAF"), "Tier Count", fontWeight = styleEqual(c("10"), c("bold")), border = styleEqual(c("10"), c("2px solid red"))) - %>% formatStyle(c("RNA VAF", "RNA Expr"), "Tier Count", fontWeight = styleEqual(c("11"), c("bold")), border = styleEqual(c("11"), c("2px solid red"))) - %>% formatStyle(c("IC50 WT", "Pos"), "Tier Count", fontWeight = styleEqual(c("13"), c("bold")), border = styleEqual(c("13"), c("2px solid red"))) - %>% formatStyle(c("DNA VAF"), "Tier Count", fontWeight = styleEqual(c("14"), c("bold")), border = styleEqual(c("14"), c("2px solid red"))) - %>% formatStyle(c("DNA VAF", "IC50 WT", "Pos"), "Tier Count", fontWeight = styleEqual(c("15"), c("bold")), border = styleEqual(c("15"), c("2px solid red"))) - %>% formatStyle(c("IC50 WT", "Pos", "DNA VAF", "Allele Expr"), "Tier Count", fontWeight = styleEqual(c("23"), c("bold")), border = styleEqual(c("23"), c("2px solid red"))) - %>% formatStyle(c("DNA VAF", "Allele Expr"), "Tier Count", fontWeight = styleEqual(c("22"), c("bold")), border = styleEqual(c("22"), c("2px solid red"))) - %>% formatStyle(c("IC50 WT", "Pos", "Allele Expr"), "Tier Count", fontWeight = styleEqual(c("21"), c("bold")), border = styleEqual(c("21"), c("2px solid red"))) - %>% formatStyle(c("Allele Expr"), "Tier Count", fontWeight = styleEqual(c("20"), c("bold")), border = styleEqual(c("20"), c("2px solid red"))) - %>% formatStyle(c("Gene"), "Gene of Interest", fontWeight = styleEqual(c(TRUE), c("bold")), border = styleEqual(c(TRUE), c("2px solid green"))) - %>% formatStyle(c("TSL"), "Bad TSL", fontWeight = styleEqual(c(TRUE), c("bold")), border = styleEqual(c(TRUE), c("2px solid red"))) - %>% formatStyle(c("%ile MT"), "Percentile Fail", border = styleEqual(c(TRUE), c("2px solid red"))) - %>% formatStyle(c("Prob Pos"), "Has Prob Pos", fontWeight = styleEqual(c(TRUE), c("bold")), border = styleEqual(c(TRUE), c("2px solid red"))) - %>% formatStyle(c("Ref Match"), "Ref Match", fontWeight = styleEqual(c("True"), c("bold")), border = styleEqual(c("True"), c("2px solid red"))) - %>% formatStyle("Best Peptide", fontFamily="monospace") - , server = FALSE) - #help menu for main table - observeEvent(input$help, { - showModal(modalDialog( - title = "Aggregate Report of Best Candidates by Mutation", - h5("* Hover over individual column names to see further description of specific columns. (HLA allele columns excluded)"), - h4(" HLA specific columns:", style = "font-weight: bold"), - h5(" Number of good binding peptides for each specific HLA-allele.", br(), - " The same peptide could be counted in multiple columns if it was predicted to be a good binder for multiple HLA alleles."), - h4(" Color scale for IC50 MT column:", style = "font-weight: bold"), - h5(" lightgreen to darkgreen (0nM to 500nM); ", br(), "yellow to orange (500nM to 1000nM);", br(), " red (> 1000nM) "), - h4(" Color scale for %ile MT column:", style = "font-weight: bold"), - h5(" lightgreen to darkgreen (0-0.5%);", br(), " yellow to orange (0.5% to 2 %);", br(), " red (> 2%) "), - h4(" Bar backgrounds:", style = "font-weight: bold"), - h5(" RNA VAF and DNA VAF: Bar graphs range from 0 to 1", br(), - " RNA Depth: Bar graph ranging from 0 to maximum value of RNA depth values across variants", br(), - " RNA Expr: Bar graph ranging from 0 to 50 (this is meant to highlight variants with lower expression values for closer inspection)", br(), - " Allele Expr: Bar graph ranging from 0 to (50 * maximum value of RNA VAF values across variants) "), - h4(" Tier Types:", style = "font-weight: bold"), - h5(" Variants are ordered by their Tiers in the following way: Pass, LowExpr, Anchor, Subclonal, Poor, NoExpr. - Within the same tier, variants are ordered by the sum of their ranking in binding affinity and allele expression (i.e. lower binding - affinity and higher allele expression is prioritized.)"), - h5(" NoExpr: Mutant allele is not expressed ", br(), - " LowExpr: Mutant allele has low expression (Allele Expr < allele expression threshold)", br(), - " Subclonal: Likely not in the founding clone of the tumor (DNA VAF > max(DNA VAF)/2)", br(), - " Anchor: Mutation is at an anchor residue in the shown peptide, and the WT allele has good binding (WT IC50 < binding threshold)", br(), - " Poor: Fails two or more of the above criteria", br(), - " Pass: Passes the above criteria, has strong MT binding (IC50 < 500) and strong expression (Allele Expr > allele expression threshold)" - ), - )) - }) - ##update table upon selecting to investigate each individual row - observeEvent(input$select_button, { - if (is.null(df$mainTable)) { - return() - } - df$selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2]) - session$sendCustomMessage("unbind-DT", "mainTable") - df$mainTable$`Evaluation` <- shinyValue("selecter_", nrow(df$mainTable), df$mainTable) - df$mainTable$`Eval` <- shinyInput(df$mainTable, selectInput, nrow(df$mainTable), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - dataTableProxy("mainTable") %>% - selectPage((df$selectedRow - 1) %/% df$pageLength + 1) - }) - ##selected row text box - output$selected <- renderText({ - if (is.null(df$mainTable)) { - return() - } - df$selectedRow - }) - ##selected id update - selectedID <- reactive({ - if (is.null(df$selectedRow)) { - df$mainTable$ID[1] - }else { - df$mainTable$ID[df$selectedRow] - } - }) - output$selectedPeptide <- reactive({ - if (is.null(df$selectedRow)) { - df$mainTable$`Best Peptide`[1] - }else { - df$mainTable$`Best Peptide`[df$selectedRow] - } - }) - output$selectedAAChange <- reactive({ - if (is.null(df$selectedRow)) { - df$mainTable$`AA Change`[1] - }else { - df$mainTable$`AA Change`[df$selectedRow] - } - }) - output$selectedPos <- reactive({ - if (is.null(df$selectedRow)) { - df$mainTable$`Pos`[1] - }else { - df$mainTable$`Pos`[df$selectedRow] - } - }) - output$selectedGene <- reactive({ - if (is.null(df$selectedRow)) { - df$mainTable$`Gene`[1] - }else { - df$mainTable$`Gene`[df$selectedRow] - } - }) - ## Update comments section based on selected row - observeEvent(input$comment, { - if (is.null(df$mainTable)) { - return() - } - df$comments[selectedID(), 1] <- input$comments - }) - ##display of genomic information - output$metricsTextGenomicCoord <- renderText({ - if (is.null(df$metricsData)) { - return() - } - selectedID() - }) - ##display of openCRAVAT link for variant - output$url <- renderUI({ - if (is.null(df$mainTable)) { - return() - } - id <- strsplit(selectedID(), "-") - chromosome <- id[[1]][1] - start <- id[[1]][2] - stop <- id[[1]][3] - ref <- id[[1]][4] - alt <- id[[1]][5] - url <- a("OpenCRAVAT variant report", href = paste("https://run.opencravat.org/webapps/variantreport/index.html?chrom=", chromosome, "&pos=", stop, "&ref_base=", ref, "&alt_base=", alt, sep = ""), target = "_blank") - HTML(paste(url)) - }) - ##display of RNA VAF - output$metricsTextRNA <- renderText({ - if (is.null(df$metricsData)) { - return() - } - df$metricsData[[selectedID()]]$`RNA VAF` - }) - ##display of DNA VAF - output$metricsTextDNA <- renderText({ - if (is.null(df$metricsData)) { - return() - } - df$metricsData[[selectedID()]]$`DNA VAF` - }) - ##display of MT IC50 from additional data file - output$addData_IC50 <- renderText({ - if (is.null(df$additionalData)) { - return() - } - df$additionalData[df$additionalData$ID == selectedID(), ]$`IC50 MT` - }) - ##display of MT percentile from additional data file - output$addData_percentile <- renderText({ - df$additionalData[df$additionalData$ID == selectedID(), ]$`%ile MT` - }) - ##display of Best Peptide from additional data file - output$addData_peptide <- renderText({ - df$additionalData[df$additionalData$ID == selectedID(), ]$`Best Peptide` - }) - ##display of Corresponding HLA allele from additional data file - output$addData_allele <- renderText({ - df$additionalData[df$additionalData$ID == selectedID(), ]$`Allele` - }) - ##display of Best Transcript from additional data file - output$addData_transcript <- renderText({ - df$additionalData[df$additionalData$ID == selectedID(), ]$`Best Transcript` - }) - ##transcripts sets table displaying sets of transcripts with the same consequence - output$transcriptSetsTable <- renderDT({ - withProgress(message = "Loading Transcript Sets Table", value = 0, { - GB_transcripts <- data.frame() - best_transcript <- df$mainTable[df$mainTable$ID == selectedID(), ]$`Best Transcript` - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - GB_transcripts <- data.frame( - "Transcript Sets" = df$metricsData[[selectedID()]]$sets, - "# Transcripts" = df$metricsData[[selectedID()]]$transcript_counts, - "# Peptides" = df$metricsData[[selectedID()]]$peptide_counts, - "Total Expr" = df$metricsData[[selectedID()]]$set_expr - ) - names(GB_transcripts) <- c("Transcripts Sets", "#Transcripts", "# Peptides", "Total Expr") - best_transcript_set <- NULL - incProgress(0.5) - for (i in 1:length(df$metricsData[[selectedID()]]$sets)){ - transcript_set <- df$metricsData[[selectedID()]]$good_binders[[df$metricsData[[selectedID()]]$sets[i]]]$`transcripts` - transcript_set <- lapply(transcript_set, function(x) strsplit(x, "-")[[1]][1]) - if (best_transcript %in% transcript_set) { - best_transcript_set <- df$metricsData[[selectedID()]]$sets[i] - } - } - incProgress(0.5) - datatable(GB_transcripts, selection = list(mode = "single", selected = "1"), style="bootstrap") %>% - formatStyle("Transcripts Sets", backgroundColor = styleEqual(c(best_transcript_set), c("#98FF98"))) - }else { - GB_transcripts <- data.frame("Transcript Sets" = character(), "# Transcripts" = character(), "# Peptides" = character(), "Total Expr" = character()) - names(GB_transcripts) <- c("Transcripts Sets", "#Transcripts", "# Peptides", "Total Expr") - incProgress(0.5) - datatable(GB_transcripts) - incProgress(0.5) - } - }) - }) - ##update selected transcript set id - selectedTranscriptSet <- reactive({ - selection <- input$transcriptSetsTable_rows_selected - if (is.null(selection)) { - selection <- 1 - } - df$metricsData[[selectedID()]]$sets[selection] - }) - - ##transcripts table displaying transcript id and transcript expression values - output$transcriptsTable <- renderDT({ - withProgress(message = "Loading Transcripts Table", value = 0, { - GB_transcripts <- data.frame() - best_transcript <- df$mainTable[df$mainTable$ID == selectedID(), ]$`Best Transcript` - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - GB_transcripts <- data.frame("Transcripts" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`transcripts`, - "Expression" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`transcript_expr`, - "TSL" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`tsl`, - "Biotype" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`biotype`, - "Length" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`transcript_length`) - GB_transcripts$`Best Transcript` <- apply(GB_transcripts, 1, function(x) grepl(best_transcript, x["Transcripts"], fixed = TRUE)) - incProgress(0.5) - names(GB_transcripts) <- c("Transcripts in Selected Set", "Expression", "Transcript Support Level", "Biotype", "Transcript Length (#AA)", "Best Transcript") - incProgress(0.5) - datatable(GB_transcripts, options = list(columnDefs = list(list(defaultContent = "N/A", targets = c(3)), list(visible = FALSE, targets = c(-1))))) %>% - formatStyle(c("Transcripts in Selected Set"), "Best Transcript", backgroundColor = styleEqual(c(TRUE), c("#98FF98"))) - }else { - GB_transcripts <- data.frame("Transcript" = character(), "Expression" = character(), "TSL" = character(), "Biotype" = character(), "Transcript Length (#AA)"= character(), "Length" = character()) - incProgress(0.5) - names(GB_transcripts) <- c("Transcripts in Selected Set", "Expression", "Transcript Support Level", "Biotype", "Transcript Length (#AA)", "Best Transcript") - incProgress(0.5) - datatable(GB_transcripts) - } - }) - }) - - ##display transcript expression - output$metricsTextTranscript <- renderText({ - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`transcript_expr` - }else { - "N/A" - } - }) - ##display gene expression - output$metricsTextGene <- renderText({ - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - df$metricsData[[selectedID()]]$`gene_expr` - }else { - "N/A" - } - }) - ##display peptide table with coloring - output$peptideTable <- renderDT({ - withProgress(message = "Loading Peptide Table", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0 & !is.null(df$metricsData)) { - peptide_data <- df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`peptides` - best_peptide <- df$mainTable[df$mainTable$ID == selectedID(), ]$`Best Peptide` - peptide_names <- names(peptide_data) - for (i in 1:length(peptide_names)) { - peptide_data[[peptide_names[[i]]]]$individual_ic50_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_percentile_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_el_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_el_percentile_calls <- NULL - } - incProgress(0.5) - peptide_data <- as.data.frame(peptide_data) - incProgress(0.5) - dtable <- datatable(do.call("rbind", lapply(peptide_names, table_formatting, peptide_data)), options = list( - pageLength = 10, - columnDefs = list(list(defaultContent = "X", - targets = c(2:hla_count() + 1)), - list(orderable = TRUE, targets = 0), - list(visible = FALSE, targets = c(-1, -2))), - rowCallback = JS("function(row, data, index, rowId) {", - "if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {", - 'row.style.backgroundColor = "#E0E0E0";', "}", "}") - ), - selection = list(mode = "single", selected = "1"), - style="bootstrap") %>% - formatStyle("Type", fontWeight = styleEqual("MT", "bold")) %>% - formatStyle(c("Peptide Sequence"), "Has ProbPos", border = styleEqual(c(TRUE), c("2px solid red"))) %>% - formatStyle(c("Problematic Positions"), "Has ProbPos", border = styleEqual(c(TRUE), c("2px solid red"))) %>% - formatStyle(c("Peptide Sequence"), "Has AnchorResidueFail", border = styleEqual(c(TRUE), c("2px solid red"))) %>% - formatStyle(c("Anchor Residue Fail"), "Has AnchorResidueFail", border = styleEqual(c(TRUE), c("2px solid red"))) %>% - formatStyle("Peptide Sequence", backgroundColor = styleEqual(c(best_peptide), c("#98FF98"))) %>% - formatStyle("Peptide Sequence", fontFamily="monospace") - dtable$x$data[[1]] <- as.numeric(dtable$x$data[[1]]) - dtable - }else { - incProgress(1) - datatable(data.frame("Peptide Datatable" = character()), selection = list(mode = "single", selected = "1"), style="bootstrap") - } - }) - }) - ##update selected peptide data - selectedPeptideData <- reactive({ - selection <- input$peptideTable_rows_selected - if (is.null(selection)) { - selection <- 1 - } - peptide_names <- names(df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`peptides`) - index <- floor((as.numeric(selection) + 1) / 2) - df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$peptides[[peptide_names[index]]] - }) - ##Add legend for anchor heatmap - output$peptideFigureLegend <- renderPlot({ - colors <- colorRampPalette(c("lightblue", "blue"))(99)[seq(1, 99, 7)] - color_pos <- data.frame(d = as.character(seq(1, 99, 7)), x1 = seq(0.1, 1.5, 0.1), x2 = seq(0.2, 1.6, 0.1), y1 = rep(1, 15), y2 = rep(1.1, 15), colors = colors) - color_label <- data.frame(x = c(0.1, 0.8, 1.6), y = rep(0.95, 3), score = c(0, 0.5, 1)) - p1 <- ggplot() + - scale_y_continuous(limits = c(0.90, 1.2), name = "y") + scale_x_continuous(limits = c(0, 1.7), name = "x") + - geom_rect(data = color_pos, aes(xmin = x1, xmax = x2, ymin = y1, ymax = y2, fill = colors), color = "black", alpha = 1) + - scale_fill_identity() - p1 <- p1 + geom_text(data = color_label, aes(x = x, y = y, label = score), size = 4, fontface = 2) + - annotate(geom = "text", x = 0.5, y = 1.18, label = "Normalized Anchor Score", size = 4, fontface = 2) + - coord_fixed() + - theme_void() + theme(legend.position = "none", panel.border = element_blank(), plot.margin = margin(0, 0, 0, 0, "cm")) - print(p1) - }) - ##Anchor Heatmap overlayed on selected peptide sequences - output$anchorPlot <- renderPlot({ - if (is.null(df$metricsData)) { - return() - } - withProgress(message = "Loading Anchor Heatmap", value = 0, { - if (type() == 2) { - p1 <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available for Class II HLA alleles", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p1) - }else if (length(df$metricsData[[selectedID()]]$sets) != 0) { - peptide_data <- df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`peptides` - peptide_names <- names(peptide_data) - for (i in 1:length(peptide_names)) { - peptide_data[[peptide_names[[i]]]]$individual_ic50_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_percentile_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_el_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_el_percentile_calls <- NULL - } - peptide_data <- as.data.frame(peptide_data) - p1 <- ggplot() + scale_x_continuous(limits = c(0, 80)) + scale_y_continuous(limits = c(-31, 1)) - all_peptides <- list() - incProgress(0.1) - for (i in 1:length(peptide_names)) { - #set & constrain mutation_pos' to not exceed length of peptide (may happen if mutation range goes off end) - mutation_pos <- range_str_to_seq(df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$peptides[[peptide_names[i]]]$`mutation_position`) - mt_peptide_length <- nchar(peptide_names[i]) - mutation_pos <- mutation_pos[mutation_pos <= mt_peptide_length] - #set associated wt peptide to current mt peptide - wt_peptide <- as.character(df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$peptides[[peptide_names[i]]]$`wt_peptide`) - #create dataframes for mt/wt pair - df_mt_peptide <- data.frame("aa" = unlist(strsplit(peptide_names[i], "", fixed = TRUE)), "x_pos" = c(1:nchar(peptide_names[i]))) - df_mt_peptide$mutation <- "not_mutated" - df_mt_peptide$type <- "mt" - df_mt_peptide$y_pos <- (i * 2 - 1) * -1 - df_mt_peptide$length <- mt_peptide_length - df_mt_peptide[mutation_pos, "mutation"] <- "mutated" - df_wt_peptide <- data.frame("aa" = unlist(strsplit(wt_peptide, "", fixed = TRUE)), "x_pos" = c(1:nchar(wt_peptide))) - df_wt_peptide$mutation <- "not_mutated" - df_wt_peptide$type <- "wt" - df_wt_peptide$y_pos <- (i * 2) * -1 - df_wt_peptide$length <- nchar(wt_peptide) - all_peptides[[i]] <- rbind(df_mt_peptide, df_wt_peptide) - } - incProgress(0.4) - all_peptides <- do.call(rbind, all_peptides) - peptide_table <- do.call("rbind", lapply(peptide_names, table_formatting, peptide_data)) - peptide_table_filtered <- Filter(function(x) length(unique(x)) != 1, peptide_table) - peptide_table_names <- names(peptide_table_filtered) - hla_list <- peptide_table_names[grepl("^HLA-*", peptide_table_names)] - hla_data <- data.frame(hla = hla_list) - hla_sep <- max(nchar(peptide_table$`Peptide Sequence`)) - hla_data$y_pos <- 1 - hla_data$x_pos <- hla_sep / 2 - pad <- 3 - all_peptides_multiple_hla <- list() - incProgress(0.1) - for (i in 1:length(hla_list)) { - hla_data$x_pos[i] <- hla_data$x_pos[i] + (hla_sep + pad) * (i - 1) - omit_rows <- which(is.na(peptide_table_filtered[names(peptide_table_filtered) == hla_list[[i]]])) * -1 - all_peptides_multiple_hla[[i]] <- all_peptides[!(all_peptides$y_pos %in% omit_rows), ] - all_peptides_multiple_hla[[i]]$color_value <- apply(all_peptides_multiple_hla[[i]], 1, function(x) peptide_coloring(hla_list[[i]], x)) - all_peptides_multiple_hla[[i]]$x_pos <- all_peptides_multiple_hla[[i]]$x_pos + (hla_sep + pad) * (i - 1) - } - incProgress(0.2) - all_peptides_multiple_hla <- do.call(rbind, all_peptides_multiple_hla) - h_line_pos <- data.frame(y_pos = seq(min(all_peptides_multiple_hla["y_pos"]) - 0.5, max(all_peptides_multiple_hla["y_pos"]) - 1.5, 2), x_pos = c(min(all_peptides_multiple_hla["x_pos"]) - 1)) - h_line_pos <- rbind(h_line_pos, data.frame(x_pos = max(all_peptides_multiple_hla["x_pos"]) + 1, y_pos = seq(min(all_peptides_multiple_hla["y_pos"]) - 0.5, max(all_peptides_multiple_hla["y_pos"]) - 1.5, 2))) - incProgress(0.2) - p1 <- p1 + - geom_rect(data = all_peptides_multiple_hla, aes(xmin = x_pos - 0.5, xmax = 1 + x_pos - 0.5, ymin = .5 + y_pos, ymax = -.5 + y_pos), fill = all_peptides_multiple_hla$color_value) + - geom_text(data = all_peptides_multiple_hla, aes(x = x_pos, y = y_pos, label = aa, color = mutation), size = 5) + - geom_text(data = hla_data, aes(x = x_pos, y = y_pos, label = hla), size = 5, fontface = "bold") + - geom_line(data = h_line_pos, (aes(x = x_pos, y = y_pos, group = y_pos)), linetype = "dashed") - p1 <- p1 + scale_color_manual("mutation", values = c("not_mutated" = "#000000", "mutated" = "#e74c3c")) - p1 <- p1 + theme_void() + theme(legend.position = "none", panel.border = element_blank()) - print(p1) - }else { - p1 <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p1) - } - }) - }, height = 500, width = 1000) - ##updating IC50 binding score for selected peptide pair - bindingScoreDataIC50 <- reactive({ - if (is.null(df$metricsData)) { - return() - } - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - algorithm_names <- data.frame(algorithms = selectedPeptideData()$individual_ic50_calls$algorithms) - wt_data <- as.data.frame(selectedPeptideData()$individual_ic50_calls$WT, check.names = FALSE) - colnames(wt_data) <- paste(colnames(wt_data), "_WT_Score", sep = "") - mt_data <- as.data.frame(selectedPeptideData()$individual_ic50_calls$MT, check.names = FALSE) - colnames(mt_data) <- paste(colnames(mt_data), "_MT_Score", sep = "") - full_data <- cbind(algorithm_names, mt_data, wt_data) %>% - gather("col", "val", colnames(mt_data)[1]:tail(colnames(wt_data), n = 1)) %>% - separate(col, c("HLA_allele", "Mutant", "Score"), sep = "\\_") %>% - spread("Score", val) - full_data - }else { - return() - } - }) - ##plotting IC5 binding score violin plot - output$bindingData_IC50 <- renderPlot({ - withProgress(message = "Loading Binding Score Plot (IC50)", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - line.data <- data.frame(yintercept = c(500, 1000), Cutoffs = c("500nM", "1000nM"), color = c("#28B463", "#EC7063")) - hla_allele_count <- length(unique(bindingScoreDataIC50()$HLA_allele)) - incProgress(0.5) - p <- ggplot(data = bindingScoreDataIC50(), aes(x = Mutant, y = Score, color = Mutant), trim = FALSE) + geom_violin() + facet_grid(cols = vars(HLA_allele)) + scale_y_continuous(trans = "log10") + #coord_trans(y = "log10") + - stat_summary(fun.y = mean, fun.ymin = mean, fun.ymax = mean, geom = "crossbar", width = 0.25, position = position_dodge(width = .25)) + - geom_jitter(data = bindingScoreDataIC50(), aes(shape = algorithms), sizes = 5, stroke = 1, position = position_jitter(0.3)) + - scale_shape_manual(values = 0:8) + - geom_hline(aes(yintercept = yintercept, linetype = Cutoffs), line.data, color = rep(line.data$color, hla_allele_count)) + - scale_color_manual(values = rep(c("MT" = "#D2B4DE", "WT" = "#F7DC6F"), hla_allele_count)) + - theme(strip.text = element_text(size = 15), axis.text = element_text(size = 10), axis.title = element_text(size = 15), axis.ticks = element_line(size = 3), legend.text = element_text(size = 15), legend.title = element_text(size = 15)) - incProgress(0.5) - print(p) - }else { - p <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p) - } - }) - }) - ##updating percentile binding score for selected peptide pair - bindingScoreDataPercentile <- reactive({ - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - algorithm_names <- data.frame(algorithms = selectedPeptideData()$individual_percentile_calls$algorithms) - wt_data <- as.data.frame(selectedPeptideData()$individual_percentile_calls$WT, check.names = FALSE) - colnames(wt_data) <- paste(colnames(wt_data), "_WT_Score", sep = "") - mt_data <- as.data.frame(selectedPeptideData()$individual_percentile_calls$MT, check.names = FALSE) - colnames(mt_data) <- paste(colnames(mt_data), "_MT_Score", sep = "") - full_data <- cbind(algorithm_names, mt_data, wt_data) %>% - gather("col", "val", colnames(mt_data)[1]:tail(colnames(wt_data), n = 1)) %>% - separate(col, c("HLA_allele", "Mutant", "Score"), sep = "\\_") %>% - spread("Score", val) - full_data - }else { - return() - } - }) - ##plotting percentile binding score violin plot - output$bindingData_percentile <- renderPlot({ - withProgress(message = "Loading Binding Score Plot (Percentile)", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - line.data <- data.frame(yintercept = c(0.5, 2), Cutoffs = c("0.5%", "2%"), color = c("#28B463", "#EC7063")) - hla_allele_count <- length(unique(bindingScoreDataPercentile()$HLA_allele)) - incProgress(0.5) - p <- ggplot(data = bindingScoreDataPercentile(), aes(x = Mutant, y = Score, color = Mutant), trim = FALSE) + geom_violin() + facet_grid(cols = vars(HLA_allele)) + scale_y_continuous(trans = "log10") + #coord_trans(y = "log10") + - stat_summary(fun.y = mean, fun.ymin = mean, fun.ymax = mean, geom = "crossbar", width = 0.25, position = position_dodge(width = .25)) + - geom_jitter(data = bindingScoreDataPercentile(), aes(shape = algorithms), size = 5, stroke = 1, position = position_jitter(0.3)) + - scale_shape_manual(values = 0:8) + - geom_hline(aes(yintercept = yintercept, linetype = Cutoffs), line.data, color = rep(line.data$color, hla_allele_count)) + - scale_color_manual(values = rep(c("MT" = "#D2B4DE", "WT" = "#F7DC6F"), hla_allele_count)) + - theme(strip.text = element_text(size = 15), axis.text = element_text(size = 10), axis.title = element_text(size = 15), axis.ticks = element_line(size = 3), legend.text = element_text(size = 15), legend.title = element_text(size = 15)) - incProgress(0.5) - print(p) - }else { - p <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p) - } - }) - }) - ##plotting binding data table with IC50 and percentile values - output$bindingDatatable <- renderDT({ - withProgress(message = "Loading binding datatable", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - binding_data <- bindingScoreDataIC50() - names(binding_data)[names(binding_data) == "Score"] <- "IC50 Score" - binding_data["% Score"] <- bindingScoreDataPercentile()["Score"] - binding_data["Score"] <- paste(round(as.numeric(binding_data$`IC50 Score`), 2), " (%: ", round(as.numeric(binding_data$`% Score`), 2), ")", sep = "") - binding_data["IC50 Score"] <- NULL - binding_data["% Score"] <- NULL - binding_reformat <- dcast(binding_data, HLA_allele + Mutant ~ algorithms, value.var = "Score") - incProgress(1) - dtable <- datatable(binding_reformat, options = list( - pageLength = 10, - lengthMenu = c(10), - rowCallback = JS("function(row, data, index, rowId) {", - "if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {", - 'row.style.backgroundColor = "#E0E0E0";', "}", "}") - )) %>% formatStyle("Mutant", fontWeight = styleEqual("MT", "bold"), color = styleEqual("MT", "#E74C3C")) - dtable - }else { - incProgress(1) - datatable(data.frame("Binding Predictions Datatable" = character())) - } - }) - }) - ##updating elution score for selected peptide pair - elutionScoreData <- reactive({ - if (is.null(df$metricsData)) { - return() - } - if (length(df$metricsData[[selectedID()]]$sets) != 0 && length(selectedPeptideData()$individual_el_calls$algorithms) > 0) { - algorithm_names <- data.frame(algorithms = selectedPeptideData()$individual_el_calls$algorithms) - wt_data <- as.data.frame(selectedPeptideData()$individual_el_calls$WT, check.names = FALSE) - colnames(wt_data) <- paste(colnames(wt_data), "_WT_Score", sep = "") - mt_data <- as.data.frame(selectedPeptideData()$individual_el_calls$MT, check.names = FALSE) - colnames(mt_data) <- paste(colnames(mt_data), "_MT_Score", sep = "") - full_data <- cbind(algorithm_names, mt_data, wt_data) %>% - gather("col", "val", colnames(mt_data)[1]:tail(colnames(wt_data), n = 1)) %>% - separate(col, c("HLA_allele", "Mutant", "Score"), sep = "\\_") %>% - spread("Score", val) - full_data - }else { - return() - } - }) - ##updating elution percentile for selected peptide pair - elutionPercentileData <- reactive({ - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - algorithm_names <- data.frame(algorithms = selectedPeptideData()$individual_el_percentile_calls$algorithms) - wt_data <- as.data.frame(selectedPeptideData()$individual_el_percentile_calls$WT, check.names = FALSE) - colnames(wt_data) <- paste(colnames(wt_data), "_WT_Score", sep = "") - mt_data <- as.data.frame(selectedPeptideData()$individual_el_percentile_calls$MT, check.names = FALSE) - colnames(mt_data) <- paste(colnames(mt_data), "_MT_Score", sep = "") - full_data <- cbind(algorithm_names, mt_data, wt_data) %>% - gather("col", "val", colnames(mt_data)[1]:tail(colnames(wt_data), n = 1)) %>% - separate(col, c("HLA_allele", "Mutant", "Score"), sep = "\\_") %>% - spread("Score", val) - full_data - }else { - return() - } - }) - ##plotting elution data table - output$elutionDatatable <- renderDT({ - withProgress(message = "Loading elution datatable", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - elution_data <- elutionScoreData() - if (!is.null(elution_data)) { - names(elution_data)[names(elution_data) == "Score"] <- "Elution Score" - elution_data["% Score"] <- elutionPercentileData()["Score"] - elution_data["Score"] <- paste(round(as.numeric(elution_data$`Elution Score`), 2), " (%: ", round(as.numeric(elution_data$`% Score`), 2), ")", sep = "") - elution_data["Elution Score"] <- NULL - elution_data["% Score"] <- NULL - elution_reformat <- dcast(elution_data, HLA_allele + Mutant ~ algorithms, value.var = "Score") - incProgress(1) - dtable <- datatable(elution_reformat, options = list( - pageLength = 10, - lengthMenu = c(10), - rowCallback = JS("function(row, data, index, rowId) {", - "if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {", - 'row.style.backgroundColor = "#E0E0E0";', "}", "}") - )) %>% formatStyle("Mutant", fontWeight = styleEqual("MT", "bold"), color = styleEqual("MT", "#E74C3C")) - dtable - }else { - incProgress(1) - datatable(data.frame("Elution Datatable" = character())) - } - }else { - incProgress(1) - datatable(data.frame("Elution Datatable" = character())) - } - }) - }) - - ##updating reference matches for selected peptide - output$hasReferenceMatchData <- reactive({ - if (is.null(df$metricsData[[selectedID()]]$reference_matches)) { - "Reference Similarity not run" - } else { - "" - } - }) - referenceMatchData <- reactive({ - if (length(df$metricsData[[selectedID()]]$reference_matches$matches) != 0) { - as.data.frame(df$metricsData[[selectedID()]]$reference_matches$matches, check.names = False) - }else { - return() - } - }) - output$referenceMatchHitCount <- reactive({ - if (is.null(df$metricsData[[selectedID()]]$reference_matches)) { - "N/A" - } else { - df$metricsData[[selectedID()]]$reference_matches$count - } - }) - output$referenceMatchQuerySequence <- reactive({ - if (is.null(df$metricsData[[selectedID()]]$reference_matches)) { - "N/A" - } else { - df$metricsData[[selectedID()]]$reference_matches$query_peptide - } - }) - output$referenceMatchDatatable <- renderDT({ - withProgress(message = "Loading reference match datatable", value = 0, { - reference_match_data <- referenceMatchData() - if (!is.null(reference_match_data)) { - incProgress(1) - dtable <- datatable(reference_match_data, options = list( - pageLength = 10, - lengthMenu = c(10) - ), - style="bootstrap") %>% - formatStyle("Matched Peptide", fontFamily="monospace") - dtable - } else { - incProgress(1) - datatable(data.frame("Reference Matches Datatable" = character())) - } - }) - }) - ##Best Peptide with mutated positions marked - output$referenceMatchPlot <- renderPlot({ - withProgress(message = "Loading Reference Match Best Peptide Plot", value = 0, { - selectedPosition <- if (is.null(df$selectedRow)) { - df$mainTable$`Pos`[1] - }else { - df$mainTable$`Pos`[df$selectedRow] - } - selectedPeptide <- if (is.null(df$selectedRow)) { - df$mainTable$`Best Peptide`[1] - }else { - df$mainTable$`Best Peptide`[df$selectedRow] - } - #set & constrain mutation_pos' to not exceed length of peptide (may happen if mutation range goes off end) - mutation_pos <- range_str_to_seq(selectedPosition) - peptide_length <- nchar(selectedPeptide) - mutation_pos <- mutation_pos[mutation_pos <= peptide_length] - #create dataframes - df_peptide <- data.frame("aa" = unlist(strsplit(selectedPeptide, "", fixed = TRUE)), "x_pos" = c(1:nchar(selectedPeptide))) - df_peptide$mutation <- "not_mutated" - df_peptide$type <- "mt" - df_peptide$y_pos <- 1.05 - df_peptide$x_pos <- seq(0.05, peptide_length*0.1+0.05, length.out=peptide_length) - df_peptide$length <- peptide_length - df_peptide[mutation_pos, "mutation"] <- "mutated" - ref_match_colors <- rep("white", peptide_length) - x1_bins = seq(0, peptide_length*0.1, length.out=peptide_length) - x2_start = peptide_length*0.1/(peptide_length-1) - x2_bins = seq(x2_start, peptide_length*0.1+x2_start, length.out=peptide_length) - ref_match_color_pos <- data.frame(d = df_peptide, x1 = x1_bins, x2 = x2_bins, y1 = rep(1, peptide_length), y2 = rep(1.1, peptide_length), colors = ref_match_colors) - p2 <- ggplot() + - geom_rect(data = ref_match_color_pos, aes(xmin = x1, xmax = x2, ymin = y1, ymax = y2, fill = colors), color = "black", alpha = 1) + - geom_text(data = df_peptide, aes(x = x_pos, y = y_pos, label = aa, color = mutation), size = 5) + - scale_fill_identity() + - coord_fixed() + - theme_void() + theme(legend.position = "none", panel.border = element_blank(), plot.margin = margin(0, 0, 0, 0, "pt")) - p2 <- p2 + scale_color_manual("mutation", values = c("not_mutated" = "#000000", "mutated" = "#e74c3c")) - print(p2) - }) - }, height = 20, width = function(){ - selectedPeptide <- if (is.null(df$selectedRow)) { - df$mainTable$`Best Peptide`[1] - }else { - df$mainTable$`Best Peptide`[df$selectedRow] - } - nchar(selectedPeptide) * 20 - } ) - ##Best Peptide with best peptide highlighted and mutated positions marked - output$referenceMatchQueryPlot <- renderPlot({ - withProgress(message = "Loading Reference Match Query Peptide Plot", value = 0, { - selectedPosition <- if (is.null(df$selectedRow)) { - df$mainTable$`Pos`[1] - }else { - df$mainTable$`Pos`[df$selectedRow] - } - selectedPeptide <- if (is.null(df$selectedRow)) { - df$mainTable$`Best Peptide`[1] - }else { - df$mainTable$`Best Peptide`[df$selectedRow] - } - mutation_pos <- range_str_to_seq(selectedPosition) - #remove leading amino acids from the selectedPeptide that don't occur in - #the query peptide - if (mutation_pos[1] > 8) { - offset <- mutation_pos[1] - 8 - selectedPeptide <- substr(selectedPeptide, offset + 1, nchar(selectedPeptide)) - mutation_pos <- mutation_pos - offset - } - if (!is.null(df$metricsData[[selectedID()]]$reference_matches)) { - queryPeptide <- df$metricsData[[selectedID()]]$reference_matches$query_peptide - peptide_length <- nchar(queryPeptide) - ref_match_colors <- rep("white", peptide_length) - #set & constrain mutation_pos' to not exceed length of peptide (may happen if mutation range goes off end) - bestPeptidePos <- str_locate(queryPeptide, fixed(selectedPeptide)) - #if the selectedPeptide is not found in the queryPeptide there are - #trailing amino acids that don't occur in the queryPeptide - remove them - while (is.na(bestPeptidePos[, 1])) { - selectedPeptide <- substr(selectedPeptide, 1, nchar(selectedPeptide) - 1) - bestPeptidePos <- str_locate(queryPeptide, fixed(selectedPeptide)) - } - best_peptide_positions <- seq(bestPeptidePos[, 1], bestPeptidePos[, 2]) - mutation_pos <- mutation_pos + bestPeptidePos[, 1] - 1 - mutation_pos <- mutation_pos[mutation_pos <= peptide_length] - ref_match_colors[best_peptide_positions] <- "yellow" - #create dataframes - df_peptide <- data.frame("aa" = unlist(strsplit(queryPeptide, "", fixed = TRUE)), "x_pos" = c(1:nchar(queryPeptide))) - df_peptide$mutation <- "not_mutated" - df_peptide$type <- "mt" - df_peptide$y_pos <- 1.05 - df_peptide$x_pos <- seq(0.05, peptide_length*0.1+0.05, length.out=peptide_length) - df_peptide$length <- peptide_length - df_peptide[mutation_pos, "mutation"] <- "mutated" - x1_bins = seq(0, peptide_length*0.1, length.out=peptide_length) - x2_start = peptide_length*0.1/(peptide_length-1) - x2_bins = seq(x2_start, peptide_length*0.1+x2_start, length.out=peptide_length) - ref_match_color_pos <- data.frame(d = df_peptide, x1 = x1_bins, x2 = x2_bins, y1 = rep(1, peptide_length), y2 = rep(1.1, peptide_length), colors = ref_match_colors) - p3 <- ggplot() + - geom_rect(data = ref_match_color_pos, aes(xmin = x1, xmax = x2, ymin = y1, ymax = y2, fill = colors), color = "black", alpha = 1) + - geom_text(data = df_peptide, aes(x = x_pos, y = y_pos, label = aa, color = mutation), size = 5) + - scale_fill_identity() + - coord_fixed() + - theme_void() + theme(legend.position = "none", panel.border = element_blank(), plot.margin = margin(0, 0, 0, 0, "pt")) - p3 <- p3 + scale_color_manual("mutation", values = c("not_mutated" = "#000000", "mutated" = "#e74c3c")) - incProgress(1) - print(p3) - } else { - p3 <- ggplot() + annotate(geom = "text", x = 0, y = 0, label = "N/A", size = 5) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p3) - } - }) - }, height = 20, width = function(){ - if (is.null(df$metricsData[[selectedID()]]$reference_matches$query_peptide)) { - return(40) - } else { - return(nchar(df$metricsData[[selectedID()]]$reference_matches$query_peptide) * 20) - } - } ) - ##############################EXPORT TAB############################################## - #evalutation overview table - output$checked <- renderTable({ - if (is.null(df$mainTable)) { - return() - } - Evaluation <- data.frame(selected = shinyValue("selecter_", nrow(df$mainTable), df$mainTable)) - data <- as.data.frame(table(Evaluation)) - data$Count <- data$Freq - data$Freq <- NULL - data - }) - #export table display with options to download - output$ExportTable <- renderDataTable({ - if (is.null(df$mainTable)) { - return() - } - colsToDrop <- colnames(df$mainTable) %in% c("Evaluation", "Eval", "Select", "Scaled BA", "Scaled percentile", "Tier Count", "Bad TSL", - "Comments", "Gene of Interest", "Bad TSL", "Col RNA Expr", "Col RNA VAF", "Col Allele Expr", - "Col RNA Depth", "Col DNA VAF", "Percentile Fail", "Has Prob Pos") - data <- df$mainTable[, !(colsToDrop)] - col_names <- colnames(data) - data <- data.frame(data, Evaluation = shinyValue("selecter_", nrow(df$mainTable), df$mainTable)) - colnames(data) <- c(col_names, "Evaluation") - comments <- data.frame("ID" = row.names(df$comments), Comments = df$comments[, 1]) - data <- join(data, comments) - data[is.na(data)] <- "NA" - data - }, escape = FALSE, server = FALSE, rownames = FALSE, - options = list(dom = "Bfrtip", - buttons = list( - list(extend = "csvHtml5", - filename = input$exportFileName, - fieldSeparator = "\t", - text = "Download as TSV", - extension = ".tsv"), - list(extend = "excel", - filename = input$exportFileName, - text = "Download as excel") - ), - initComplete = htmlwidgets::JS( - "function(settings, json) {", - paste0("$(this.api().table().header()).css({'font-size': '", "8pt", "'});"), - "}") - ), - selection = "none", - extensions = c("Buttons")) - - - ### Other Modules ############################################################ - - - ############### NeoFox Tab ########################## - df_neofox <- reactiveValues( - mainTable_neofox = NULL - ) - observeEvent(input$loadDefaultneofox, { - #session$sendCustomMessage("unbind-DT", "neofoxTable") - #data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/f83c52c8b8387beae69be8b200a44dcf199d9af2/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_I.all_epitopes.aggregated.tsv") - #mainData <- read.table(text = data, sep = '\t', header = FALSE, stringsAsFactors = FALSE, check.names=FALSE) - #data <- getURL("https://raw.githubusercontent.com/TRON-Bioinformatics/neofox/master/neofox/tests/resources/synthetic_data/neoantigens_no_wt_100patients_10neoantigens.1.txt") - #mainData <- read.table(text = data, sep = '\t', header = FALSE, stringsAsFactors = FALSE, check.names=FALSE) - #data <- "/Users/evelynschmidt/pVACtools/pvactools/tools/pvacview_dev/neoantigens_10patients_10neoantigens.4.tsv" - #mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - data_neofox <- "/Users/evelynschmidt/pVACtools/pvactools/tools/pvacview_dev_eve/test_data/test_pt1_neoantigen_candidates_annotated.tsv" - mainData_neofox <- read.table(data_neofox, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData_neofox) <- mainData_neofox[1, ] - mainData_neofox <- mainData_neofox[-1, ] - row.names(mainData_neofox) <- NULL - df_neofox$mainTable_neofox <- mainData_neofox - updateTabItems(session, "neofox_tabs", "neofox_explore") - }) - output$neofox_upload_ui <- renderUI({ - fileInput(inputId = "neofox_data", label = "NeoFox output table (tsv required)", - accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) - }) - observeEvent(input$neofox_data$datapath, { - #session$sendCustomMessage("unbind-DT", "neofoxTable") - mainData_neofox <- read.table(input$neofox_data$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData_neofox) <- mainData_neofox[1, ] - mainData_neofox <- mainData_neofox[-1, ] - row.names(mainData_neofox) <- NULL - df_neofox$mainTable_neofox <- mainData_neofox - }) - observeEvent(input$visualize_neofox, { - updateTabItems(session, "neofox_tabs", "neofox_explore") - }) - - observeEvent(input$neofox_page_length, { - if (is.null(df_neofox$mainTable_neofox)) { - return() - } - df$pageLength <- as.numeric(input$neofox_page_length) - }) - - # output$neofoxTable <- DT::renderDataTable( - # if (is.null(df_neofox$mainTable_neofox)) { - # return(datatable(data.frame("Annotated Table" = character()))) - # } else { - # datatable(df_neofox$mainTable_neofox, - # escape = FALSE, class = "stripe", - # options = list( - # lengthChange = FALSE, - # dom = "Bfrtip", - # server = FALSE, # Enable server-side processing - # processing = TRUE, - # pageLength = input$neofox_page_length, - # columnDefs = list(list(visible = FALSE, targets = c(-1:-12)), - # list(orderable = TRUE, targets = 0)), - # buttons = list(I("colvis")) - # ), - # selection = "multiple", - # extensions = c("Buttons") - # ) - # } - # ) - - output$neofoxTable <- DT::renderDataTable( - if (is.null(df_neofox$mainTable_neofox)) { - return(datatable(data.frame("Annotated Table" = character()))) - } else { - datatable(df_neofox$mainTable_neofox, - escape = FALSE, class = "stripe", - selection = "multiple", - extensions = c("Buttons") - - ) - } - ) - - - output$neofox_selected <- renderText({ - if (is.null(df_neofox$mainTable_neofox)) { - return() - } - input$neofoxTable_rows_selected - }) - - - output$noefox_features_ui1 <- renderUI({ - df <- df_neofox$mainTable_neofox - df <- type.convert(df, as.is = TRUE) - df[is.na(df)] <- 0 - - feature <- names(df)[sapply(df, is.numeric)] - default_selection <- "imputedGeneExpression" - pickerInput(inputId = "x_scatter", - label = "X Axis", - choices = feature, - selected = default_selection, - options = list(`live-search` = TRUE), - multiple = FALSE - ) - }) - - output$noefox_features_ui2 <- renderUI({ - df <- df_neofox$mainTable_neofox - df <- type.convert(df, as.is = TRUE) - df[is.na(df)] <- 0 - - feature <- names(df)[sapply(df, is.numeric)] - default_selection <- "DAI_MHCI_bestAffinity" - pickerInput(inputId = "y_scatter", - label = "Y Axis", - choices = feature, - selected = default_selection, - options = list(`live-search` = TRUE), - multiple = FALSE - ) - }) - - output$noefox_features_ui3 <- renderUI({ - df <- df_neofox$mainTable_neofox - df <- type.convert(df, as.is = TRUE) - df[is.na(df)] <- 0 - - feature <- names(df)[sapply(df, is.numeric)] - default_selection <- "IEDB_Immunogenicity_MHCI" - pickerInput(inputId = "color_scatter", - label = "Color", - choices = feature, - selected = default_selection, - options = list(`live-search` = TRUE), - multiple = FALSE - ) - }) - - output$noefox_features_ui4 <- renderUI({ - df <- df_neofox$mainTable_neofox - df <- type.convert(df, as.is = TRUE) - df[is.na(df)] <- 0 - - feature <- names(df)[sapply(df, is.numeric)] - default_selection <- "Vaxrank_totalScore" - pickerInput(inputId = "size_scatter", - label = "Size", - choices = feature, - selected = default_selection, - options = list(`live-search` = TRUE), - multiple = FALSE - ) - }) - - output$scatter <- renderPlot({ - withProgress(message = "Loading Scatter Plots", value = 0, { - req(input$x_scatter, input$y_scatter) # Use req() to check if inputs are not NULL - - df <- df_neofox$mainTable_neofox - df <- type.convert(df, as.is = TRUE) - df[is.na(df)] <- 0 - - df$Selected <- "No" - df[input$neofoxTable_rows_selected, "Selected"] <- "Yes" - - scatter_plot <- ggplot(df, aes(x = .data[[input$x_scatter]], y = .data[[input$y_scatter]])) + - geom_point(aes(color = .data[[input$color_scatter]], size = .data[[input$size_scatter]])) + # Correct placement of aes() here - scale_color_gradient(low = "grey", high = "blue") + - theme(strip.text = element_text(size = 15), axis.text = element_text(size = 10), axis.title = element_text(size = 15), axis.ticks = element_line(size = 3), legend.text = element_text(size = 15), legend.title = element_text(size = 15)) - - incProgress(1) - print(scatter_plot) - }) - }) - - - - # Drop down to select what features to show violin plots for - # only allow to select 5 - output$noefox_features_ui <- renderUI({ - df <- df_neofox$mainTable_neofox - df <- type.convert(df, as.is = TRUE) - df[is.na(df)] <- 0 - feature <- names(df)[sapply(df, is.numeric)] - - default_selection <- c("imputedGeneExpression", "DAI_MHCI_bestAffinity", "IEDB_Immunogenicity_MHCI", "IEDB_Immunogenicity_MHCII", "MixMHCpred_bestScore_rank", "HexAlignmentScore_MHCI") - - pickerInput(inputId = "neofox_features", - label = "Plots to Display", - choices = feature, - selected = default_selection, - options = list(`live-search` = TRUE, "max-options" = 6), - multiple = TRUE, - ) - }) - - # Violin Plots - output$neofox_violin_plots_row1 <- renderPlot({ - withProgress(message = "Loading Violin Plots", value = 0, { - if (length(input$neofoxTable_rows_selected) != 0 & length(input$neofox_features) != 0) { - - plot_cols_neofox <- c("mutatedXmer", input$neofox_features) - plot_data_neofox <- df_neofox$mainTable_neofox[, plot_cols_neofox] - plot_data_neofox <- type.convert(plot_data_neofox, as.is = TRUE) - plot_data_neofox[is.na(plot_data_neofox)] <- 0 - - plot_data_neofox$Selected <- "No" - plot_data_neofox[input$neofoxTable_rows_selected, "Selected"] <- "Yes" - #reformat_data_neofox <- plot_data_neofox %>% - #gather("Feature", "Value", colnames(plot_data_neofox)[2]:tail(colnames(plot_data_neofox), n = 2)) - reformat_data_neofox <- plot_data_neofox %>% - gather("Feature", "Value", -c("mutatedXmer", "Selected")) - - - p_neofox <- ggplot(reformat_data_neofox, aes(x = "", y = Value)) + geom_violin() + - geom_jitter(data = reformat_data_neofox[reformat_data_neofox["Selected"] == "No", ], aes(color = Selected), size = 1, alpha = 0.5, stroke = 1, position = position_jitter(0.3)) + - geom_jitter(data = reformat_data_neofox[reformat_data_neofox["Selected"] == "Yes", ], aes(color = Selected), size = 2, alpha = 1, stroke = 1, position = position_jitter(0.3)) + - scale_color_manual(values = c("No" = "#939094", "Yes" = "#f42409")) + - labs(x = NULL) + - facet_wrap(~Feature, scales="free", ncol=6) + - theme(strip.text = element_text(size = 15), axis.text = element_text(size = 10), axis.title = element_text(size = 10), axis.ticks = element_line(size = 3), legend.text = element_text(size = 10), legend.title = element_text(size = 10)) - - incProgress(0.5) - print(p_neofox) - }else { - p_neofox <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p_neofox) - } - }) - }) - - ############### Custom Tab ########################## - df_custom <- reactiveValues( - selectedRow = 1, - fullData = NULL, - mainTable = NULL, - group_inds = NULL, - metricsData = NULL, - pageLength = 10, - groupBy = NULL, - orderBy = NULL, - peptide_features = NULL - ) - observeEvent(input$loadDefault_Vaxrank, { - data <- "/Users/evelynschmidt/pVACtools/pvactools/tools/pvacview_dev_eve/test_data/vaxrank_output.tsv" - mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_custom$fullData <- mainData - }) - observeEvent(input$loadDefault_Neopredpipe, { - data <- "/Users/evelynschmidt/pVACtools/pvactools/tools/pvacview_dev_eve/test_data/HCC1395Run.neoantigens.txt" - mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_custom$fullData <- mainData - }) - observeEvent(input$loadDefault_antigengarnish, { - data <- "/Users/evelynschmidt/pVACtools/pvactools/tools/pvacview_dev_eve/test_data/ag_test_antigen.tsv" - mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_custom$fullData <- mainData - }) - output$custom_upload_ui <- renderUI({ - fileInput(inputId = "custom_data", label = "Custom input table (tsv required)", - accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) - }) - observeEvent(input$custom_data$datapath, { - mainData <- read.table(input$custom_data$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_custom$fullData <- mainData - }) - - output$custom_group_by_feature_ui <- renderUI({ - feature <- names(df_custom$fullData) - pickerInput(inputId = "feature_1", - label = "Feature to group peptides by", - choices = feature, # a list of strings - #options = list(`actions-box` = TRUE, `live-search` = TRUE), - multiple = FALSE) - }) - output$custom_order_by_feature_ui <- renderUI({ - feature <- names(df_custom$fullData) - pickerInput(inputId = "feature_2", - label = "Feature to sort peptides by", - choices = feature, # a list of strings - #options = list(`actions-box` = TRUE, `live-search` = TRUE), - multiple = FALSE) - }) - output$custom_peptide_features_ui <- renderUI({ - feature <- names(df_custom$fullData) - pickerInput(inputId = "peptide_features", - label = "Subset of features to display in peptide subtable", - choices = feature[((feature != input$feature_2) & (feature != input$feature_1))], # a list of strings - options = list(`actions-box` = TRUE, `live-search` = TRUE), - multiple = TRUE) - }) - observeEvent(input$visualize_custom, { - #browser() - df_custom$groupBy <- input$feature_1 - df_custom$orderBy <- input$feature_2 - reformat_data <- df_custom$fullData %>% group_by(across(all_of(df_custom$groupBy))) %>% arrange(across(all_of(df_custom$orderBy))) - df_custom$fullData <- reformat_data - row_ind <- reformat_data %>% group_rows() - row_ind_df <- as.data.frame(row_ind) - df_custom$group_inds <- row_ind_df - row_ind_top <- apply(row_ind_df, 1, function(x) {unlist(x[1])[1]}) - df_custom$mainTable <- as.data.frame(reformat_data[row_ind_top, ]) - #df_custom$mainTable <- cbind("Eval" = shinyInput(df_custom$mainTable, selectInput, nrow(df_custom$mainTable), "custom_selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px"), df_custom$mainTable) - df_custom$mainTable <- cbind(Select = shinyInputSelect(actionButton, nrow(df_custom$mainTable), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"custom_select_button\", this.id)'), df_custom$mainTable) - #if (is.null(df_custom$mainTable$`Evaluation`)) { - # df_custom$mainTable$`Evaluation` <- rep("Pending", nrow(df_custom$mainTable)) - #} - #gene_data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/7c7b8352d81b44ec7743578e7715c65261f5dab7/pvactools/tools/pvacview/data/cancer_census_hotspot_gene_list.tsv") - #gene_list <- read.table(text = gene_data, sep = '\t', header = FALSE, stringsAsFactors = FALSE, check.names=FALSE) - #df_custom$gene_list <- gene_list - #df_custom$mainTable$`Gene of Interest` <- apply(df_custom$mainTable,1, function(x) {any(x['Gene Name'] == df_custom$gene_list)}) - df_custom$metricsData <- get_group_inds(df_custom$fullData, df_custom$group_inds) - df_custom$peptide_features <- input$peptide_features - updateTabItems(session, "custom_tabs", "custom_explore") - }) - output$customTable <- DT::renderDataTable( - if (is.null(df_custom$mainTable)) { - return(datatable(data.frame("Annotated Table" = character()))) - }else { - datatable(df_custom$mainTable, - escape = FALSE, class = "stripe", - options = list(lengthChange = FALSE, dom = "Bfrtip", pageLength = input$custom_page_length, - columnDefs = list(list(visible = FALSE, targets = c(-1:-12)), - list(orderable = TRUE, targets = 0)), buttons = list(I("colvis")), - initComplete = htmlwidgets::JS( - "function(settings, json) {", - paste("$(this.api().table().header()).css({'font-size': '", "10pt", "'});"), - "}")), - selection = "none", - extensions = c("Buttons")) - }, server = FALSE) - observeEvent(input$custom_select_button, { - if (is.null(df_custom$mainTable) | is.null(df_custom$selectedRow)){ - return () - } - #browser() - df_custom$selectedRow <- as.numeric(strsplit(input$custom_select_button, "_")[[1]][2]) - session$sendCustomMessage('unbind-DT', 'customTable') - dataTableProxy("customMainTable") %>% - selectPage((df_custom$selectedRow-1) %/% df_custom$pageLength + 1) - }) - output$customPeptideTable <- renderDT({ - withProgress(message = 'Loading Peptide Table', value = 0, { - incProgress(0.5) - #browser() - if (!is.null(df_custom$selectedRow) & !(is.null(df_custom$mainTable)) & !is.null(df_custom$peptide_features)){ - display_table <- get_current_group_info(df_custom$peptide_features, df_custom$metricsData, df_custom$fullData, df_custom$selectedRow) - incProgress(0.5) - dtable <- datatable(display_table, options =list( - pageLength = 10, - rowCallback = JS('function(row, data, index, rowId) {', - 'console.log(rowId)','if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {', - 'row.style.backgroundColor = "#E0E0E0";','}','}') - ), selection = list(mode='single', selected = '1')) - dtable - } - else{ - incProgress(1) - datatable(data.frame("Peptide Datatable"=character()), selection = list(mode='single', selected = '1')) - }}) - }) - - -}) diff --git a/pvactools/tools/pvacview_dev_eve/server_original_dev.R b/pvactools/tools/pvacview_dev_eve/server_original_dev.R deleted file mode 100644 index 007b1448d..000000000 --- a/pvactools/tools/pvacview_dev_eve/server_original_dev.R +++ /dev/null @@ -1,1327 +0,0 @@ -library(shiny) -library(ggplot2) -library(DT) -library(reshape2) -library(jsonlite) -library(tibble) -library(tidyr) -library(plyr) -library(dplyr) -library(grid) -library(gridExtra) -library(shinyWidgets) - -source("anchor_and_helper_functions.R", local = TRUE) -source("styling.R") - -#specify max shiny app upload size (currently 300MB) -options(shiny.maxRequestSize = 300 * 1024^2) -options(shiny.host = '127.0.0.1') -options(shiny.port = 3333) - -server <- shinyServer(function(input, output, session) { - - ##############################DATA UPLOAD TAB################################### - ## helper function defined for generating shinyInputs in mainTable (Evaluation dropdown menus) - shinyInput <- function(data, FUN, len, id, ...) { - inputs <- character(len) - for (i in seq_len(len)) { - inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ..., selected = data[i, "Evaluation"])) - } - inputs - } - ## helper function defined for generating shinyInputs in mainTable (Investigate button) - shinyInputSelect <- function(FUN, len, id, ...) { - inputs <- character(len) - for (i in seq_len(len)) { - inputs[i] <- as.character(FUN(paste0(id, i), ...)) - } - inputs - } - ## helper function defined for getting values of shinyInputs in mainTable (Evaluation dropdown menus) - shinyValue <- function(id, len, data) { - unlist(lapply(seq_len(len), function(i) { - value <- input[[paste0(id, i)]] - if (is.null(value)) { - data[i, "Evaluation"] - } else { - value - } - })) - } - #reactive values defined for row selection, main table, metrics data, additional data, and dna cutoff - df <- reactiveValues( - selectedRow = 1, - mainTable = NULL, - dna_cutoff = NULL, - metricsData = NULL, - additionalData = NULL, - gene_list = NULL, - binding_threshold = NULL, - aggregate_inclusion_binding_threshold = NULL, - percentile_threshold = NULL, - binding_cutoffs = NULL, - is_allele_specific_binding_cutoff = NULL, - allele_expr = NULL, - anchor_mode = NULL, - anchor_contribution = NULL, - comments = data.frame("N/A"), - pageLength = 10 - ) - #Option 1: User uploaded main aggregate report file - observeEvent(input$mainDataInput$datapath, { - #session$sendCustomMessage("unbind-DT", "mainTable") - mainData <- read.table(input$mainDataInput$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - mainData$`Eval` <- shinyInput(mainData, selectInput, nrow(mainData), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - mainData$Select <- shinyInputSelect(actionButton, nrow(mainData), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') - mainData$`IC50 MT` <- as.numeric(mainData$`IC50 MT`) - mainData$`%ile MT` <- as.numeric(mainData$`%ile MT`) - mainData$`RNA Depth` <- as.integer(mainData$`RNA Depth`) - mainData$`TSL`[is.na(mainData$`TSL`)] <- "NA" - df$mainTable <- mainData - df$metricsData <- NULL - }) - #Option 1: User uploaded metrics file - observeEvent(input$metricsDataInput, { - df$metricsData <- fromJSON(input$metricsDataInput$datapath) - df$binding_threshold <- df$metricsData$`binding_threshold` - df$aggregate_inclusion_binding_threshold <- df$metricsData$`aggregate_inclusion_binding_threshold` - df$percentile_threshold <- df$metricsData$`percentile_threshold` - df$binding_cutoffs <- df$metricsData$`binding_cutoffs` - df$is_allele_specific_binding_cutoff <- df$metricsData$`is_allele_specific_binding_cutoff` - df$dna_cutoff <- df$metricsData$vaf_clonal - df$allele_expr <- df$metricsData$allele_expr_threshold - df$anchor_mode <- ifelse(df$metricsData$`allele_specific_anchors`, "allele-specific", "default") - df$anchor_contribution <- df$metricsData$`anchor_contribution_threshold` - hla <- names(df$metricsData$binding_cutoffs) - if (input$hla_class == "class_i"){ - converted_hla_names <- unlist(lapply(hla, function(x) {strsplit(x, "HLA-")[[1]][2]})) - } else if (input$hla_class == "class_ii"){ - converted_hla_names <- hla - } - if (!("Ref Match" %in% colnames(df$mainTable))) { - df$mainTable$`Ref Match` <- "Not Run" - } - columns_needed <- c("ID", converted_hla_names, "Gene", "AA Change", "Num Passing Transcripts", "Best Peptide", "Best Transcript", "TSL", "Allele", - "Pos", "Prob Pos", "Num Passing Peptides", "IC50 MT", "IC50 WT", "%ile MT", "%ile WT", "RNA Expr", "RNA VAF", - "Allele Expr", "RNA Depth", "DNA VAF", "Tier", "Ref Match", "Evaluation", "Eval", "Select") - if ("Comments" %in% colnames(df$mainTable)) { - columns_needed <- c(columns_needed, "Comments") - df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) - }else { - df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) - } - df$mainTable <- df$mainTable[, columns_needed] - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) - if ("Comments" %in% colnames(df$mainTable)) { - df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) - }else { - df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) - } - rownames(df$comments) <- df$mainTable$ID - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$binding_cutoffs, df$is_allele_specific_binding_cutoff, df$binding_threshold, x["Allele"], x["IC50 MT"])) - df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse(is.null(df$percentile_threshold), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) - df$mainTable$`Bad TSL` <- apply(df$mainTable, 1, function(x) {x["TSL"] == "NA" | (x["TSL"] != "NA" & x["TSL"] != "Not Supported" & x["TSL"] > df$metricsData$maximum_transcript_support_level)}) - df$mainTable$`Col RNA Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Expr"]), 0, x["RNA Expr"])}) - df$mainTable$`Col RNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA VAF"]), 0, x["RNA VAF"])}) - df$mainTable$`Col Allele Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["Allele Expr"]), 0, x["Allele Expr"])}) - df$mainTable$`Col RNA Depth` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Depth"]), 0, x["RNA Depth"])}) - df$mainTable$`Col DNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["DNA VAF"]), 0, x["DNA VAF"])}) - if (is.null(df$percentile_threshold)) { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) - }else { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) - } - df$mainTable$`Has Prob Pos` <- apply(df$mainTable, 1, function(x) {ifelse(x["Prob Pos"] != "None", TRUE, FALSE)}) - }) - #Option 1: User uploaded additional data file - observeEvent(input$additionalDataInput, { - addData <- read.table(input$additionalDataInput$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(addData) <- addData[1, ] - addData <- addData[-1, ] - row.names(addData) <- NULL - df$additionalData <- addData - }) - #Option 1: User uploaded additional gene list - observeEvent(input$gene_list, { - gene_list <- read.table(input$gene_list$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - df$gene_list <- gene_list - df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) - }) - #Option 2: Load from HCC1395 demo data from github - observeEvent(input$loadDefaultmain, { - ## Class I demo aggregate report - #session$sendCustomMessage("unbind-DT", "mainTable") - #data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/f83c52c8b8387beae69be8b200a44dcf199d9af2/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_I.all_epitopes.aggregated.tsv") - #mainData <- read.table(text = data, sep = '\t', header = FALSE, stringsAsFactors = FALSE, check.names=FALSE) - #data <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/v11/data/H_NJ-HCC1395-HCC1395.all_epitopes.aggregated.all_parameters.7.1000.tsv" - data <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/debugging/MHC_Class_I/mcdb044-tumor-exome.all_epitopes.aggregated.tsv" - mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - mainData$`Eval` <- shinyInput(mainData, selectInput, nrow(mainData), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - mainData$Select <- shinyInputSelect(actionButton, nrow(mainData), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') - mainData$`IC50 MT` <- as.numeric(mainData$`IC50 MT`) - mainData$`%ile MT` <- as.numeric(mainData$`%ile MT`) - mainData$`RNA Depth` <- as.integer(mainData$`RNA Depth`) - mainData$`TSL`[is.na(mainData$`TSL`)] <- "NA" - df$mainTable <- mainData - ## Class I demo metrics file - #metricsdata <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/f83c52c8b8387beae69be8b200a44dcf199d9af2/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_I.all_epitopes.aggregated.metrics.json") - #metricsdata <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/v11/data/H_NJ-HCC1395-HCC1395.all_epitopes.aggregated.all_parameters.7.1000.metrics.json" - metricsdata <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/debugging/MHC_Class_I/mcdb044-tumor-exome.all_epitopes.aggregated.metrics.json" - df$metricsData <- fromJSON(txt = metricsdata) - df$binding_threshold <- df$metricsData$`binding_threshold` - df$aggregate_inclusion_binding_threshold <- df$metricsData$`aggregate_inclusion_binding_threshold` - df$percentile_threshold <- df$metricsData$`percentile_threshold` - df$binding_cutoffs <- df$metricsData$`binding_cutoffs` - df$is_allele_specific_binding_cutoff <- df$metricsData$`is_allele_specific_binding_cutoff` - df$dna_cutoff <- df$metricsData$vaf_clonal - df$allele_expr <- df$metricsData$allele_expr_threshold - df$anchor_mode <- ifelse(df$metricsData$`allele_specific_anchors`, "allele-specific", "default") - df$anchor_contribution <- df$metricsData$`anchor_contribution_threshold` - hla <- names(df$metricsData$binding_cutoffs) - converted_hla_names <- unlist(lapply(hla, function(x) {strsplit(x, "HLA-")[[1]][2]})) - if (!("Ref Match" %in% colnames(df$mainTable))) { - df$mainTable$`Ref Match` <- "Not Run" - } - columns_needed <- c("ID", converted_hla_names, "Gene", "AA Change", "Num Passing Transcripts", "Best Peptide", "Best Transcript", "TSL", "Allele", - "Pos", "Prob Pos", "Num Passing Peptides", "IC50 MT", "IC50 WT", "%ile MT", "%ile WT", "RNA Expr", "RNA VAF", - "Allele Expr", "RNA Depth", "DNA VAF", "Tier", "Ref Match", "Evaluation", "Eval", "Select") - if ("Comments" %in% colnames(df$mainTable)) { - columns_needed <- c(columns_needed, "Comments") - df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) - }else { - df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) - } - df$mainTable <- df$mainTable[, columns_needed] - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - if ("Comments" %in% colnames(df$mainTable)) { - df$comments <- data.frame(data = df$mainTable$`Comments`, nrow = nrow(df$mainTable), ncol = 1) - }else { - df$comments <- data.frame(matrix("No comments", nrow = nrow(df$mainTable)), ncol = 1) - } - rownames(df$comments) <- df$mainTable$ID - ## Class II additional demo aggregate report - add_data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/6c24091a9276618af422c76cc9f1c23f16c2074d/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_II.all_epitopes.aggregated.tsv") - addData <- read.table(text = add_data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(addData) <- addData[1, ] - addData <- addData[-1, ] - row.names(addData) <- NULL - df$additionalData <- addData - ## Hotspot gene list autoload - gene_data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/7c7b8352d81b44ec7743578e7715c65261f5dab7/pvactools/tools/pvacview/data/cancer_census_hotspot_gene_list.tsv") - gene_list <- read.table(text = gene_data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - df$gene_list <- gene_list - df$mainTable$`Gene of Interest` <- apply(df$mainTable, 1, function(x) {any(x["Gene"] == df$gene_list)}) - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$binding_cutoffs, df$is_allele_specific_binding_cutoff, df$binding_threshold, x["Allele"], x["IC50 MT"])) - df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse(is.null(df$percentile_threshold), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) - df$mainTable$`Bad TSL` <- apply(df$mainTable, 1, function(x) {x["TSL"] == "NA" | (x["TSL"] != "NA" & x["TSL"] != "Not Supported" & x["TSL"] > df$metricsData$maximum_transcript_support_level)}) - df$mainTable$`Col RNA Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Expr"]), 0, x["RNA Expr"])}) - df$mainTable$`Col RNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA VAF"]), 0, x["RNA VAF"])}) - df$mainTable$`Col Allele Expr` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["Allele Expr"]), 0, x["Allele Expr"])}) - df$mainTable$`Col RNA Depth` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["RNA Depth"]), 0, x["RNA Depth"])}) - df$mainTable$`Col DNA VAF` <- apply(df$mainTable, 1, function(x) {ifelse(is.na(x["DNA VAF"]), 0, x["DNA VAF"])}) - if (is.null(df$percentile_threshold)) { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) - }else { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) - } - df$mainTable$`Has Prob Pos` <- apply(df$mainTable, 1, function(x) {ifelse(x["Prob Pos"] != "None", TRUE, FALSE)}) - updateTabItems(session, "tabs", "explore") - }) - ##Clear file inputs if demo data load button is clicked - output$aggregate_report_ui <- renderUI({ - input$loadDefaultmain - fileInput(inputId = "mainDataInput", label = "1. Neoantigen Candidate Aggregate Report (tsv required)", - accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) - }) - output$metrics_ui <- renderUI({ - input$loadDefaultmain - fileInput(inputId = "metricsDataInput", label = "2. Neoantigen Candidate Metrics file (json required)", - accept = c("application/json", ".json")) - }) - output$add_file_ui <- renderUI({ - input$loadDefaultmain - fileInput(inputId = "additionalDataInput", label = "3. Additional Neoantigen Candidate Aggregate Report (tsv required)", - accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) - }) - ##Visualize button - observeEvent(input$visualize, { - updateTabItems(session, "tabs", "explore") - }) - ##Parameter UIs - output$binding_threshold_ui <- renderUI({ - current_binding <- df$binding_threshold - max_cutoff <- df$aggregate_inclusion_binding_threshold - numericInput("binding_threshold", "Binding Threshold", current_binding, min = 0, max = max_cutoff, step = 10, width = 500) - }) - output$percentile_threshold_ui <- renderUI({ - current_percentile <- df$percentile_threshold - numericInput("percentile_threshold", "Percentile Threshold", current_percentile, min = 0, max = 100, step = 0.01, width = 500) - }) - output$dna_cutoff_ui <- renderUI({ - current_dna_cutoff <- df$dna_cutoff - numericInput("dna_cutoff", "Clonal DNA VAF (Anything lower than 1/2 of chosen VAF level will be considered subclonal)", current_dna_cutoff, min = 0, max = 1, step = 0.01, width = 500) - }) - output$allele_expr_ui <- renderUI({ - current_allele_expr <- df$allele_expr - numericInput("allele_expr", "Allele Expression cutoff to be considered a Pass variant. Note that this criteria is also used in determining Anchor and Subclonal variants.", current_allele_expr, min = 0, max = 100, step = 0.1, width = 500) - }) - #reactions for once "regenerate table" command is submitted - observeEvent(input$submit, { - session$sendCustomMessage("unbind-DT", "mainTable") - df$binding_threshold <- input$binding_threshold - df$percentile_threshold <- input$percentile_threshold - df$dna_cutoff <- input$dna_cutoff - df$allele_expr <- input$allele_expr - df$mainTable$`Evaluation` <- shinyValue("selecter_", nrow(df$mainTable), df$mainTable) - if (input$use_anchor) { - df$anchor_mode <- "allele-specific" - df$anchor_contribution <- input$anchor_contribution - df$mainTable$`Tier` <- apply(df$mainTable, 1, function(x) tier(x, df$anchor_contribution, input$dna_cutoff, input$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, input$dna_cutoff, input$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - }else { - df$anchor_mode <- "default" - df$mainTable$`Tier` <- apply(df$mainTable, 1, function(x) tier(x, df$anchor_contribution, input$dna_cutoff, input$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, input$dna_cutoff, input$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - } - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$binding_cutoffs, df$is_allele_specific_binding_cutoff, df$binding_threshold, x["Allele"], x["IC50 MT"])) - df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse((is.null(df$percentile_threshold) || is.na(df$percentile_threshold)), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) - if (is.null(df$percentile_threshold) || is.na(df$percentile_threshold)) { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) - }else { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) - } - tier_sorter <- c("Pass", "LowExpr", "Anchor", "Subclonal", "Poor", "NoExpr") - df$mainTable$`Rank_ic50` <- NA - df$mainTable$`Rank_expr` <- NA - df$mainTable$`Rank_ic50` <- rank(as.numeric(df$mainTable$`IC50 MT`), ties.method = "first") - df$mainTable$`Rank_expr` <- rank(desc(as.numeric(df$mainTable$`Allele Expr`)), ties.method = "first") - df$mainTable$`Rank` <- df$mainTable$`Rank_ic50` + df$mainTable$`Rank_expr` - df$mainTable <- df$mainTable %>% - arrange(factor(Tier, levels = tier_sorter), Rank) - df$mainTable$`Rank` <- NULL - df$mainTable$`Rank_ic50` <- NULL - df$mainTable$`Rank_expr` <- NULL - df$mainTable$Select <- shinyInputSelect(actionButton, nrow(df$mainTable), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') - df$mainTable$`Eval` <- shinyInput(df$mainTable, selectInput, nrow(df$mainTable), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - }) - #reset tier-ing with original parameters - observeEvent(input$reset_params, { - session$sendCustomMessage("unbind-DT", "mainTable") - df$binding_threshold <- df$metricsData$`binding_threshold` - df$percentile_threshold <- df$metricsData$`percentile_threshold` - df$dna_cutoff <- df$metricsData$`vaf_clonal` - df$allele_expr <- df$metricsData$`allele_expr` - df$anchor_mode <- ifelse(df$metricsData$`allele_specific_anchors`, "allele-specific", "default") - df$anchor_contribution <- df$metricsData$`anchor_contribution_threshold` - df$mainTable$`Evaluation` <- shinyValue("selecter_", nrow(df$mainTable), df$mainTable) - df$mainTable$`Tier` <- apply(df$mainTable, 1, function(x) tier(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - df$mainTable$`Tier Count` <- apply(df$mainTable, 1, function(x) tier_numbers(x, df$anchor_contribution, df$dna_cutoff, df$allele_expr, x["Pos"], x["Allele"], x["TSL"], df$metricsData[1:15], df$anchor_mode)) - df$mainTable$`Scaled BA` <- apply(df$mainTable, 1, function(x) scale_binding_affinity(df$binding_cutoffs, df$is_allele_specific_binding_cutoff, df$binding_threshold, x["Allele"], x["IC50 MT"])) - df$mainTable$`Scaled percentile` <- apply(df$mainTable, 1, function(x) {ifelse(is.null(df$percentile_threshold), as.numeric(x["%ile MT"]), as.numeric(x["%ile MT"]) / (df$percentile_threshold))}) - if (is.null(df$percentile_threshold)) { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {FALSE}) - }else { - df$mainTable$`Percentile Fail` <- apply(df$mainTable, 1, function(x) {ifelse(as.numeric(x["%ile MT"]) > as.numeric(df$percentile_threshold), TRUE, FALSE)}) - } - tier_sorter <- c("Pass", "LowExpr", "Anchor", "Subclonal", "Poor", "NoExpr") - df$mainTable$`Rank_ic50` <- NA - df$mainTable$`Rank_expr` <- NA - df$mainTable$`Rank_ic50` <- rank(as.numeric(df$mainTable$`IC50 MT`), ties.method = "first") - df$mainTable$`Rank_expr` <- rank(desc(as.numeric(df$mainTable$`Allele Expr`)), ties.method = "first") - df$mainTable$`Rank` <- df$mainTable$`Rank_ic50` + df$mainTable$`Rank_expr` - df$mainTable <- df$mainTable %>% - arrange(factor(Tier, levels = tier_sorter), Rank) - df$mainTable$`Rank` <- NULL - df$mainTable$`Rank_ic50` <- NULL - df$mainTable$`Rank_expr` <- NULL - df$mainTable$Select <- shinyInputSelect(actionButton, nrow(df$mainTable), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"select_button\", this.id)') - df$mainTable$`Eval` <- shinyInput(df$mainTable, selectInput, nrow(df$mainTable), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - }) - #determine hla allele count in order to generate column tooltip locations correctly - hla_count <- reactive({ - which(colnames(df$mainTable) == "Gene") - 1 - }) - #class type of user-provided additional file - type <- reactive({ - switch(input$hla_class, - class_i = 1, - class_ii = 2) - }) - output$type_text <- renderText({ - input$add_file_label - }) - output$paramTable <- renderTable( - data <- data.frame( - "Parameter" = c("Tumor Purity", "VAF Clonal", "VAF Subclonal", "Allele Expression for Passing Variants", - "Binding Threshold", "Binding Threshold for Inclusion into Metrics File", "Maximum TSL", - "Percentile Threshold", "Allele Specific Binding Thresholds", - "MT Top Score Metric", "WT Top Score Metric", - "Allele Specific Anchors Used", "Anchor Contribution Threshold"), - "Value" = c(if (is.null(df$metricsData$tumor_purity)) {"NULL"}else {df$metricsData$tumor_purity}, - df$metricsData$`vaf_clonal`, df$metricsData$`vaf_subclonal`, df$metricsData$`allele_expr_threshold`, - df$metricsData$binding_threshold, df$metricsData$`aggregate_inclusion_binding_threshold`, - df$metricsData$maximum_transcript_support_level, - if (is.null(df$metricsData$percentile_threshold)) {"NULL"}else { df$metricsData$percentile_threshold}, - df$metricsData$allele_specific_binding_thresholds, - df$metricsData$mt_top_score_metric, df$metricsData$wt_top_score_metric, - df$metricsData$allele_specific_anchors, df$metricsData$anchor_contribution_threshold) - ), digits = 3 - ) - output$bindingParamTable <- renderTable( - data <- data.frame( - "HLA Alleles" = names(df$metricsData$binding_cutoffs), - "Binding Cutoffs" = unlist(lapply(names(df$metricsData$binding_cutoffs), function(x) df$metricsData$binding_cutoffs[[x]])) - ) - ) - output$comment_text <- renderUI({ - if (is.null(df$mainTable)) { - return(HTML("N/A")) - } - HTML(paste(df$comments[selectedID(), 1])) - }) - observeEvent(input$page_length, { - if (is.null(df$mainTable)) { - return() - } - df$pageLength <- as.numeric(input$page_length) - session$sendCustomMessage("unbind-DT", "mainTable") - df$mainTable$`Evaluation` <- shinyValue("selecter_", nrow(df$mainTable), df$mainTable) - df$mainTable$`Eval` <- shinyInput(df$mainTable, selectInput, nrow(df$mainTable), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - }) - output$filesUploaded <- reactive({ - val <- !(is.null(df$mainTable) | is.null(df$metricsData)) - print(val) - }) - outputOptions(output, "filesUploaded", suspendWhenHidden = FALSE) - ##############################PEPTIDE EXPLORATION TAB################################ - ##main table display with color/background/font/border configurations - output$mainTable <- DT::renderDataTable( - if (is.null(df$mainTable) | is.null(df$metricsData)) { - return(datatable(data.frame("Aggregate Report" = character()))) - }else { - datatable(df$mainTable[, !(colnames(df$mainTable) == "ID") & !(colnames(df$mainTable) == "Evaluation") & !(colnames(df$mainTable) == "Comments")], - escape = FALSE, callback = JS(callback(hla_count(), df$metricsData$mt_top_score_metric)), class = "stripe", - options = list(lengthChange = FALSE, dom = "Bfrtip", pageLength = df$pageLength, - columnDefs = list(list(defaultContent = "NA", targets = c(hla_count() + 10, (hla_count() + 12):(hla_count() + 17))), - list(className = "dt-center", targets = c(0:hla_count() - 1)), list(visible = FALSE, targets = c(-1:-12)), - list(orderable = TRUE, targets = 0)), buttons = list(I("colvis")), - initComplete = htmlwidgets::JS( - "function(settings, json) {", - paste("$(this.api().table().header()).css({'font-size': '", "10pt", "'});"), - "}"), - rowCallback = JS(rowcallback(hla_count(), df$selectedRow - 1)), - preDrawCallback = JS("function() { - Shiny.unbindAll(this.api().table().node()); }"), - drawCallback = JS("function() { - Shiny.bindAll(this.api().table().node()); } ")), - selection = "none", - extensions = c("Buttons")) - } - %>% formatStyle("IC50 MT", "Scaled BA", backgroundColor = styleInterval(c(0.1, 0.2, 0.4, 0.6, 0.8, 1, 1.2, 1.4, 1.6, 1.8, 2), - c("#68F784", "#60E47A", "#58D16F", "#4FBD65", "#47AA5A", "#3F9750", "#F3F171", "#F3E770", "#F3DD6F", "#F0CD5B", "#F1C664", "#FF9999")) - , fontWeight = styleInterval(c(1000), c("normal", "bold")), border = styleInterval(c(1000), c("normal", "2px solid red"))) - %>% formatStyle("%ile MT", "Scaled percentile", backgroundColor = styleInterval(c(0.2, 0.4, 0.6, 0.8, 1, 1.25, 1.5, 1.75, 2), - c("#68F784", "#60E47A", "#58D16F", "#4FBD65", "#47AA5A", "#F3F171", "#F3E770", "#F3DD6F", "#F1C664", "#FF9999"))) - %>% formatStyle("Tier", color = styleEqual(c("Pass", "Poor", "Anchor", "Subclonal", "LowExpr", "NoExpr"), c("green", "orange", "#b0b002", "#D4AC0D", "salmon", "red"))) - %>% formatStyle(c("RNA VAF"), "Col RNA VAF", background = styleColorBar(range(0, 1), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("DNA VAF"), "Col DNA VAF", background = styleColorBar(range(0, 1), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("RNA Expr"), "Col RNA Expr", background = styleColorBar(range(0, 50), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("RNA Depth"), "Col RNA Depth", background = styleColorBar(range(0, 200), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("Allele Expr"), "Col Allele Expr", background = styleColorBar(range(0, (max(as.numeric(as.character(unlist(df$mainTable["Col RNA VAF"]))) * 50))), "lightblue"), backgroundSize = "98% 88%", backgroundRepeat = "no-repeat", backgroundPosition = "right") - %>% formatStyle(c("Allele Expr"), "Tier Count", fontWeight = styleEqual(c("2"), c("bold")), border = styleEqual(c("2"), c("2px solid red"))) - %>% formatStyle(c("IC50 MT", "Allele Expr"), "Tier Count", fontWeight = styleEqual(c("3"), c("bold")), border = styleEqual(c("3"), c("2px solid red"))) - %>% formatStyle(c("IC50 MT"), "Tier Count", fontWeight = styleEqual(c("4"), c("bold")), border = styleEqual(c("4"), c("2px solid red"))) - %>% formatStyle(c("Allele Expr", "%ile MT"), "Tier Count", fontWeight = styleEqual(c("102"), c("bold")), border = styleEqual(c("102"), c("2px solid red"))) - %>% formatStyle(c("IC50 MT", "Allele Expr", "%ile MT"), "Tier Count", fontWeight = styleEqual(c("103"), c("bold")), border = styleEqual(c("103"), c("2px solid red"))) - %>% formatStyle(c("%ile MT"), "Tier Count", fontWeight = styleEqual(c("104"), c("bold")), border = styleEqual(c("104"), c("2px solid red"))) - %>% formatStyle(c("IC50 MT", "%ile MT"), "Tier Count", fontWeight = styleEqual(c("105"), c("bold")), border = styleEqual(c("105"), c("2px solid red"))) - %>% formatStyle(c("IC50 WT", "Pos"), "Tier Count", fontWeight = styleEqual(c("5"), c("bold")), border = styleEqual(c("5"), c("2px solid red"))) - %>% formatStyle(c("DNA VAF"), "Tier Count", fontWeight = styleEqual(c("6"), c("bold")), border = styleEqual(c("6"), c("2px solid red"))) - %>% formatStyle(c("Allele Expr"), "Tier Count", fontWeight = styleEqual(c("7"), c("bold")), border = styleEqual(c("7"), c("2px solid red"))) - %>% formatStyle(c("Gene Expression"), "Tier Count", fontWeight = styleEqual(c("8"), c("bold")), border = styleEqual(c("8"), c("2px solid red"))) - %>% formatStyle(c("RNA VAF", "RNA Depth"), "Tier Count", fontWeight = styleEqual(c("8"), c("bold")), border = styleEqual(c("8"), c("2px solid green"))) - %>% formatStyle(c("RNA Expr", "Tier Count"), fontWeight = styleEqual(c("9"), c("bold")), border = styleEqual(c("9"), c("2px solid red"))) - %>% formatStyle(c("RNA VAF"), "Tier Count", fontWeight = styleEqual(c("10"), c("bold")), border = styleEqual(c("10"), c("2px solid red"))) - %>% formatStyle(c("RNA VAF", "RNA Expr"), "Tier Count", fontWeight = styleEqual(c("11"), c("bold")), border = styleEqual(c("11"), c("2px solid red"))) - %>% formatStyle(c("IC50 WT", "Pos"), "Tier Count", fontWeight = styleEqual(c("13"), c("bold")), border = styleEqual(c("13"), c("2px solid red"))) - %>% formatStyle(c("DNA VAF"), "Tier Count", fontWeight = styleEqual(c("14"), c("bold")), border = styleEqual(c("14"), c("2px solid red"))) - %>% formatStyle(c("DNA VAF", "IC50 WT", "Pos"), "Tier Count", fontWeight = styleEqual(c("15"), c("bold")), border = styleEqual(c("15"), c("2px solid red"))) - %>% formatStyle(c("IC50 WT", "Pos", "DNA VAF", "Allele Expr"), "Tier Count", fontWeight = styleEqual(c("23"), c("bold")), border = styleEqual(c("23"), c("2px solid red"))) - %>% formatStyle(c("DNA VAF", "Allele Expr"), "Tier Count", fontWeight = styleEqual(c("22"), c("bold")), border = styleEqual(c("22"), c("2px solid red"))) - %>% formatStyle(c("IC50 WT", "Pos", "Allele Expr"), "Tier Count", fontWeight = styleEqual(c("21"), c("bold")), border = styleEqual(c("21"), c("2px solid red"))) - %>% formatStyle(c("Allele Expr"), "Tier Count", fontWeight = styleEqual(c("20"), c("bold")), border = styleEqual(c("20"), c("2px solid red"))) - %>% formatStyle(c("Gene"), "Gene of Interest", fontWeight = styleEqual(c(TRUE), c("bold")), border = styleEqual(c(TRUE), c("2px solid green"))) - %>% formatStyle(c("TSL"), "Bad TSL", border = styleEqual(c(TRUE), c("2px solid red"))) - %>% formatStyle(c("%ile MT"), "Percentile Fail", border = styleEqual(c(TRUE), c("2px solid red"))) - %>% formatStyle(c("Prob Pos"), "Has Prob Pos", fontWeight = styleEqual(c(TRUE), c("bold")), border = styleEqual(c(TRUE), c("2px solid red"))) - , server = FALSE) - #help menu for main table - observeEvent(input$help, { - showModal(modalDialog( - title = "Aggregate Report of Best Candidates by Mutation", - h5("* Hover over individual column names to see further description of specific columns. (HLA allele columns excluded)"), - h4(" HLA specific columns:", style = "font-weight: bold"), - h5(" Number of good binding peptides for each specific HLA-allele.", br(), - " The same peptide could be counted in multiple columns if it was predicted to be a good binder for multiple HLA alleles."), - h4(" Color scale for IC50 MT column:", style = "font-weight: bold"), - h5(" lightgreen to darkgreen (0nM to 500nM); ", br(), "yellow to orange (500nM to 1000nM);", br(), " red (> 1000nM) "), - h4(" Color scale for %ile MT column:", style = "font-weight: bold"), - h5(" lightgreen to darkgreen (0-0.5%);", br(), " yellow to orange (0.5% to 2 %);", br(), " red (> 2%) "), - h4(" Bar backgrounds:", style = "font-weight: bold"), - h5(" RNA VAF and DNA VAF: Bar graphs range from 0 to 1", br(), - " RNA Depth: Bar graph ranging from 0 to maximum value of RNA depth values across variants", br(), - " RNA Expr: Bar graph ranging from 0 to 50 (this is meant to highlight variants with lower expression values for closer inspection)", br(), - " Allele Expr: Bar graph ranging from 0 to (50 * maximum value of RNA VAF values across variants) "), - h4(" Tier Types:", style = "font-weight: bold"), - h5(" Variants are ordered by their Tiers in the following way: Pass, LowExpr, Anchor, Subclonal, Poor, NoExpr. - Within the same tier, variants are ordered by the sum of their ranking in binding affinity and allele expression (i.e. lower binding - affinity and higher allele expression is prioritized.)"), - h5(" NoExpr: Mutant allele is not expressed ", br(), - " LowExpr: Mutant allele has low expression (Allele Expr < allele expression threshold)", br(), - " Subclonal: Likely not in the founding clone of the tumor (DNA VAF > max(DNA VAF)/2)", br(), - " Anchor: Mutation is at an anchor residue in the shown peptide, and the WT allele has good binding (WT IC50 < binding threshold)", br(), - " Poor: Fails two or more of the above criteria", br(), - " Pass: Passes the above criteria, has strong MT binding (IC50 < 500) and strong expression (Allele Expr > allele expression threshold)" - ), - )) - }) - ##update table upon selecting to investigate each individual row - observeEvent(input$select_button, { - if (is.null(df$mainTable)) { - return() - } - df$selectedRow <- as.numeric(strsplit(input$select_button, "_")[[1]][2]) - session$sendCustomMessage("unbind-DT", "mainTable") - df$mainTable$`Evaluation` <- shinyValue("selecter_", nrow(df$mainTable), df$mainTable) - df$mainTable$`Eval` <- shinyInput(df$mainTable, selectInput, nrow(df$mainTable), "selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px") - dataTableProxy("mainTable") %>% - selectPage((df$selectedRow - 1) %/% df$pageLength + 1) - }) - ##selected row text box - output$selected <- renderText({ - if (is.null(df$mainTable)) { - return() - } - df$selectedRow - }) - ##selected id update - selectedID <- reactive({ - if (is.null(df$selectedRow)) { - df$mainTable$ID[1] - }else { - df$mainTable$ID[df$selectedRow] - } - }) - ## Update comments section based on selected row - observeEvent(input$comment, { - if (is.null(df$mainTable)) { - return() - } - df$comments[selectedID(), 1] <- input$comments - }) - ##display of genomic information - output$metricsTextGenomicCoord <- renderText({ - if (is.null(df$metricsData)) { - return() - } - selectedID() - }) - ##display of openCRAVAT link for variant - output$url <- renderUI({ - if (is.null(df$mainTable)) { - return() - } - id <- strsplit(selectedID(), "-") - chromosome <- id[[1]][1] - start <- id[[1]][2] - stop <- id[[1]][3] - ref <- id[[1]][4] - alt <- id[[1]][5] - url <- a("OpenCRAVAT variant report", href = paste("https://run.opencravat.org/webapps/variantreport/index.html?chrom=", chromosome, "&pos=", stop, "&ref_base=", ref, "&alt_base=", alt, sep = ""), target = "_blank") - HTML(paste(url)) - }) - ##display of RNA VAF - output$metricsTextRNA <- renderText({ - if (is.null(df$metricsData)) { - return() - } - df$metricsData[[selectedID()]]$`RNA VAF` - }) - ##display of DNA VAF - output$metricsTextDNA <- renderText({ - if (is.null(df$metricsData)) { - return() - } - df$metricsData[[selectedID()]]$`DNA VAF` - }) - ##display of MT IC50 from additional data file - output$addData_IC50 <- renderText({ - if (is.null(df$additionalData)) { - return() - } - df$additionalData[df$additionalData$ID == selectedID(), ]$`IC50 MT` - }) - ##display of MT percentile from additional data file - output$addData_percentile <- renderText({ - df$additionalData[df$additionalData$ID == selectedID(), ]$`%ile MT` - }) - ##display of Best Peptide from additional data file - output$addData_peptide <- renderText({ - df$additionalData[df$additionalData$ID == selectedID(), ]$`Best Peptide` - }) - ##display of Corresponding HLA allele from additional data file - output$addData_allele <- renderText({ - df$additionalData[df$additionalData$ID == selectedID(), ]$`Allele` - }) - ##display of Best Transcript from additional data file - output$addData_transcript <- renderText({ - df$additionalData[df$additionalData$ID == selectedID(), ]$`Best Transcript` - }) - ##transcripts sets table displaying sets of transcripts with the same consequence - output$transcriptSetsTable <- renderDT({ - withProgress(message = "Loading Transcript Sets Table", value = 0, { - GB_transcripts <- data.frame() - best_transcript <- df$mainTable[df$mainTable$ID == selectedID(), ]$`Best Transcript` - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - GB_transcripts <- data.frame( - "Transcript Sets" = df$metricsData[[selectedID()]]$sets, - "# Transcripts" = df$metricsData[[selectedID()]]$transcript_counts, - "# Peptides" = df$metricsData[[selectedID()]]$peptide_counts, - "Total Expr" = df$metricsData[[selectedID()]]$set_expr - ) - names(GB_transcripts) <- c("Transcripts Sets", "#Transcripts", "# Peptides", "Total Expr") - best_transcript_set <- NULL - incProgress(0.5) - for (i in 1:length(df$metricsData[[selectedID()]]$sets)){ - transcript_set <- df$metricsData[[selectedID()]]$good_binders[[df$metricsData[[selectedID()]]$sets[i]]]$`transcripts` - transcript_set <- lapply(transcript_set, function(x) strsplit(x, "-")[[1]][1]) - if (best_transcript %in% transcript_set) { - best_transcript_set <- df$metricsData[[selectedID()]]$sets[i] - } - } - incProgress(0.5) - datatable(GB_transcripts, selection = list(mode = "single", selected = "1"), style="bootstrap") %>% - formatStyle("Transcripts Sets", backgroundColor = styleEqual(c(best_transcript_set), c("#98FF98"))) - }else { - GB_transcripts <- data.frame("Transcript Sets" = character(), "# Transcripts" = character(), "# Peptides" = character(), "Total Expr" = character()) - names(GB_transcripts) <- c("Transcripts Sets", "#Transcripts", "# Peptides", "Total Expr") - incProgress(0.5) - datatable(GB_transcripts) - incProgress(0.5) - } - }) - }) - ##update selected transcript set id - selectedTranscriptSet <- reactive({ - selection <- input$transcriptSetsTable_rows_selected - if (is.null(selection)) { - selection <- 1 - } - df$metricsData[[selectedID()]]$sets[selection] - }) - - ##transcripts table displaying transcript id and transcript expression values - output$transcriptsTable <- renderDT({ - withProgress(message = "Loading Transcripts Table", value = 0, { - GB_transcripts <- data.frame() - best_transcript <- df$mainTable[df$mainTable$ID == selectedID(), ]$`Best Transcript` - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - GB_transcripts <- data.frame("Transcripts" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`transcripts`, - "Expression" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`transcript_expr`, - "TSL" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`tsl`, - "Biotype" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`biotype`, - "Length" = df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`transcript_length`) - GB_transcripts$`Best Transcript` <- apply(GB_transcripts, 1, function(x) grepl(best_transcript, x["Transcripts"], fixed = TRUE)) - incProgress(0.5) - names(GB_transcripts) <- c("Transcripts in Selected Set", "Expression", "Transcript Support Level", "Biotype", "Transcript Length (#AA)", "Best Transcript") - incProgress(0.5) - datatable(GB_transcripts, options = list(columnDefs = list(list(defaultContent = "N/A", targets = c(3)), list(visible = FALSE, targets = c(-1))))) %>% - formatStyle(c("Transcripts in Selected Set"), "Best Transcript", backgroundColor = styleEqual(c(TRUE), c("#98FF98"))) - }else { - GB_transcripts <- data.frame("Transcript" = character(), "Expression" = character(), "TSL" = character(), "Biotype" = character(), "Length" = character()) - incProgress(0.5) - names(GB_transcripts) <- c("Transcripts in Selected Set", "Expression", "Transcript Support Level", "Biotype", "Transcript Length (#AA)", "Best Transcript") - incProgress(0.5) - datatable(GB_transcripts) - } - }) - }) - - ##display transcript expression - output$metricsTextTranscript <- renderText({ - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`transcript_expr` - }else { - "N/A" - } - }) - ##display gene expression - output$metricsTextGene <- renderText({ - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - df$metricsData[[selectedID()]]$`gene_expr` - }else { - "N/A" - } - }) - ##display peptide table with coloring - output$peptideTable <- renderDT({ - withProgress(message = "Loading Peptide Table", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0 & !is.null(df$metricsData)) { - peptide_data <- df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`peptides` - best_peptide <- df$mainTable[df$mainTable$ID == selectedID(), ]$`Best Peptide` - peptide_names <- names(peptide_data) - for (i in 1:length(peptide_names)) { - peptide_data[[peptide_names[[i]]]]$individual_ic50_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_percentile_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_el_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_el_percentile_calls <- NULL - } - incProgress(0.5) - peptide_data <- as.data.frame(peptide_data) - incProgress(0.5) - dtable <- datatable(do.call("rbind", lapply(peptide_names, table_formatting, peptide_data)), options = list( - pageLength = 10, - columnDefs = list(list(defaultContent = "X", - targets = c(2:hla_count() + 1)), - list(orderable = TRUE, targets = 0), - list(visible = FALSE, targets = c(-1))), - rowCallback = JS("function(row, data, index, rowId) {", - "console.log(rowId)", - "if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {", - 'row.style.backgroundColor = "#E0E0E0";', "}", "}") - ), - selection = list(mode = "single", selected = "1")) %>% - formatStyle("Type", fontWeight = styleEqual("MT", "bold")) %>% - formatStyle(c("Peptide Sequence"), "Has ProbPos", border = styleEqual(c(TRUE), c("2px solid red"))) %>% - formatStyle(c("Problematic Positions"), "Has ProbPos", border = styleEqual(c(TRUE), c("2px solid red"))) %>% - formatStyle("Peptide Sequence", backgroundColor = styleEqual(c(best_peptide), c("#98FF98"))) - dtable$x$data[[1]] <- as.numeric(dtable$x$data[[1]]) - dtable - }else { - incProgress(1) - datatable(data.frame("Peptide Datatable" = character()), selection = list(mode = "single", selected = "1")) - } - }) - }) - ##update selected peptide data - selectedPeptideData <- reactive({ - selection <- input$peptideTable_rows_selected - if (is.null(selection)) { - selection <- 1 - } - peptide_names <- names(df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`peptides`) - index <- floor((as.numeric(selection) + 1) / 2) - df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$peptides[[peptide_names[index]]] - }) - ##Add legend for anchor heatmap - output$peptideFigureLegend <- renderPlot({ - colors <- colorRampPalette(c("lightblue", "blue"))(99)[seq(1, 99, 7)] - color_pos <- data.frame(d = as.character(seq(1, 99, 7)), x1 = seq(0.1, 1.5, 0.1), x2 = seq(0.2, 1.6, 0.1), y1 = rep(1, 15), y2 = rep(1.1, 15), colors = colors) - color_label <- data.frame(x = c(0.1, 0.8, 1.6), y = rep(0.95, 3), score = c(0, 0.5, 1)) - p1 <- ggplot() + - scale_y_continuous(limits = c(0.90, 1.2), name = "y") + scale_x_continuous(limits = c(0, 1.7), name = "x") + - geom_rect(data = color_pos, aes(xmin = x1, xmax = x2, ymin = y1, ymax = y2, fill = colors), color = "black", alpha = 1) + - scale_fill_identity() - p1 <- p1 + geom_text(data = color_label, aes(x = x, y = y, label = score), size = 4, fontface = 2) + - annotate(geom = "text", x = 0.5, y = 1.18, label = "Normalized Anchor Score", size = 4, fontface = 2) + - coord_fixed() + - theme_void() + theme(legend.position = "none", panel.border = element_blank(), plot.margin = margin(0, 0, 0, 0, "cm")) - print(p1) - }) - ##Anchor Heatmap overlayed on selected peptide sequences - output$anchorPlot <- renderPlot({ - if (is.null(df$metricsData)) { - return() - } - withProgress(message = "Loading Anchor Heatmap", value = 0, { - if (type() == 2) { - p1 <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available for Class II HLA alleles", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p1) - }else if (length(df$metricsData[[selectedID()]]$sets) != 0) { - peptide_data <- df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$`peptides` - peptide_names <- names(peptide_data) - for (i in 1:length(peptide_names)) { - peptide_data[[peptide_names[[i]]]]$individual_ic50_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_percentile_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_el_calls <- NULL - peptide_data[[peptide_names[[i]]]]$individual_el_percentile_calls <- NULL - } - peptide_data <- as.data.frame(peptide_data) - p1 <- ggplot() + scale_x_continuous(limits = c(0, 80)) + scale_y_continuous(limits = c(-31, 1)) - all_peptides <- list() - incProgress(0.1) - for (i in 1:length(peptide_names)) { - #set & constrain mutation_pos' to not exceed length of peptide (may happen if mutation range goes off end) - mutation_pos <- range_str_to_seq(df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$peptides[[peptide_names[i]]]$`mutation_position`) - mt_peptide_length <- nchar(peptide_names[i]) - mutation_pos <- mutation_pos[mutation_pos <= mt_peptide_length] - #set associated wt peptide to current mt peptide - wt_peptide <- as.character(df$metricsData[[selectedID()]]$good_binders[[selectedTranscriptSet()]]$peptides[[peptide_names[i]]]$`wt_peptide`) - #create dataframes for mt/wt pair - df_mt_peptide <- data.frame("aa" = unlist(strsplit(peptide_names[i], "", fixed = TRUE)), "x_pos" = c(1:nchar(peptide_names[i]))) - df_mt_peptide$mutation <- "not_mutated" - df_mt_peptide$type <- "mt" - df_mt_peptide$y_pos <- (i * 2 - 1) * -1 - df_mt_peptide$length <- mt_peptide_length - df_mt_peptide[mutation_pos, "mutation"] <- "mutated" - df_wt_peptide <- data.frame("aa" = unlist(strsplit(wt_peptide, "", fixed = TRUE)), "x_pos" = c(1:nchar(wt_peptide))) - df_wt_peptide$mutation <- "not_mutated" - df_wt_peptide$type <- "wt" - df_wt_peptide$y_pos <- (i * 2) * -1 - df_wt_peptide$length <- nchar(wt_peptide) - all_peptides[[i]] <- rbind(df_mt_peptide, df_wt_peptide) - } - incProgress(0.4) - all_peptides <- do.call(rbind, all_peptides) - peptide_table <- do.call("rbind", lapply(peptide_names, table_formatting, peptide_data)) - peptide_table_filtered <- Filter(function(x) length(unique(x)) != 1, peptide_table) - peptide_table_names <- names(peptide_table_filtered) - hla_list <- peptide_table_names[grepl("^HLA-*", peptide_table_names)] - hla_data <- data.frame(hla = hla_list) - hla_sep <- max(nchar(peptide_table$`Peptide Sequence`)) - hla_data$y_pos <- 1 - hla_data$x_pos <- hla_sep / 2 - pad <- 3 - all_peptides_multiple_hla <- list() - incProgress(0.1) - for (i in 1:length(hla_list)) { - hla_data$x_pos[i] <- hla_data$x_pos[i] + (hla_sep + pad) * (i - 1) - omit_rows <- which(is.na(peptide_table_filtered[names(peptide_table_filtered) == hla_list[[i]]])) * -1 - all_peptides_multiple_hla[[i]] <- all_peptides[!(all_peptides$y_pos %in% omit_rows), ] - all_peptides_multiple_hla[[i]]$color_value <- apply(all_peptides_multiple_hla[[i]], 1, function(x) peptide_coloring(hla_list[[i]], x)) - all_peptides_multiple_hla[[i]]$x_pos <- all_peptides_multiple_hla[[i]]$x_pos + (hla_sep + pad) * (i - 1) - } - incProgress(0.2) - all_peptides_multiple_hla <- do.call(rbind, all_peptides_multiple_hla) - h_line_pos <- data.frame(y_pos = seq(min(all_peptides_multiple_hla["y_pos"]) - 0.5, max(all_peptides_multiple_hla["y_pos"]) - 1.5, 2), x_pos = c(min(all_peptides_multiple_hla["x_pos"]) - 1)) - h_line_pos <- rbind(h_line_pos, data.frame(x_pos = max(all_peptides_multiple_hla["x_pos"]) + 1, y_pos = seq(min(all_peptides_multiple_hla["y_pos"]) - 0.5, max(all_peptides_multiple_hla["y_pos"]) - 1.5, 2))) - incProgress(0.2) - p1 <- p1 + - geom_rect(data = all_peptides_multiple_hla, aes(xmin = x_pos - 0.5, xmax = 1 + x_pos - 0.5, ymin = .5 + y_pos, ymax = -.5 + y_pos), fill = all_peptides_multiple_hla$color_value) + - geom_text(data = all_peptides_multiple_hla, aes(x = x_pos, y = y_pos, label = aa, color = mutation), size = 5) + - geom_text(data = hla_data, aes(x = x_pos, y = y_pos, label = hla), size = 5, fontface = "bold") + - geom_line(data = h_line_pos, (aes(x = x_pos, y = y_pos, group = y_pos)), linetype = "dashed") - p1 <- p1 + scale_color_manual("mutation", values = c("not_mutated" = "#000000", "mutated" = "#e74c3c")) - p1 <- p1 + theme_void() + theme(legend.position = "none", panel.border = element_blank()) - print(p1) - }else { - p1 <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p1) - } - }) - }, height = 500, width = 1000) - ##updating IC50 binding score for selected peptide pair - bindingScoreDataIC50 <- reactive({ - if (is.null(df$metricsData)) { - return() - } - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - algorithm_names <- data.frame(algorithms = selectedPeptideData()$individual_ic50_calls$algorithms) - wt_data <- as.data.frame(selectedPeptideData()$individual_ic50_calls$WT, check.names = FALSE) - colnames(wt_data) <- paste(colnames(wt_data), "_WT_Score", sep = "") - mt_data <- as.data.frame(selectedPeptideData()$individual_ic50_calls$MT, check.names = FALSE) - colnames(mt_data) <- paste(colnames(mt_data), "_MT_Score", sep = "") - full_data <- cbind(algorithm_names, mt_data, wt_data) %>% - gather("col", "val", colnames(mt_data)[1]:tail(colnames(wt_data), n = 1)) %>% - separate(col, c("HLA_allele", "Mutant", "Score"), sep = "\\_") %>% - spread("Score", val) - full_data - }else { - return() - } - }) - ##plotting IC5 binding score violin plot - output$bindingData_IC50 <- renderPlot({ - withProgress(message = "Loading Binding Score Plot (IC50)", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - line.data <- data.frame(yintercept = c(500, 1000), Cutoffs = c("500nM", "1000nM"), color = c("#28B463", "#EC7063")) - hla_allele_count <- length(unique(bindingScoreDataIC50()$HLA_allele)) - incProgress(0.5) - p <- ggplot(data = bindingScoreDataIC50(), aes(x = Mutant, y = Score, color = Mutant), trim = FALSE) + geom_violin() + facet_grid(cols = vars(HLA_allele)) + scale_y_continuous(trans = "log10") + #coord_trans(y = "log10") + - stat_summary(fun.y = mean, fun.ymin = mean, fun.ymax = mean, geom = "crossbar", width = 0.25, position = position_dodge(width = .25)) + - geom_jitter(data = bindingScoreDataIC50(), aes(shape = algorithms), sizes = 5, stroke = 1, position = position_jitter(0.3)) + - scale_shape_manual(values = 0:8) + - geom_hline(aes(yintercept = yintercept, linetype = Cutoffs), line.data, color = rep(line.data$color, hla_allele_count)) + - scale_color_manual(values = rep(c("MT" = "#D2B4DE", "WT" = "#F7DC6F"), hla_allele_count)) + - theme(strip.text = element_text(size = 15), axis.text = element_text(size = 10), axis.title = element_text(size = 15), axis.ticks = element_line(size = 3), legend.text = element_text(size = 15), legend.title = element_text(size = 15)) - incProgress(0.5) - print(p) - }else { - p <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p) - } - }) - }) - ##updating percentile binding score for selected peptide pair - bindingScoreDataPercentile <- reactive({ - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - algorithm_names <- data.frame(algorithms = selectedPeptideData()$individual_percentile_calls$algorithms) - wt_data <- as.data.frame(selectedPeptideData()$individual_percentile_calls$WT, check.names = FALSE) - colnames(wt_data) <- paste(colnames(wt_data), "_WT_Score", sep = "") - mt_data <- as.data.frame(selectedPeptideData()$individual_percentile_calls$MT, check.names = FALSE) - colnames(mt_data) <- paste(colnames(mt_data), "_MT_Score", sep = "") - full_data <- cbind(algorithm_names, mt_data, wt_data) %>% - gather("col", "val", colnames(mt_data)[1]:tail(colnames(wt_data), n = 1)) %>% - separate(col, c("HLA_allele", "Mutant", "Score"), sep = "\\_") %>% - spread("Score", val) - full_data - }else { - return() - } - }) - ##plotting percentile binding score violin plot - output$bindingData_percentile <- renderPlot({ - withProgress(message = "Loading Binding Score Plot (Percentile)", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - line.data <- data.frame(yintercept = c(0.5, 2), Cutoffs = c("0.5%", "2%"), color = c("#28B463", "#EC7063")) - hla_allele_count <- length(unique(bindingScoreDataPercentile()$HLA_allele)) - incProgress(0.5) - p <- ggplot(data = bindingScoreDataPercentile(), aes(x = Mutant, y = Score, color = Mutant), trim = FALSE) + geom_violin() + facet_grid(cols = vars(HLA_allele)) + scale_y_continuous(trans = "log10") + #coord_trans(y = "log10") + - stat_summary(fun.y = mean, fun.ymin = mean, fun.ymax = mean, geom = "crossbar", width = 0.25, position = position_dodge(width = .25)) + - geom_jitter(data = bindingScoreDataPercentile(), aes(shape = algorithms), size = 5, stroke = 1, position = position_jitter(0.3)) + - scale_shape_manual(values = 0:8) + - geom_hline(aes(yintercept = yintercept, linetype = Cutoffs), line.data, color = rep(line.data$color, hla_allele_count)) + - scale_color_manual(values = rep(c("MT" = "#D2B4DE", "WT" = "#F7DC6F"), hla_allele_count)) + - theme(strip.text = element_text(size = 15), axis.text = element_text(size = 10), axis.title = element_text(size = 15), axis.ticks = element_line(size = 3), legend.text = element_text(size = 15), legend.title = element_text(size = 15)) - incProgress(0.5) - print(p) - }else { - p <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p) - } - }) - }) - ##plotting binding data table with IC50 and percentile values - output$bindingDatatable <- renderDT({ - withProgress(message = "Loading binding datatable", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - binding_data <- bindingScoreDataIC50() - names(binding_data)[names(binding_data) == "Score"] <- "IC50 Score" - binding_data["% Score"] <- bindingScoreDataPercentile()["Score"] - binding_data["Score"] <- paste(round(as.numeric(binding_data$`IC50 Score`), 2), " (%: ", round(as.numeric(binding_data$`% Score`), 2), ")", sep = "") - binding_data["IC50 Score"] <- NULL - binding_data["% Score"] <- NULL - binding_reformat <- dcast(binding_data, HLA_allele + Mutant ~ algorithms, value.var = "Score") - incProgress(1) - dtable <- datatable(binding_reformat, options = list( - pageLength = 10, - lengthMenu = c(10), - rowCallback = JS("function(row, data, index, rowId) {", - "console.log(rowId)", - "if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {", - 'row.style.backgroundColor = "#E0E0E0";', "}", "}") - )) %>% formatStyle("Mutant", fontWeight = styleEqual("MT", "bold"), color = styleEqual("MT", "#E74C3C")) - dtable - }else { - incProgress(1) - datatable(data.frame("Binding Predictions Datatable" = character())) - } - }) - }) - ##updating elution score for selected peptide pair - elutionScoreData <- reactive({ - if (is.null(df$metricsData)) { - return() - } - if (length(df$metricsData[[selectedID()]]$sets) != 0 && length(selectedPeptideData()$individual_el_calls$algorithms) > 0) { - algorithm_names <- data.frame(algorithms = selectedPeptideData()$individual_el_calls$algorithms) - wt_data <- as.data.frame(selectedPeptideData()$individual_el_calls$WT, check.names = FALSE) - colnames(wt_data) <- paste(colnames(wt_data), "_WT_Score", sep = "") - mt_data <- as.data.frame(selectedPeptideData()$individual_el_calls$MT, check.names = FALSE) - colnames(mt_data) <- paste(colnames(mt_data), "_MT_Score", sep = "") - full_data <- cbind(algorithm_names, mt_data, wt_data) %>% - gather("col", "val", colnames(mt_data)[1]:tail(colnames(wt_data), n = 1)) %>% - separate(col, c("HLA_allele", "Mutant", "Score"), sep = "\\_") %>% - spread("Score", val) - full_data - }else { - return() - } - }) - ##updating elution percentile for selected peptide pair - elutionPercentileData <- reactive({ - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - algorithm_names <- data.frame(algorithms = selectedPeptideData()$individual_el_percentile_calls$algorithms) - wt_data <- as.data.frame(selectedPeptideData()$individual_el_percentile_calls$WT, check.names = FALSE) - colnames(wt_data) <- paste(colnames(wt_data), "_WT_Score", sep = "") - mt_data <- as.data.frame(selectedPeptideData()$individual_el_percentile_calls$MT, check.names = FALSE) - colnames(mt_data) <- paste(colnames(mt_data), "_MT_Score", sep = "") - full_data <- cbind(algorithm_names, mt_data, wt_data) %>% - gather("col", "val", colnames(mt_data)[1]:tail(colnames(wt_data), n = 1)) %>% - separate(col, c("HLA_allele", "Mutant", "Score"), sep = "\\_") %>% - spread("Score", val) - full_data - }else { - return() - } - }) - ##plotting elution data table - output$elutionDatatable <- renderDT({ - withProgress(message = "Loading elution datatable", value = 0, { - if (length(df$metricsData[[selectedID()]]$sets) != 0) { - elution_data <- elutionScoreData() - if (!is.null(elution_data)) { - names(elution_data)[names(elution_data) == "Score"] <- "Elution Score" - elution_data["% Score"] <- elutionPercentileData()["Score"] - elution_data["Score"] <- paste(round(as.numeric(elution_data$`Elution Score`), 2), " (%: ", round(as.numeric(elution_data$`% Score`), 2), ")", sep = "") - elution_data["Elution Score"] <- NULL - elution_data["% Score"] <- NULL - elution_reformat <- dcast(elution_data, HLA_allele + Mutant ~ algorithms, value.var = "Score") - incProgress(1) - dtable <- datatable(elution_reformat, options = list( - pageLength = 10, - lengthMenu = c(10), - rowCallback = JS("function(row, data, index, rowId) {", - "console.log(rowId)","if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {", - 'row.style.backgroundColor = "#E0E0E0";', "}", "}") - )) %>% formatStyle("Mutant", fontWeight = styleEqual("MT", "bold"), color = styleEqual("MT", "#E74C3C")) - dtable - }else { - incProgress(1) - datatable(data.frame("Elution Datatable" = character())) - } - }else { - incProgress(1) - datatable(data.frame("Elution Datatable" = character())) - } - }) - }) - ##############################EXPORT TAB############################################## - #evalutation overview table - output$checked <- renderTable({ - if (is.null(df$mainTable)) { - return() - } - Evaluation <- data.frame(selected = shinyValue("selecter_", nrow(df$mainTable), df$mainTable)) - data <- as.data.frame(table(Evaluation)) - data$Count <- data$Freq - data$Freq <- NULL - data - }) - #export table display with options to download - output$ExportTable <- renderDataTable({ - if (is.null(df$mainTable)) { - return() - } - colsToDrop = colnames(df$mainTable) %in% c("Evaluation", "Eval", "Select", "Scaled BA", "Scaled percentile", "Tier Count", "Bad TSL", - "Comments", "Gene of Interest", "Bad TSL", "Col RNA Expr", "Col RNA VAF", "Col Allele Expr", - "Col RNA Depth", "Col DNA VAF", "Percentile Fail", "Has Prob Pos") - data <- df$mainTable[, !(colsToDrop)] - col_names <- colnames(data) - data <- data.frame(data, Evaluation = shinyValue("selecter_", nrow(df$mainTable), df$mainTable)) - colnames(data) <- c(col_names, "Evaluation") - comments <- data.frame("ID" = row.names(df$comments), Comments = df$comments[, 1]) - data <- join(data, comments) - data - }, escape = FALSE, server = FALSE, rownames = FALSE, - options = list(dom = "Bfrtip", - buttons = list( - list(extend = "csvHtml5", - filename = input$exportFileName, - fieldSeparator = "\t", - text = "Download as TSV", - extension = ".tsv"), - list(extend = "excel", - filename = input$exportFileName, - text = "Download as excel") - ), - initComplete = htmlwidgets::JS( - "function(settings, json) {", - paste0("$(this.api().table().header()).css({'font-size': '", "8pt", "'});"), - "}") - ), - selection = "none", - extensions = c("Buttons")) - ############### NeoFox Tab ########################## - df_neofox <- reactiveValues( - mainTable = NULL - ) - observeEvent(input$loadDefaultneofox, { - #session$sendCustomMessage("unbind-DT", "neofoxTable") - #data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/f83c52c8b8387beae69be8b200a44dcf199d9af2/pvactools/tools/pvacview/data/H_NJ-HCC1395-HCC1395.Class_I.all_epitopes.aggregated.tsv") - #mainData <- read.table(text = data, sep = '\t', header = FALSE, stringsAsFactors = FALSE, check.names=FALSE) - data <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/v11/data/test_pt1_neoantigen_candidates_annotated.tsv" - mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_neofox$mainTable <- mainData - updateTabItems(session, "neofox_tabs", "neofox_explore") - }) - output$neofox_upload_ui <- renderUI({ - fileInput(inputId = "neofox_data", label = "NeoFox output table (tsv required)", - accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) - }) - observeEvent(input$neofox_data$datapath, { - #session$sendCustomMessage("unbind-DT", "neofoxTable") - mainData <- read.table(input$neofox_data$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_neofox$mainTable <- mainData - }) - observeEvent(input$visualize_neofox, { - updateTabItems(session, "neofox_tabs", "neofox_explore") - }) - output$neofoxTable <- DT::renderDataTable( - if (is.null(df_neofox$mainTable)) { - return(datatable(data.frame("Annotated Table" = character()))) - }else { - datatable(df_neofox$mainTable, - escape = FALSE, class = "stripe", - options = list(lengthChange = FALSE, dom = "Bfrtip", pageLength = input$neofox_page_length, - columnDefs = list(list(visible = FALSE, targets = c(-1:-12)), - list(orderable = TRUE, targets = 0)), buttons = list(I("colvis")), - initComplete = htmlwidgets::JS( - "function(settings, json) {", - paste("$(this.api().table().header()).css({'font-size': '", "10pt", "'});"), - "}")), - selection = "multiple", - extensions = c("Buttons")) - }, server = FALSE) - output$neofox_selected <- renderText({ - if (is.null(df_neofox$mainTable)) { - return() - } - input$neofoxTable_rows_selected - }) - output$neofox_violin_plots_row1 <- renderPlot({ - withProgress(message = "Loading Violin Plots", value = 0, { - if (length(input$neofoxTable_rows_selected) != 0) { - plot_cols <- c("mutatedXmer", "imputedGeneExpression", "DAI_MHCI_bestAffinity", "IEDB_Immunogenicity_MHCI") - plot_data <- df_neofox$mainTable[, plot_cols] - plot_data[, "imputedGeneExpression"] <- as.numeric(plot_data[, "imputedGeneExpression"]) - plot_data[, "DAI_MHCI_bestAffinity"] <- as.numeric(plot_data[, "DAI_MHCI_bestAffinity"]) - plot_data[, "IEDB_Immunogenicity_MHCI"] <- as.numeric(plot_data[, "IEDB_Immunogenicity_MHCI"]) - plot_data$Selected <- "No" - plot_data[input$neofoxTable_rows_selected, "Selected"] <- "Yes" - reformat_data <- plot_data %>% - gather("Feature", "Value", colnames(plot_data)[2]:tail(colnames(plot_data), n = 2)) - gene_expr_data <- reformat_data[reformat_data["Feature"] == "imputedGeneExpression", ] - gene_expr_plot <- ggplot(data = gene_expr_data, aes(x = Feature, y = Value)) + geom_violin() + - geom_jitter(data = gene_expr_data[gene_expr_data["Selected"] == "No", ], aes(color = Selected), size = 1, alpha = 0.5, stroke = 1, position = position_jitter(0.3)) + - geom_jitter(data = gene_expr_data[gene_expr_data["Selected"] == "Yes", ], aes(color = Selected), size = 2, alpha = 1, stroke = 1, position = position_jitter(0.3)) + - scale_color_manual(values = c("No" = "#939094", "Yes" = "#f42409")) + - theme(legend.position = "none") - DAI_ClassI_data <- reformat_data[reformat_data["Feature"] == "DAI_MHCI_bestAffinity", ] - DAI_ClassI_plot <- ggplot(DAI_ClassI_data, aes(x = Feature, y = Value)) + geom_violin() + - geom_jitter(data = DAI_ClassI_data[DAI_ClassI_data["Selected"] == "No", ], aes(color = Selected), size = 1, alpha = 0.5, stroke = 1, position = position_jitter(0.3)) + - geom_jitter(data = DAI_ClassI_data[DAI_ClassI_data["Selected"] == "Yes", ], aes(color = Selected), size = 2, alpha = 1, stroke = 1, position = position_jitter(0.3)) + - scale_color_manual(values = c("No" = "#939094", "Yes" = "#f42409")) + - theme(legend.position = "none") - IEDB_Immuno_data <- reformat_data[reformat_data["Feature"] == "IEDB_Immunogenicity_MHCI", ] - IEDB_Immuno_plot <- ggplot(IEDB_Immuno_data, aes(x = Feature, y = Value)) + geom_violin() + - geom_jitter(data = IEDB_Immuno_data[IEDB_Immuno_data["Selected"] == "No", ], aes(color = Selected), size = 1, alpha = 0.5, stroke = 1, position = position_jitter(0.3)) + - geom_jitter(data = IEDB_Immuno_data[IEDB_Immuno_data["Selected"] == "Yes", ], aes(color = Selected), size = 2, alpha = 1, stroke = 1, position = position_jitter(0.3)) + - scale_color_manual(values = c("No" = "#939094", "Yes" = "#f42409")) - p <- grid.arrange(gene_expr_plot, DAI_ClassI_plot, IEDB_Immuno_plot, ncol = 3) - incProgress(1) - print(p) - }else { - p <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p) - } - }) - }) - output$neofox_violin_plots_row2 <- renderPlot({ - withProgress(message = "Loading Violin Plots", value = 0, { - if (length(input$neofoxTable_rows_selected) != 0) { - plot_cols <- c("mutatedXmer", "MixMHCpred_bestScore_rank", "HexAlignmentScore_MHCI", "PRIME_best_rank") - plot_data <- df_neofox$mainTable[, plot_cols] - plot_data[, "MixMHCpred_bestScore_rank"] <- as.numeric(plot_data[, "MixMHCpred_bestScore_rank"]) - plot_data[, "HexAlignmentScore_MHCI"] <- as.numeric(plot_data[, "HexAlignmentScore_MHCI"]) - plot_data[, "PRIME_best_rank"] <- as.numeric(plot_data[, "PRIME_best_rank"]) - plot_data$Selected <- "No" - plot_data[input$neofoxTable_rows_selected, "Selected"] <- "Yes" - reformat_data <- plot_data %>% - gather("Feature", "Value", colnames(plot_data)[2]:tail(colnames(plot_data), n = 2)) - mixpred_data <- reformat_data[reformat_data["Feature"] == "MixMHCpred_bestScore_rank", ] - mixpred_plot <- ggplot(data = mixpred_data, aes(x = Feature, y = Value)) + geom_violin() + - geom_jitter(data = mixpred_data[mixpred_data["Selected"] == "No", ], aes(color = Selected), size = 1, alpha = 0.5, stroke = 1, position = position_jitter(0.3)) + - geom_jitter(data = mixpred_data[mixpred_data["Selected"] == "Yes", ], aes(color = Selected), size = 2, alpha = 1, stroke = 1, position = position_jitter(0.3)) + - scale_color_manual(values = c("No" = "#939094", "Yes" = "#f42409")) + - theme(legend.position = "none") - hex_data <- reformat_data[reformat_data["Feature"] == "HexAlignmentScore_MHCI", ] - hex_plot <- ggplot(hex_data, aes(x = Feature, y = Value)) + geom_violin() + - geom_jitter(data = hex_data[hex_data["Selected"] == "No", ], aes(color = Selected), size = 1, alpha = 0.5, stroke = 1, position = position_jitter(0.3)) + - geom_jitter(data = hex_data[hex_data["Selected"] == "Yes", ], aes(color = Selected), size = 2, alpha = 1, stroke = 1, position = position_jitter(0.3)) + - scale_color_manual(values = c("No" = "#939094", "Yes" = "#f42409")) + - theme(legend.position = "none") - prime_data <- reformat_data[reformat_data["Feature"] == "PRIME_best_rank", ] - prime_plot <- ggplot(prime_data, aes(x = Feature, y = Value)) + geom_violin() + - geom_jitter(data = prime_data[prime_data["Selected"] == "No", ], aes(color = Selected), size = 1, alpha = 0.5, stroke = 1, position = position_jitter(0.3)) + - geom_jitter(data = prime_data[prime_data["Selected"] == "Yes", ], aes(color = Selected), size = 2, alpha = 1, stroke = 1, position = position_jitter(0.3)) + - scale_color_manual(values = c("No" = "#939094", "Yes" = "#f42409")) - p <- grid.arrange(mixpred_plot, hex_plot, prime_plot, ncol = 3) - incProgress(1) - print(p) - }else { - p <- ggplot() + annotate(geom = "text", x = 10, y = 20, label = "No data available", size = 6) + - theme_void() + theme(legend.position = "none", panel.border = element_blank()) - incProgress(1) - print(p) - } - }) - }) - ############### Custom Tab ########################## - df_custom <- reactiveValues( - selectedRow = 1, - fullData = NULL, - mainTable = NULL, - group_inds = NULL, - metricsData = NULL, - pageLength = 10, - groupBy = NULL, - orderBy = NULL, - peptide_features = NULL - ) - observeEvent(input$loadDefault_Vaxrank, { - data <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/v11/data/vaxrank_output.tsv" - mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_custom$fullData <- mainData - }) - observeEvent(input$loadDefault_Neopredpipe, { - data <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/v11/data/HCC1395Run.neoantigens.txt" - mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_custom$fullData <- mainData - }) - observeEvent(input$loadDefault_antigengarnish, { - data <- "~/Desktop/Griffith_Lab/R_shiny_visualization/neoantigen_visualization/v11/data/ag_test_antigen.tsv" - mainData <- read.table(data, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_custom$fullData <- mainData - }) - output$custom_upload_ui <- renderUI({ - fileInput(inputId = "custom_data", label = "Custom input table (tsv required)", - accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")) - }) - observeEvent(input$custom_data$datapath, { - mainData <- read.table(input$custom_data$datapath, sep = "\t", header = FALSE, stringsAsFactors = FALSE, check.names = FALSE) - colnames(mainData) <- mainData[1, ] - mainData <- mainData[-1, ] - row.names(mainData) <- NULL - df_custom$fullData <- mainData - }) - - output$custom_group_by_feature_ui <- renderUI({ - feature <- names(df_custom$fullData) - pickerInput(inputId = "feature_1", - label = "Feature to group peptides by", - choices = feature, # a list of strings - #options = list(`actions-box` = TRUE, `live-search` = TRUE), - multiple = FALSE) - }) - output$custom_order_by_feature_ui <- renderUI({ - feature <- names(df_custom$fullData) - pickerInput(inputId = "feature_2", - label = "Feature to sort peptides by", - choices = feature, # a list of strings - #options = list(`actions-box` = TRUE, `live-search` = TRUE), - multiple = FALSE) - }) - output$custom_peptide_features_ui <- renderUI({ - feature <- names(df_custom$fullData) - pickerInput(inputId = "peptide_features", - label = "Subset of features to display in peptide subtable", - choices = feature[((feature != input$feature_2) & (feature != input$feature_1))], # a list of strings - options = list(`actions-box` = TRUE, `live-search` = TRUE), - multiple = TRUE) - }) - observeEvent(input$visualize_custom, { - #browser() - df_custom$groupBy <- input$feature_1 - df_custom$orderBy <- input$feature_2 - reformat_data <- df_custom$fullData %>% group_by(across(all_of(df_custom$groupBy))) %>% arrange(across(all_of(df_custom$orderBy))) - df_custom$fullData <- reformat_data - row_ind <- reformat_data %>% group_rows() - row_ind_df <- as.data.frame(row_ind) - df_custom$group_inds <- row_ind_df - row_ind_top <- apply(row_ind_df, 1, function(x) {unlist(x[1])[1]}) - df_custom$mainTable <- as.data.frame(reformat_data[row_ind_top, ]) - #df_custom$mainTable <- cbind("Eval" = shinyInput(df_custom$mainTable, selectInput, nrow(df_custom$mainTable), "custom_selecter_", choices = c("Pending", "Accept", "Reject", "Review"), width = "60px"), df_custom$mainTable) - df_custom$mainTable <- cbind(Select = shinyInputSelect(actionButton, nrow(df_custom$mainTable), "button_", label = "Investigate", onclick = 'Shiny.onInputChange(\"custom_select_button\", this.id)'), df_custom$mainTable) - #if (is.null(df_custom$mainTable$`Evaluation`)) { - # df_custom$mainTable$`Evaluation` <- rep("Pending", nrow(df_custom$mainTable)) - #} - #gene_data <- getURL("https://raw.githubusercontent.com/griffithlab/pVACtools/7c7b8352d81b44ec7743578e7715c65261f5dab7/pvactools/tools/pvacview/data/cancer_census_hotspot_gene_list.tsv") - #gene_list <- read.table(text = gene_data, sep = '\t', header = FALSE, stringsAsFactors = FALSE, check.names=FALSE) - #df_custom$gene_list <- gene_list - #df_custom$mainTable$`Gene of Interest` <- apply(df_custom$mainTable,1, function(x) {any(x['Gene Name'] == df_custom$gene_list)}) - df_custom$metricsData <- get_group_inds(df_custom$fullData, df_custom$group_inds) - df_custom$peptide_features <- input$peptide_features - updateTabItems(session, "custom_tabs", "custom_explore") - }) - output$customTable <- DT::renderDataTable( - if (is.null(df_custom$mainTable)) { - return(datatable(data.frame("Annotated Table" = character()))) - }else { - datatable(df_custom$mainTable, - escape = FALSE, class = "stripe", - options = list(lengthChange = FALSE, dom = "Bfrtip", pageLength = input$custom_page_length, - columnDefs = list(list(visible = FALSE, targets = c(-1:-12)), - list(orderable = TRUE, targets = 0)), buttons = list(I("colvis")), - initComplete = htmlwidgets::JS( - "function(settings, json) {", - paste("$(this.api().table().header()).css({'font-size': '", "10pt", "'});"), - "}")), - selection = "none", - extensions = c("Buttons")) - }, server = FALSE) - observeEvent(input$custom_select_button, { - if (is.null(df_custom$mainTable) | is.null(df_custom$selectedRow)){ - return () - } - #browser() - df_custom$selectedRow <- as.numeric(strsplit(input$custom_select_button, "_")[[1]][2]) - session$sendCustomMessage('unbind-DT', 'customTable') - dataTableProxy("customMainTable") %>% - selectPage((df_custom$selectedRow-1) %/% df_custom$pageLength + 1) - }) - output$customPeptideTable <- renderDT({ - withProgress(message = 'Loading Peptide Table', value = 0, { - incProgress(0.5) - #browser() - if (!is.null(df_custom$selectedRow) & !(is.null(df_custom$mainTable)) & !is.null(df_custom$peptide_features)){ - display_table <- get_current_group_info(df_custom$peptide_features, df_custom$metricsData, df_custom$fullData, df_custom$selectedRow) - incProgress(0.5) - dtable <- datatable(display_table, options =list( - pageLength = 10, - rowCallback = JS('function(row, data, index, rowId) {', - 'console.log(rowId)','if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {', - 'row.style.backgroundColor = "#E0E0E0";','}','}') - ), selection = list(mode='single', selected = '1')) - dtable - } - else{ - incProgress(1) - datatable(data.frame("Peptide Datatable"=character()), selection = list(mode='single', selected = '1')) - }}) - }) -}) - diff --git a/pvactools/tools/pvacview_dev_eve/styling.R b/pvactools/tools/pvacview_dev_eve/styling.R deleted file mode 100755 index 336f05f94..000000000 --- a/pvactools/tools/pvacview_dev_eve/styling.R +++ /dev/null @@ -1,61 +0,0 @@ -## server side callback functions -rowcallback <- function(hla_count, row_num) { - c( - "function(row, data, displayNum, displayIndex){", - gsub("0", row_num, " if (displayIndex == 0){"), - " $('td',row).css('border-top','3px solid #0390fc');", - " $('td',row).css('border-bottom','3px solid #0390fc');", - " }", - "}") -} - -callback <- function(hla_count, score_mode) { - c( - "var tips = ['Gene - The Ensembl gene name of the affected gene.',", - " 'AA Change - The amino acid change for the mutation. Note that FS indicates a frameshift variant.',", - " 'Num Passing Transcripts - The number of transcripts for this mutation that resulted in at least one well-binding peptide.',", - " 'Best Peptide - The best-binding mutant epitope sequence (lowest mutant binding affinity) prioritizing epitope sequences that resulted from a protein_coding transcript with a TSL below the maximum transcript support level and having no problematic positions.',", - " 'Best Transcript - Transcript corresponding to the best peptide with the lowest TSL and shortest length.',", - " 'TSL - Transcript support level of the best peptide.',", - " 'Pos - The one-based position of the start of the mutation within the epitope sequence. 0 if the start of the mutation is before the epitope (as can occur downstream of frameshift mutations).',", - " 'Prob Pos - Problematic positions within the best peptide.',", - " 'Num Passing Peptides - The number of unique well-binding peptides for this mutation.',", - gsub("X", score_mode," 'IC50 MT - X IC50 binding affinity of the best-binding mutant epitope across all prediction algorithms used.', "), - " 'IC50 WT - IC50 binding affinity of the corresponding wildtype epitope.',", - gsub("X", score_mode," '%ile MT - X binding affinity percentile rank of the best-binding mutant epitope across all prediction algorithms used (those that provide percentile output).', "), - " '%ile WT - Binding affinity percentile rank of the corresponding wildtype epitope across all prediction algorithms used (those that provide percentile output).', ", - " 'RNA Expr - Gene expression value for the annotated gene containing the variant.',", - " 'RNA VAF - Tumor RNA variant allele frequency (VAF) at this position.',", - " 'Allele Expr - Gene expression value * Tumor RNA VAF. This is used to approximate the expression of the variant allele.',", - " 'RNA Depth - Tumor RNA depth at this position.',", - " 'DNA VAF - Tumor DNA variant allele frequency (VAF) at this position.',", - " 'Tier - A tier suggesting the suitability of variants for use in vaccines.',", - " 'Eval - User-selected evaluation of neoantigen candidate. Options include: Accept, Reject, Review. (Default: Pending)'],", - "header = table.columns().header();", - gsub("7", hla_count, "for (var i = 7; i-7 < tips.length; i++) {"), - gsub("7", hla_count, "$(header[i]).attr('title', tips[i-7]);"), - "}" - ) -} - - -#### ui side styling settings -csscode <- HTML(" -.sidebar-mini.sidebar-collapse .shiny-bound-input.action-button { - margin: 6px 6px 6px 3px; - max-width: 85%; -} -.sidebar-mini.sidebar-collapse .fa { - font-size: initial; -} -.sidebar-mini.sidebar-collapse #tohide { - display: none; -} -") - -# Create the theme -mytheme <- create_theme( - adminlte_color( - light_blue = "#4e635c" - ) -) diff --git a/pvactools/tools/pvacview_dev_eve/test_data/vaxrank_output.tsv b/pvactools/tools/pvacview_dev_eve/test_data/vaxrank_output.tsv deleted file mode 100644 index 5bc515518..000000000 --- a/pvactools/tools/pvacview_dev_eve/test_data/vaxrank_output.tsv +++ /dev/null @@ -1,4 +0,0 @@ -Allele Mutant_peptide_sequence Score Predicted_mutant_pMHC_affinity Variant_allele RNA_read_count Wildtype_sequence Predicted_wildtype_pMHC_affinity Gene_name Genomic_variant -HLA-C*06:02 RKFSYRSTV 3.602910221 44.90 1457 RKFSYRSRV 228.5788773 DDX3X chrX_g.41344255G>C -HLA-C*06:02 SYRSTVRPC 3.602910221 85.53 1457 SYRSRVRPC 153.3440023 DDX3X chrX_g.41344255G>C -HLA-A*29:02 STVRPCVVY 3.602910221 115.78 1457 SRVRPCVVY 3415.131825 DDX3X chrX_g.41344255G>C diff --git a/pvactools/tools/pvacview_dev_eve/ui.R b/pvactools/tools/pvacview_dev_eve/ui.R deleted file mode 100755 index cd4307b38..000000000 --- a/pvactools/tools/pvacview_dev_eve/ui.R +++ /dev/null @@ -1,648 +0,0 @@ -# load shiny library -library(shiny) -library(shinydashboard) -library(shinydashboardPlus) -library(DT) -library(fresh) -library(shinycssloaders) - -source("styling.R") -source("neofox_ui.R") -source("custom_ui.R") - -## UPLOAD TAB ## -upload_tab <- tabItem( - "upload", - # infoBoxes - fluidRow( - column(width = 6, - box( - title="Option 1: View demo data", status = "primary", solidHeader = TRUE, width = NULL, - actionButton("loadDefaultmain", "Load demo data", style = "color: #fff; background-color: #c92424; border-color: #691111"), - h5("Please wait a couple seconds after clicking and you should be redirected to the Visualize and Explore tab.") - ), - box( - title = "Option 2: Upload your own data Files", status = "primary", solidHeader = TRUE, width = NULL, - HTML("
(Required) Please upload the aggregate report file. Note that this will be the data displayed in the main table in the Explore tab.
"), - uiOutput("aggregate_report_ui"), - radioButtons("hla_class", "Does this aggregate report file correspond to Class I or Class II prediction data?", - c("Class I data (e.g. HLA-A*02:01) " = "class_i", "Class II data (e.g. DPA1*01:03)" = "class_ii")), - hr(style = "border-color: white"), - HTML("
(Required) Please upload the corresponding metrics file for the main file that you have chosen.
"), - uiOutput("metrics_ui"), - hr(style = "border-color: white"), - HTML("
(Optional) If you would like, you can upload an additional aggregate report file generated with either Class I or Class II results to supplement your main table. (E.g. if you uploaded Class I data as the main table, you can upload your Class II report here as supplemental data)
"), - uiOutput("add_file_ui"), - textInput("add_file_label", "Please provide a label for the additional file uploaded (e.g. Class I data or Class II data)"), - hr(style = "border-color: white"), - HTML("
(Optional) Additionally, you can upload a gene-of-interest list in a tsv format, where each row is a single gene name. These genes (if in your aggregate report) will be highlighted in the Gene Name column.
"), - fileInput(inputId = "gene_list", label = "4. Gene-of-interest List (tsv required)", accept = c("text/tsv", "text/tab-separated-values,text/plain", ".tsv")), - actionButton("visualize", "Visualize") - ) - ), - column(6, - box( - title = "Basic Instructions: How to explore your data using pVACview?", status = "primary", solidHeader = TRUE, width = NULL, - h4("Step 1: Upload your own data / Load demo data", style = "font-weight: bold"), - h5("You can either choose to explore a demo dataset that we have prepared from the HCC1395 cell line, or choose to upload your own datasets."), - HTML("
If you are uploading your own datasets, the two required inputs are output files you obtain after running the pVACseq pipeline. - The aggregated tsv file is a list of all predicted epitopes and their binding affinity scores with additional variant information - and the metrics json file contains additional transcript and peptide level information.
"), - h5("You have the option of uploading an additional file to supplement the data you are exploring. This includes: additional class I or II information and - a gene-of-interest tsv file."), - actionButton("help_doc_upload", "More details", onclick = "window.open('https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#upload', '_blank')"), - h4("Step 2: Exploring your data", style = "font-weight: bold"), - HTML("
To explore the different aspects of your neoantigen candidates, you will need to navigate to the Aggregate Report of Best Candidate by Variant on the visualize and explore tab. - For detailed variant, transcript and peptide information for each candidate listed, you will need to click on the Investigate button for the specific row of interest. - This will prompt both the transcript and peptide table to reload with the matching information.
"), - h5("By hovering over each column header, you will be able to see a brief description of the corresponding column and for more details, you can click on the tooltip located at the top right of the aggregate report table.", br(), - "After investigating each candidate, you can label the candidate using the dropdown menu located at the second to last column of the table. Choices include: - Accept, Reject or Review."), - actionButton("help_doc_explore", "More details", onclick = "window.open('https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#visualize-and-explore', '_blank')"), - h4("Step 3: Exporting your data", style = "font-weight: bold"), - h5("When you have either finished ranking your neoantigen candidates or need to pause and would like to save your current evaluations, - you can export the current main aggregate report using the export page."), - HTML("
Navigate to the export tab, and you will be able to name your file prior to downloading in either tsv or excel format. - The excel format is user-friendly for downstream visualization and manipulation. However, if you plan on to continuing editing the aggregate report - and would like to load it back in pVACview with the previous evaluations preloaded, you will need to download the file in a tsv format. - This serves as a way to save your progress as your evaluations are cleared upon closing or refreshing the pVACview app.
"), - actionButton("help_doc_export", "More details", onclick = "window.open('https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#export', '_blank')") - ) - ), - ) -) - -## EXPLORE TAB ## -explore_tab <- tabItem( - "explore", - conditionalPanel( - condition = "output.filesUploaded", - fluidRow( - tags$style( - type = "text/css", - ".modal-dialog { width: fit-content !important; }" - ), - tags$script(HTML("Shiny.addCustomMessageHandler('unbind-DT', function(id) { - Shiny.unbindAll($('#'+id).find('table').DataTable().table().node()); - })")), - box(width = 6, - title = "Advanced Options: Regenerate Tiering with different parameters", - status = "primary", solidHeader = TRUE, collapsible = TRUE, collapsed = TRUE, - "*Please note that the metrics file is required in order to regenerate tiering information with different parameters", br(), - "Current version of pVACseq results defaults to positions 1, 2, n-1 and n (for a n-mer peptide) when determining anchor positions. - If you would like to use our allele specific anchor results and regenerate the tiering results for your variants, - please specify your contribution cutoff and submit for recalculation. ", tags$a(href = "https://www.biorxiv.org/content/10.1101/2020.12.08.416271v1", "More details can be found here.", target = "_blank"), br(), - uiOutput("allele_specific_anchors_ui"), - uiOutput("anchor_contribution_ui"), - uiOutput("binding_threshold_ui"), - uiOutput("allele_specific_binding_ui"), - uiOutput("percentile_threshold_ui"), - uiOutput("dna_cutoff_ui"), - uiOutput("allele_expr_ui"), - h5("For further explanations on these inputs, please refer to the ", tags$a(href = "https://pvactools.readthedocs.io/en/latest/pvacview/getting_started.html#visualize-and-explore", "pVACview documentation.", target = "_blank")), - actionButton("submit", "Recalculate Tiering with new parameters"), - style = "overflow-x: scroll;font-size:100%"), - box(width = 3, - title = "Original Parameters for Tiering", - status = "primary", solidHeader = TRUE, collapsible = TRUE, - column(width = 12, - h5("These are the original parameters used in the tiering calculations extracted from the metrics data file given as input."), - tableOutput("paramTable"), - tableOutput("bindingParamTable"), style = "height:250px; overflow-y: scroll;overflow-x: scroll;"), - actionButton("reset_params", "Reset to original parameters"), - style = "overflow-x: scroll;font-size:100%"), - box(width = 3, - title = "Add Comments for selected variant", - status = "primary", solidHeader = TRUE, collapsible = TRUE, - textAreaInput("comments", "Please add/update your comments for the variant you are currently examining", value = ""), - actionButton("comment", "Update Comment Section"), - h5("Comment:"), htmlOutput("comment_text"), - style = "font-size:100%") - ), - fluidRow( - box(width = 12, - title = "Aggregate Report of Best Candidates by Variant", - status = "primary", solidHeader = TRUE, collapsible = TRUE, - enable_sidebar = TRUE, sidebar_width = 25, sidebar_start_open = TRUE, - dropdownMenu = boxDropdown(boxDropdownItem("Help", id = "help", icon = icon("question-circle"))), - selectInput("page_length", "Number of variants displayed per page:", selected = "10", c("10", "20", "50", "100"), width = "280px"), - DTOutput("mainTable") %>% withSpinner(color = "#8FCCFA"), - span("Currently investigating row: ", verbatimTextOutput("selected")), - style = "overflow-x: scroll;font-size:100%") - ), - - fluidRow( - box(width = 12, title = "Variant Information", status = "primary", solidHeader = TRUE, collapsible = TRUE, - tabBox(width = 6, title = " ", - tabPanel("Transcript Sets of Selected Variant", - DTOutput("transcriptSetsTable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;font-size:100%"), - tabPanel("Reference Matches", - h4("Best Peptide Data"), - column(6, - span("Best Peptide: "), - plotOutput(outputId = "referenceMatchPlot", height="20px") - ), - column(2, - span("AA Change: ", verbatimTextOutput("selectedAAChange")) - ), - column(2, - span("Pos: ", verbatimTextOutput("selectedPos")) - ), - column(2, - span("Gene: ", verbatimTextOutput("selectedGene")) - ), - h4("Query Data"), - h5(uiOutput("hasReferenceMatchData")), - column(10, - span("Query Sequence: "), - plotOutput(outputId = "referenceMatchQueryPlot", height="20px") - ), - column(2, - span("Hits: ", verbatimTextOutput("referenceMatchHitCount")) - ), - h4("Hits"), - DTOutput(outputId = "referenceMatchDatatable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" - ), - tabPanel("Additional Data", - span("Additional Data Type: ", verbatimTextOutput("type_text")), - span("Median MT IC50: ", verbatimTextOutput("addData_IC50")), - span("Median MT Percentile: ", verbatimTextOutput("addData_percentile")), - span("Best Peptide: ", verbatimTextOutput("addData_peptide")), - span("Corresponding HLA allele: ", verbatimTextOutput("addData_allele")), - span("Best Transcript: ", verbatimTextOutput("addData_transcript"))) - ), - box(width = 4, solidHeader = TRUE, title = "Variant & Gene Info", - span("DNA VAF", verbatimTextOutput("metricsTextDNA")), - span("RNA VAF", verbatimTextOutput("metricsTextRNA")), - span("Gene Expression", verbatimTextOutput("metricsTextGene")), - span("Genomic Information (chromosome - start - stop - ref - alt)", verbatimTextOutput("metricsTextGenomicCoord")), - h5("Additional variant information:"), - uiOutput("url"), style = "overflow-x: scroll;font-size:100%"), - box(width = 2, solidHeader = TRUE, title = "Peptide Evalutation Overview", - tableOutput("checked"), style = "overflow-x: scroll;font-size:100%") - ) - ), - fluidRow( - box(width = 12, title = "Transcript Set Detailed Data", solidHeader = TRUE, collapsible = TRUE, status = "primary", - tabBox(width = 12, title = " ", - tabPanel("Peptide Candidates from Selected Transcript Set", - DTOutput("peptideTable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;font-size:100%"), - tabPanel("Transcripts in Set", - DTOutput("transcriptsTable") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;font-size:100%") - ) - ) - ), - fluidRow( - box(width = 12, title = "Additional Peptide Information", status = "primary", solidHeader = TRUE, collapsible = TRUE, - tabBox(title = " ", id = "info", - tabPanel("IC50 Plot", - h4("Violin Plots showing distribution of MHC IC50 predictions for selected peptide pair (MT and WT)."), - plotOutput(outputId = "bindingData_IC50") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" - ), - tabPanel("%ile Plot", - h4("Violin Plots showing distribution of MHC percentile predictions for selected peptide pair (MT and WT)."), - plotOutput(outputId = "bindingData_percentile") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" - ), - tabPanel("Binding Data", - h4("Prediction score table showing exact MHC binding values for IC50 and percentile calculations."), - DTOutput(outputId = "bindingDatatable"), style = "overflow-x: scroll;" - ), - tabPanel("Elution Table", - h4("Prediction score table showing exact MHC binding values for elution and percentile calculations."), - DTOutput(outputId = "elutionDatatable"), - br(), - strong("MHCflurryEL Processing"), span(': An "antigen processing" predictor that attempts to model MHC allele-independent effects such as proteosomal cleavage. ('), - a(href = "https://www.sciencedirect.com/science/article/pii/S2405471220302398", "Citation"), span(")"), - br(), - strong("MHCflurryEL Presentation"), span(': A predictor that integrates processing predictions with binding affinity predictions to give a composite "presentation score." ('), - a(href = "https://www.sciencedirect.com/science/article/pii/S2405471220302398", "Citation"), span(")"), - br(), - strong("NetMHCpanEL / NetMHCIIpanEL"), span(": A predictor trained on eluted ligand data. ("), - a(href = "https://academic.oup.com/nar/article/48/W1/W449/5837056", "Citation"), span(")"), - style = "overflow-x: scroll;" - ), - tabPanel("Anchor Heatmap", - h4("Allele specific anchor prediction heatmap for top 20 candidates in peptide table."), - plotOutput(outputId = "peptideFigureLegend", height = "50px"), - plotOutput(outputId = "anchorPlot") %>% withSpinner(color = "#8FCCFA"), style = "overflow-x: scroll;" - ) - ), - box( - column(width = 4, - h4("Allele Specific Anchor Prediction Heatmap"), - h5(" This tab displays HLA allele specific anchor predictions overlaying good-binding peptide sequences generated from each specific transcript.", br(), - " Current version supports the first 15 MT/WT peptide sequence pairs (first 30 rows of the peptide table)."), br(), - h4("MHC Binding Prediction Scores"), - h5(" This tab contains violin plots that showcase individual binding prediction scores from each algorithm used. A solid line is used to represent the median score.") - ), - column(width = 8, - box(title = "Anchor vs Mutation position Scenario Guide", collapsible = TRUE, collapsed = FALSE, width = 12, - img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/anchor.jpg", - align = "center", height = "350px", width = "600px"), style = "overflow-x: scroll;") - ) - ) - ) - ) - ), - conditionalPanel( - condition = "output.filesUploaded == false", - h4("Error: Missing required files (both aggregate report and metrics files are required to properly visualize and explore candidates).", style = "font-weight: bold"), - ) -) - -## EXPORT TAB ## -export_tab <- tabItem( - "export", - fluidRow( - textInput("exportFileName", "Export filename: ", value = "Annotated.Neoantigen_Candidates", width = NULL, placeholder = NULL) - ), - fluidRow( - column(12, - DTOutput("ExportTable") %>% withSpinner(color = "#8FCCFA")) - ) -) - -## TUTORIAL TAB ## -tutorial_tab <- tabItem("tutorial", - tabsetPanel(type = "tabs", - tabPanel("Variant Level", - ## Aggregate Report Column Descriptions" - h3("Main table full column descriptions"), - p("If using pVACview with pVACtools output, the user is required to provide at least the following two files: ", - code("all_epitopes.aggregated.tsv"), code("all_epitopes.aggregated.metrics.json")), br(), - p("The ", code("all_epitopes.aggregated.tsv"), - "file is an aggregated version of the all_epitopes TSV. - It presents the best-scoring (lowest binding affinity) epitope for each variant, along with - additional binding affinity, expression, and coverage information for that epitope. - It also gives information about the total number of well-scoring epitopes for each variant, - the number of transcripts covered by those epitopes, and the HLA alleles that those - epitopes are well-binding to. Here, a well-binding or well-scoring epitope is any epitope that has a stronger - binding affinity than the ", code("aggregate_inclusion_binding_threshold"), "described below. The report then bins variants into - tiers that offer suggestions about the suitability of variants for use in vaccines."), br(), - p("The ", code("all_epitopes.aggregated.metrics.json"), - "complements the ", code("all_epitopes_aggregated.tsv"), "and is required for the tool's proper functioning."), br(), - p(strong("Column Names : Description")), - p(code("ID"), " : ", "A unique identifier for the variant"), - p(code("HLA Alleles"), " : ", "For each HLA allele in the run, the number of this variant’s - epitopes that bound well to the HLA allele (with ", code("lowest"), " or ", code("median"), - " mutant binding affinity < ", code("aggregate_inclusion_binding_threshold"), ")"), - p(code("Gene"), " : ", "The Ensembl gene name of the affected gene"), - p(code("AA Change"), " : ", "The amino acid change for the mutation"), - p(code("Num Passing Transcripts"), " : ", "The number of transcripts - for this mutation that resulted in at least one well-binding peptide (", code("lowest"), " or ", - code("median"), " mutant binding affinity < ", code("aggregate_inclusion_binding_threshold"), ")"), - p(code("Best Peptide"), " : ", "The best-binding mutant epitope sequence (lowest binding affinity) - prioritizing epitope sequences that resulted from a protein_coding transcript with a TSL below the - maximum transcript support level and having no problematic positions."), - p(code("Best Transcript"), " : ", "Transcript corresponding to the best peptide with the lowest TSL and shortest length."), - p(code("TSL"), " : ", "Transcript support level of the best peptide"), - p(code("Pos"), " : ", "The one-based position of the start of the mutation within the epitope sequence. ", - code("0"), " if the start of the mutation is before the epitope (as can occur downstream of frameshift mutations)"), - p(code("Num Passing Peptides"), " : ", "The number of unique well-binding peptides for this mutation."), - p(code("IC50 MT"), " : ", code("Lowest"), " or ", code("Median"), " ic50 binding affinity of - the best-binding mutant epitope across all prediction algorithms used."), - p(code("IC50 WT"), " : ", code("Lowest"), " or ", code("Median"), " ic50 binding affinity of - the corresponding wildtype epitope across all prediction algorithms used."), - p(code("%ile MT"), " : ", code("Lowest"), " or ", code("Median"), "binding affinity percentile rank - of the best-binding mutant epitope across all prediction algorithms used (those that provide percentile output)"), - p(code("%ile WT"), " : ", code("Lowest"), " or ", code("Median"), "binding affinity percentile rank of the - corresponding wildtype epitope across all prediction algorithms used (those that provide percentile output)"), - p(code("RNA Expr"), " : ", "Gene expression value for the annotated gene containing the variant."), - p(code("RNA VAF"), " : ", "Tumor RNA variant allele frequency (VAF) at this position."), - p(code("Allele Expr"), " : ", "RNA Expr * RNA VAF"), - p(code("RNA Depth"), " : ", "Tumor RNA depth at this position."), - p(code("DNA VAF"), " : ", "Tumor DNA variant allele frequency (VAF) at this position."), - p(code("Tier"), " : ", "A tier suggesting the suitability of variants for use in vaccines."), - p(code("Evaluation"), " : ", "Column to store the evaluation of each variant when evaluating the run in pVACview. - Can be ", code("Accept,"), " ", code("Reject"), " or ", code("Review"), "."), - ## Tiering Explained ## - h3("How is the Tiering column determined / How are the Tiers assigned?"), br(), - p(strong("Tier : Criteria")), - p(code("Pass"), " : ", code(("(MT binding < binding threshold) AND allele expr filter pass AND vaf clonal filter pass - AND tsl filter pass AND anchor residue filter pass"))), - p(code("Anchor"), " : ", code(("(MT binding < binding threshold) AND allele expr filter pass AND vaf clonal filter pass - AND tsl filter pass AND anchor residue filter fail"))), - p(code("Subclonal"), " : ", code(("(MT binding < binding threshold) AND allele expr filter pass AND vaf clonal filter fail - AND tsl filter pass AND anchor residue filter pass"))), - p(code("LowExpr"), " : ", code(("(MT binding < binding threshold) AND low expression criteria met AND allele expr filter pass - AND vaf clonal filter pass AND tsl filter pass AND anchor residue filter pass"))), - p(code("Poor"), " : ", "Best peptide for current variant FAILS in two or more categories"), - p(code("NoExpr"), " : ", code("((gene expr == 0) OR (RNA VAF == 0)) AND low expression criteria not met")), br(), - p("Here we list out the exact criteria for passing each respective filter: "), - p(strong("Allele Expr Filter: "), code("(allele expr >= allele expr cutoff) OR (rna_vaf == 'NA') OR (gene_expr == 'NA')")), - p(strong("VAF Clonal Filter: "), code("(dna vaf < vaf subclonal) OR (dna_vaf == 'NA')")), - p(strong("TSL Filter: "), code("(TSL != 'NA') AND (TSL < maximum transcript support level)")), - p(strong("Anchor Residue Filter: "), br(), - strong("1. "), code("(Mutation(s) is at anchor(s)) AND - ((WT binding < binding threshold) OR (WT percentile < percentile threshold))"), br(), - strong(" OR"), br(), strong("2. "), code("Mutation(s) not or not entirely at anchor(s)")), - p(strong("Low Expression Criteria: "), code("(allele expr > 0) OR ((gene expr == 0) AND (RNA Depth > RNA Coverage Cutoff) AND (RNA VAF > RNA vaf cutoff))")),br(), - p("Note that if a percentile threshold has been provided, then the ", code("%ile MT"), " column is also required to be lower than - the given threshold to qualify for tiers, including Pass, Anchor, Subclonal and LowExpr.") - ), - tabPanel("Transcript Level", - h3(" "), - fluidRow( - column(width = 6, - h4("Transcript Set Table", style = "font-weight: bold; text-decoration: underline;"), - p("Upon selecting a variant for investigation, you may have multiple transcripts covering the region.", br(), br(), - "These transcripts are grouped into ", strong("Trancripts Sets"), " , based on the good-binding peptides - produced. (Transcripts that produce the exact same set of peptides are grouped together.)", br(), br(), - "The table also lists the number of transcripts and corresponding peptides in each set (each pair of WT and MT peptides are considered 1 when - counting).", br(), " A sum of the total expression across all transcripts in each set is also shown.", br(), " A light green color is used to - highlight the ", strong("Transcript Set"), " producing the Best Peptide for the variant in question.") - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Transcript_Set.png?raw=true", - align = "center", height = "300px", width = "500px"), - ) - ), - fluidRow( - column(width = 3, - h4("Transcript Set Detailed Data", style = "font-weight: bold; text-decoration: underline;"), - p("Upon selecting a specific transcript set, you can see more details about the exact transcripts that are included.", br(), br(), - "The ", strong("Transcripts in Set"), "table lists all information regarding each transcript including:", br(), br(), - "Transcript ID, Gene Name, Amino Acid Change, Mutation Position, individual transcript expression, transcript support level, biotype and transcript length.", br(), br(), - " A light green color is used to highlight the specific", strong("Transcript in Selected Set"), " that produced the Best Peptide for the variant in question.") - ), - column(width = 9, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Transcript_in_Set.png?raw=true", - align = "center", height = "300px", width = "1200px"), - ) - ) - ), - tabPanel("Peptide Level", - h4(" "), - fluidRow( - column(width = 12, - h4("Peptide Table", style = "font-weight: bold; text-decoration: underline;"), - p("Upon selecting a specific transcript set, you can also visualize which good-binding peptides are produced from this set.", br(), br(), - "Both, mutant (", code("MT"), ") and wildtype (", code("WT"), ") sequences are shown, along with either the", code("lowest"), " or ", code("median"), - " binding affinities, depending on how you generated the aggregate report.", br(), br(), - "An ", code("X"), "is marked for binding affinities higher than the ", code("aggregate_inclusion_binding_threshold"), " set when generating the aggregate report.", br(), br(), - "We also include three extra columns, one specifying the mutated position(s) in the peptide, one providing information on any problematic amino acids in the mutant sequence, and one identifying whether the peptide failed the anchor criteria for any of the HLA alleles.", br(), - "Note that if users wish to utlitize the ", strong("problematic positions"), " feature, they should run the standalone command ", code("pvacseq identify_problematic_amino_acids"), - " or run pVACseq with the ", code("--problematic-amino-acids"), " option enabled to generate the needed information." - ) - ) - ), - fluidRow( - column(width = 12, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Peptide_Table.png?raw=true", - align = "center", height = "400px", width = "1500px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h4("Additional Information", style = "font-weight: bold; text-decoration: underline;"), - h5("IC50 Plot", style = "font-weight: bold;"), - p("By clicking on each MT/WT peptide pair, you can then assess the peptides in more detail by navigating to the ", strong("Additional Peptide Information"), " tab.", br(), br(), - "There are five different tabs in this section of the app, providing peptide-level details on the MT/WT peptide pair that you have selected.", br(), - "The ", strong("IC50 Plot"), "tab shows violin plots of the individual IC50-based binding affinity predictions of the MT and WT peptides for HLA - alleles that the MT binds well to. These peptides each have up to 8 binding algorithm scores for Class I alleles or up - to 4 algorithm scores for Class II alleles.", br()) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_IC50_Plots.png?raw=true", - align = "center", height = "350px", width = "700px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h5("%ile Plot", style = "font-weight: bold;"), - p("The ", strong("%ile Plot"), "tab shows violin plots of the individual percentile-based binding affinity predictions of the MT and WT peptides - for HLA alleles that the MT binds well to.", br()) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Percentile_Plots.png?raw=true", - align = "center", height = "350px", width = "700px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h5("Binding Data", style = "font-weight: bold;"), - p("The ", strong("Binding Data"), "tab shows the specific IC50 and percentile binding affinity predictions generated from each individual algorithm. - Each cell shows the IC50 prediction followed by the percentile predictions in parenthesis.", br()) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Binding_Data.png?raw=true", - align = "center", height = "350px", width = "720px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h5("Elution Table", style = "font-weight: bold;"), - p("The ", strong("Elution Table"), "tab shows prediction results based on algorithms trained from peptide elution data. This includes algorithms - such as NetMHCpanEL/NetMHCIIpanEL, MHCflurryELProcessing and MHCflurryELPresentation.", br()) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Elution_Data.png?raw=true", - align = "center", height = "350px", width = "720px"), br(), br() - ) - ), - fluidRow( - column(width = 4, - h5("Anchor Heatmap", style = "font-weight: bold;"), - p("The ", strong("Anchor Heatmap"), "tab shows the top 30 MT/WT peptide pairs from the peptide table with anchor probabilities overlayed as a heatmap. - The anchor probabilities shown are both allele and peptide length specific. The mutated amino acid is marked in red (for missense mutations) and each - MT/WT pair are separated from others using a dotted line. ", br(), - "For peptide sequences with no overlaying heatmap, we currently do not have allele-specific predictions for them in our database.", br(), br(), - "For more details and explanations regarding anchor positions and its influence on neoantigen prediction and prioritization, please refer to the next section: ", - strong("Advanced Options: Anchor Contribution")) - ), - column(width = 8, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Anchor_Heatmap.png?raw=trueg", - align = "center", height = "350px", width = "720px"), br(), br() - ) - ) - ), - tabPanel("Advanced Options: Anchor Contribution", - h4(" "), - fluidRow( - column(width = 6, - h4("Anchor vs Mutation Posiions", style = "font-weight: bold; text-decoration: underline;"), - p("Neoantigen identification and prioritization relies on correctly predicting whether the presented - peptide sequence can successfully induce an immune response. As the majority of somatic mutations are single nucleotide variants, - changes between wildtype and mutated peptides are typically subtle and require cautious interpretation. ", br(), br(), - "In the context of neoantigen presentation by specific MHC alleles, researchers have noted that a subset of - peptide positions are presented to the T-cell receptor for recognition, while others are responsible for anchoring - to the MHC, making these positional considerations critical for predicting T-cell responses.", br(), br(), - "Multiple factors should be considered when prioritizing neoantigens, including mutation location, anchor position, predicted MT - and WT binding affinities, and WT/MT fold change, also known as agretopicity.", br(), br(), - "Examples of the four distinct possible scenarios for a predicted strong MHC binding peptide involving these factors are illustrated - in the figure on the right. There are other possible scenarios where the MT is a poor binder, however those are not listed as - they would not pertain to our goal of neoantigen identification.", br(), br(), - strong("Scenario 1"), "shows the case where the WT is a poor binder and the MT peptide is a strong binder, - containing a mutation at an anchor location. Here, the mutation results in a tighter binding of the MHC and allows for - better presentation and potential for recognition by the TCR. As the WT does not bind (or is a poor binder), this neoantigen - remains a good candidate since the sequence presented to the TCR is novel.", br(), br(), - strong("Scenario 2"), " and ", strong("Scenario 3"), " both have strong binding WT and MT peptides. In ", strong("Scenario 2"), - ", the mutation of the peptide is located at a non-anchor location, creating a difference in the sequence participating in TCR - recognition compared to the WT sequence. In this case, although the WT is a strong binder, the neoantigen remains a good candidate - that should not be subject to central tolerance.", br(), br(), - "However, as shown in ", strong("Scenario 3"), ", there are neoantigen candidates where the mutation is located at the anchor position - and both peptides are strong binders. Although anchor positions can themselves influence TCR recognition, a mutation at a strong - anchor location generally implies that both WT and MT peptides will present the same residues for TCR recognition. As the WT peptide - is a strong binder, the MT neoantigen, while also a strong binder, will likely be subject to central tolerance and should not be - considered for prioritization.", br(), br(), - strong("Scenario 4"), " is similar to the first scenario where the WT is a poor binder. However, in this case, the mutation is - located at a non-anchor position, likely resulting in a different set of residues presented to the TCR and thus making the neoantigen a good candidate." - ) - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Anchor_Scenarios.png?raw=true", - align = "center", height = "800px", width = "400px"), br(), br() - ) - ), - fluidRow( - column(width = 6, - h4("Anchor Guidance", style = "font-weight: bold; text-decoration: underline;"), - p("To summarize, here are the specific criteria for prioritizing (accept) and not prioritizing (reject) a neoantigen candidate:", br(), - "Note that in all four cases, we are assuming a strong MT binder which means ", - code("(MT IC50 < binding threshold) OR (MT percentile < percentile threshold)"), br(), br()), - p(code("I: WT Weak binder"), " : ", code("(WT IC50 < binding threshold) OR (WT percentile < percentile threshold)")), - p(code("II: WT Strong binder"), " : ", code("(WT IC50 > binding threshold) AND (WT percentile > percentile threshold)")), - p(code("III: Mutation at Anchor"), " : ", code("set(All mutated positions) is a subset of set(Anchor Positions of corresponding HLA allele)")), - p(code("IV: Mutation not at Anchor"), " : ", code("There is at least one mutated position between the WT and MT that is not at an anchor position")), - p(strong("Scenario 1 : "), code(" I + IV"), strong(" -> Accept")), - p(strong("Scenario 2 : "), code(" II + IV"), strong(" -> Accept")), - p(strong("Scenario 3 : "), code(" II + III"), strong(" -> Reject")), - p(strong("Scenario 4 : "), code(" I + III"), strong(" -> Accept")) - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/anchor.jpg", - align = "center", height = "350px", width = "600px"), br(), br() - ) - ) - ), - tabPanel("Advanced Options: Regenerate Tiering", - h4(" "), - fluidRow( - column(width = 6, - h4("Reassigning Tiers for all variants after adjusting parameters", style = "font-weight: bold; text-decoration: underline;"), - p("The Tier column generated by pVACtools is aimed at helping users group and prioritize neoantigens in a more efficient manner. - For details on how Tiering is done, please refer to the Variant Level tutorial tab where we break down each - specific Tier and its criteria.", br(), br(), - "While we try to provide a set of reasonable default parameters, we fully understand the need for flexible changes to the - parameters used in the underlying Tiering algorithm. Thus, we provide an Advanced Options tab in our app where users can change the following - cutoffs custom to their individual analysis: ", br(), br(), - code("Binding Threshold"), p("IC50 cutoff for a peptide to be considered a strong binder. Note that if allele-specific binding thresholds are - in place, those will stay the same and not overwritten by this parameter value change."), br(), - code("Percentile Threshold"), p("Percentile cutoff for a peptide to be considered a strong binder."), br(), - code("Clonal DNA VAF"), p("VAF cutoff that is taken into account when deciding subclonal variants. Note that variants with a DNA VAF lower - than half of the clonal VAF cutoff will be considered subclonal (e.g. setting a 0.6 clonal VAF cutoff means anything under 0.3 VAF is subclonal)."), br(), - code("Allele Expr"), p("Allele expression cutoff for a peptide to be considered expressed. Note for each variant, the allele expression - is calculated by multiplying gene expression and RNA VAF."), br(), - code("Default Anchors vs Allele-specific Anchors"), br(), - "By default, pVACtools considers positions 1, 2, n-1, and n to be anchors for an n-mer allele. However, a recent study has shown that anchors should be - considered on an allele-specific basis and different anchor patterns exist among HLA alleles.", - "Here, we provide users with the option to utilize allele-specific anchors when generating the Anchor Tier. However, to objectively determine - which positions are anchors for each individual allele, the users need to set a contribution percentage threshold (X).", - "Per anchor calculation results from the described computational workflow in the cited paper, each position of the n-mer peptide is assigned a - score based on how its binding to a certain HLA allele was influenced by mutations. These scores can then be used to calculate the relative - contribution of each position to the overall binding affinity of the peptide. Given the contribution threshold X, we rank the normalized score - across the peptide in descending order (e.g. [2,9,1,3,2,8,7,6,5] for a 9-mer peptide) and start summing the scores from top to bottom. - Positions that together account for X% of the overall binding affinity change (e.g. 2,9,1) will be assigned as anchor locations for tiering purposes.", br(), br(), - "However, we recommend users also navigating to the Anchor Heatmap Tab in the peptide level description for a less binary approach." - ) - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Regenerate_Tiering.png?raw=true", - align = "center", height = "400px", width = "700px"), br(), br() - ) - ), - fluidRow( - column(width = 6, - h4("Original Parameters", style = "font-weight: bold; text-decoration: underline;"), - p(" In this box, we provide users with the original parameters they had used to generate the currently loaded aggregate report and metrics file.", - "This not only allows users to compare their current parameters (if changed) with the original setting but we also offer a ", strong("reset"), - " button that allows the user to restore the original tiering when desired.", br(), br(), - "Note that the app will keep track of your peptide evaluations and comments accordingly even when changing or reseting the parameters.", br(), br(), - "If you see a parameter in the original parameter box but did not see an option to change it in the advanced options section, it is likely that you - will be required to rerun the", code("pvacseq generate-aggregate-report"), " command. This is likely due to the current metrics file not - having the necessary peptide information to perform this request." - ) - ), - column(width = 6, - img(src = "https://github.com/griffithlab/pVACtools/blob/pvacview/pvactools/tools/pvacview/www/Explore_Original_Parameters.png?raw=true", - align = "center", height = "400px", width = "300px"), br(), br() - ) - ) - ) - ) -) - -## CONTACT TAB ## -contact_tab <- tabItem("contact", - p("Bug reports or feature requests can be submitted on the ", tags$a(href = "https://github.com/griffithlab/pVACtools", "pVACtools Github page."), - "You may also contact us by email at ", code("help@pvactools.org", ".")) - -) - -ui <- dashboardPage( - ## HEADER ## - header = dashboardHeader( - title = tagList(tags$a(class = "logo", - span(class = "logo-mini", tags$img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/pVACview_logo_mini.png")), - span(class = "logo-lg", tags$img(src = "https://github.com/griffithlab/pVACtools/raw/master/pvactools/tools/pvacview/www/pVACview_logo.png")) - )), - tags$li(class = "dropdown", tags$a(href = "https://pvactools.readthedocs.io/en/latest/", class = "my_class", "Help", target = "_blank")) - ), - ## SIDEBAR ## - sidebar = dashboardSidebar( - sidebarMenu( - tags$head(tags$style(csscode)), - id = "tabs", - menuItem("pVACtools Output", tabName = "pvactools", startExpanded = TRUE, icon = icon("far fa-chart-bar"), - br(), - menuSubItem("Upload", tabName = "upload", icon = icon("upload")), - br(), - menuSubItem("Visualize and Explore", tabName = "explore", icon = icon("digital-tachograph")), - br(), - menuSubItem("Export", tabName = "export", icon = icon("file-export")), - br() - ), - menuItem("Tutorials", tabName = "tutorial", startExpanded = TRUE, icon = icon("fas fa-book-open")), - menuItem("Neofox Data Visualization", tabName = "neofox", startExpanded = TRUE, icon = icon("fas fa-file")), - menuItem("Custom Data Visualization", tabName = "custom", startExpanded = TRUE, icon = icon("fas fa-pen-to-square")), - menuItem("pVACview Documentation", icon = icon("fas fa-file-invoice"), href = "https://pvactools.readthedocs.io/en/latest/pvacview.html"), - menuItem("Submit Github Issue", tabName = "contact", icon = icon("far fa-question-circle")) - ) - ), - body = dashboardBody( - use_theme(mytheme), - tags$head( - tags$style(HTML("table.dataTable tr.active td, table.dataTable td.active {color: black !important}")), - tags$style(HTML("table.dataTable { border-collapse: collapse;}")), - tags$style(HTML("table.dataTable.hover tbody tr:hover, table.dataTable.display tbody tr:hover { - background-color: #92c8f0 !important; } ")), - tags$style(HTML(".skin-blue .main-header .logo {background-color: #dff5ee;}")), - tags$style(HTML(".skin-blue .main-header .navbar { background-color: #739187;}")), - tags$style(HTML("element.style {}.skin-blue .wrapper, .skin-blue .main-sidebar, .skin-blue .left-side {background-color: #739187;}")), - tags$style(HTML(".main-header .sidebar-toggle {background-color: #b6d1c8}")), - tags$style(HTML(".box-header.with-border {border-bottom: 1px solid #f4f4f4;}")), - tags$style(HTML(".skin-blue .main-header .navbar .sidebar-toggle {color: #4e635c;}")), - tags$style(HTML(".content-wrapper {background-color: #ecf0f5;}")), - tags$style(HTML(".main-header .logo {padding-right : 5px; padding-left : 5px;}")), - tags$style(HTML(".box.box-solid.box-primary {border-radius: 12px}")), - tags$style(HTML(".box-header.with-border {border-radius: 10px}")) - ), - - tabItems( - ## UPLOAD TAB ## - upload_tab, - ## EXPLORE TAB ## - explore_tab, - ## EXPORT TAB ## - export_tab, - ## TUTORIAL TAB ## - tutorial_tab, - ## NEOFOX TAB ## - neofox_tab, - ## CUSTOM TAB ## - custom_tab, - ## CONTACT TAB ## - contact_tab - ) - ) -) \ No newline at end of file