Skip to content
Prev 324193 / 398503 Next

QA

I thought you want to compare between the rows of two columns even if their corresponding values fall in the same row.


fun3<- function(mat){
??????? indmat<-combn(seq_len(ncol(mat)),2)
??? lst1<- lapply(seq_len(ncol(indmat)),function(i) {mat[,indmat[,i]]})?? 
??? names(lst1)<-as.character(interaction(as.data.frame(t(indmat)),sep="_",drop=TRUE))?????? 
??? lst2<- lapply(lst1,function(x) {x1<- apply(x,2,fun1)})
?? 
??? lst3<- lapply(lst2,function(x) expand.grid(lapply(x,function(y) y[,1])))
??? lst4<-lapply(lst3,function(x) unlist(x[which.min(apply(x,1,function(y) abs(diff(y)))),]) )
??? lst5<- lapply(lst4,function(x){
??????????????? if(abs(diff(x))>(nrow(mat)/2)){
??????????????? nrow(mat)-abs(diff(x))
??????????????????? }
??????????????????????? else(abs(diff(x)))
??????????????????? })
?????? 
??? lst6<- lapply(seq_along(lst5),function(i) {
??????????????? x2<-lst1[[i]]
??????????????? if(lst5[[i]]==0) {
??????????????????? #indx1<- seq(length(x2[,2]))
??????????????????? #sum(abs(x2[,1]-x2[indx1,2]))
??? ??? ???? 0?? ? ######################## set to zero ??????????????????? 
??? ??? ??? }
??????????????? else{
??????????????????? lapply(seq(1+lst5[[i]]),function(j){x3<-x2[,2]
??????????????????????????? indx1<-seq(length(x3)-(j-1))
??????????????????????????? indx2<-c(setdiff(seq_along(x3),indx1),indx1)
??????????????????????????? sum(abs(x2[,1]-x2[indx2,2]))
??????????????????????????? })
??????????????? }
??????????????? })?? 
?????????????? 
??? names(lst6)<- names(lst1)
??? lst7<-lapply(lst6,unlist)
??? lst8<- lapply(lst7,function(x) {
??????????? Seq1<-seq_along(x)
??????????? if(length(Seq1)==1) x
??????????? else if(length(Seq1)==2){
??????????????????????? sum(abs(x[1]-x[2]))?? 
??????????????????????? }
??????????? else{
??????????????? ind<-rep(Seq1,each=2)[-1]
??????????????? ind1<-ind[-length(ind)]
??????????????? Reduce(`+`,lapply(split(ind1,(seq_along(ind1)-1)%/%2+1),function(i) {
??????????????????????????????????? abs(diff(x[i]))
??????????????????????????????????? }))?????????????????????????? 
??????????????? }

??????????????????? }
??????????? )
??? lst9<-do.call(rbind,lst8)
??? lst9??? ?? 
??? }

?fun3(mm)
#????????? [,1]
#1_2? 2.5966051
#1_3? 1.0267435
#1_4? 0.0000000
#1_5? 1.8489204
#1_6? 0.0000000
#2_3? 0.0000000
#2_4? 1.9040790
#2_5? 2.2874235
#2_6? 5.1526016
#3_4? 0.9726777
#3_5? 2.1359229
#3_6? 5.0221450
#4_5? 0.9124638
#4_6? 0.0000000
#5_6 14.0550864


xx
#????? 1? 8? 9 23 87 89
#[1,]? 5? 4? 4? 5? 6 12
#[2,] 12 NA NA? 9 NA NA
#[3,] NA NA NA 12 NA NA

According to xx, 1&4, 2&3, 4&6 (also 0 because both have 12)
A.K.