hollorol/RBBGCMuso
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixAlloc

Browse Source
This commit is contained in:
Roland Hollós 2023-02-27 18:27:05 +01:00
parent bdc37b696e
commit 2b89cc114f
12 changed files with 102 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
RBBGCMuso/NAMESPACE
View File

@ -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)

22
RBBGCMuso/R/assistantFunctions.R
View File

@ -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)

6
RBBGCMuso/R/calibMuso.R
View File

@ -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,)
}

33
RBBGCMuso/R/otherUsefullFunctions.R
View File

@ -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)
})
}

12
RBBGCMuso/R/parametersweep.R
View File

@ -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)"

4
RBBGCMuso/R/quickeffect.R
View File

@ -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)

2
RBBGCMuso/man/createSoilFile.Rd
View File

@ -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{

16
RBBGCMuso/man/fixAlloc.Rd Normal file
View File

@ -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
}

3
RBBGCMuso/man/musoQuickEffect.Rd
View File

@ -15,7 +15,8 @@ musoQuickEffect(
outVar,
parName = "parVal",
yearNum = 1,
year = (settings$startYear + yearNum - 1)
year = (settings$startYear + yearNum - 1),
fixAlloc = FALSE
)
}
\arguments{

3
RBBGCMuso/man/paramSweep.Rd
View File

@ -10,7 +10,8 @@ paramSweep(
outputDir = NULL,
iterations = 10,
outVar = "daily_gpp",
htmlOutName = "paramsweep.html"
htmlOutName = "paramsweep.html",
fixAlloc = FALSE
)
}
\arguments{

14
RBBGCMuso/man/readValuesFromFile.Rd Normal file
View File

@ -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
}

2
RBBGCMuso/man/tuneMusoUI.Rd
View File

@ -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
}