From 4b0d43465d98aa28315d79ad4349f42df24bff56 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roland=20Holl=C3=B3s?= Date: Mon, 28 Jan 2019 11:36:33 +0100 Subject: [PATCH] fix the rounding bug in musoQuickEffect function --- RBBGCMuso/DESCRIPTION | 2 +- RBBGCMuso/R/assistantFunctions.R | 19 +++++++++++++++++++ RBBGCMuso/R/quickeffect.R | 3 ++- 3 files changed, 22 insertions(+), 2 deletions(-) diff --git a/RBBGCMuso/DESCRIPTION b/RBBGCMuso/DESCRIPTION index 340e2fc..af0433f 100644 --- a/RBBGCMuso/DESCRIPTION +++ b/RBBGCMuso/DESCRIPTION @@ -1,6 +1,6 @@ Package: RBBGCMuso 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")) Description: What the package does (one paragraph). Depends: R (>= 3.3.2) diff --git a/RBBGCMuso/R/assistantFunctions.R b/RBBGCMuso/R/assistantFunctions.R index 7d0193c..cfdd16c 100644 --- a/RBBGCMuso/R/assistantFunctions.R +++ b/RBBGCMuso/R/assistantFunctions.R @@ -104,4 +104,23 @@ compareNA <- function(v,a){ 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)) +} diff --git a/RBBGCMuso/R/quickeffect.R b/RBBGCMuso/R/quickeffect.R index a4258da..32060ed 100644 --- a/RBBGCMuso/R/quickeffect.R +++ b/RBBGCMuso/R/quickeffect.R @@ -41,6 +41,7 @@ musoQuickEffect <- function(settings = NULL,calibrationPar = NULL, startVal, en } parVals <- seq(startVal, endVal, length = (nSteps + 1)) + parVals <- dynRound(startVal, endVal, seqLen = (nSteps + 1)) 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}) if(all(is.na(calResult))){ @@ -58,5 +59,5 @@ musoQuickEffect <- function(settings = NULL,calibrationPar = NULL, startVal, en tbl_df %>% mutate(date=as.Date(rownames(a),"%d.%m.%Y")) %>% 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)))) }