From 0d9d551fd92b6656331448dac233dd704843d6b1 Mon Sep 17 00:00:00 2001 From: hollorol Date: Tue, 19 Feb 2019 09:48:29 +0100 Subject: [PATCH] Modify many --- RBBGCMuso/DESCRIPTION | 2 +- RBBGCMuso/NAMESPACE | 2 +- RBBGCMuso/R/assistantFunctions.R | 5 ++--- RBBGCMuso/R/calibration.R | 24 ++++++++++++++-------- RBBGCMuso/R/musoTime.R | 27 ++++++++++++++++-------- RBBGCMuso/R/plotMuso.R | 6 +++--- RBBGCMuso/man/alignData.Rd | 5 +++-- RBBGCMuso/man/optiMuso.Rd | 34 +++++++++++++++---------------- RBBGCMuso/man/readMeasuredMuso.Rd | 15 -------------- RBBGCMuso/man/readObservedData.Rd | 15 ++++++++++++++ 10 files changed, 74 insertions(+), 61 deletions(-) delete mode 100644 RBBGCMuso/man/readMeasuredMuso.Rd create mode 100644 RBBGCMuso/man/readObservedData.Rd diff --git a/RBBGCMuso/DESCRIPTION b/RBBGCMuso/DESCRIPTION index cc75f13..dd37868 100644 --- a/RBBGCMuso/DESCRIPTION +++ b/RBBGCMuso/DESCRIPTION @@ -1,6 +1,6 @@ Package: RBBGCMuso Title: An R package for BiomeBGC-MuSo ecosystem modelling -Version: 0.7.0.0 +Version: 0.7.0.1 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/NAMESPACE b/RBBGCMuso/NAMESPACE index 656816d..4649a8c 100644 --- a/RBBGCMuso/NAMESPACE +++ b/RBBGCMuso/NAMESPACE @@ -23,7 +23,7 @@ export(paramSweep) export(plotMuso) export(plotMusoWithData) export(randEpc) -export(readMeasuredMuso) +export(readObservedData) export(runMuso) export(rungetMuso) export(saveAllMusoPlots) diff --git a/RBBGCMuso/R/assistantFunctions.R b/RBBGCMuso/R/assistantFunctions.R index 150df05..6c8c904 100644 --- a/RBBGCMuso/R/assistantFunctions.R +++ b/RBBGCMuso/R/assistantFunctions.R @@ -146,7 +146,7 @@ readValuesFromFile <- function(epc, linums){ #' @importFrom data.table fread data.table #' @export -readMeasuredMuso <- function(inFile, +readObservedData <- function(inFile, naString = NULL, sep = ",", leapYearHandling = TRUE, convert.var = NULL, @@ -181,8 +181,7 @@ readMeasuredMuso <- function(inFile, } head(baseData) if(!is.null(selVar)){ - baseData <- cbind.data.frame(baseData,convert.fun(baseData[,selVar])) - colnames(baseData)[ncol(baseData)]<- paste0("M",selVar) + baseData[,selVar] <-convert.fun(baseData[,selVar]) } return(data.table(baseData)) diff --git a/RBBGCMuso/R/calibration.R b/RBBGCMuso/R/calibration.R index a697f7a..28fe2d6 100644 --- a/RBBGCMuso/R/calibration.R +++ b/RBBGCMuso/R/calibration.R @@ -28,7 +28,7 @@ #' @export optiMuso <- function(measuredData, parameters = NULL, startDate, endDate, formatString = "%Y-%m-%d", - leapYear = TRUE, + leapYearHandling = TRUE, dataVar, outLoc = "./calib", preTag = "cal-", settings = NULL, @@ -40,7 +40,8 @@ optiMuso <- function(measuredData, parameters = NULL, startDate, likelihood = function(x, y){ exp(-sqrt(mean((x-y)^2))) }, - calPar = 3009) + continious, + modelVar = 3009) { dataCol <- grep(dataVar, colnames(measuredData)) @@ -75,7 +76,8 @@ optiMuso <- function(measuredData, parameters = NULL, startDate, npar <- length(settings$calibrationPar) ##reading the original epc file at the specified - ## row numbers + ## row numbers + print("optiMuso is randomizing the epc parameters now...",quote = FALSE) if(iterations < 3000){ randVals <- musoRand(parameters = parameters,constrains = constrains, iterations = 3000) randVals[[2]]<- randVals[[2]][sample(1:3000,iterations),] @@ -94,18 +96,22 @@ optiMuso <- function(measuredData, parameters = NULL, startDate, ## csv files for each run progBar <- txtProgressBar(1,iterations,style=3) - colNumb <- which(settings$dailyVarCodes == calPar) + colNumb <- which(settings$dailyVarCodes == modelVar) 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]] - list2env(alignData(measuredData,dataCol = dataCol,modellSettings = settings,startDate = startDate,endDate = endDate,leapYear = FALSE),envir=environment()) + list2env(alignData(measuredData,dataCol = dataCol,modellSettings = settings,startDate = startDate,endDate = endDate,leapYear = leapYearHandling, continious = continious),envir=environment()) modellOut <- numeric(iterations + 1) # single variable solution - origModellOut <- calibMuso(settings=settings,silent=TRUE) + rmse <- numeric(iterations + 1) + origModellOut <- calibMuso(settings=settings,silent=TRUE, skipSpinup = skipSpinup) + + write.csv(x=origModellOut, file=paste0(pretag,1,".csv")) modellOut[1] <- likelihood(measuredData,origModellOut[modIndex,colNumb]) + print("Running the model with the random epc values...", quote = FALSE) for(i in 2:(iterations+1)){ tmp <- tryCatch(calibMuso(settings = settings, parameters = randValues[(i-1),], @@ -113,10 +119,10 @@ optiMuso <- function(measuredData, parameters = NULL, startDate, skipSpinup = skipSpinup)[modIndex,colNumb], error = function (e) NA) modellOut[i]<- likelihood(measuredData,tmp) + rmse[i] <- sqrt(mean((measuredData-tmp)^2)) write.csv(x=tmp, file=paste0(pretag,(i+1),".csv")) setTxtProgressBar(progBar,i) } - modellOut paramLines <- parameters[,2] paramLines <- order(paramLines) randInd <- randVals[[1]][(randVals[[1]] %in% parameters[,2])] @@ -128,7 +134,7 @@ optiMuso <- function(measuredData, parameters = NULL, startDate, randValues[,randVals[[1]] %in% parameters[,2]][,randInd]) - preservedCalib <- cbind(epcStrip, + preservedCalib <- cbind(epcStrip,rmsr, modellOut) colnames(preservedCalib) <- c(parameterNames[paramLines], "likelihood") p<-list() @@ -137,7 +143,7 @@ optiMuso <- function(measuredData, parameters = NULL, startDate, p[[i]] <- ggplot(as.data.frame(preservedCalib),aes_string(colnames(preservedCalib)[i],"likelihood"))+geom_point(size=0.9) } - ggsave(plotName,grid.arrange(grobs = p, ncol = floor(sqrt(ncol(preservedCalib)-1))),dpi = 600) + ggsave(plotName,grid.arrange(grobs = p, ncol = floor(sqrt(ncol(preservedCalib)-1))),dpi = 3000) write.csv(preservedCalib,"preservedCalib.csv") return(preservedCalib[preservedCalib[,"likelihood"]==max(preservedCalib[,"likelihood"]),]) } diff --git a/RBBGCMuso/R/musoTime.R b/RBBGCMuso/R/musoTime.R index 88dffb6..92d5ce4 100644 --- a/RBBGCMuso/R/musoTime.R +++ b/RBBGCMuso/R/musoTime.R @@ -11,7 +11,6 @@ #' @importFrom lubridate leap_year #' @export - musoDate <- function(startYear, endYears = NULL, numYears, combined = TRUE, leapYearHandling = FALSE, prettyOut = FALSE){ if(is.null(endYears) & is.null(numYears)){ @@ -60,8 +59,9 @@ musoDate <- function(startYear, endYears = NULL, numYears, combined = TRUE, leap #' This function align the data to the model and the model to the data #' @importFrom lubridate leap_year #' @keywords internal -alignData <- function(mdata, dataCol, modellSettings = NULL, startDate, endDate, formatString = "%Y-%m-%d", leapYear = TRUE){ +alignData <- function(mdata, dataCol, modellSettings = NULL, startDate=NULL, endDate=NULL, formatString = "%Y-%m-%d", leapYear = TRUE, continious = TRUE){ + startDate <- as.Date(startDate, format = formatString) endDate <- as.Date(endDate, format = formatString) mdata <- as.data.frame(mdata) @@ -69,16 +69,25 @@ alignData <- function(mdata, dataCol, modellSettings = NULL, startDate, endDate if(is.null(modellSettings)){ modellSettings <- setupMuso() } - - dates <- seq(startDate, to = endDate, by= "day") - if(!leapYear){ - dates <- dates[which(format(dates,"%m%d") != "0229")] + + if(continious){ + dates <- seq(startDate, to = endDate, by= "day") + } else{ + dates <- do.call(c,lapply(seq(nrow(mdata)), function(i){ as.Date(paste0(mdata[i,1],sprintf("%02d",mdata[i,2]),mdata[i,3]),format = "%Y%m%d")})) } + + if(!leapYear){ + casualDays <- which(format(dates,"%m%d") != "0229") + #mdata <- mdata[casualDays,] + dates <- dates[casualDays] + } + mdata <- mdata[dates >= as.Date(paste0(modellSettings$startYear,"01","01"),format = "%Y%m%d"),] dates <- dates[dates >= as.Date(paste0(modellSettings$startYear,"01","01"),format = "%Y%m%d")] - goodInd <- which(!(leap_year(dates)& - (format(dates,"%m") == "12")& - (format(dates,"%d") == "31"))) + ## goodInd <- which(!(leap_year(dates)& + ## (format(dates,"%m") == "12")& + ## (format(dates,"%d") == "31"))) + if(leapYear){ goodInd <- which(!(leap_year(dates)& (format(dates,"%m") == "12")& diff --git a/RBBGCMuso/R/plotMuso.R b/RBBGCMuso/R/plotMuso.R index dbb392b..2d58118 100644 --- a/RBBGCMuso/R/plotMuso.R +++ b/RBBGCMuso/R/plotMuso.R @@ -251,7 +251,7 @@ plotMuso <- function(settings = NULL, variable = 1, #' @export plotMusoWithData <- function(mdata, plotName=NULL, startDate, endDate, - colour=c("black","blue"),dataVar, modelVar, settings = setupMuso(), silent = TRUE){ + colour=c("black","blue"),dataVar, modelVar, settings = setupMuso(), silent = TRUE, continious = TRUE){ dataCol<- grep(paste0("^",dataVar,"$"), colnames(mdata)) selVar <- grep(modelVar,(settings$dailyVarCodes))+4 @@ -259,14 +259,14 @@ plotMusoWithData <- function(mdata, plotName=NULL, list2env(alignData(mdata, dataCol = dataCol, modellSettings = settings, startDate = startDate, - endDate = endDate, leapYear = FALSE),envir=environment()) + endDate = endDate, leapYear = FALSE, continious = continious),envir=environment()) ## measuredData is created baseData <- calibMuso(settings = settings, silent = silent, prettyOut = TRUE)[modIndex,] baseData[,1] <- as.Date(baseData[,1],format = "%d.%m.%Y") selVarName <- colnames(baseData)[selVar] - if(colnames(baseData) != unique(colnames(baseData))){ + if(!all.equal(colnames(baseData),unique(colnames(baseData)))){ notUnique <- setdiff((unlist(settings$dailyVarCodes)),unique(unlist(settings$dailyVarCodes))) stop(paste0("Error: daily output variable list in the ini file must contain unique numbers. Check your ini files! Not unique codes: ",notUnique)) } diff --git a/RBBGCMuso/man/alignData.Rd b/RBBGCMuso/man/alignData.Rd index a304852..d747d3f 100644 --- a/RBBGCMuso/man/alignData.Rd +++ b/RBBGCMuso/man/alignData.Rd @@ -4,8 +4,9 @@ \alias{alignData} \title{alignData} \usage{ -alignData(mdata, dataCol, modellSettings = NULL, startDate, endDate, - formatString = "\%Y-\%m-\%d", leapYear = TRUE) +alignData(mdata, dataCol, modellSettings = NULL, startDate = NULL, + endDate = NULL, formatString = "\%Y-\%m-\%d", leapYear = TRUE, + continious = TRUE) } \description{ This function align the data to the model and the model to the data diff --git a/RBBGCMuso/man/optiMuso.Rd b/RBBGCMuso/man/optiMuso.Rd index 23b584d..819e91e 100644 --- a/RBBGCMuso/man/optiMuso.Rd +++ b/RBBGCMuso/man/optiMuso.Rd @@ -4,22 +4,16 @@ \alias{optiMuso} \title{optiMuso} \usage{ -optiMuso(measuredDataFile, parameters = NULL, sep = ",", startDate, - endDate, formatString = "\%Y-\%m-\%d", - naString = getOption("datatable.na.strings", "NA"), leapYear = TRUE, - filterCol = NULL, filterVal = 1, selVar, outLoc = "./calib", - preTag = "cal-", settings = NULL, outVars = NULL, - iterations = 30, skipSpinup = TRUE, constrains = NULL, - plotName = "calib.jpg", likelihood = function(x, y) { - exp(-sqrt(mean((x - y)^2))) }, calPar = 3009) +optiMuso(measuredData, parameters = NULL, startDate, endDate, + formatString = "\%Y-\%m-\%d", leapYear = TRUE, dataVar, + outLoc = "./calib", preTag = "cal-", settings = NULL, + outVars = NULL, iterations = 30, skipSpinup = TRUE, + constrains = NULL, plotName = "calib.jpg", likelihood = function(x, + y) { exp(-sqrt(mean((x - y)^2))) }, calPar = 3009) } \arguments{ -\item{measuredDataFile}{a} - \item{parameters}{b} -\item{sep}{c} - \item{startDate}{d} \item{endDate}{e} @@ -28,12 +22,6 @@ optiMuso(measuredDataFile, parameters = NULL, sep = ",", startDate, \item{leapYear}{b} -\item{filterCol}{a} - -\item{filterVal}{b} - -\item{selVar}{c} - \item{outLoc}{c} \item{settings}{e} @@ -50,6 +38,16 @@ optiMuso(measuredDataFile, parameters = NULL, sep = ",", startDate, \item{calPar}{a} +\item{measuredDataFile}{a} + +\item{sep}{c} + +\item{filterCol}{a} + +\item{filterVal}{b} + +\item{selVar}{c} + \item{pretag}{a} } \description{ diff --git a/RBBGCMuso/man/readMeasuredMuso.Rd b/RBBGCMuso/man/readMeasuredMuso.Rd deleted file mode 100644 index 9e15211..0000000 --- a/RBBGCMuso/man/readMeasuredMuso.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/assistantFunctions.R -\name{readMeasuredMuso} -\alias{readMeasuredMuso} -\title{readMeasuredMuso} -\usage{ -readMeasuredMuso(inFile, naString = getOption("datatable.na.strings", - "NA"), sep = ",", leapYearHandling = TRUE, convert.var = NULL, - convert.scalar = 1, convert.fun = (function(x) { x * - convert.scalar }), convert.file = NULL, filterCol = NULL, - filterVal = 1, selVar = NULL) -} -\description{ -MuSo data reader -} diff --git a/RBBGCMuso/man/readObservedData.Rd b/RBBGCMuso/man/readObservedData.Rd new file mode 100644 index 0000000..622b4a3 --- /dev/null +++ b/RBBGCMuso/man/readObservedData.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/assistantFunctions.R +\name{readObservedData} +\alias{readObservedData} +\title{readMeasuredMuso} +\usage{ +readObservedData(inFile, naString = NULL, sep = ",", + leapYearHandling = TRUE, convert.var = NULL, convert.scalar = 1, + convert.fun = (function(x) { x * convert.scalar }), + convert.file = NULL, filterCol = NULL, filterVal = 1, + selVar = NULL) +} +\description{ +MuSo data reader +}