karyoploteR：画染色体的好帮手

2017.12.14 zhang
我也是昨天才发现这个包的，只会一些简单的基础用法，该包最终能做十分复杂精美的染色体图，就看自己怎么搭配了，强烈推荐official的github tutorial，比bioconductor的那个要详细的多的多

karyoploteR

• official website(github)
• bioconductor
• github
• 帮助文档HTML版
• pubmed文章

简介

一个用来做多物种染色体分布情况图的R包，可以非常方便的添加多种自定义内容，使用体验，爽

一、 基础用法

目前有一个问题，我没发现如何通过rstudio交互的检查作图质量，只能dev输出到图像文件，然后依次检查

1. 最基础的图形

kp <- plotKaryotype(genome="mm10", plot.type=1, main="The mm10 genome", cex=0.6)

• genome：指定要做什么染色体组的图，eg：mm10、hg19
• plot.type：有1,2,3,4,5五种，在染色体形状的细节上有区别，可以根据自己的喜好修改
• main：标题
• cex：字体比例，cex越大字体越大

效果如下：

mm10的染色体

2. 只做某几个染色体的

kp <- plotKaryotype(genome="hg19", plot.type=2, chromosomes=c("chr1", "chr2", "chr3"))

效果如下：红色标记为plot.type 2和1的主要区别

chr1、chr2、chr3的效果

3. 添加附加的坐标轴

kp <- plotKaryotype(chromosomes=c("chr1", "chr2"), plot.type=2)
  
 # data.panel=1，添加在染色体上方
 kpDataBackground(kp)
 # data.panel=2，添加在染色体下方，添加了两个data.panel
 kpDataBackground(kp, r1=0.47, data.panel=2)
 kpDataBackground(kp, r0=0.53, data.panel=2)

# 开始添加坐标轴
# Default axis，添加染色体上方的左侧轴
kpAxis(kp) 
# Axis on the right side of the data.panel，添加染色体上方的右侧轴
kpAxis(kp, side = 2) 

# Changing the limits and having more ticks, with a smaller font size，调整染色体下方第一个panel的左侧轴
kpAxis(kp, r1=0.47, ymin=-5000, ymax = 5000, numticks = 5, cex=0.5, data.panel=2)  
#and a different scale on the right，调整染色体下方第一个panel的右侧轴
kpAxis(kp, r1=0.47, ymin=-2, ymax = 2, numticks = 3, cex=0.5, data.panel=2, side=2)
#Changing the colors and labels and tick positions，调整染色体下方第二个panel的左侧轴
kpAxis(kp, r0=0.53, tick.pos = c(0.3, 0.6, 1), labels = c("A", "B", "C"), col="#66AADD",
         cex=0.5, data.panel=2)

效果如下：上方代码是官方文档里的，只不过我调整了顺序，可能更便于理解

image.png

4. 添加附加的散点图

# 生成散点图需要的点
data.points <- data.frame(chr="chr1", pos=(1:240)*1e6, value=rnorm(240, 0.5, 0.1))

# 只做一个染色体的内容
kp <- plotKaryotype(plot.type = 4, chromosomes = "chr1")

# 添加一个附加图的背景，data.panel为1，应当是在染色体上方作图的意思
kpDataBackground(kp, data.panel = 1)

# 添加染色体上的距离标记
kpAddBaseNumbers(kp)

# 做散点图
kpPoints(kp, chr = data.points$chr, x=data.points$pos, y=data.points$value, col=rainbow(240))

效果如下：

image.png

5. 添加自定义的区段

这个也是用的最多的一个了吧，相当简单，从DataFrame直接往里边添加即可
dataframe只需要包含三列内容：chr、start、end

# 第一个自定义的区段
gains <- makeGRangesFromDataFrame(data.frame(chr=c("chr1", "chr5", "chr17", "chr22"), start=c(1, 1000000, 4000000, 1), end=c(5000000, 3200000, 80000000, 1200000)))

# 第二个自顶一个区段
losses <- makeGRangesFromDataFrame(data.frame(chr=c("chr3", "chr9", "chr17"), start=c(80000000, 20000000, 1),  end=c(170000000, 30000000, 25000000)))

# 作图，并且以特定的颜色添加自定义的区段
kp <- plotKaryotype(genome="hg19")
kpPlotRegions(kp, gains, col="#FFAACC")
kpPlotRegions(kp, losses, col="#CCFFAA")

效果如下：

自定义而区段效果图

如果自定义的染色体位置中间包含有重合位点，会自动在同一个位置，用几个不同的段来展示，如下：

有重合位点的自定义染色体区域

6. 最后，扔一段集大成的代码和图，供大家参考

 pp <- getDefaultPlotParams(plot.type = 1)
  pp$data1height=600
  
  tr.i <- 1/11
  tr.o <- 1/10
  
  kp <- plotKaryotype(chromosomes=c("chr1"), plot.params = pp) 
  
  dd <- toGRanges(data.frame(chr="chr1", start=end(kp$genome[1])/50*(0:49), end=end(kp$genome[1])/50*(1:50)))
  mcols(dd) <- data.frame(y=((sin(start(dd)) + rnorm(n=50, mean=0, sd=0.1))/5)+0.5)
  
  tn <- 0
  kpDataBackground(kp, r0=tr.o*tn, r1=tr.o*tn+tr.i)
  kpPoints(kp, dd, r0=tr.o*tn, r1=tr.o*tn+tr.i, pch=".", cex=2)
  kpRect(kp, chr="chr1", x0=5000000, x1=45000000, y0=0.2, y1=0.8, r0=tr.o*tn, r1=tr.o*tn+tr.i, col="#EEEEEE", border="#666666")
  kpText(kp, chr="chr1", x=25000000, y=0.5, col="red", r0=tr.o*tn, r1=tr.o*tn+tr.i, labels="kpPoints", cex=0.7)
  
  tn <- 1
  kpDataBackground(kp, r0=tr.o*tn, r1=tr.o*tn+tr.i)
  kpLines(kp, dd, r0=tr.o*tn, r1=tr.o*tn+tr.i, pch=".", cex=2)
  kpRect(kp, chr="chr1", x0=5000000, x1=45000000, y0=0.2, y1=0.8, r0=tr.o*tn, r1=tr.o*tn+tr.i, col="#EEEEEE", border="#666666")
  kpText(kp, chr="chr1", x=25000000, y=0.5, col="red", r0=tr.o*tn, r1=tr.o*tn+tr.i, labels="kpLines", cex=0.7)
  
  tn <- 2
  kpDataBackground(kp, r0=tr.o*tn, r1=tr.o*tn+tr.i)
  kpBars(kp, dd, y1=dd$y, r0=tr.o*tn, r1=tr.o*tn+tr.i, col="#AAFFAA", border="#66DD66")
  kpRect(kp, chr="chr1", x0=5000000, x1=45000000, y0=0.2, y1=0.8, r0=tr.o*tn, r1=tr.o*tn+tr.i, col="#EEEEEE", border="#666666")
  kpText(kp, chr="chr1", x=25000000, y=0.5, col="red", r0=tr.o*tn, r1=tr.o*tn+tr.i, labels="kpBars", cex=0.7)
  
  tn <- 3
  kpDataBackground(kp, r0=tr.o*tn, r1=tr.o*tn+tr.i)
  kpRect(kp, dd, y0=dd$y-0.3, y1=dd$y, r0=tr.o*tn, r1=tr.o*tn+tr.i, col="#AAAAFF", border="#6666DD")
  kpRect(kp, chr="chr1", x0=5000000, x1=45000000, y0=0.2, y1=0.8, r0=tr.o*tn, r1=tr.o*tn+tr.i, col="#EEEEEE", border="#666666")
  kpText(kp, chr="chr1", x=25000000, y=0.5, col="red", r0=tr.o*tn, r1=tr.o*tn+tr.i, labels="kpRect", cex=0.7)
  
  tn <- 4
  kpDataBackground(kp, r0=tr.o*tn, r1=tr.o*tn+tr.i)
  kpText(kp, dd, labels=as.character(1:50), cex=0.5, r0=tr.o*tn, r1=tr.o*tn+tr.i, col="#DDAADD")
  kpRect(kp, chr="chr1", x0=5000000, x1=45000000, y0=0.2, y1=0.8, r0=tr.o*tn, r1=tr.o*tn+tr.i, col="#EEEEEE", border="#666666")
  kpText(kp, chr="chr1", x=25000000, y=0.5, col="red", r0=tr.o*tn, r1=tr.o*tn+tr.i, labels="kpText", cex=0.7)
  
  tn <- 5
  kpDataBackground(kp, r0=tr.o*tn, r1=tr.o*tn+tr.i)
  kpSegments(kp, dd, y0=dd$y-0.3, y1=dd$y, r0=tr.o*tn, r1=tr.o*tn+tr.i)
  kpRect(kp, chr="chr1", x0=5000000, x1=45000000, y0=0.2, y1=0.8, r0=tr.o*tn, r1=tr.o*tn+tr.i, col="#EEEEEE", border="#666666")
  kpText(kp, chr="chr1", x=25000000, y=0.5, col="red", r0=tr.o*tn, r1=tr.o*tn+tr.i, labels="kpSegments", cex=0.7)

  tn <- 6
  kpDataBackground(kp, r0=tr.o*tn, r1=tr.o*tn+tr.i)
  kpArrows(kp, dd, y0=dd$y-0.3, y1=dd$y, r0=tr.o*tn, r1=tr.o*tn+tr.i, length=0.04)
  kpRect(kp, chr="chr1", x0=5000000, x1=45000000, y0=0.2, y1=0.8, r0=tr.o*tn, r1=tr.o*tn+tr.i, col="#EEEEEE", border="#666666")
  kpText(kp, chr="chr1", x=25000000, y=0.5, col="red", r0=tr.o*tn, r1=tr.o*tn+tr.i, labels="kpArrows", cex=0.7)

  tn <- 7
  kpDataBackground(kp, r0=tr.o*tn, r1=tr.o*tn+tr.i)
  kpHeatmap(kp, dd, r0=tr.o*tn+tr.i/4, r1=tr.o*tn+tr.i-tr.i/4, colors = c("green", "black", "red"))
  kpRect(kp, chr="chr1", x0=5000000, x1=45000000, y0=0.2, y1=0.8, r0=tr.o*tn, r1=tr.o*tn+tr.i, col="#EEEEEE", border="#666666")
  kpText(kp, chr="chr1", x=25000000, y=0.5, col="red", r0=tr.o*tn, r1=tr.o*tn+tr.i, labels="kpHeatmap", cex=0.7)

  tn <- 8
  kpDataBackground(kp, r0=tr.o*tn, r1=tr.o*tn+tr.i)
  kpPolygon(kp, dd, r0=tr.o*tn, r1=tr.o*tn+tr.i)
  kpRect(kp, chr="chr1", x0=5000000, x1=45000000, y0=0.2, y1=0.8, r0=tr.o*tn, r1=tr.o*tn+tr.i, col="#EEEEEE", border="#666666")
  kpText(kp, chr="chr1", x=25000000, y=0.5, col="red", r0=tr.o*tn, r1=tr.o*tn+tr.i, labels="kpPolygon", cex=0.7)
  
  tn <- 9
  kpDataBackground(kp, r0=tr.o*tn, r1=tr.o*tn+tr.i)
  kpAbline(kp, h=c(0.25, 0.5, 0.75), v=start(dd), r0=tr.o*tn, r1=tr.o*tn+tr.i)
  kpRect(kp, chr="chr1", x0=5000000, x1=45000000, y0=0.2, y1=0.8, r0=tr.o*tn, r1=tr.o*tn+tr.i, col="#EEEEEE", border="#666666")
  kpText(kp, chr="chr1", x=25000000, y=0.5, col="red", r0=tr.o*tn, r1=tr.o*tn+tr.i, labels="kpAbline", cex=0.7)

包内支持的各种附加图的类型

---

更多原创精彩视频敬请关注生信杂谈: