Hi Elisa,
Try this:
dat1<- read.csv("DQV.csv",sep="\t")
res<- do.call(cbind,lapply(seq_len(nrow(dat1)),function(i)
do.call(rbind,lapply(split(rbind(dat1[i,],dat1[-i,]),1:nrow(rbind(dat1[i,],dat1[-i,]))),function(x)
{x1<- rbind(dat1[i,],x); colnames(x1)<- gsub("[.]","",colnames(x1));
if({indx<- colSums(is.na(x1)); indx[2]==0 & indx[3]==1}) # 2 peaks 1 peak
comparison
{x2<- x1[rev(order(x1$Peak2v, x1$Npeak2v)),];
with(x2,{abs(Peak1v[1]-Peak1v[2])+abs(Peak1v[1]-Peak2v[2]) +
abs(Npeak1v[1]-Npeak1v[2])+abs(Npeak1v[1]-Npeak2v[2]) })
}
else {x1[is.na(x1)]<-0; x1; #cases where peaks are similar
with(x1,{abs(Peak1v[1]-Peak1v[2])+ abs(Peak2v[1]-Peak2v[2])+
abs(Npeak1v[1]-Npeak1v[2])+ abs(Npeak2v[1]-Npeak2v[2])})
}
}))))
res2<-do.call(cbind,lapply(seq_len(ncol(res)),function(i)
c(c(tail(res[seq(1,i,1),i],-1),0),res[-c(1:i),i])))
row.names(res2)<-1:nrow(res2)
dim(res2)
#[1] 124 124
res2[1:5,1:5]
# [,1] [,2] [,3] [,4] [,5]
#1 0.0000000 0.8024471 2.3537210 2.1929718 3.7746302
#2 0.8024471 0.0000000 3.1233237 2.9954189 4.5442329
#3 2.3537210 3.1233237 0.0000000 0.4094026 0.8108279
#4 2.1929718 2.9954189 0.4094026 0.0000000 0.8571442
#5 3.7746302 4.5442329 0.8108279 0.8571442 0.0000000
A.K.
________________________________
From: eliza botto <eliza_bo...@hotmail.com>
To: "smartpink...@yahoo.com" <smartpink...@yahoo.com>
Sent: Wednesday, March 27, 2013 12:07 PM
Subject: RE: a similar question
Dear Arun,
The last question regarding this distance measurement is that how to modify the
following codes for calculation of distance if we have 2 peaks atmost. The data
file is attached
Thanks in advance
Elisa
> Date: Tue, 26 Mar 2013 16:02:01 -0700
> From: smartpink...@yahoo.com
> Subject: Re: a similar question
> To: eliza_bo...@hotmail.com
> CC: r-help@r-project.org
>
> HI Elisa,
>
> You need to review the formulas. Some of them (especially between 84 & 85 or
> 4 & 84 is not making sense, possibly typos). I changed it according to the
> pattern of the formulas.
> source("ElisaNew.txt")
> #mat1 # dataset
>
> res<-do.call(cbind,lapply(seq_len(nrow(mat1)),function(i)
> do.call(rbind,lapply(split(rbind(mat1[i,],mat1[-i,]),1:nrow(rbind(mat1[i,],mat1[-i,]))),
> function(x) {x1<- rbind(mat1[i,],x);x1<-as.data.frame(x1);
> if({indx<-colSums(is.na(x1));indx[1]==0 & indx[2]==0 & indx[3]==1 &
> indx[4]==2}) #3 peaks 2 peaks comparison
> {x2<- x1[rev(order(x1$Peak3,x1$Npeak3)),];
> with(x2,{abs(Peak1[1]-Peak1[2])+abs(Peak2[1]-Peak2[2])+abs(Peak1[1]-Peak3[2])
> + abs(Npeak1[1]-Npeak1[2])+abs(Npeak2[1]-Npeak2[2])+abs(Npeak1[1]-Npeak3[2])})
> }
>
> else if({indx[1]==0 & indx[2]==1 & indx[3]==2 & indx[4]==2}) #2 peaks 1 peak
> comparison
> {x3<- x1[rev(order(x1$Peak2,x1$Npeak2)),];
> with(x3,{abs(Peak1[1]-Peak1[2])+ abs(Peak1[1]-Peak2[2])+
> abs(Npeak1[1]-Npeak1[2])+ abs(Npeak1[1]-Npeak2[2])})
> }
> else if({indx[1]==0 & indx[2]==0 & indx[3]==1 & indx[4]==1}) #4 peaks 2 peaks
> comparison
> {x4<- x1[rev(order(x1$Peak3,x1$Peak4,x1$Npeak3,x1$Npeak4)),];
> with(x4,{abs(Peak1[1]-Peak1[2])+abs(Peak2[1]-Peak2[2])+
> abs(Peak1[1]-Peak3[2])+ abs(Peak2[1]-Peak4[2])+
> abs(Npeak1[1]-Npeak1[2])+abs(Npeak2[1]-Npeak2[2])+ abs(Npeak1[1]-Npeak3[2])+
> abs(Npeak2[1]-Npeak4[2])})
> }
>
> else if({indx[1]==0 & indx[2]==0 & indx[3]==0 & indx[4]==1}) #4 peaks 3 peaks
> comparison
> {x5<- x1[rev(order(x1$Peak4,x1$Npeak4)),];
> with(x5,{abs(Peak1[1]-Peak1[2])+abs(Peak2[1]-Peak2[2])+
> abs(Peak3[1]-Peak3[2])+ abs(Peak1[1]-Peak4[2])+
> abs(Npeak1[1]-Npeak1[2])+abs(Npeak2[1]-Npeak2[2])+ abs(Npeak3[1]-Npeak3[2])+
> abs(Npeak1[1]-Npeak4[2])})
> }
> else if({indx[1]==0 & indx[2]==1 & indx[3]==1 & indx[4]==1}) #4 peak 1 peak
> comparison
> {x6<-
> x1[rev(order(x1$Peak2,x1$Peak3,x1$Peak4,x1$Npeak2,x1$Npeak3,x1$Npeak4)),];
> with(x6,{abs(Peak1[1]-Peak1[2])+
> abs(Peak1[1]-Peak2[2])+abs(Peak1[1]-Peak3[2])+ abs(Peak1[1]-Peak4[2])+
> abs(Npeak1[1]-Npeak1[2])+ abs(Npeak1[1]-Npeak2[2])+abs(Npeak1[1]-Npeak3[2])+
> abs(Npeak1[1]-Npeak4[2])})
> }
> else if({indx[1]==0 & indx[2]==1 & indx[3]==1 & indx[4]==2}) # 3 peaks 1 peak
> comparison
> {x7<- x1[rev(order(x1$Peak2,x1$Peak3,x1$Npeak2,x1$Npeak3)),];
> with(x7,{abs(Peak1[1]-Peak1[2])+abs(Peak1[1]-Peak2[2])+abs(Peak1[1]-Peak3[2])+
> abs(Npeak1[1]-Npeak1[2])+abs(Npeak1[1]-Npeak2[2])+abs(Npeak1[1]-Npeak3[2])})
> }
> else {x1[is.na(x1)]<-0; x1; #cases where peaks are similar
> with(x1,{abs(Peak1[1]-Peak1[2])+ abs(Peak2[1]-Peak2[2])+
> abs(Peak3[1]-Peak3[2])+abs(Peak4[1]-Peak4[2]) + abs(Npeak1[1]-Npeak1[2])+
> abs(Npeak2[1]-Npeak2[2])+ abs(Npeak3[1]-Npeak3[2])+abs(Npeak4[1]-Npeak4[2])})
> }
>
> }))))
>
> res2<-do.call(cbind,lapply(seq_len(ncol(res)),function(i)
> c(c(tail(res[seq(1,i,1),i],-1),0),res[-c(1:i),i])))
> row.names(res2)<-1:nrow(res2)
> dim(res2)
> #[1] 124 124
> res2[1:5,1:5]
> # [,1] [,2] [,3] [,4] [,5]
> #1 0.00000 65.59415 86.62556 407.9987 104.78294
> #2 65.59415 0.00000 42.14256 307.3830 39.18879
> #3 86.62556 42.14256 0.00000 314.4331 33.88839
> #4 407.99871 307.38297 314.43309 0.0000 266.78887
> #5 104.78294 39.18879 33.88839 266.7889 0.00000
>
>
>
> A.K.
>
>
>
>
______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
