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

fix the rounding bug in musoQuickEffect function

Browse Source
This commit is contained in:
Roland Hollós 2019-01-28 11:36:33 +01:00
parent 5eef789c59
commit 4b0d43465d
3 changed files with 22 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
RBBGCMuso/DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: RBBGCMuso Package: RBBGCMuso
Title: An R package for BiomeBGC-MuSo ecosystem modelling Title: An R package for BiomeBGC-MuSo ecosystem modelling
Version: 0.6.1.2 Version: 0.6.1.3
Authors@R: person("Roland", "Hollo's", , "hollorol@gmail.com", role = c("aut", "cre")) Authors@R: person("Roland", "Hollo's", , "hollorol@gmail.com", role = c("aut", "cre"))
Description: What the package does (one paragraph). Description: What the package does (one paragraph).
Depends: R (>= 3.3.2) Depends: R (>= 3.3.2)

19
RBBGCMuso/R/assistantFunctions.R
View File

@ -104,4 +104,23 @@ compareNA <- function(v,a){
return(compared) return(compared)
} }
#' dynRound
#'
#'This function rounds a sequence (definded by its endpoints and the length) optimally
#'
#'@param x The lower end of the sequence
#'@param y The higher end of the sequence
#' @param seqLen The length of the sequence
#'@return rounded sequence
#'@keywords internal
dynRound <- function(x,y,seqLen){
digitNum <- 2
a <- seq(x,y, length = seqLen)
while(length(a) != length(unique(round(a,digitNum)))){
digitNum <- digitNum +1
}
return(round(a,digitNum))
}

3
RBBGCMuso/R/quickeffect.R
View File

@ -41,6 +41,7 @@ musoQuickEffect <- function(settings = NULL,calibrationPar = NULL, startVal, en
} }
parVals <- seq(startVal, endVal, length = (nSteps + 1)) parVals <- seq(startVal, endVal, length = (nSteps + 1))
parVals <- dynRound(startVal, endVal, seqLen = (nSteps + 1))
a <- do.call(rbind,lapply(parVals, function(parVal){ a <- do.call(rbind,lapply(parVals, function(parVal){
calResult <- tryCatch(calibMuso(settings = settings,calibrationPar = calibrationPar, parameters = parVal, outVars = outVarIndex, silent = TRUE,fileToChange = fileToChange), error = function(e){NA}) calResult <- tryCatch(calibMuso(settings = settings,calibrationPar = calibrationPar, parameters = parVal, outVars = outVarIndex, silent = TRUE,fileToChange = fileToChange), error = function(e){NA})
if(all(is.na(calResult))){ if(all(is.na(calResult))){
@ -58,5 +59,5 @@ musoQuickEffect <- function(settings = NULL,calibrationPar = NULL, startVal, en
tbl_df %>% tbl_df %>%
mutate(date=as.Date(rownames(a),"%d.%m.%Y")) %>% mutate(date=as.Date(rownames(a),"%d.%m.%Y")) %>%
select(date,as.character(varNames),parVal) select(date,as.character(varNames),parVal)
print(suppressWarnings(ggplot(data = a, aes_string(x= "date", y= varNames))+geom_line(aes(alpha = factor(round(parVal,2)))) + labs(y=varNames, alpha = parName) + scale_alpha_discrete(range=c(0.25,1)))) print(suppressWarnings(ggplot(data = a, aes_string(x= "date", y= varNames))+geom_line(aes(alpha = factor(parVal))) + labs(y=varNames, alpha = parName) + scale_alpha_discrete(range=c(0.25,1))))
} }