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))