Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Various pVACview improvements #1012

Merged
merged 12 commits into from
Feb 27, 2024
Merged

Various pVACview improvements #1012

Show file tree
Hide file tree
Changes from 11 commits
Commits
Show all changes
12 commits
Select commit Hold shift + click to select a range
36160ad
Move anchor heatmap to the Transcript Set Detailed Data panel
susannasiebert Jul 31, 2023
71f52db
Rename Transcript Set Detailed Data panel in pVACview
susannasiebert Aug 3, 2023
16f542f
Merge remote-tracking branch 'origin/staging' into pvacview
susannasiebert Jan 24, 2024
39a5422
Merge remote-tracking branch 'origin/staging' into pvacview
susannasiebert Feb 13, 2024
5b09991
Remove Show X entries dropdown from binding and elution data tables
susannasiebert Feb 13, 2024
f124d85
Update header for elution data table
susannasiebert Feb 13, 2024
f70bfcc
Display pVACtools version on the bottom of the sidebar menu
susannasiebert Feb 13, 2024
d75a597
Improve anchor heatmap display
susannasiebert Feb 14, 2024
a18ea70
Add anchor weights table
susannasiebert Feb 15, 2024
6299b16
Add box showing current tiering parameters
susannasiebert Feb 19, 2024
4d8b287
By default, select the transcript set in with the best transcript in …
susannasiebert Feb 19, 2024
d7274b6
Apply suggestions from code review
susannasiebert Feb 20, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
37 changes: 37 additions & 0 deletions pvactools/tools/pvacview/anchor_and_helper_functions.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
library(RCurl)
library(curl)
library(data.table)

## Load Anchor data
anchor_data <- list()
Expand Down Expand Up @@ -80,6 +81,42 @@ peptide_coloring <- function(hla_allele, peptide_row) {
colors <- colorRampPalette(c("lightblue", "blue"))(99)[value_bins]
return(colors[[position]])
}
#calculate per-length anchor score for HLA allele
anchor_weights_for_alleles <- function(hla_alleles) {
scores_df <- data.frame()
for (hla_allele in hla_alleles) {
if (any(hla_allele == anchor_data[[8]]["HLA"])) {
eight_mer_scores <- append(anchor_data[[8]][anchor_data[[8]]["HLA"] == hla_allele][1:(8 + 1)], "9mer", 1)
susannasiebert marked this conversation as resolved.
Show resolved Hide resolved
susannasiebert marked this conversation as resolved.
Show resolved Hide resolved
}
else {
eight_mer_scores <- c(hla_allele, "8mer")
}
if (any(hla_allele == anchor_data[[9]]["HLA"])) {
nine_mer_scores <- append(anchor_data[[9]][anchor_data[[9]]["HLA"] == hla_allele][1:(9 + 1)], "9mer", 1)
}
else {
nine_mer_scores <- c(hla_allele, "9mer")
}
if (any(hla_allele == anchor_data[[10]]["HLA"])) {
ten_mer_scores <- append(anchor_data[[10]][anchor_data[[10]]["HLA"] == hla_allele][1:(10 + 1)], "10mer", 1)
}
else {
ten_mer_scores <- c(hla_allele, "8mer")
susannasiebert marked this conversation as resolved.
Show resolved Hide resolved
susannasiebert marked this conversation as resolved.
Show resolved Hide resolved
}
if (any(hla_allele == anchor_data[[11]]["HLA"])) {
eleven_mer_scores <- append(anchor_data[[11]][anchor_data[[11]]["HLA"] == hla_allele][1:(11 + 1)], "11mer", 1)
}
else {
eleven_mer_scores <- c(hla_allele, "8mer")
susannasiebert marked this conversation as resolved.
Show resolved Hide resolved
susannasiebert marked this conversation as resolved.
Show resolved Hide resolved
}
scores <- list(eight_mer_scores, nine_mer_scores, ten_mer_scores, eleven_mer_scores)
scores <- lapply(scores, `length<-`, 13)
scores <- transpose(data.frame(scores))
colnames(scores) <- c("HLA Allele", "Peptide Length", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11")
scores_df <- rbind(scores_df, scores)
}
return(scores_df)
}
#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({
Expand Down
71 changes: 64 additions & 7 deletions pvactools/tools/pvacview/server.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,8 @@ options(shiny.host = '0.0.0.0')
options(shiny.port = 3333)

server <- shinyServer(function(input, output, session) {
## pVACtools version
output$version <- renderText({"pVACtools version 4.0.8"})

##############################DATA UPLOAD TAB###################################
## helper function defined for generating shinyInputs in mainTable (Evaluation dropdown menus)
Expand Down Expand Up @@ -419,6 +421,46 @@ server <- shinyServer(function(input, output, session) {
)
}
)
output$currentParamTable <- renderTable(
data <- data.frame(
"Parameter" = c("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(
df$dna_cutoff,
df$dna_cutoff / 2,
df$allele_expr,
df$binding_threshold,
df$metricsData$`aggregate_inclusion_binding_threshold`,
df$metricsData$maximum_transcript_support_level,
if (is.null(df$percentile_threshold) || is.na(df$percentile_threshold)) {"NULL"}else { df$percentile_threshold},
df$use_allele_specific_binding_thresholds,
df$metricsData$mt_top_score_metric,
df$metricsData$wt_top_score_metric,
df$allele_specific_anchors, df$anchor_contribution)
), digits = 3
)
output$currentBindingParamTable <- renderTable(
if (df$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$binding_threshold
}
}
)))
} else {
data <- data.frame(
"HLA Alleles" = df$metricsData$alleles,
"Binding Cutoffs" = unlist(lapply(df$metricsData$alleles, function(x) df$binding_threshold))
)
}
)
output$comment_text <- renderUI({
if (is.null(df$mainTable)) {
return(HTML("N/A"))
Expand Down Expand Up @@ -673,10 +715,11 @@ server <- shinyServer(function(input, output, session) {
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]
best_transcript_set_id <- i
}
}
incProgress(0.5)
datatable(GB_transcripts, selection = list(mode = "single", selected = "1"), style="bootstrap") %>%
datatable(GB_transcripts, selection = list(mode = "single", selected = best_transcript_set_id), 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())
Expand Down Expand Up @@ -740,7 +783,7 @@ server <- shinyServer(function(input, output, session) {
}
})
##display peptide table with coloring
output$peptideTable <- renderDT({
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`
Expand Down Expand Up @@ -879,8 +922,8 @@ server <- shinyServer(function(input, output, session) {
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_text(data = all_peptides_multiple_hla, aes(x = x_pos, y = y_pos, label = aa, color = mutation), size = 4) +
geom_text(data = hla_data, aes(x = x_pos, y = y_pos, label = hla), size = 4, 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())
Expand All @@ -892,7 +935,21 @@ server <- shinyServer(function(input, output, session) {
print(p1)
}
})
}, height = 500, width = 1000)
}, height = 400, width = 800)
#anchor score tables for each HLA allele
output$anchorWeights<- renderDT({
withProgress(message = "Loading Anchor Weights Table", value = 0, {
weights <- anchor_weights_for_alleles(df$metricsData$alleles)
dtable <- datatable(weights, options = list(
pageLength = 10,
lengthChange = FALSE,
rowCallback = JS("function(row, data, index, rowId) {",
"if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {",
'row.style.backgroundColor = "#E0E0E0";', "}", "}")
))
dtable
})
})
##updating IC50 binding score for selected peptide pair
bindingScoreDataIC50 <- reactive({
if (is.null(df$metricsData)) {
Expand Down Expand Up @@ -992,7 +1049,7 @@ server <- shinyServer(function(input, output, session) {
incProgress(1)
dtable <- datatable(binding_reformat, options = list(
pageLength = 10,
lengthMenu = c(10),
lengthChange = FALSE,
rowCallback = JS("function(row, data, index, rowId) {",
"if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {",
'row.style.backgroundColor = "#E0E0E0";', "}", "}")
Expand Down Expand Up @@ -1056,7 +1113,7 @@ server <- shinyServer(function(input, output, session) {
incProgress(1)
dtable <- datatable(elution_reformat, options = list(
pageLength = 10,
lengthMenu = c(10),
lengthChange = FALSE,
rowCallback = JS("function(row, data, index, rowId) {",
"if(((rowId+1) % 4) == 3 || ((rowId+1) % 4) == 0) {",
'row.style.backgroundColor = "#E0E0E0";', "}", "}")
Expand Down
Loading
Loading