R/combine.chunks.R

In pik-piam/nitrogen: Nitrogen Library

###################################
######  combine.chunks       ######
###################################

#to combine two arrays of same dimension into a bigger array

combine.chunks <- function(chunk1,chunk2,nodata=0) {
  
################################ first checks for correct use of function ############################################

  #checking if one chunk is empty and combining therefore trivial:
  if (is.null(chunk1)) {
    combine.chunks <- chunk2
  } else if (is.null(chunk2)) {
    combine.chunks <- chunk1
  } else {
    #now, checking if dimensions of chunks correspond with each other:	
    if(length(dim(chunk1))!=length(dim(chunk2))){
      stop(paste("Incompatible chunks: chunk1 has",length(dim(chunk1)),"dimensions, while chunk2 has",length(dim(chunk2)),"dimensions!"))
    }
	
    ndim <- length(dim(chunk1))	#number of dimensions

    #in case of chunks being data.frames, convert them into matrices:
    if(is.data.frame(chunk1)) chunk1 <- as.matrix(chunk1)
    if(is.data.frame(chunk2)) chunk2 <- as.matrix(chunk2)	
    
    #checking if dimnames exist in each dimension
    for(i in 1:ndim){
      if((is.null(dimnames(chunk1)[[i]]) & dim(chunk1)[i]!=0) | (is.null(dimnames(chunk2)[[i]]) & dim(chunk2)[i]!=0)){
        stop(paste("Dimnames in dimension",i,"are missing!"))
      }
    }

###################################### the core functionality #######################################################

    dim.names <- list() # list to save the aggregated dimnames of both chunks
    dim.length <- NULL	# dimension vector to save the aggregated dim vectors of both chunks
    
    #now, combine dimnames of chunks:	
    for(i in 1:ndim) {
      dim.names[[i]] <- unique(c(dimnames(chunk1)[[i]],dimnames(chunk2)[[i]]))
      #copying also names of dimnames, if they exist:
      if(!is.null(names(dimnames(chunk2)))&& !is.na(names(dimnames(chunk2))[i])){
        if(names(dimnames(chunk2))[i] != ""){
          names(dim.names)[i] <- names(dimnames(chunk2))[i]
        }
      }
      else if(!is.null(names(dimnames(chunk1)))&& !is.na(names(dimnames(chunk1))[i])){
        if(names(dimnames(chunk1))[i] != ""){
          names(dim.names)[i] <- names(dimnames(chunk1))[i]
        }
      }
        
      dim.length <- c(dim.length,length(dim.names[[i]])) 
    }
    #and create the appropriate array, filled with "nodata" first:	
    combine.chunks <- array(nodata, dim = dim.length, dimnames = dim.names)
    
    if(prod(dim(chunk1))>0) subarray(combine.chunks, dimnames(chunk1), useDimNames =FALSE) <- chunk1
    if(prod(dim(chunk2))>0) subarray(combine.chunks, dimnames(chunk2), useDimNames =FALSE) <- chunk2
	
    return(combine.chunks)
  }
}
############################################# finish combine.chunks  ##########################################################