From 32657c7330504c5ebff45b51ffd53967a8d2a521 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roland=20Holl=C3=B3s?= Date: Tue, 12 Feb 2019 21:24:16 +0100 Subject: [PATCH] Adding element to setupmuso, oneCsv option in musoMonte --- RBBGCMuso/R/calibration.R | 4 +- RBBGCMuso/R/musoMonte.R | 80 +++++++++++++++++++++++++++++---------- RBBGCMuso/R/setupMuso.R | 4 +- 3 files changed, 66 insertions(+), 22 deletions(-) diff --git a/RBBGCMuso/R/calibration.R b/RBBGCMuso/R/calibration.R index 23edf8e..f6796ff 100644 --- a/RBBGCMuso/R/calibration.R +++ b/RBBGCMuso/R/calibration.R @@ -1,2 +1,2 @@ -GPP_mes <- read.csv("hhs_GPP_measured.csv", stringAsFactors) -head(GPP_mes$year) +## GPP_mes <- read.csv("hhs_GPP_measured.csv", stringAsFactors) +## head(GPP_mes$year) diff --git a/RBBGCMuso/R/musoMonte.R b/RBBGCMuso/R/musoMonte.R index 0bb315a..e4b34a6 100644 --- a/RBBGCMuso/R/musoMonte.R +++ b/RBBGCMuso/R/musoMonte.R @@ -181,27 +181,69 @@ musoMonte <- function(settings=NULL, ## csv files for each run oneCsv <- function () { - stop("This function is not implemented yet") - ## numDays <- settings$numdata[1] - ## if(!onDisk){ - ## for(i in 1:iterations){ - - ## parVar <- apply(parameters,1,function (x) { - ## runif(1, as.numeric(x[3]), as.numeric(x[4]))}) - - ## preservedEpc[(i+1),] <- parVar - ## exportName <- paste0(preTag,".csv") - ## write.csv(parvar,"preservedEpc.csv",append=TRUE) - ## calibMuso(settings,debugging = "stamplog", - ## parameters = parVar,keepEpc = TRUE) %>% - ## {mutate(.,iD = i)} %>% - ## {write.csv(.,file=exportName,append=TRUE)} - ## } + # stop("This function is not implemented yet") + settings$iniInput[2] %>% + (function(x) paste0(dirname(x),"/",tools::file_path_sans_ext(basename(x)),"-tmp.",tools::file_ext(x))) %>% + unlink + randValues <- randVals[[2]] + settings$calibrationPar <- randVals[[1]] + ## randValues <- randValues[,randVals[[1]] %in% parameters[,2]][,rank(parameters[,2])] + modellOut <- matrix(ncol = numVars, nrow = iterations + 1) + + origModellOut <- calibMuso(settings=settings,silent=TRUE) + write.csv(x=origModellOut, file=paste0(pretag,".csv")) + + if(!is.list(fun)){ + funct <- rep(list(fun), numVars) + } - ## return(preservedEpc) - ## } else { + tmp2 <- numeric(numVars) + + for(j in 1:numVars){ + tmp2[j]<-funct[[j]](origModellOut[,j]) + } + modellOut[1,]<- tmp2 + + for(i in 2:(iterations+1)){ + tmp <- tryCatch(calibMuso(settings = settings, + parameters = randValues[(i-1),], + silent= TRUE, + skipSpinup = skipSpinup, + keepEpc = keepEpc, + debugging = debugging, + outVars = outVars), error = function (e) NA) - ## } + if(!is.na(tmp)){ + for(j in 1:numVars){ + tmp2[j]<-funct[[j]](tmp[,j]) + } + } else { + for(j in 1:numVars){ + tmp2[j]<-rep(NA,length(settings$outputVars[[1]])) + } + } + + + + modellOut[i,]<- tmp2 + write.table(x=tmp, file=paste0(pretag,".csv"), append = TRUE,col.names = FALSE, sep = ",") + setTxtProgressBar(progBar,i) + } + + paramLines <- parameters[,2] + paramLines <- order(paramLines) + randInd <- randVals[[1]][(randVals[[1]] %in% parameters[,2])] + randInd <- order(randInd) + + + epcStrip <- rbind(origEpc[order(parameters[,2])], + randValues[,randVals[[1]] %in% parameters[,2]][,randInd]) + + + preservedEpc <- cbind(epcStrip, + modellOut) + colnames(preservedEpc) <- c(parameterNames[paramLines], sapply(outVarNames, function (x) paste0("mod.", x))) + return(preservedEpc) } netCDF <- function () { diff --git a/RBBGCMuso/R/setupMuso.R b/RBBGCMuso/R/setupMuso.R index 42882df..473b070 100644 --- a/RBBGCMuso/R/setupMuso.R +++ b/RBBGCMuso/R/setupMuso.R @@ -273,7 +273,9 @@ setupMuso <- function(executable=NULL, numYears=numYears, outputVars=outputVars, dailyVarCodes= gsub("\\s.*","",dailyVarCodes), - annualVarCodes = gsub("\\s.*","",annualVarCodes) + annualVarCodes = gsub("\\s.*","",annualVarCodes), + numVarY = length(outputVars[[2]]), + numVarD = length(outputVars[[1]]) ) if(writep!=nrow(grepHelper)){