Hi Eliza,
Some lines of code in the end didn't look very convincing for me.? (I
didn't change it anyway). For example:
#####
?amata<-data.frame(amata)
aavg<-as.matrix(amata, ncol=1)
b<-aavg
sss<-(max(b)+max(amata))/2
####
Also, multiple objects of the same name were created through out the code, which
makes it bit hard.
##solution
? Eliz <- load("/home/arunksa111/Downloads/Elizaaa.RData" )
Dm <- `Dm`
ffr <- `ffr`
?j <- `j`
?m <- `m`
d15<-Dm/mean(Dm)
dr1<-ffr/mean(ffr)
t<-as.matrix((d15)+(dr1))
w<-sqrt(t)
mat1<-w
zz<-w? ## multiple objects!!
rlst<- lapply(1:124,function(i)
matrix(sort(as.matrix(zz)[i,],index.return=TRUE)$ix,ncol=1))
rlstN <- lapply(rlst,function(x) {
??? ??? ??? ??????? u<- x[2:8,1]
??? ??? ??? ??? mata <- m[,u]
??? ??? ??? ??? ?a <- matrix(rowMeans(mata),ncol=1)
??? ??? ??? ??? ?mat <- cbind(j,a)
??? ??? ??? ??? lst1<-lapply(split(mat,col(mat)),function(x){
??? ??? ??? ??? ??? ??? ??? big<- x>0.8*max(x)
??? ??? ??? ??? ??? ??? ??? ?n<- length(big)
??? ??? ??? ??? ??? ??? ??? startRunOfBigs<- which(c(big[1],!big[-n] &
big[-1]))
??? ??? ??? ??? ??? ??? ??? endRunOfBigs<- which(c(big[-n] & !big[-1],
big[n]))
??? ??? ??? ??? ??? index<- vapply(seq_along(startRunOfBigs),function(i)
which.max(x[startRunOfBigs[i]:endRunOfBigs[i]])+startRunOfBigs[i]-1L,0L) ??? ???
??? ??? ??? ??? index<-ifelse(sum(is.na(match(index,c(1,12))))==0 &
x[index]!=max(x[index]), NA,index)
??? ??? ??? ??? ???
data.frame(Index=index[!is.na(index)],Value=x[index[!is.na(index)]])?
??? ??? ??? ??? ??? })
??? ???????? ??? nm <- lapply(lst1,function(x) x$Index)
??? ??? ??? max_length<- max(unlist(lapply(nm,length)))
??? ??? ?????? nm_filled<-lapply(nm,function(x){
??? ??? ??? ??? ??? ans<- rep(NA,length=max_length)
???? ??? ??? ??? ??? ans[1:length(x)]<- x
??? ??? ??? ??? ??? return(ans)
??? ??? ??? ??? ??? })
??? ??? ??? xx<-do.call(cbind,nm_filled)? ##didn't see this part being
used in the end
??? ??? ??? ?mat})
###Using a subset of list elements
srlstN <- rlstN[61:62]
library(hydroGOF)
res <-? lapply(srlstN, function(x) {
??? ??? ??? ??? ??? i<- as.list(fun3(x))
????????????????? xx<- do.call(cbind,i)
???????????????? xx<- t(xx)
???????????????? x1 <- matrix(xx,nrow=1)
???????????????? y <- matrix(0,nrow=125,ncol=125)
???????????????? y[lower.tri(y)]<- x1
???????????????? yy <- as.dist(y)
???????????????? list1<- lapply(seq_len(ncol(x)),function(j)
t(apply(x,1,function(u) u[j]-u)))
???????????????? x2<- matrix(unlist(list1),ncol=15625)
???????????????? x2<- abs(x2)
???????????????? y1 <- colSums(x2,na.rm=FALSE)
??? ??? ??? ??? z1 <- matrix(y1,ncol=125)
???????????????? zz <- as.dist(z1)
??? ??? ??? ??? x3 <- apply(x,2,max)
???????????????? xx1 <- dist(x3)
???????????????? xx1[yy==0] <-0
???????????????? ff <- zz+yy+xx1
???????????????? r <-
matrix(sort(as.matrix(ff)[125,],index.return=TRUE)$ix,ncol=1)
??? ??? ??? ??? u1 <- r[2:8,1]
???????????????? mata <- x[,u1]
???????????????? amata <- data.frame(rowMeans(mata))
???????????????? aavg <- as.matrix(amata, ncol=1)
???????????????? sss <- (max(aavg)+max(amata))/2
????????????????? aavg[which(aavg==max(aavg))] <- sss
???????????????? mat2<- do.call(rbind,lapply(seq_len(ncol(x)), function(j){
??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? RRR
<- rmse(aavg,matrix(x[,j],ncol=1))
??????????????????????????????????????????????????????????????????????????? UUU
<- NSE(aavg,matrix(x[,j],ncol=1))
???????????????????????????????????????????????????????????????????????????? cc
<- sum(abs(aavg - x[,j]))
????????????????????????????????????????????????????????????????????????????
c(RRR,UUU,cc)
??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ??? ???
}))
???????????????? colnames(mat2) <-
c("RRR","UUU","cc")
???????????????? mat2
???????????? })
?head(res[[1]])
#?????????? RRR??????? UUU??????? cc
#[1,] 0.3830867? 0.5155312? 3.617801
#[2,] 0.5149736 -0.6779912? 4.194520
#[3,] 1.4246430 -1.3620793 15.116817
#[4,] 1.0875600 -1.4012783 11.170334
#[5,] 1.3309777 -0.8873588 14.078342
#[6,] 0.2056404? 0.9170877? 1.959848
A.K.
On Tuesday, October 15, 2013 12:08 PM, eliza botto <eliza_botto at
hotmail.com> wrote:
Dear Arun,
You once helped prepared me following codes for my work. Now i automatically
want to replace "61" in all the four steps indicated with
">>>>>" in the beginning, with 1,2,3,4........, 124 so
that i have three lists in the end each for ?RRR, UU and cc.
Can it be done? I hope i am clear in my question.
Thanks in advance
Eliza
## d15 and dr1 are ?distance matrices of 8*8 dimensions
d15<-Dm/mean(Dm)?
dr1<-ffr/mean(ffr)?
t<-as.matrix((d15)+(dr1))
w<-sqrt(t)
mat1<-w
zz<-w>>>>>r<-matrix(sort(as.matrix(zz)[61,],index.return=TRUE)$ix,ncol=1)
u<-r[c(2,3,4,5,6,7,8),1]
mata<-m[,c(u)]##(shifted)
amata<-apply(mata,1,mean)
amata<-data.frame(amata)
aavg<-as.matrix(amata, ncol=1)
a<-aavg
## j is matrix of 8 rows and 2 columns
m<-cbind(j,a)
mat<-m
?lst1<-lapply(split(mat,col(mat)),function(x){big<- x>0.8*max(x);
n<- length(big);startRunOfBigs<- which(c(big[1],!big[-n] & big[-1]));
endRunOfBigs<- which(c(big[-n] & !big[-1], big[n]));index<-
vapply(seq_along(startRunOfBigs),function(i)
which.max(x[startRunOfBigs[i]:endRunOfBigs[i]])+startRunOfBigs[i]-1L,0L);
index<-ifelse(sum(is.na(match(index,c(1,12))))==0 &
x[index]!=max(x[index]),
NA,index);data.frame(Index=index[!is.na(index)],Value=x[index[!is.na(index)]])
?})
?nm<-lapply(lst1,function(x)(x$Index))
max_length<- max(unlist(lapply(nm,length)))
nm_filled<-lapply(nm,function(x){ans<- rep(NA,length=max_length);
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ans[1:length(x)]<- x;
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? return(ans)})
xx<-do.call(cbind,nm_filled)
fun1<- function(x){
? ? big<- x>0.8*max(x)?
? ? n<- length(big)
? ? startRunOfBigs<- which(c(big[1],!big[-n] & big[-1]))
? ? endRunOfBigs<- which(c(big[-n] & !big[-1], big[n]))
? ? index<- vapply(seq_along(startRunOfBigs),function(i)
which.max(x[startRunOfBigs[i]:endRunOfBigs[i]])+startRunOfBigs[i]-1L,0L)
? ? ?index<-ifelse(sum(is.na(match(index,c(1,12))))==0 &
x[index]!=max(x[index]), NA,index)
? ? data.frame(Index=index[!is.na(index)],Value=x[index[!is.na(index)]])
? ? ?}
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(m)
########
i<-as.list(fun3(m))
xx<-do.call(cbind, i)
xx<-t(xx)
x<-matrix(xx,nrow=1)
?y <- matrix(0, nrow=125, ncol=125)?
y[lower.tri(y)] <- x?
yy<-as.dist(y)
##==============list1<-list()
for(i in 1:ncol(m)){
?list1[[i]]<-t(apply(m,1,function(x) x[i]-x))
?list1}
x<-list1
x<-matrix(unlist(x),ncol=15625)
x<-abs(x)
y<-colSums(x, na.rm=FALSE)
z<-matrix(y, ncol=125)
zz<-as.dist(z)
x<-apply(m, 2, max)
xx<-dist(x)
xx<-as.dist(xx)
xx[yy==0]<-0
ff<-((zz))+((yy))+((xx))
r<-matrix(sort(as.matrix(ff)[125,],index.return=TRUE)$ix,ncol=1)
u<-r[c(2,3,4,5,6,7,8),1]
mata<-m[,c(u)]##(shifted)
amata<-apply(mata,1,mean)
amata<-data.frame(amata)
aavg<-as.matrix(amata, ncol=1)
b<-aavg
sss<-(max(b)+max(amata))/2
b[which(b == max(b))]<-sss
library(hydroGOF)>>>>>RRR<-rmse(b,matrix(m[,61],ncol=1))
>>>>>UUU<-NSE(b,matrix(m[,61],ncol=1))
>>>>>cc<-sum(abs(b-m[,61]))