2012年10月14日日曜日

R: wigもつくる

せっかく自動でgffをつくったので、wigもつくってみる。
まず、前回の「gff.gen()」に若干の修正を加えてgffを得る。


gffをつくる関数

gff.gen <- function(n=1000,chrnum=3,type="protein_coding"){
chrs <- paste("chr",1:chrnum,sep="")
source <- "R"
type <- type
dots <- rep(".",n)
chr <- sample(chrs,n,replace=T)
start <- sample(1:9990000,n)
end <- start+1500+(round(rnorm(n)/2*500))
strand <- sample(c("+","-"),n,replace=T,prob=c(0.5,0.5))
id <- paste("gene",1:n,sep="")
gff <- data.frame(chr,source,type,start,end,dots,strand,dots,id)
return(gff)
}

gffをつくってソート

gff <- gff.gen(1000,3,"protein_coding")
gff <- sort.left(gff)


このgffの中の一部の遺伝子の5'末端にふくらみのあるwigをつくる。

# wigをつくる関数(上のgffがあることが前提)
wig.gen <- function(chrnum=3){

# chrの名前をつくる
chrs <- paste("chr",1:chrnum,sep="")

# chr毎に作業する
for (i in 1:length(chrs)){
chr <- chrs[i]

# headerをつくる
wig.head1 <- paste("track type=wiggle_0 name=\"",chr,"\" description=\"generated by R\"",sep="")
wig.head2 <- paste("variableStep chrom=",chr," span=10",sep="")
wig.head <- c(wig.head1,wig.head2)
wig.head.file <- paste("head_",chr,".txt",sep="")
write(wig.head,file=wig.head.file)

# bodyをつくる
n <- 10000000
step <- 10
pos <- seq(1,n,step)
depth <- round(rnorm(1:length(pos),100,sd=2))
wig.body <- cbind(pos,depth)

# chr毎のgffをつくる
assign(paste("gff.",chr,".fw",sep=""),gff[gff$chr==chr&gff$strand=="+",])
assign(paste("gff.",chr,".rv",sep=""),gff[gff$chr==chr&gff$strand=="-",])

# bodyに変化を加える
y.rep <- nrow(get(paste("gff.",chr,".fw",sep="")))%/%5
for(y in 1:y.rep) {
tss <- sample(get(paste("gff.",chr,".fw",sep=""))[,4],1)%/%10
upst <- tss-19
dnst <- tss+20
hight <- sample(1:2000,1)
add.tag.upst <- round((cos(seq(1*pi,0,length=20))+1)*hight)
add.tag.dnst <- round((cos(seq(0,1*pi,length=20))+1)*hight)
wig.body[upst:tss,2] <- wig.body[upst:tss,2]+add.tag.upst
wig.body[(tss+1):dnst,2] <- wig.body[(tss+1):dnst,2]+add.tag.dnst
tss <- sample(get(paste("gff.",chr,".rv",sep=""))[,5],1)%/%10
upst <- tss-19
dnst <- tss+20
hight <- sample(1:2000,1)
add.tag.upst <- round((cos(seq(1*pi,0,length=20))+1)*hight)
add.tag.dnst <- round((cos(seq(0,1*pi,length=20))+1)*hight)
wig.body[upst:tss,2] <- wig.body[upst:tss,2]+add.tag.upst
wig.body[(tss+1):dnst,2] <- wig.body[(tss+1):dnst,2]+add.tag.dnst
}

# bodyを保存する
wig.body.file <- paste("body_",chr,".txt",sep="")
write.table(wig.body,file=wig.body.file,col.names=F,row.names=F,sep=" ")

# headerbodyをつなげる
wig.file <- paste(chr,".wig",sep="")
sys.command <- paste("cat",wig.head.file,wig.body.file,">",wig.file,sep=" ")
system(sys.command)

# headerとbodyを消す
system(paste("rm",wig.head.file,sep=" "))
system(paste("rm",wig.body.file,sep=" "))

} # chr毎のループはここまで
} # この関数はここまで


上の関数を使ってwigをつくる
wig.gen(3)




0 件のコメント:

コメントを投稿