89 lines
4.3 KiB
R
89 lines
4.3 KiB
R
#' updateMusoMapping
|
|
#'
|
|
#' This function updates the Biome-BGCMuSo output code-variable matrix. Within Biome-BGCMuSo the state variables and fluxes are marked by integer numbers. In order to provide meaningful variable names (e.g. 3009 means Gross Primary Production in Biome-BGCMuSo v5) a conversion table is needed which is handled by this function.
|
|
#' @author Roland HOLLOS
|
|
#' @param excelName Name of the excelfile which contains the parameters
|
|
#' @return The output code-variable matrix, and also the function changes the global variable
|
|
#' @export
|
|
|
|
updateMusoMapping<-function(excelName, dest="./", version=getOption("RMuso_version")){
|
|
|
|
expandRangeRows <- function (ind) {
|
|
rangeString <- gsub(".*?(\\d*\\-\\d*).*","\\1",toExpand[2])
|
|
interval <- as.numeric(strsplit(rangeString,split="-")[[1]])
|
|
result <- do.call(rbind,lapply(interval[1]:interval[2],function(x){
|
|
toExpand[2] <- x
|
|
toExpand[1] <- gsub("\\[.*?\\]",sprintf("_%s",(x-interval[1])),toExpand[1])
|
|
toExpand
|
|
}))
|
|
result <- as.data.frame(result,stringsAsFactors = FALSE)
|
|
result[,2] <- as.numeric(result[,2])
|
|
colnames(result) <- c("names","codes","units","descriptions")
|
|
result[,c(2,1,3,4)]
|
|
}
|
|
|
|
excelDF <- read.xlsx(excelName)
|
|
excelDF <- excelDF[!is.na(excelDF[,2]),]
|
|
excelDF[,1] <- trimws(excelDF[,1])
|
|
excelDF[,2] <- trimws(excelDF[,2])
|
|
excelDF[,3] <- trimws(excelDF[,3])
|
|
excelDF[,4] <- trimws(excelDF[,4])
|
|
rangeRows <- grep("-",excelDF[,2])
|
|
nonRangeMatrix <- excelDF[setdiff(1:nrow(excelDF),rangeRows),]
|
|
nonRangeMatrix[,2] <- as.numeric(nonRangeMatrix[,2])
|
|
nonRangeMatrix[,1] <- trimws(nonRangeMatrix[,1])
|
|
names(nonRangeMatrix) <- c("names","codes","units","descriptions")
|
|
outMatrix <- rbind.data.frame(do.call(rbind.data.frame,lapply(rangeRows,expandRangeRows)),
|
|
nonRangeMatrix[,c(2,1,3,4)]
|
|
)
|
|
outMatrix <- outMatrix[order(outMatrix[,1]),]
|
|
rownames(outMatrix)<- NULL
|
|
write_json(outMatrix, file.path(dest,sprintf("varTable%s.json",version)), pretty=TRUE)
|
|
|
|
}
|
|
|
|
#' musoMapping
|
|
#'
|
|
#' musoMapping can provide the user the name of a Biome-BGCMuSo output code. Within Biome-BGCMuSo the state variables and fluxes are marked by integer numbers. In order to provide meaningful variable names (e.g. 3009 means Gross Primary Production) a conversion table is needed which is utilized by this function. This function converts variable codes into names musoMappingFind does the opposite.
|
|
#' @author Roland HOLLOS
|
|
#' @param code the MuSo outputcode
|
|
#' @param mapData updateMusomapping generated matrix
|
|
#' @return The name of the Biome-BGCMuSo output code (e.g. if code is 3009 this function should return GPP to the user)
|
|
#' @export
|
|
#' @usage musoMapping(code, mapData=NULL)
|
|
|
|
|
|
musoMapping <- function(code,
|
|
mapData=getOption("RMuso_varTable")[[as.character(getOption("RMuso_version"))]]){
|
|
if(is.null(mapData)){
|
|
return(unlist(tryCatch(mMapping[which(mMapping[,1]==code),2],error = function(e){
|
|
|
|
stop(sprintf("The code %s in inifile is not valid muso output variable code",code))
|
|
|
|
}))) #mMapping is package-scoped system variable generated by udateMusoMapping
|
|
} else {
|
|
return(unlist(mapData[which(mapData[,1]==code),2]))
|
|
}
|
|
}
|
|
|
|
|
|
#' musoMappingFind
|
|
#'
|
|
#' musoMappingFind can provide us the code of the Biome-BGCMuSo output variable name. Within Biome-BGCMuSo the state variables and fluxes are marked by integer numbers. In order to provide meaningful variable names (e.g. 3009 means Gross Primary Production) a conversion table is needed which is utilized by this function. This function converts variable names into codes. musoMapping does the opposite.
|
|
#' @author Roland HOLLOS
|
|
#' @param variable If this is null, return the whole mapping table. In other cases search for the variable code
|
|
#' @return The code of the specific output variable name
|
|
#' @export
|
|
#' @usage musoMapping(code, mapData=NULL)
|
|
|
|
|
|
musoMappingFind <- function(variable=NULL,
|
|
mMapping=getOption("RMuso_varTable")[[as.character(getOption("RMuso_version"))]]){
|
|
if(is.null(variable)){
|
|
return(mMapping)
|
|
} else {
|
|
mMapping[grep(variable,mMapping[,2]),]
|
|
}
|
|
}
|
|
|