---
title: Plot a PAF file
author: Shaun Jackman
params:
  gap_bed:
    label: "BED file of gaps"
    value: ""
    input: text
  input_paf:
    label: "Input PAF file"
    value: "map.paf.gz"
    input: text
---

```{r setup, message=FALSE}
library(dplyr)
library(forcats)
library(ggplot2)
library(Polychrome)
library(readr)
library(scales)
library(tidyr)
library(stringr)

knit_print.data.frame <- function(x, ...) kable(x) %>% paste(collapse = "\n") %>% asis_output
gap_bed <- params$gap_bed
input_paf <- params$input_paf
output_paf <- sub("\\.paf\\.gz$", ".chained.paf.gz", input_paf)

gap_bed
input_paf
output_paf
```

# Read the PAF file
```{r read-data}
tlength_threshold <- 50

paf_orig <- read_tsv(input_paf,
	col_names = c(
		"Qname", "Qlength", "Qstart", "Qend",
		"Orientation",
		"Tname", "Tlength", "Tstart", "Tend",
		"Matches", "Length", "Mapq"),
	col_types = "ciiicciiiiii")

paf <- paf_orig %>%
	filter(
		Tlength >= tlength_threshold,
		!startsWith(Qname, "NW_")) %>%
	arrange(desc(Tlength), Tname, Tstart, desc(Matches)) %>%
	distinct(Tname, Tstart, .keep_all = TRUE) %>%
	mutate(Qname = fct_relevel(Qname, unique(str_sort(Qname, numeric = TRUE)))) %>%
	arrange(Qname, Qstart, desc(Matches)) %>%
	mutate(Qname = fct_inorder(Qname), Qindex = as.numeric(Qname),
		Tindex = as.numeric(Tname)) %>%
	arrange(desc(Tlength), Tname, Tstart, desc(Matches))
```

# Read the BED file of gaps
```{r read-gaps}
gap_threshold <- 1000

qname_qindex <- paf %>%
	transmute(Name = as.character(Qname), Index = Qindex) %>%
	distinct() %>%
	arrange(Index)
if (gap_bed == ""){
	gaps <- tibble( Name=character(), Start=integer(), End=integer(), Label=character(), Index=double())
} else {
	gaps <- read_tsv(gap_bed, col_names = c("Name", "Start", "End", "Label"), col_types = "ciic") %>%
		filter(End - Start >= gap_threshold) %>%
		left_join(qname_qindex, by = "Name") %>%
		drop_na()
}
```

# Chain alignments
```{r chain-alignments}
mapq_threshold <- 1
nbarcodes_threshold <- 50
Qdistance_threshold <- 500000
Tdistance_threshold <- 10

# Return true when the two intervals [as, ae] and [bs, be] overlap.
is_overlap <- function(as, ae, bs, be) {
	as <= bs & bs <= ae | as <= be & be <= ae | bs <= as & as <= be | bs <= ae & ae <= be
}

# Return the distance between the two intervals [as, ae] and [bs, be].
# Return 0 if they overlap.
interval_distance <- function(as, ae, bs, be) {
	ifelse(is_overlap(as, ae, bs, be), 0, pmax(bs - ae, as - be))
}

paf_segmented <- paf %>%
	filter(Mapq >= mapq_threshold) %>%
	arrange(desc(Tlength), Tname, Tstart) %>%
	group_by(Qname, Tname) %>%
	filter(is_overlap(lag(Qstart), lag(Qend), Qstart, Qend)
		| is_overlap(Qstart, Qend, lead(Qstart), lead(Qend))) %>%
	mutate(
		Qdistance = interval_distance(lag(Qstart), lag(Qend), Qstart, Qend),
		Tdistance = interval_distance(lag(Tstart), lag(Tend), Tstart, Tend),
		Boundary = Qdistance >= Qdistance_threshold | Tdistance >= Tdistance_threshold) %>%
	replace_na(list(Boundary = FALSE)) %>%
	ungroup() %>%
	group_by(Qname, Tname) %>%
	mutate(Segment = cumsum(Boundary)) %>%
	ungroup()

paf_chained_orig <- paf_segmented %>%
	group_by(Qname, Qlength, Qindex, Tname, Tlength, Tindex, Segment) %>%
	summarise(
		Qstart = min(Qstart),
		Qend = max(Qend),
		Orientation = names(which.max(table(Orientation))),
		Tstart = min(Tstart),
		Tend = max(Tend),
		Matches = sum(Matches),
		Length = sum(Length),
		Mapq = median(Mapq),
		Barcodes = n(),
		Qdistance = max(Qdistance),
		Tdistance = max(Tdistance)) %>%
	ungroup() %>%
	select(Qname, Qlength, Qstart, Qend, Orientation,
		Tname, Tlength, Tstart, Tend, Matches, Length, Mapq, Barcodes, everything()) %>%
	arrange(desc(Tlength), Tname, Tstart)

paf_chained <- paf_chained_orig %>% filter(Barcodes >= nbarcodes_threshold)

paf_chained_orig %>%
	select(Qname:Barcodes) %>%
	mutate(Barcodes = paste0("XN:i:", Barcodes)) %>%
	write_tsv(output_paf, col_names = FALSE)
```

# Backbone coverage
```{r plot-paf, fig.width=8, fig.height=10}
alphabet_colours <- alphabet.colors(26)
alphabet_colours["iron"] <- c("indigo" = "#3F00FF")
alphabet_colours <- as.vector(alphabet_colours)

ggplot(paf_chained) +
	aes(xmin = Tstart, xmax = Tend, ymin = Tindex, ymax = Tindex + 1, fill = Qname) +
	geom_rect() +
	scale_x_continuous(name = "Position", labels = comma_format()) +
	scale_y_reverse(name = "Backbone (Target)",
		minor_breaks = seq(0, max(paf$Tindex), 10)) +
	scale_fill_manual(name = "Query", values = alphabet_colours) +
	theme_bw() +
	guides(fill = guide_legend(ncol = 1)) +
	labs(caption = input_paf)
```

```{r save-plot-t}
pdf_filename <- paste0(input_paf, ".pdf")
ggsave(pdf_filename, width = 8, height = 10, units = "in")
cat(pdf_filename)
```

# Reference coverage
```{r plot-pafq, fig.width=8, fig.height=10}
pafq_lumped <- paf_chained %>%
	arrange(desc(Tlength), Tname, Tstart, Barcodes) %>%
	mutate(Tname = fct_inorder(fct_lump(Tname, n = 26, w = Barcodes, ties.method = "first")))

pal <- setNames(alphabet_colours, pafq_lumped$Tname %>% setdiff("Other") %>% unique())
pal["Other1"] <- "#808080"
pal["Other2"] <- "#c0c0c0"

pafq <- pafq_lumped %>% arrange(desc(Qlength), Qname, Qstart, Barcodes)

pafq_ideogram <- pafq %>%
  arrange(desc(Qlength), Qname, Qstart, Barcodes) %>%
  group_by(Qname) %>%
  mutate(Colour = (Qindex + row_number()) %% 2) %>%
  ungroup() %>%
  mutate(Colour = fct_recode(factor(Colour), "Other1" = "0", "Other2" = "1"))

legend_breaks <- c(seq(0, 25, 1), c("Other1", "Other2"))

ggplot(pafq_ideogram) +
  geom_rect(aes(
    xmin = Qstart, xmax = Qend,
    ymin = Qindex, ymax = Qindex + 1,
    fill = Colour)) +
  geom_point(aes(x = Qlength, y = 0.5 + Qindex),
             data = distinct(pafq, Qlength, Qindex)) +
  scale_x_continuous(name = "Position", labels = unit_format(unit = "M", scale = 1e-6)) +
  scale_y_reverse(name = "Chromosome (Query)",
                  breaks = 0.5 + seq_len(nlevels(pafq$Qname)),
                  labels = levels(pafq$Qname)) +
  geom_rect(data=pafq[!(pafq$Tname=="Other"),], aes(
    xmin = Qstart, xmax = Qend,
    ymin = Qindex, ymax = Qindex + 1,
    fill = Tname)) +
  geom_rect(data = gaps, aes(
	xmin = Start, xmax = End,
	ymin = Index + 0.45, ymax = Index + 0.55),
	fill = "darkred") +
  scale_fill_manual(name = "Target", values = pal, breaks = legend_breaks) +
  theme_bw() +
  guides(fill = guide_legend(ncol = 1)) +
  labs(caption = input_paf)
```

```{r save-plot-q}
pdf_filename <- paste0(input_paf, ".q.pdf")
ggsave(pdf_filename, width = 8, height = 10, units = "in")
cat(pdf_filename)
```

# Chromosome ideogram
```{r plot-ideogram, fig.width=8, fig.height=10}
paf_ideogram <- paf_chained %>%
	arrange(desc(Qlength), Qname, Qstart, Barcodes) %>%
	group_by(Qname) %>%
	mutate(Colour = (Qindex + row_number()) %% 2) %>%
	ungroup() %>%
	mutate(Colour = factor(Colour))

ggplot(paf_ideogram) +
	geom_rect(aes(
		xmin = Qstart, xmax = Qend,
		ymin = Qindex + 0.1, ymax = Qindex + 0.9,
		fill = Colour)) +
	geom_rect(data = gaps, aes(
		xmin = Start, xmax = End,
		ymin = Index + 0.45, ymax = Index + 0.55),
		fill = "darkred") +
	geom_point(aes(x = Qlength, y = 0.5 + Qindex),
		data = distinct(pafq, Qlength, Qindex)) +
	scale_x_continuous(name = "Position", labels = unit_format(unit = "M", scale = 1e-6)) +
	scale_y_reverse(name = "Chromosome (Query)",
		breaks = 0.5 + seq_len(nlevels(pafq$Qname)), minor_breaks = NULL,
		labels = levels(pafq$Qname)) +
	scale_fill_manual(name = "Target", values = c("0" = "#808080", "1" = "#c0c0c0")) +
	theme_bw() +
	guides(fill = FALSE) +
	labs(caption = input_paf)
```

```{r save-plot-ideogram}
pdf_filename <- paste0(input_paf, ".ideo.pdf")
ggsave(pdf_filename, width = 8, height = 10, units = "in")
cat(pdf_filename)
```

# Dot plot
```{r plot-dot, fig.width=6, fig.height=24}
tlength_threshold <- 200
mapq_threshold <- 1

pafdot <- paf %>%
	filter(Tlength >= tlength_threshold, Mapq >= mapq_threshold) %>%
	mutate(Index = row_number())

boundaries <- pafdot %>% filter(Tname != lag(Tname, default = "NA"))

ggplot(pafdot) +
	aes(xmin = Qstart, xmax = Qend, ymin = Index, ymax = Index + 1, fill = Qname) +
	geom_rect() +
	scale_x_continuous(name = "Chromosome (Query) Position", labels = unit_format(unit = "M", scale = 1e-6)) +
	scale_y_reverse(name = "Backbone (Target) Position", minor_breaks = NULL,
		breaks = boundaries$Index, labels = boundaries$Tname) +
	scale_fill_manual(name = "Query", values = alphabet_colours) +
	theme_bw() +
	guides(fill = guide_legend(ncol = 1)) +
	labs(caption = input_paf)
```

```{r save-plot-dot}
pdf_filename <- paste0(input_paf, ".dot.pdf")
ggsave(pdf_filename, width = 6, height = 24, units = "in")
cat(pdf_filename)
```
