diff --git a/RBBGCMuso/NAMESPACE b/RBBGCMuso/NAMESPACE index 355ad67..0919211 100644 --- a/RBBGCMuso/NAMESPACE +++ b/RBBGCMuso/NAMESPACE @@ -10,6 +10,7 @@ export(compareMuso) export(copyMusoExampleTo) export(corrigMuso) export(createSoilFile) +export(fixAlloc) export(flatMuso) export(genEpc) export(getAnnualOutputList) @@ -37,6 +38,7 @@ export(plotMuso) export(plotMusoWithData) export(randEpc) export(readObservedData) +export(readValuesFromFile) export(runMuso) export(rungetMuso) export(saveAllMusoPlots) diff --git a/RBBGCMuso/R/assistantFunctions.R b/RBBGCMuso/R/assistantFunctions.R index 5cc50af..7d442f9 100644 --- a/RBBGCMuso/R/assistantFunctions.R +++ b/RBBGCMuso/R/assistantFunctions.R @@ -125,17 +125,27 @@ dynRound <- function(x,y,seqLen){ } -readValuesFromFile <- function(epc, linums){ - epcFile <- readLines(epc) +#' readValuesFromFile +#' +#' read Muso values from file +#' +#' @param filename The name of the +#' @usage readValuesFromFile(filename, linums) +#' @export + +readValuesFromFile <- function(filename, linums){ rows <- numeric(2) values <- sapply(linums, function(x){ rows[1] <- as.integer(x) rows[2] <- as.integer(round(100*x)) %% 10 + 1 - epcFile <- readLines(epc) - selRow <- unlist(strsplit(epcFile[rows[1]], split= "[\t ]")) + fromFile <- readLines(filename) + selRow <- unlist(strsplit(fromFile[rows[1]], split= "[\t ]")) selRow <- selRow[selRow!=""] - return(as.numeric(selRow[rows[2]])) - + ret <- suppressWarnings(as.numeric(selRow[rows[2]])) + if( is.na(ret) ){ + return(selRow[rows[2]]) + } + return(ret) }) return(values) diff --git a/RBBGCMuso/R/calibMuso.R b/RBBGCMuso/R/calibMuso.R index f0826f7..4606a0f 100644 --- a/RBBGCMuso/R/calibMuso.R +++ b/RBBGCMuso/R/calibMuso.R @@ -33,7 +33,8 @@ calibMuso <- function(settings=setupMuso(), calibrationPar=NULL, binaryPlace = "./", fileToChange = "epc", skipSpinup = TRUE, modifyOriginal = FALSE, prettyOut = FALSE, postProcString = NULL, - doBackup=TRUE + doBackup=TRUE, + fixAlloc=FALSE ){ # ######################################################################## ###########################Set local variables and places############### @@ -121,6 +122,9 @@ calibMuso <- function(settings=setupMuso(), calibrationPar=NULL, } else { NULL }) + if(fixAlloc){ + fixAlloc(settings) + } # fileToChange = fileToChange,) } diff --git a/RBBGCMuso/R/otherUsefullFunctions.R b/RBBGCMuso/R/otherUsefullFunctions.R index f70bdff..727bbad 100644 --- a/RBBGCMuso/R/otherUsefullFunctions.R +++ b/RBBGCMuso/R/otherUsefullFunctions.R @@ -183,3 +183,36 @@ return(randomNorm) getConstMatrix <- function (filetype="epc", version = as.character(getOption("RMuso_version"))) { getOption("RMuso_constMatrix")[[filetype]][[version]] } + + +#' fixAlloc +#' +#' Fix allocation parameter in the epc file +#' +#' @param settings the base RMuso settings variable +#' @param type normal or spinup depending what you want to modify +#' @usage ... +#' @export + +fixAlloc <- function(settings=NULL,type="normal"){ + if(is.null(settings)){ + settings <- setupMuso() + } + print("Need fix?") + epc_file <- settings$epcInput[type] + depTable <- options()$RMuso_constMatrix$epc[[as.character(options()$RMuso_version)]] + alloc_params<- depTable$INDEX[grep("ALLOCATION",depTable$NAME)] + alloc_groups <- round(100*(alloc_params - floor(alloc_params))) + tapply(alloc_params, alloc_groups, function(x){ + currentValues <- readValuesFromFile(epc_file,x) + difference <- 1 - sum(currentValues) + if(difference == 0){ + return(FALSE) + } + tomodiff <- currentValues[currentValues != 0] + changemulline(filePaths="c3grass_muso7.epc", + contents=(tomodiff + difference/length(tomodiff)), + calibrationPar=x[currentValues != 0]) + return(TRUE) + }) +} diff --git a/RBBGCMuso/R/parametersweep.R b/RBBGCMuso/R/parametersweep.R index 398e89a..9d77300 100644 --- a/RBBGCMuso/R/parametersweep.R +++ b/RBBGCMuso/R/parametersweep.R @@ -18,7 +18,8 @@ paramSweep <- function(inputDir="./", outputDir=NULL, iterations=10, outVar="daily_gpp", - htmlOutName = "paramsweep.html"){ + htmlOutName = "paramsweep.html", + fixAlloc=FALSE){ if(is.null(pandoc_version())){ stop("In order to use parameterSweep you have to have\n pandoc (1.12.3+) installed or run this function from Rstudio\n @@ -41,13 +42,16 @@ You can download pandoc from here: 'https://pandoc.org/',\n or Rstudio from here varNames <- musoMapping(outVar) outVarIndex<-outVar } + + if(file.exists("parameters.csv")){ + parameters <- read.csv("parameters.csv") + } - - if(is.null(parameters)){ + if(is.null(parameters) ){ parameters <- tcltk::tk_choose.files(caption = "Please select a file with the parameters and the ranges") } - rmdFile <- "---\ntitle: \"ParameterSweep basic\"\n---\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE)\n```\n```{r, echo=FALSE}\nsuppressWarnings(library(RBBGCMuso))\n```\n```{r, echo=FALSE}\nparameters <- read.csv(\"parameters.csv\")\n```\n```{r,fig.width=10, fig.height=3, echo=FALSE}\nnumPar\nfor(i in 1:numPar){\n suppressWarnings(musoQuickEffect(calibrationPar=parameters[i,2],startVal = parameters[i,3], endVal = parameters[i,4],\nnSteps = 9,\noutVar = \"daily_gpp\",\nparName = parameters[i,1]))\n}\n```" + rmdFile <- sprintf("---\ntitle: \"ParameterSweep basic\"\n---\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE)\n```\n```{r, echo=FALSE}\nsuppressWarnings(library(RBBGCMuso))\n```\n```{r, echo=FALSE}\nparameters <- read.csv(\"parameters.csv\")\n```\n```{r,fig.width=10, fig.height=3, echo=FALSE}\nnumPar\nfor(i in 1:numPar){\n suppressWarnings(musoQuickEffect(calibrationPar=parameters[i,2],startVal = parameters[i,3], endVal = parameters[i,4],\nnSteps = 9,\noutVar = \"daily_gpp\",\nparName = parameters[i,1],fixAlloc=%s))\n}\n```",fixAlloc) rmdVec <- unlist(strsplit(rmdFile,"\n")) rmdVec[11] <- paste0("parameters <- read.csv(\"",parameters,"\", stringsAsFactor = FALSE)") rmdVec[14] <- "numPar <- nrow(parameters)" diff --git a/RBBGCMuso/R/quickeffect.R b/RBBGCMuso/R/quickeffect.R index 3c1e2b5..677b14f 100644 --- a/RBBGCMuso/R/quickeffect.R +++ b/RBBGCMuso/R/quickeffect.R @@ -15,7 +15,7 @@ #' @importFrom tidyr separate #' @export -musoQuickEffect <- function(settings = setupMuso(), calibrationPar = NULL, startVal, endVal, nSteps = 1, fileToChange="epc",modifyOriginal=TRUE, outVar, parName = "parVal", yearNum=1, year=(settings$startYear + yearNum -1)){ +musoQuickEffect <- function(settings = setupMuso(), calibrationPar = NULL, startVal, endVal, nSteps = 1, fileToChange="epc",modifyOriginal=TRUE, outVar, parName = "parVal", yearNum=1, year=(settings$startYear + yearNum -1),fixAlloc=FALSE){ if(is.character(outVar)){ varNames <- as.data.frame(musoMappingFind(outVar)) @@ -45,7 +45,7 @@ musoQuickEffect <- function(settings = setupMuso(), calibrationPar = NULL, star parameters = parVal, outVars = outVarIndex, silent = TRUE, - fileToChange = fileToChange), error = function(e){NULL}) + fileToChange = fileToChange,fixAlloc=fixAlloc), error = function(e){NULL}) if(is.null(calResult)){ b <- cbind(rep(NA,365),parVal) rownames(b) <- musoDate(startYear = year, numYears = 1) diff --git a/RBBGCMuso/man/createSoilFile.Rd b/RBBGCMuso/man/createSoilFile.Rd index 73ada3b..21fb73e 100644 --- a/RBBGCMuso/man/createSoilFile.Rd +++ b/RBBGCMuso/man/createSoilFile.Rd @@ -10,7 +10,7 @@ createSoilFile( outputFile = "recent.soi", method = "constant", apiURL, - template = system.file("examples/hhs/hhs.soi", package = "RBBGCMuso") + template = system.file("examples/hhs/hhs_MuSo7.soi", package = "RBBGCMuso") ) } \description{ diff --git a/RBBGCMuso/man/fixAlloc.Rd b/RBBGCMuso/man/fixAlloc.Rd new file mode 100644 index 0000000..0d51882 --- /dev/null +++ b/RBBGCMuso/man/fixAlloc.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/otherUsefullFunctions.R +\name{fixAlloc} +\alias{fixAlloc} +\title{fixAlloc} +\usage{ +... +} +\arguments{ +\item{settings}{the base RMuso settings variable} + +\item{type}{normal or spinup depending what you want to modify} +} +\description{ +Fix allocation parameter in the epc file +} diff --git a/RBBGCMuso/man/musoQuickEffect.Rd b/RBBGCMuso/man/musoQuickEffect.Rd index 57879e4..8fb6fde 100644 --- a/RBBGCMuso/man/musoQuickEffect.Rd +++ b/RBBGCMuso/man/musoQuickEffect.Rd @@ -15,7 +15,8 @@ musoQuickEffect( outVar, parName = "parVal", yearNum = 1, - year = (settings$startYear + yearNum - 1) + year = (settings$startYear + yearNum - 1), + fixAlloc = FALSE ) } \arguments{ diff --git a/RBBGCMuso/man/paramSweep.Rd b/RBBGCMuso/man/paramSweep.Rd index 8933dce..b2945e5 100644 --- a/RBBGCMuso/man/paramSweep.Rd +++ b/RBBGCMuso/man/paramSweep.Rd @@ -10,7 +10,8 @@ paramSweep( outputDir = NULL, iterations = 10, outVar = "daily_gpp", - htmlOutName = "paramsweep.html" + htmlOutName = "paramsweep.html", + fixAlloc = FALSE ) } \arguments{ diff --git a/RBBGCMuso/man/readValuesFromFile.Rd b/RBBGCMuso/man/readValuesFromFile.Rd new file mode 100644 index 0000000..078087e --- /dev/null +++ b/RBBGCMuso/man/readValuesFromFile.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/assistantFunctions.R +\name{readValuesFromFile} +\alias{readValuesFromFile} +\title{readValuesFromFile} +\usage{ +readValuesFromFile(filename, linums) +} +\arguments{ +\item{filename}{The name of the} +} +\description{ +read Muso values from file +} diff --git a/RBBGCMuso/man/tuneMusoUI.Rd b/RBBGCMuso/man/tuneMusoUI.Rd index 25801a9..90a79e5 100644 --- a/RBBGCMuso/man/tuneMusoUI.Rd +++ b/RBBGCMuso/man/tuneMusoUI.Rd @@ -10,5 +10,5 @@ \item{parameterFile}{optional, the parameter csv file} } \description{ -This is a simple parameter tuner function which works great in a flat directory systemj +This is a simple parameter tuner function which works great in a flat directory system }