mrg <- function(A,B){ R <- c() while(length(A)>0 length(B)>0){ if(A[1]<B[1]){ R <- c(R,A[1]) A <- A[-1] } else{ R <- c(R,B[1]) B <- B[-1] } } return(c(R,A,B)) } msort <- function(A){ if(length(A)<2){ return(A) } else{ R <- c() W <- c() x <- 8 for(i in 1:length(A)){ if(i%%2==0){ R <- c(R,mrg(A[(i-1)],A[i])) } } } if((length(A)%%2)==1){ R <- c(R,A[length(A)]) } for(i in 1:length(R)){ if(i%%4==0){ j <- i W <- c(W,mrg(R[(j-3):(j-2)],R[(j-1):j])) } } if((length(R)%%4)==3){ W <- c(W,mrg(R[(j+1):(j+2)],R[(j+3)])) } if((length(R)%%4)<3 && (length(R)%%4)!=0){ W <- c(W,R[(j+1):length(R)]) } R <- W W <- c() while(x<length(R)){ for(i in 1:length(R)){ if(i%%x==0){ j <- i W <- c(W,mrg(R[(j-(x-1)):(j-(x%/%2))],R[(j-(x%/%2)+1):j])) } } if((length(R)%%x)>(x%/%2)){ W <- c(W,mrg(R[(j+1):(j+(x%/%2))],R[(j+(x%/%2)+1):length(R)])) } if((length(R)%%x)<=(x%/%2) && (length(R)%%x)!=0){ W <- c(W,R[(j+1):length(R)]) } x <- x*2 R <- W W <- c() } R <- mrg(R[1:j],R[(j+1):length(R)]) return(R) }
[[alternative HTML version deleted]] ______________________________________________ R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see 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.