Update WESopt_plot_results.R

scripts/WESopt_plot_results.R

@@ -43,6 +43,161 @@ snv_colors2 <- function(del = FALSE, alpha = 1) {
   return(var_cols)
 }
 
+# Circos + Legend
+legend_plot = function(t, sample) {
+  t <- mutate(t, TYPE = case_when(nchar(REF) == 1 & nchar(ALT) == 1 & ALT != "*" ~ "Substitution",
+                                  nchar(REF) == 1 & nchar(ALT) == 1 & ALT == "*" ~ "Deletion",
+                                  nchar(REF) > nchar(ALT) & nchar(REF) - nchar(ALT) >= 1 ~ "Deletion",
+                                  nchar(REF) < nchar(ALT) & nchar(ALT) - nchar(REF) >= 1 ~ "Insertion",
+                                  TRUE ~ "Other"))
+  # Substitutions
+  t.subs <- t %>% filter(TYPE == "Substitution") %>% tbl_df()
+  t.subs$SUB <- paste0(t.subs$REF, t.subs$ALT)
+  t.subs$SUB <- factor(t.subs$SUB, levels = sort(unique(t.subs$SUB)))
+  cols_names <- levels(t.subs$SUB)
+  cols <- snv_colors2(del = F)
+  t.subs <- merge(t.subs, data.frame(cols, SUB = names(cols)), all.x = TRUE)
+  tt.subs <- t.subs %>% filter(Sample == sample) %>% tbl_df()
+  # Deletions / Insertions
+  t.other <- t %>% filter(TYPE != "Substitution") %>% tbl_df()
+  tt.other <- t.other %>% filter(Sample == sample) %>% tbl_df()
+  if(nrow(tt.other) > 0) {
+    tt.other$AF <- 1
+  }
+  tt.other$col <- ifelse(tt.other$TYPE == "Deletion", "Red", "Blue")
+  # Circos
+  par(mar=rep(0,4))
+  chr.names <- paste0("chr", c(1:22, "X", "Y"))
+  circos.par("start.degree" = 90)
+  circos.initializeWithIdeogram(species = "hg38",
+                                chromosome.index = chr.names,
+                                plotType = c())
+  
+  # Legends (center)
+  legend(-0.5, 0.85, lty = 1, lwd = 2, seg.len = 1, col = c("Red", "Blue"),
+         legend = c("Deletion", "Insertion"), bty = 'n',
+         #xjust = 0,
+         x.intersp = 0.4,
+         y.intersp = 1,
+         inset = c(0.05, 0),
+         title.adj = 0.1,
+         title = "Small Indels")
+  legend(-0.5, 0.45, pch = 16, col = cols,
+         legend = names(cols), pt.cex = 1.2, bty = 'n',
+         ncol = 3,
+         #xjust = 0,
+         x.intersp = 0.4,
+         y.intersp = 1,
+         inset = c(0.05, 0),
+         border = "NA",
+         title.adj = 0.1,
+         title = "Substitution")
+  if ("snpEff_Impact" %in% colnames(tt.subs)) {
+    legend(-0.5, -0.2, pch = c(10, 13), col = "red",
+           legend = c("Relevant Impact", "Target Gene"), pt.cex = 1.8, bty = 'n',
+           ncol = 1,
+           #xjust = 0,
+           x.intersp = 0.6,
+           y.intersp = 1,
+           inset = c(0.2, 0),
+           border = "NA",
+           title.adj = 0,
+           title = "Highlight Variants")
+  }
+  circos.clear()
+}
+
+plot_circos <- function(t, sample) {
+  # Substitutions
+  t <- mutate(t, TYPE = case_when(nchar(REF) == 1 & nchar(ALT) == 1 & ALT != "*" ~ "Substitution",
+                                  nchar(REF) == 1 & nchar(ALT) == 1 & ALT == "*" ~ "Deletion",
+                                  nchar(REF) > nchar(ALT) & nchar(REF) - nchar(ALT) >= 1 ~ "Deletion",
+                                  nchar(REF) < nchar(ALT) & nchar(ALT) - nchar(REF) >= 1 ~ "Insertion",
+                                  TRUE ~ "Other"))
+  t.subs <- t %>% filter(TYPE == "Substitution") %>% tbl_df()
+  t.subs$SUB <- paste0(t.subs$REF, t.subs$ALT)
+  t.subs$SUB <- factor(t.subs$SUB, levels = sort(unique(t.subs$SUB)))
+  cols_names <- levels(t.subs$SUB)
+  cols <- snv_colors2(del = F, alpha = 0.8)
+  t.subs <- merge(t.subs, data.frame(cols, SUB = names(cols)), all.x = TRUE)
+  tt.subs <- t.subs %>% filter(Sample == sample) %>% tbl_df()
+  # Deletions / Insertions
+  t.other <- t %>% filter(TYPE != "Substitution") %>% tbl_df()
+  tt.other <- t.other %>% filter(Sample == sample) %>% tbl_df()
+  if(nrow(tt.other) > 0) {
+    tt.other$VAF <- 1
+  }
+  tt.other$col <- ifelse(tt.other$TYPE == "Deletion", "Red", "Blue")
+  if ("IMPACT" %in% colnames(tt.other)) {
+    hio <- subset(tt.other, IMPACT %in% c("HIGH", "MODERATE"))
+    if (nrow(hio) > 0) {
+      print(hio)
+    }
+  }
+  # Circos
+  par(mar=rep(0,4))
+  chr.names <- paste0("chr", c(1:22, "X", "Y"))
+  circos.par("start.degree" = 90)
+  circos.initializeWithIdeogram(species = "hg38",
+                                chromosome.index = chr.names,
+                                plotType = c("ideogram", "labels"))
+  
+  lines <- seq(0, 1, 0.2)
+  line_factors <- expand.grid(x = get.all.sector.index(), y = lines)
+  circos.trackPlotRegion(factors = line_factors$x,
+                         y = line_factors$y,
+                         track.height = 0.4,
+                         panel.fun = function(x,y) {
+                           xl <- get.cell.meta.data("xlim")
+                           for(i in lines) {
+                             circos.lines(xl, c(i,i), col = "grey")
+                           }
+                         })
+  for(i in lines) {
+    circos.text(0, i, i, col = "black", sector.index = "chrY", track.index = 3,
+                cex = 0.5, adj = c(0.01, 0.01))
+  }
+  circos.trackPoints(tt.subs$CHROM,
+                     tt.subs$POS,
+                     tt.subs$VAF,
+                     pch = 16,
+                     cex = 1.5,
+                     col = as.character(tt.subs$cols))
+  if ("snpEff_Impact" %in% colnames(tt.subs)) {
+    hi <- subset(tt.subs, snpEff_Impact %in% c("HIGH", "MODERATE"))
+    if (nrow(hi) > 0) {
+      circos.trackPoints(hi$CHROM,
+                         hi$POS,
+                         hi$VAF,
+                         pch = 10,
+                         cex = 1.8,
+                         col = "red",
+                         track.index = 3)
+    }
+    b2m_df <- data.frame("CHROM" = c("chr15"), "POS" = c(44715702), "VAF" = c(0.7))
+    circos.trackPoints(b2m_df$CHROM,
+                       b2m_df$POS,
+                       b2m_df$VAF,
+                       pch = 13,
+                       cex = 2.5,
+                       col = "red",
+                       track.index = 3)
+  }
+  circos.trackPlotRegion(factors = line_factors$x,
+                         ylim = c(0, 1), track.height = 0.1)
+  if(nrow(tt.other) > 0) {
+    circos.trackLines(tt.other$CHROM,
+                      tt.other$POS,
+                      tt.other$VAF,
+                      track.index = 4,
+                      col = as.character(tt.other$col),
+                      lwd = 2,
+                      type = 'h')
+  }
+  text(0,0, sample, cex = 1.5)
+  circos.clear()
+}
+
 # Variant Plot function
 plot_variants <- function(full.t, out_dir, plot_prefix, fill_by) {
   dir.create(path = out_dir, showWarnings = F)