[R] a similar question

arun smartpink111 at yahoo.com
Wed Mar 27 19:04:20 CET 2013


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_botto at hotmail.com>
To: "smartpink111 at yahoo.com" <smartpink111 at 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: smartpink111 at yahoo.com
> Subject: Re: a similar question
> To: eliza_botto at hotmail.com
> CC: r-help at 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.
> 
> 
> 
>



More information about the R-help mailing list