R/idmatch.R

In musto101/wilcox_R: What the package does (short line)

idmatch <-
function(m1,m2,id.col1,id.col2=id.col1){
#
#  for the id data in column id.col of matrices m1 and m2
#  pull out data for which both m1 and m2 have matching id's
#  return the data in a matrix, m
#
flag=!is.na(m1[,id.col1])
m1=m1[flag,]  # eliminate any rows where ID is missing
flag=!is.na(m2[,id.col1])
m2=m2[flag,]
M1=NULL
if(sum(duplicated(m1))>0)stop('Duplicate ids detected in m1')
if(sum(duplicated(m2))>0)stop('Duplicate ids detected in m2')
for(i in 1:nrow(m1)){
flag=duplicated(c(m1[i,id.col1],m2[,id.col2]))
if(sum(flag>0)){
if(is.data.frame(m1)){
if(!is.null(dim(M1)))M1=rbind(M1,as.data.frame(m1[i,]))
if(is.null(dim(M1)))M1=as.data.frame(m1[i,])
}
if(!is.data.frame(m1)){
if(!is.null(dim(M1)))M1=rbind(M1,m1[i,])
if(is.null(dim(M1)))M1=matrix(m1[i,],nrow=1)
}
}}
M2=NULL
for(i in 1:nrow(m2)){
flag=duplicated(c(m2[i,id.col2],m1[,id.col1]))
if(sum(flag>0)){
if(is.data.frame(m2)){
if(!is.null(dim(M2)))M2=rbind(M2,as.data.frame(m2[i,]))
if(is.null(dim(M2)))M2=as.data.frame(m2[i,])
}
if(!is.data.frame(m2)){
if(!is.null(dim(M2)))M2=rbind(M2,m2[i,])
if(is.null(dim(M2)))M2=matrix(m2[i,],nrow=1)
}
}}
m=cbind(M1[,id.col1],M1[,-id.col1],M2[,-id.col2])
m
}