R语言-制作motif的PWM
目录
- 一、PWM与PFM的介绍
- 二、根据碱基序列手工制作PFM与PPM
-
- 1. 主要实现函数
- 2. 实现效果
-
- 2.1 制作DNA的motif logo
- 2.2 制作RNA的motif logo
- 三、PFM-\>PPM-\>PWM
- 四、待优化
一、PWM与PFM的介绍
motif指的是转录因子偏好结合的DNA序列模式或RNA结合蛋白偏好结合的序列模式，一般使用PWM来表示motif。
制作PWM的过程如下：
- 首先计算所有序列每个位置的碱基频数，可以得到PFM(Position Frequency
Matrix)，这个可以作为ggseqlogo包的输入来绘制motif图。 - 通过PFM可以进一步计算得到PPM(Position Probability
Matrix)，表示位置频率矩阵，是计算了每个位置四种碱基的出现频率后得到的矩阵，这个PPM矩阵可以作为TOMTOM的输入去与其他motif数据库比对。 - 将PPM中的频率除以碱基背景频率然后取对数(log2)以后就得到了PWM(Position
Weight Matrix)矩阵。
制作PWM的一个示例数据可参考我之前写的博客。
下面介绍一下如何使用R语言来计算motif的PFM和PPM，代码参考了ggseqlogo的源代码并进行了修改与注释。
二、根据碱基序列手工制作PFM与PPM
要实现的目标：输入含有n条相同长度的DNA或RNA序列，返回可以表征该motif的PFM或PPM。
1. 主要实现函数
letterMatrix <- function(input){
# Ensure kmers are the same length characters(ggseqlogo)
# 首先要确保输入的碱基序列的长度都是一致的
seq.len = sapply(input, nchar) # 计算每条序列的碱基数目
num_pos = seq.len[1] # 第一条序列的碱基数目
if(! all(seq.len == num_pos)) { # 所有序列的碱基数目必须一致，不一致则报错
stop('Sequences in alignment must have identical lengths')
}
# Construct matrix of letters(ggseqlogo)
# 接下来构建一个矩阵，每个元素是一个碱基
split = unlist( sapply(input, function(seq){strsplit(seq, '')}) ) # strsplit可以将字符串切割成单个字符
t( matrix(split, seq.len, length(split)/num_pos) )
}
make_ppm <- function(seqs, ppm=TRUE, seq_type="dna") {
# seqs: A vector of strings, each string is a DNA or RNA sequence
# ppm: Whether to return PPM, default is PPM, else return PFM
# seq_type: Sequence type, can be "dna" of "rna"
letter_mat = letterMatrix(seqs) # 构建碱基矩阵，每一行是一条序列，每一列是碱基位置
# Get namespace(ggseqlogo)
if(seq_type == "dna") {
namespace = c("A", "T", "G", "C")
} else if (seq_type == "rna" ) {
namespace = c("A", "U", "G", "C")
} else {
stop('Wrong seq_type! Must be one of "dna" and "rna".')
}
# Construct PWM(ggseqlogo)
pfm_mat = apply(letter_mat, 2, function(pos.data){ # apply第二个参数为2，表示对列进行操作
# Get frequencies (ggseqlogo)
t = table(pos.data) # 计算该位置四种碱基的频数
# Match to aa(ggseqlogo)
ind = match(namespace, names(t)) #
# Create column(ggseqlogo)
col = t[ind] #
col[is.na(col)] = 0
names(col) = namespace
if(ppm) { # 若返回PPM，则将碱基频数除以该列碱基总数
col = col / sum(col)
}
col # 函数返回值col
})
num_pos = nchar(seqs[1])
colnames(pfm_mat) = 1:num_pos
pfm_mat
}
用法如下：
seqs <- c("CGTAA", "ATTAG", "CTAAG", "ATTAA", "CATAA")
# 计算PPM(TOMTOM的输入格式)
ppm <- make_ppm(seqs, ppm=TRUE)
ppm
## 1 2 3 4 5
## A 0.4 0.2 0.2 1 0.6
## T 0.0 0.6 0.8 0 0.0
## G 0.0 0.2 0.0 0 0.4
## C 0.6 0.0 0.0 0 0.0
# 计算PFM(ggseqlogo的输入格式)
pfm <- make_ppm(seqs, ppm=FALSE) # ppm=FALSE则输出PFM
pfm
## 1 2 3 4 5
## A 2 1 1 5 3
## T 0 3 4 0 0
## G 0 1 0 0 2
## C 3 0 0 0 0
2. 实现效果
ggseqlogo包可以接受一个存储碱基序列的字符串向量或者PFM来绘制motif
logo，下面就依次使用这两种方法对5条DNA和RNA序列绘制motif
logo，以验证手工计算出的PFM与该包计算的结果一致。
2.1 制作DNA的motif logo
首先用ggseqlogo画一下这5条序列的motif logo，如下图所示
# install.packages('ggseqlogo')
library('ggseqlogo')
seqs <- c("CGTAA", "ATTAG", "CTAAG", "ATTAA", "CATAA")
ggseqlogo(seqs)
## Warning: `guides( = FALSE)` is deprecated. Please use `guides( =
## "none")` instead.
接下来使用上面自定义的函数来计算PFM然后绘制motif logo：
seqs <- c("CGTAA", "ATTAG", "CTAAG", "ATTAA", "CATAA")
pfm <- make_ppm(seqs, ppm=FALSE)
pfm
## 1 2 3 4 5
## A 2 1 1 5 3
## T 0 3 4 0 0
## G 0 1 0 0 2
## C 3 0 0 0 0
ggseqlogo(pfm)
## Warning: `guides( = FALSE)` is deprecated. Please use `guides( =
## "none")` instead.
可以看到画出来的图与直接使用ggseqlogo的结果是一样的。
该代码也可以计算出PPM(TOMTOM需要的格式)，如下所示：
seqs <- c("CGTAA", "ATTAG", "CTAAG", "ATTAA", "CATAA")
pfm <- make_ppm(seqs)
pfm
## 1 2 3 4 5
## A 0.4 0.2 0.2 1 0.6
## T 0.0 0.6 0.8 0 0.0
## G 0.0 0.2 0.0 0 0.4
## C 0.6 0.0 0.0 0 0.0
2.2 制作RNA的motif logo
首先用ggseqlogo画motif logo如下：
# install.packages('ggseqlogo')
library('ggseqlogo')
seqs <- c("CGUAA", "AUUAG", "CUAAG", "AUUAA", "CAUAA")
ggseqlogo(seqs)
## Warning: `guides( = FALSE)` is deprecated. Please use `guides( =
## "none")` instead.
使用make_ppm函数计算PFM，在对RNA进行计算时需要指定seq_type=“rna”，代码如下：
seqs <- c("CGUAA", "AUUAG", "CUAAG", "AUUAA", "CAUAA")
pfm <- make_ppm(seqs, ppm=FALSE, seq_type='rna')
pfm
## 1 2 3 4 5
## A 2 1 1 5 3
## U 0 3 4 0 0
## G 0 1 0 0 2
## C 3 0 0 0 0
ggseqlogo(pfm)
## Warning: `guides( = FALSE)` is deprecated. Please use `guides( =
## "none")` instead.
上述logo图与ggseqlogo画出来的结果是一样的。
三、PFM->PPM->PWM
上面实现了根据碱基序列制作PFM与PPM，但如果已经有了PFM呢？有了PFM以后就可以依次计算PPM和PWM了，下面写一下PFM->PPM->PWM的代码。
- PFM->PPM
代码如下，
pfm2ppm <- function(pfm) {
ppm <- apply(pfm, 2, function(col) {col / sum(col)} ) # 对
return(ppm)
}
# 示例
seqs <- c("CGTAA", "ATTAG", "CTAAG", "ATTAA", "CATAA")
pfm <- make_ppm(seqs, ppm=FALSE)
pfm
## 1 2 3 4 5
## A 2 1 1 5 3
## T 0 3 4 0 0
## G 0 1 0 0 2
## C 3 0 0 0 0
ppm_ori <- make_ppm(seqs)
ppm_ori
## 1 2 3 4 5
## A 0.4 0.2 0.2 1 0.6
## T 0.0 0.6 0.8 0 0.0
## G 0.0 0.2 0.0 0 0.4
## C 0.6 0.0 0.0 0 0.0
ppm <- pfm2ppm(pfm)
ppm
## 1 2 3 4 5
## A 0.4 0.2 0.2 1 0.6
## T 0.0 0.6 0.8 0 0.0
## G 0.0 0.2 0.0 0 0.4
## C 0.6 0.0 0.0 0 0.0
ppm_ori == ppm
## 1 2 3 4 5
## A TRUE TRUE TRUE TRUE TRUE
## T TRUE TRUE TRUE TRUE TRUE
## G TRUE TRUE TRUE TRUE TRUE
## C TRUE TRUE TRUE TRUE TRUE
# 两种方法计算出来的PPM是一致的。
- PPM->PWM
由PPM到PWM需要先将PPM除以每种碱基的背景频率(一般情况下四种碱基的背景频率均为0.25)，然后取对数(log2)就得到了PWM，代码如下：
ppm2pwm <- function(ppm) {
pwm <- log2(ppm / 0.25)
pwm[is.infinite(pwm)] <- 0 # 频率为0的碱基取对数以后是负无穷，需要将其置为0
return(pwm)
}
seqs <- c("CGTAA", "ATTAG", "CTAAG", "ATTAA", "CATAA")
ppm <- make_ppm(seqs)
ppm
## 1 2 3 4 5
## A 0.4 0.2 0.2 1 0.6
## T 0.0 0.6 0.8 0 0.0
## G 0.0 0.2 0.0 0 0.4
## C 0.6 0.0 0.0 0 0.0
pwm <- ppm2pwm(ppm)
pwm
## 1 2 3 4 5
## A 0.6780719 -0.3219281 -0.3219281 2 1.2630344
## T 0.0000000 1.2630344 1.6780719 0 0.0000000
## G 0.0000000 -0.3219281 0.0000000 0 0.6780719
## C 1.2630344 0.0000000 0.0000000 0 0.0000000
- 直接读入PFM矩阵并计算PPM，然后使用ggseqlogo画图
seqs_text <- ' 1 2 3 4 5
A 2 1 1 5 3
T 0 3 4 0 0
G 0 1 0 0 2
C 3 0 0 0 0'
seqs_pfm <- read.table(text=seqs_text)
# 计算PPM
pfm2ppm(seqs_pfm)
## X1 X2 X3 X4 X5
## A 0.4 0.2 0.2 1 0.6
## T 0.0 0.6 0.8 0 0.0
## G 0.0 0.2 0.0 0 0.4
## C 0.6 0.0 0.0 0 0.0
# 直接绘图
library(ggseqlogo)
ggseqlogo(as.matrix(seqs_pfm))
## Warning: `guides( = FALSE)` is deprecated. Please use `guides( =
## "none")` instead.
四、待优化
- 优化代码，使其可自动判断输入类型是DNA还是RNA，即无需指定seq_type参数。
- 博客文章需要改一下数字，顺便将代码放上去。