作者cywhale (cywhale)
看板R_Language
标题Re: [问题] 捞资料
时间Thu Aug 21 00:24:14 2014
da = data.frame(gene =c("A","B","C"),
chr =c("1","X","2"),
start=c(25000,1000,0),
end =c(50000,2000,800))
db = data.frame(probe=c("a1","a2","a3","a4","a5"),
chr =c("2","4","1","X","1"),
start=c(175,600,23575,1010,30000),
end =c(200,625,23600,1035,30025))
chr_match = t(sapply(1:dim(da)[1],
function(x,gen,prb) match(prb,gen[x]),
gen = da$chr, prb = db$chr))
loc_match = function (x,y) {
ifelse (x[1]>=y[1] & x[2]<=y[2], 1, 0)
}
prb_match = lapply(1:dim(da)[1],
function(x,loca,locb,chr_mat) {
apply(locb[which(!is.na(chr_mat[x,])),],
MARGIN=1,
FUN =loc_match, y=loca[x,])
},loca = da[,c(3:4)], locb = db[,c(3:4)],
chr_mat = chr_match)
data.frame(
gene_a = da$gene,
match_probe =
sapply(1:dim(da)[1],
function(x,prb_mat) {
paste(unlist(paste("a",
names(prb_mat[[x]][which(prb_mat[[x]]==1)]),
sep="")),collapse=",")
}, prb_mat = prb_match))
--
※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 114.45.51.225
※ 文章网址: http://webptt.com/cn.aspx?n=bbs/R_Language/M.1408551856.A.DEA.html
※ 编辑: cywhale (114.45.51.225), 08/21/2014 00:30:19