R/read.vectorized.geotop.recovery.R

Defines functions read.vectorized.geotop.recovery

Documented in read.vectorized.geotop.recovery

# TODO: Add comment
# 
# Author: ecor
###############################################################################


NULL

#'
#' Reads a text file like the one generated by  \code{\link{write.vectorized.geotop.recovery}} 
#' 
#' 
#' #. containing  values and matedata of a z-layer brick referred to a time instant (e.g. date). The file is formatted like an ascii format like \code{'geotop.inpts'} file. 
#' 

#' @param file file name to write 
#' @param comment character. Comment indicator. Default is \code{"!"}.
#' @param formatter,extension,xx see \code{\link{get.geotop.recovery.state}}. 
#' @param NAflag numeric. Default is -9999, see \code{\link{writeRasterxGEOtop}}.
#' @param crs Character or object of class CRS. PROJ4 type description of a Coordinate Reference System (map projection) (optional). See \code{\link{brick}} or \code{\link{raster}}.
#' @param matlab.syntax logical value. Default is \code{TRUE}. If \code{TRUE} the file syntax is like the one of a *.m Matlab script file.
#' @param ... further aguments inserted as attribute
# @export 
#' 
#' 
#' 
#' @return a \code{\link{list}} object like \code{\link{get.geotop.recovery.state}}
#' 
#' @export
#' @seealso \code{\link{write.vectorized.geotop.recovery}}
#' 
#' @examples 
#' # see the examples of read.ascii.vectorized.brick

read.vectorized.geotop.recovery <- function(file=file,comment="!",matlab.syntax=TRUE,xx="0000",formatter="L%04d",extension=".asc",NAflag=-9999,crs="",...) {

	lnames <- c("noLayers","soilLayersWithZero","soilLayers","snowLayers") 

	if (matlab.syntax) comment="#"
	
	df <- geotopbricks::declared.geotop.inpts.keywords(inpts.file=file,comment=comment,warn=FALSE,wpath=NULL,...) # commented wpath='.'
	
	xmx <- get.geotop.inpts.keyword.value("xmx",inpts.frame=df,numeric=TRUE)
	xmn <- get.geotop.inpts.keyword.value("xmn",inpts.frame=df,numeric=TRUE)
	ymx <- get.geotop.inpts.keyword.value("ymx",inpts.frame=df,numeric=TRUE)
	ymn <- get.geotop.inpts.keyword.value("ymn",inpts.frame=df,numeric=TRUE)
	## IN
	nrow <- get.geotop.inpts.keyword.value("nrow",inpts.frame=df,numeric=TRUE)
	ncol <- get.geotop.inpts.keyword.value("ncol",inpts.frame=df,numeric=TRUE)

	lnames <- get.geotop.inpts.keyword.value(lnames,inpts.frame=df,matlab.syntax=matlab.syntax,vector_sep=",")
	
	names <- as.vector(unlist(lnames))
	

	out <- lapply(X=lnames,FUN=function(x){names %in% x})
	out$names <- names
	
	# See get.geotop.recovery.state 
	layer <- array(formatter,length(names))
	if (!is.null(out$noLayers)) layer[out$noLayers] <- ""
	out$files <- paste(names,xx,layer,extension,sep="")
	
	nlayers <- as.vector(unlist(lapply(X=paste("nlayers_",names(lnames),sep=""),FUN=function(x){get.geotop.inpts.keyword.value(x,inpts.frame=df,numeric=TRUE)})))
	names(nlayers) <- names(lnames)
	
#	out[names] <- get.geotop.inpts.keyword.value(names,inpts.frame=df,numeric=TRUE,vector_sep=",",matlab.syntax=TRUE)
	
#	out[names] <- lapply(X=out[names],FUN=function(x,NAflag) { x[x==NAflag] <- NA; return(x)},NAflag=NAflag)

	b <- lapply(X=nlayers,FUN=function(x,nrow,ncol, xmn, xmx, ymn, ymx,crs) {brick(nrow=nrow,ncol=ncol, xmn=xmn, xmx=xmx, ymn=ymn, ymx=ymx,crs=crs,nl=x)},nrow=nrow,ncol=ncol,xmn=xmn, xmx=xmx, ymn=ymn, ymx=ymx,crs=crs)
	names(b) <- names(nlayers)
	
	
	#out$b <- b
	
	for (il in names(b)) {
		
		names0 <- names[out[[il]]]
#####		print(il)
#####		print(":")
		for (it in names0) {
			x <- b[[il]]
#########			print("start")
			brickvalues <- get.geotop.inpts.keyword.value(it,inpts.frame=df,numeric=TRUE)
#########			print("end")
			brickvalues[brickvalues==NAflag] <- NA
			
			for (i in 1:nlayers(x)) {
				
				element <- nrow*ncol*(i-1)+1:(nrow*ncol)
				
				M <- (array(brickvalues[element],c(ncol,nrow)))
				x <- setValues(x,M,layer=i)						
			}
			 
			 out[[it]] <- x
		}
		
	}
	

	
	
	

	return(out)
}

Try the geotopbricks package in your browser

Any scripts or data that you put into this service are public.

geotopbricks documentation built on May 29, 2017, 9:48 a.m.