### R code from vignette source 'vignettes/ggbio/inst/doc/circular.Rnw'

###################################################
### code chunk number 1: processing
###################################################
crc1 <- system.file("extdata", "crc1-missense.csv", package = "biovizBase")
crc1 <- read.csv(crc1)
library(GenomicRanges)
mut.gr <- with(crc1,GRanges(Chromosome, IRanges(Start_position, End_position),
                            strand = Strand))
values(mut.gr) <- subset(crc1, select = -c(Start_position, End_position, Chromosome))
data("hg19Ideogram", package = "biovizBase")
seqs <- seqlengths(hg19Ideogram)
## subset_chr
chr.sub <- paste("chr", 1:22, sep = "")
## levels tweak
seqlevels(mut.gr) <- c(chr.sub, "chrX")
mut.gr <- keepSeqlevels(mut.gr, chr.sub)
seqs.sub <- seqs[chr.sub]
## remove wrong position
bidx <- end(mut.gr) <= seqs.sub[match(as.character(seqnames(mut.gr)),
              names(seqs.sub))]
mut.gr <- mut.gr[which(bidx)]
## assign_seqlengths
seqlengths(mut.gr) <- seqs.sub
## reanme to shorter names
new.names <- as.character(1:22)
names(new.names) <- paste("chr", new.names, sep = "")
new.names
mut.gr.new <- renameSeqlevels(mut.gr, new.names)
head(mut.gr.new)


###################################################
### code chunk number 2: ideo
###################################################
hg19Ideo <- hg19Ideogram
hg19Ideo <- keepSeqlevels(hg19Ideogram, chr.sub)
hg19Ideo <- renameSeqlevels(hg19Ideo, new.names)
head(hg19Ideo)


###################################################
### code chunk number 3: lower-ideo-track
###################################################
library(ggbio)
p <- ggplot() + layout_circle(hg19Ideo, geom = "ideo", fill = "gray70",
                              radius = 30, trackWidth = 4)
p


###################################################
### code chunk number 4: lower-scale-track
###################################################
p <- p + layout_circle(hg19Ideo, geom = "scale", size = 2, radius = 35, trackWidth = 2)
p


###################################################
### code chunk number 5: lower-text-track
###################################################
p <- p + layout_circle(hg19Ideo, geom = "text", aes(label = seqnames), vjust = 0,
                       radius = 38, trackWidth = 7)
p


###################################################
### code chunk number 6: lower-mut-track
###################################################
p <- p + layout_circle(mut.gr, geom = "rect", color = "steelblue",
                       radius = 23 ,trackWidth = 6)
p


###################################################
### code chunk number 7: links
###################################################
rearr  <- read.csv(system.file("extdata", "crc-rearrangment.csv", package = "biovizBase"))
## start position
gr1 <- with(rearr, GRanges(chr1, IRanges(pos1, width = 1)))
## end position
gr2 <- with(rearr, GRanges(chr2, IRanges(pos2, width = 1)))
## add extra column
nms <- colnames(rearr)
.extra.nms <- setdiff(nms, c("chr1", "chr2", "pos1", "pos2"))
values(gr1) <- rearr[,.extra.nms]
## remove out-of-limits data
seqs <- as.character(seqnames(gr1))
.mx <- seqlengths(hg19Ideo)[seqs]
idx1 <- start(gr1) > .mx
seqs <- as.character(seqnames(gr2))
.mx <- seqlengths(hg19Ideo)[seqs]
idx2 <- start(gr2) > .mx
idx <- !idx1 & !idx2
gr1 <- gr1[idx]
seqlengths(gr1) <- seqlengths(hg19Ideo)
gr2 <- gr2[idx]
seqlengths(gr2) <- seqlengths(hg19Ideo)


###################################################
### code chunk number 8: link-data
###################################################
values(gr1)$to.gr <- gr2
## rename to gr
gr <- gr1


###################################################
### code chunk number 9: rearr
###################################################
values(gr)$rearrangements <- ifelse(as.character(seqnames(gr))
                                    == as.character(seqnames((values(gr)$to.gr))),
                                    "intrachromosomal", "interchromosomal")


###################################################
### code chunk number 10: subset-crc-1
###################################################
gr.crc1 <- gr[values(gr)$individual == "CRC-1"]


###################################################
### code chunk number 11: lower-point-track
###################################################
p <- p + layout_circle(gr.crc1, geom = "point", aes(y = score, size = tumreads), color = "red",
                       radius = 12 ,trackWidth = 10, grid = TRUE) +
  scale_size(range = c(1, 2.5))
p


###################################################
### code chunk number 12: lower-link-track
###################################################
p <- p + layout_circle(gr.crc1, geom = "link", linked.to = "to.gr", aes(color = rearrangements),
                       radius = 10 ,trackWidth = 1)
p


###################################################
### code chunk number 13: single-arr
###################################################
cols <- RColorBrewer::brewer.pal(3, "Set2")[2:1]
names(cols) <- c("interchromosomal", "intrachromosomal")

p0 <- ggplot() + layout_circle(gr.crc1, geom = "link", linked.to = "to.gr",
                              aes(color = rearrangements), radius = 7.1) +
  layout_circle(hg19Ideo, geom = "ideo", trackWidth = 1.5,
                color = "gray70", fill = "gray70") +
  scale_color_manual(values = cols)  
p0


###################################################
### code chunk number 14: legend
###################################################
library(gridExtra)
g = ggplotGrob(p0)
gg = editGrob(getGrob(g, gPath("guide-box"), 
  grep=TRUE), vp=viewport())


###################################################
### code chunk number 15: arrangement
###################################################
grl <- split(gr, values(gr)$individual)
## need "unit", load grid
library(grid)
lst <- lapply(grl, function(gr.cur){
  print(unique(as.character(values(gr.cur)$individual)))
  cols <- RColorBrewer::brewer.pal(3, "Set2")[2:1]
  names(cols) <- c("interchromosomal", "intrachromosomal")
  p <- ggplot() + layout_circle(gr.cur, geom = "link", linked.to = "to.gr",
                         aes(color = rearrangements), radius = 7.1) +
                           layout_circle(hg19Ideo, geom = "ideo", trackWidth = 1.5,
                         color = "gray70", fill = "gray70") +
                           scale_color_manual(values = cols)  + 
     opts(title = (unique(values(gr.cur)$individual))) +
    opts(plot.margin = unit(rep(0, 4), "lines"))
})
lst.nolegend <- lapply(lst, function(p) p + opts(legend.position = "none"))
l.g <- lapply(lst.nolegend, ggplotGrob)


###################################################
### code chunk number 16: 9-circle
###################################################
grid.arrange(do.call(arrangeGrob, l.g), gg, ncol = 2, widths = c(4/5, 1/5))


###################################################
### code chunk number 17: simple-wrapper (eval = FALSE)
###################################################
## ## noitce this code doesn't have opts(legend.position = "none"), which means
## ## we keep the legend for each plot.
## arrangeGrobByParsingLegend(lst, widths = c(4, 1), legend.idx = 1, ncol = 2)


###################################################
### code chunk number 18: sesseionInfo
###################################################
sessionInfo()