From 36036edba49341e5aad3f278d0ccb5f184416db0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roland=20Holl=C3=B3s?= Date: Tue, 29 Jan 2019 16:48:27 +0100 Subject: [PATCH 1/5] file system changes --- RBBGCMuso/R/calibration.R | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 RBBGCMuso/R/calibration.R diff --git a/RBBGCMuso/R/calibration.R b/RBBGCMuso/R/calibration.R new file mode 100644 index 0000000..23edf8e --- /dev/null +++ b/RBBGCMuso/R/calibration.R @@ -0,0 +1,2 @@ +GPP_mes <- read.csv("hhs_GPP_measured.csv", stringAsFactors) +head(GPP_mes$year) From 32657c7330504c5ebff45b51ffd53967a8d2a521 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roland=20Holl=C3=B3s?= Date: Tue, 12 Feb 2019 21:24:16 +0100 Subject: [PATCH 2/5] Adding element to setupmuso, oneCsv option in musoMonte --- RBBGCMuso/R/calibration.R | 4 +- RBBGCMuso/R/musoMonte.R | 80 +++++++++++++++++++++++++++++---------- RBBGCMuso/R/setupMuso.R | 4 +- 3 files changed, 66 insertions(+), 22 deletions(-) diff --git a/RBBGCMuso/R/calibration.R b/RBBGCMuso/R/calibration.R index 23edf8e..f6796ff 100644 --- a/RBBGCMuso/R/calibration.R +++ b/RBBGCMuso/R/calibration.R @@ -1,2 +1,2 @@ -GPP_mes <- read.csv("hhs_GPP_measured.csv", stringAsFactors) -head(GPP_mes$year) +## GPP_mes <- read.csv("hhs_GPP_measured.csv", stringAsFactors) +## head(GPP_mes$year) diff --git a/RBBGCMuso/R/musoMonte.R b/RBBGCMuso/R/musoMonte.R index 0bb315a..e4b34a6 100644 --- a/RBBGCMuso/R/musoMonte.R +++ b/RBBGCMuso/R/musoMonte.R @@ -181,27 +181,69 @@ musoMonte <- function(settings=NULL, ## csv files for each run oneCsv <- function () { - stop("This function is not implemented yet") - ## numDays <- settings$numdata[1] - ## if(!onDisk){ - ## for(i in 1:iterations){ - - ## parVar <- apply(parameters,1,function (x) { - ## runif(1, as.numeric(x[3]), as.numeric(x[4]))}) - - ## preservedEpc[(i+1),] <- parVar - ## exportName <- paste0(preTag,".csv") - ## write.csv(parvar,"preservedEpc.csv",append=TRUE) - ## calibMuso(settings,debugging = "stamplog", - ## parameters = parVar,keepEpc = TRUE) %>% - ## {mutate(.,iD = i)} %>% - ## {write.csv(.,file=exportName,append=TRUE)} - ## } + # stop("This function is not implemented yet") + 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]] + ## randValues <- randValues[,randVals[[1]] %in% parameters[,2]][,rank(parameters[,2])] + modellOut <- matrix(ncol = numVars, nrow = iterations + 1) + + origModellOut <- calibMuso(settings=settings,silent=TRUE) + write.csv(x=origModellOut, file=paste0(pretag,".csv")) + + if(!is.list(fun)){ + funct <- rep(list(fun), numVars) + } - ## return(preservedEpc) - ## } else { + tmp2 <- numeric(numVars) + + for(j in 1:numVars){ + tmp2[j]<-funct[[j]](origModellOut[,j]) + } + modellOut[1,]<- tmp2 + + for(i in 2:(iterations+1)){ + tmp <- tryCatch(calibMuso(settings = settings, + parameters = randValues[(i-1),], + silent= TRUE, + skipSpinup = skipSpinup, + keepEpc = keepEpc, + debugging = debugging, + outVars = outVars), error = function (e) NA) - ## } + if(!is.na(tmp)){ + for(j in 1:numVars){ + tmp2[j]<-funct[[j]](tmp[,j]) + } + } else { + for(j in 1:numVars){ + tmp2[j]<-rep(NA,length(settings$outputVars[[1]])) + } + } + + + + modellOut[i,]<- tmp2 + write.table(x=tmp, file=paste0(pretag,".csv"), append = TRUE,col.names = FALSE, sep = ",") + setTxtProgressBar(progBar,i) + } + + paramLines <- parameters[,2] + paramLines <- order(paramLines) + randInd <- randVals[[1]][(randVals[[1]] %in% parameters[,2])] + randInd <- order(randInd) + + + epcStrip <- rbind(origEpc[order(parameters[,2])], + randValues[,randVals[[1]] %in% parameters[,2]][,randInd]) + + + preservedEpc <- cbind(epcStrip, + modellOut) + colnames(preservedEpc) <- c(parameterNames[paramLines], sapply(outVarNames, function (x) paste0("mod.", x))) + return(preservedEpc) } netCDF <- function () { diff --git a/RBBGCMuso/R/setupMuso.R b/RBBGCMuso/R/setupMuso.R index 42882df..473b070 100644 --- a/RBBGCMuso/R/setupMuso.R +++ b/RBBGCMuso/R/setupMuso.R @@ -273,7 +273,9 @@ setupMuso <- function(executable=NULL, numYears=numYears, outputVars=outputVars, dailyVarCodes= gsub("\\s.*","",dailyVarCodes), - annualVarCodes = gsub("\\s.*","",annualVarCodes) + annualVarCodes = gsub("\\s.*","",annualVarCodes), + numVarY = length(outputVars[[2]]), + numVarD = length(outputVars[[1]]) ) if(writep!=nrow(grepHelper)){ From 587faa780488562dc7744399cbbec176869e3d43 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roland=20Holl=C3=B3s?= Date: Wed, 13 Feb 2019 08:02:16 +0100 Subject: [PATCH 3/5] GLUE first working example --- RBBGCMuso/DESCRIPTION | 3 +- RBBGCMuso/NAMESPACE | 9 ++ RBBGCMuso/R/assistantFunctions.R | 48 ++++++++++ RBBGCMuso/R/calibration.R | 149 +++++++++++++++++++++++++++++- RBBGCMuso/R/musoTime.R | 72 ++++++++++----- RBBGCMuso/man/alignData.Rd | 13 +++ RBBGCMuso/man/calibMuso.Rd | 4 +- RBBGCMuso/man/dayOfMonths.Rd | 20 ---- RBBGCMuso/man/dayOfYears.Rd | 15 --- RBBGCMuso/man/isLeapyear.Rd | 18 ---- RBBGCMuso/man/musoDate.Rd | 25 +---- RBBGCMuso/man/musoLeapYears.Rd | 15 --- RBBGCMuso/man/optiMuso.Rd | 59 ++++++++++++ RBBGCMuso/man/readMeasuredMuso.Rd | 15 +++ RBBGCMuso/man/sumDaysOfPeriod.Rd | 15 --- 15 files changed, 349 insertions(+), 131 deletions(-) create mode 100644 RBBGCMuso/man/alignData.Rd delete mode 100644 RBBGCMuso/man/dayOfMonths.Rd delete mode 100644 RBBGCMuso/man/dayOfYears.Rd delete mode 100644 RBBGCMuso/man/isLeapyear.Rd delete mode 100644 RBBGCMuso/man/musoLeapYears.Rd create mode 100644 RBBGCMuso/man/optiMuso.Rd create mode 100644 RBBGCMuso/man/readMeasuredMuso.Rd delete mode 100644 RBBGCMuso/man/sumDaysOfPeriod.Rd diff --git a/RBBGCMuso/DESCRIPTION b/RBBGCMuso/DESCRIPTION index 1c5cf6f..42e5060 100644 --- a/RBBGCMuso/DESCRIPTION +++ b/RBBGCMuso/DESCRIPTION @@ -24,7 +24,8 @@ Imports: tibble, tidyr, tcltk, - digest + digest, + data.table LinkingTo: Rcpp SystemRequirements: C++11 Maintainer: Roland Hollo's diff --git a/RBBGCMuso/NAMESPACE b/RBBGCMuso/NAMESPACE index a11b3e9..c50660c 100644 --- a/RBBGCMuso/NAMESPACE +++ b/RBBGCMuso/NAMESPACE @@ -18,10 +18,12 @@ export(musoRand) export(musoRandomizer) export(musoSensi) export(normalMuso) +export(optiMuso) export(paramSweep) export(plotMuso) export(plotMusoWithData) export(randEpc) +export(readMeasuredMuso) export(runMuso) export(rungetMuso) export(saveAllMusoPlots) @@ -32,6 +34,7 @@ export(updateMusoMapping) import(ggplot2) import(utils) importFrom(Rcpp,evalCpp) +importFrom(data.table,fread) importFrom(digest,digest) importFrom(dplyr,'%>%') importFrom(dplyr,filter) @@ -40,6 +43,10 @@ importFrom(dplyr,mutate) importFrom(dplyr,select) importFrom(dplyr,summarize) importFrom(dplyr,tbl_df) +importFrom(ggplot,aes_string) +importFrom(ggplot,geom_point) +importFrom(ggplot,ggplot) +importFrom(ggplot,ggsave) importFrom(ggplot2,aes) importFrom(ggplot2,aes_string) importFrom(ggplot2,element_blank) @@ -57,7 +64,9 @@ importFrom(ggplot2,theme) importFrom(ggplot2,theme_classic) importFrom(ggplot2,xlab) importFrom(ggplot2,ylab) +importFrom(gridExtra,grid.arrange) importFrom(limSolve,xsample) +importFrom(lubridate,leap_year) importFrom(magrittr,'%<>%') importFrom(magrittr,'%>%') importFrom(rmarkdown,pandoc_version) diff --git a/RBBGCMuso/R/assistantFunctions.R b/RBBGCMuso/R/assistantFunctions.R index d198b84..a8fd3da 100644 --- a/RBBGCMuso/R/assistantFunctions.R +++ b/RBBGCMuso/R/assistantFunctions.R @@ -124,3 +124,51 @@ dynRound <- function(x,y,seqLen){ return(round(a,digitNum)) } + +readValuesFromFile <- function(epc, linums){ + epcFile <- readLines(epc) + 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 ]")) + selRow <- selRow[selRow!=""] + return(as.numeric(selRow[rows[2]])) + + }) + + return(values) +} +#' readMeasuredMuso +#' +#' MuSo data reader +#' @importFrom data.table fread +#' @export + +readMeasuredMuso <- function(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 + ){ + + baseData <- fread(file = inFile, na.strings = as.character(naString), sep=sep) + baseData <- as.data.frame(baseData) + if(!is.null(filterCol)){ + filterVar<- colnames(baseData)[filterCol] + baseData[(baseData[,filterVar] == filterVal),selVar] <- NA + } + head(baseData) + if(!is.null(selVar)){ + baseData <- cbind.data.frame(baseData,convert.fun(baseData[,selVar])) + colnames(baseData)[ncol(baseData)]<- paste0("M",selVar) + } + + return(data.table(baseData)) +} diff --git a/RBBGCMuso/R/calibration.R b/RBBGCMuso/R/calibration.R index f6796ff..69f1c17 100644 --- a/RBBGCMuso/R/calibration.R +++ b/RBBGCMuso/R/calibration.R @@ -1,2 +1,147 @@ -## GPP_mes <- read.csv("hhs_GPP_measured.csv", stringAsFactors) -## head(GPP_mes$year) +#' optiMuso +#' +#' This function calculates the -users specified- likelihood for random model input. +#' +#' @author Roland HOLLOS +#' @param measuredDataFile a +#' @param parameters b +#' @param sep c +#' @param startDate d +#' @param endDate e +#' @param formatString a +#' @param filterCol a +#' @param filterVal b +#' @param selVar c +#' @param outLoc c +#' @param pretag a +#' @param calPar a +#' @param skipSpinup a +#' @param iterations c +#' @param constrains d +#' @param likelihood d +#' @param settings e +#' @param leapYear b +#' @param plotName u +#' @importFrom ggplot ggplot aes_string geom_point ggsave +#' @importFrom magrittr '%>%' +#' @importFrom gridExtra grid.arrange +#' @export +optiMuso <- function(measuredDataFile, parameters = NULL, + sep = ",", startDate, + endDate, formatString = "%Y-%m-%d", + naString = NULL, 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) +{ + measuredData <- readMeasuredMuso(inFile = measuredDataFile, sep = sep, selVar = selVar,filterCol = filterCol, filterVal = filterVal) + + if(is.null(parameters)){ + parameters <- tryCatch(read.csv("parameters.csv", stringsAsFactor=FALSE), error = function (e) { + stop("You need to specify a path for the parameters.csv, or a matrix.") + }) + } else { + if((!is.list(parameters)) & (!is.matrix(parameters))){ + parameters <- tryCatch(read.csv(parameters, stringsAsFactor=FALSE), error = function (e){ + stop("Cannot find neither parameters file neither the parameters matrix") + }) + }} + + outLoc <- normalizePath(outLoc) + outLocPlain <- basename(outLoc) + currDir <- getwd() + + if(!dir.exists(outLoc)){ + dir.create(outLoc) + warning(paste(outLoc," is not exists, so it was created")) + } + + outLoc <- normalizePath(outLoc) + + if(is.null(settings)){ + settings <- setupMuso() + } + + parameterNames <- parameters[,1] + pretag <- file.path(outLoc,preTag) + npar <- length(settings$calibrationPar) + + ##reading the original epc file at the specified + ## row numbers + if(iterations < 3000){ + randVals <- musoRand(parameters = parameters,constrains = constrains, iterations = 3000) + randVals[[2]]<- randVals[[2]][sample(1:3000,iterations),] + } else { + randVals <- musoRand(parameters = parameters,constrains = constrains, iterations = iterations) + } + + origEpc <- readValuesFromFile(settings$epc[2],parameters[,2]) + + ## Prepare the preservedCalib matrix for the faster + ## run. + + pretag <- file.path(outLoc,preTag) + + ## Creating function for generating separate + ## csv files for each run + + progBar <- txtProgressBar(1,iterations,style=3) + colNumb <- which(settings$dailyVarCodes == calPar) + 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 = 8,modellSettings = settings,startDate = startDate,endDate = endDate,leapYear = FALSE),envir=environment()) + + modellOut <- numeric(iterations + 1) # single variable solution + origModellOut <- calibMuso(settings=settings,silent=TRUE) + write.csv(x=origModellOut, file=paste0(pretag,1,".csv")) + modellOut[1] <- likelihood(measuredData,origModellOut[modIndex,colNumb]) + for(i in 2:(iterations+1)){ + tmp <- tryCatch(calibMuso(settings = settings, + parameters = randValues[(i-1),], + silent= TRUE, + skipSpinup = skipSpinup)[modIndex,colNumb], error = function (e) NA) + + modellOut[i]<- likelihood(measuredData,tmp) + 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])] + randInd <- order(randInd) + + + + epcStrip <- rbind(origEpc[order(parameters[,2])], + randValues[,randVals[[1]] %in% parameters[,2]][,randInd]) + + + preservedCalib <- cbind(epcStrip, + modellOut) + colnames(preservedCalib) <- c(parameterNames[paramLines], "likelihood") + p<-list() + + for(i in seq_along(colnames(preservedCalib)[-ncol(preservedCalib)])){ + 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) + + return(preservedCalib[preservedCalib[,"likelihood"]==max(preservedCalib[,"likelihood"]),]) +} + + diff --git a/RBBGCMuso/R/musoTime.R b/RBBGCMuso/R/musoTime.R index 042dde1..88dffb6 100644 --- a/RBBGCMuso/R/musoTime.R +++ b/RBBGCMuso/R/musoTime.R @@ -25,7 +25,10 @@ musoDate <- function(startYear, endYears = NULL, numYears, combined = TRUE, leap dates <- seq(from = as.Date(paste0(startYear,"01","01"),format = "%Y%m%d"), to = as.Date(paste0(endYear,"12","31"),format = "%Y%m%d"), by = "day") if(leapYearHandling){ if(prettyOut){ - return(cbind(format(dates,"%d.%m.%Y"),as.numeric(format(dates,"%d")),as.numeric(format(dates,"%m")),as.numeric(format(dates,"%Y"))) ) + return(cbind(format(dates,"%d.%m.%Y"), + as.numeric(format(dates,"%d")), + as.numeric(format(dates,"%m")), + as.numeric(format(dates,"%Y"))) ) } if(combined == FALSE){ @@ -35,10 +38,14 @@ musoDate <- function(startYear, endYears = NULL, numYears, combined = TRUE, leap } } else { + dates <- dates[format(dates,"%m%d")!="0229"] if(prettyOut){ - return(cbind(format(dates,"%d.%m.%Y"),as.numeric(format(dates,"%d")),as.numeric(format(dates,"%m")),as.numeric(format(dates,"%Y"))) ) + return(data.frame(date = format(dates,"%d.%m.%Y"), + day = as.numeric(format(dates,"%d")), + month = as.numeric(format(dates,"%m")), + year = as.numeric(format(dates,"%Y")))) } - dates <- dates[format(dates,"%m%d")!="0229"] + if(combined == FALSE){ return(cbind(format(dates,"%d"),format(dates,"%m"),format(dates,"%Y"))) @@ -48,29 +55,48 @@ musoDate <- function(startYear, endYears = NULL, numYears, combined = TRUE, leap } } +#' alignData +#' +#' 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){ -corrigLeapYear <- function(data, dataCol, modellSettings = NULL, startYear, fromDate = NULL,toDate = NULL,formatString = "%Y-%m-%d"){ - data <- as.data.frame(data) - numDays <- nrow(data) - dates <- seq(as.Date(paste0(startYear,"01","01"),format = "%Y%m%d"), by= "day", length = numDays) - goodInd <- which(!(leap_year(dates)& - (format(date,"%m") == "12")& - (format(date,"%d") == "31"))) - realDate <- musoDate(startYear = startYear, numYears = numYears) + startDate <- as.Date(startDate, format = formatString) + endDate <- as.Date(endDate, format = formatString) + mdata <- as.data.frame(mdata) - data <- cbind.data.frame(real,data[goodInd]) - - modellDates <- musoDate(startYear = settings$startYear,numYears = settings$numYears) - - - if(is.null(modellSettings)){ modellSettings <- setupMuso() } - - -} - -alignDataWithModelIndex <- function(){ -} + dates <- seq(startDate, to = endDate, by= "day") + if(!leapYear){ + dates <- dates[which(format(dates,"%m%d") != "0229")] + } + 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"))) + if(leapYear){ + goodInd <- which(!(leap_year(dates)& + (format(dates,"%m") == "12")& + (format(dates,"%d") == "31"))) + } else { + goodInd <-seq_along(dates) + } + realDate <- dates[which(format(dates,"%m%d") != "0229")] + if(leapYear){ + mdata <- cbind.data.frame(realDate,mdata) + } else { + mdata <- cbind.data.frame(dates,mdata) + } + modellDates <- as.Date(musoDate(startYear = modellSettings$startYear,numYears = modellSettings$numYears), format = "%d.%m.%Y") + mdata <- mdata[mdata[,1] %in% modellDates,] + nonEmpty <- which(!is.na(mdata[,dataCol+1])) + mdata <- mdata[nonEmpty,] + modIndex <- which(modellDates %in% mdata[,1]) + + list(measuredData = mdata[,dataCol +1], modIndex = modIndex) +} diff --git a/RBBGCMuso/man/alignData.Rd b/RBBGCMuso/man/alignData.Rd new file mode 100644 index 0000000..a304852 --- /dev/null +++ b/RBBGCMuso/man/alignData.Rd @@ -0,0 +1,13 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/musoTime.R +\name{alignData} +\alias{alignData} +\title{alignData} +\usage{ +alignData(mdata, dataCol, modellSettings = NULL, startDate, endDate, + formatString = "\%Y-\%m-\%d", leapYear = TRUE) +} +\description{ +This function align the data to the model and the model to the data +} +\keyword{internal} diff --git a/RBBGCMuso/man/calibMuso.Rd b/RBBGCMuso/man/calibMuso.Rd index 4731e8e..99d96cb 100644 --- a/RBBGCMuso/man/calibMuso.Rd +++ b/RBBGCMuso/man/calibMuso.Rd @@ -26,8 +26,6 @@ keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE) \item{aggressive}{It deletes every possible modell-outputs from the previous modell runs.} -\item{leapYear}{Should the function do a leapyear correction on the outputdata? If TRUE, then the 31.12 day will be doubled.} - \item{keepBinary}{In default RBBGCMuso to keep working area as clean as possible, deletes all the regular output files. The results are directly printed to the standard output, but you can redirect it, and save it to a variable, or you can export your results to the desired destination in a desired format. Whith this variable you can enable to keep the binary output files. If you want to set the location of the binary output, please take a look at the binaryPlace argument.} \item{binaryPlace}{The place of the binary output files.} @@ -37,6 +35,8 @@ keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE) \item{skipSpinup}{If TRUE, calibMuso wont do spinup simulation} \item{prettyOut}{date ad Date type, separate year, month, day vectors} + +\item{leapYear}{Should the function do a leapyear correction on the outputdata? If TRUE, then the 31.12 day will be doubled.} } \value{ No return, outputs are written to file diff --git a/RBBGCMuso/man/dayOfMonths.Rd b/RBBGCMuso/man/dayOfMonths.Rd deleted file mode 100644 index 9bf83bc..0000000 --- a/RBBGCMuso/man/dayOfMonths.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/musoTime.R -\name{dayOfMonths} -\alias{dayOfMonths} -\title{dayOfMonths} -\usage{ -dayOfMonths(year, corrigated=TRUE) -} -\arguments{ -\item{year}{a year} - -\item{corrigated}{Do you want to handle the leapyears, if yes choose TRUE} -} -\value{ -vector with 12 element. First is January, the last is December. All of the vector element represents the number of the days in that specific month -} -\description{ -This function gives as a vector which contains the number of the days per each month -} -\keyword{internal} diff --git a/RBBGCMuso/man/dayOfYears.Rd b/RBBGCMuso/man/dayOfYears.Rd deleted file mode 100644 index ffea8ab..0000000 --- a/RBBGCMuso/man/dayOfYears.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/musoTime.R -\name{dayOfYears} -\alias{dayOfYears} -\title{This function tells us how many days are in the given year.} -\usage{ -dayOfYears(year, corrigated = TRUE) -} -\description{ -This function tells us how many days are in the given year. -} -\author{ -Roland Hollos -} -\keyword{internal} diff --git a/RBBGCMuso/man/isLeapyear.Rd b/RBBGCMuso/man/isLeapyear.Rd deleted file mode 100644 index e502643..0000000 --- a/RBBGCMuso/man/isLeapyear.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/musoTime.R -\name{isLeapyear} -\alias{isLeapyear} -\title{isLeapyear} -\usage{ -isLeapyear(year) -} -\arguments{ -\item{year}{a year} -} -\value{ -TRUE, if leapyear, FALSE if dont. -} -\description{ -This function tells us if its argument a leapyear or not. -} -\keyword{internal} diff --git a/RBBGCMuso/man/musoDate.Rd b/RBBGCMuso/man/musoDate.Rd index 011a92a..d8096e7 100644 --- a/RBBGCMuso/man/musoDate.Rd +++ b/RBBGCMuso/man/musoDate.Rd @@ -2,29 +2,14 @@ % Please edit documentation in R/musoTime.R \name{musoDate} \alias{musoDate} -\title{It generates BiomeBGC-MuSo dates} +\title{musoDate} \usage{ -musoDate(startYear, numYears, timestep = "d", combined = TRUE, - corrigated = TRUE, format = "en") -} -\arguments{ -\item{timestep}{timestep, which can be daily ("d"), monthly ("m"), yearly("y")} - -\item{combined}{If FALSE the output is a vector of 3 string: day, month year, if true, these strings will be concatenated.} - -\item{corrigated}{If True it counts with leapyears, else dont.} - -\item{format}{This is the format of the date. It can be "en" (dd.mm.yyyy), or "hu" (yyyy.mm.dd)} - -\item{settings}{You have to run the setupMuso function before musoDate. It is its output which contains all of the necessary system variables. It sets the whole environment.} -} -\value{ -The exact date-vectors for the BioBGC-MuSo output. You can use this for labelling purpose for example. +musoDate(startYear, endYears = NULL, numYears, combined = TRUE, + leapYearHandling = FALSE, prettyOut = FALSE) } \description{ -It generates all of the day-dates which are between the start and endyear of BiomeBGC-MuSo run. -How many days are from the given date and given period length(periodlen)? +This function generates MuSo compatibla dates for the data } \author{ -Roland Hollos +Roland HOLLOS } diff --git a/RBBGCMuso/man/musoLeapYears.Rd b/RBBGCMuso/man/musoLeapYears.Rd deleted file mode 100644 index 3a4c3fb..0000000 --- a/RBBGCMuso/man/musoLeapYears.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/musoTime.R -\name{musoLeapYears} -\alias{musoLeapYears} -\title{Musoleapyear} -\usage{ -musoLeapYears(settings) -} -\description{ -How many days are from the given date and given period length(periodlen)? -} -\author{ -Roland Hollos -} -\keyword{internal} diff --git a/RBBGCMuso/man/optiMuso.Rd b/RBBGCMuso/man/optiMuso.Rd new file mode 100644 index 0000000..1db9db9 --- /dev/null +++ b/RBBGCMuso/man/optiMuso.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calibration.R +\name{optiMuso} +\alias{optiMuso} +\title{optiMuso} +\usage{ +optiMuso(measuredDataFile, parameters = NULL, sep = ",", startDate, + endDate, formatString, naString = NULL, 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) +} +\arguments{ +\item{measuredDataFile}{a} + +\item{parameters}{b} + +\item{sep}{c} + +\item{startDate}{d} + +\item{endDate}{e} + +\item{formatString}{a} + +\item{leapYear}{b} + +\item{filterCol}{a} + +\item{filterVal}{b} + +\item{selVar}{c} + +\item{outLoc}{c} + +\item{settings}{e} + +\item{iterations}{c} + +\item{skipSpinup}{a} + +\item{constrains}{d} + +\item{plotName}{u} + +\item{likelihood}{d} + +\item{calPar}{a} + +\item{pretag}{a} +} +\description{ +This function calculates the -users specified- likelihood for random model input. +} +\author{ +Roland HOLLOS +} diff --git a/RBBGCMuso/man/readMeasuredMuso.Rd b/RBBGCMuso/man/readMeasuredMuso.Rd new file mode 100644 index 0000000..9e15211 --- /dev/null +++ b/RBBGCMuso/man/readMeasuredMuso.Rd @@ -0,0 +1,15 @@ +% 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/sumDaysOfPeriod.Rd b/RBBGCMuso/man/sumDaysOfPeriod.Rd deleted file mode 100644 index ea7e49f..0000000 --- a/RBBGCMuso/man/sumDaysOfPeriod.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/musoTime.R -\name{sumDaysOfPeriod} -\alias{sumDaysOfPeriod} -\title{How many days are from the given date and given period length(periodlen)?} -\usage{ -sumDaysOfPeriod(year, periodlen, corrigated = TRUE) -} -\description{ -How many days are from the given date and given period length(periodlen)? -} -\author{ -Roland Hollos -} -\keyword{internal} From d00d513949c0eb61b41807f483a32e709e8c2c90 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roland=20Holl=C3=B3s?= Date: Wed, 13 Feb 2019 08:10:35 +0100 Subject: [PATCH 4/5] minor bugfix and major version upgrade --- RBBGCMuso/DESCRIPTION | 5 +++-- RBBGCMuso/NAMESPACE | 4 ---- RBBGCMuso/R/calibration.R | 2 +- RBBGCMuso/man/optiMuso.Rd | 12 ++++++------ 4 files changed, 10 insertions(+), 13 deletions(-) diff --git a/RBBGCMuso/DESCRIPTION b/RBBGCMuso/DESCRIPTION index 42e5060..cc75f13 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.3.0 +Version: 0.7.0.0 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) @@ -25,7 +25,8 @@ Imports: tidyr, tcltk, digest, - data.table + data.table, + gridExtra LinkingTo: Rcpp SystemRequirements: C++11 Maintainer: Roland Hollo's diff --git a/RBBGCMuso/NAMESPACE b/RBBGCMuso/NAMESPACE index c50660c..080f02f 100644 --- a/RBBGCMuso/NAMESPACE +++ b/RBBGCMuso/NAMESPACE @@ -43,10 +43,6 @@ importFrom(dplyr,mutate) importFrom(dplyr,select) importFrom(dplyr,summarize) importFrom(dplyr,tbl_df) -importFrom(ggplot,aes_string) -importFrom(ggplot,geom_point) -importFrom(ggplot,ggplot) -importFrom(ggplot,ggsave) importFrom(ggplot2,aes) importFrom(ggplot2,aes_string) importFrom(ggplot2,element_blank) diff --git a/RBBGCMuso/R/calibration.R b/RBBGCMuso/R/calibration.R index 69f1c17..0456bb2 100644 --- a/RBBGCMuso/R/calibration.R +++ b/RBBGCMuso/R/calibration.R @@ -22,7 +22,7 @@ #' @param settings e #' @param leapYear b #' @param plotName u -#' @importFrom ggplot ggplot aes_string geom_point ggsave +#' @importFrom ggplot2 ggplot aes_string geom_point ggsave #' @importFrom magrittr '%>%' #' @importFrom gridExtra grid.arrange #' @export diff --git a/RBBGCMuso/man/optiMuso.Rd b/RBBGCMuso/man/optiMuso.Rd index 1db9db9..1decc2c 100644 --- a/RBBGCMuso/man/optiMuso.Rd +++ b/RBBGCMuso/man/optiMuso.Rd @@ -5,12 +5,12 @@ \title{optiMuso} \usage{ optiMuso(measuredDataFile, parameters = NULL, sep = ",", startDate, - endDate, formatString, naString = NULL, 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) + endDate, formatString = "\%Y-\%m-\%d", naString = NULL, + 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) } \arguments{ \item{measuredDataFile}{a} From 9363ef8c9f3a1c70392de7fecea1f6e1288e0fca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roland=20Holl=C3=B3s?= Date: Thu, 14 Feb 2019 18:54:43 +0100 Subject: [PATCH 5/5] Fixing few bugs --- RBBGCMuso/NAMESPACE | 1 + RBBGCMuso/R/assistantFunctions.R | 2 +- RBBGCMuso/R/calibration.R | 16 +++++----- RBBGCMuso/R/plotMuso.R | 49 +++++++++++++------------------ RBBGCMuso/man/optiMuso.Rd | 13 ++++---- RBBGCMuso/man/plotMusoWithData.Rd | 12 ++++---- 6 files changed, 43 insertions(+), 50 deletions(-) diff --git a/RBBGCMuso/NAMESPACE b/RBBGCMuso/NAMESPACE index 080f02f..656816d 100644 --- a/RBBGCMuso/NAMESPACE +++ b/RBBGCMuso/NAMESPACE @@ -34,6 +34,7 @@ export(updateMusoMapping) import(ggplot2) import(utils) importFrom(Rcpp,evalCpp) +importFrom(data.table,data.table) importFrom(data.table,fread) importFrom(digest,digest) importFrom(dplyr,'%>%') diff --git a/RBBGCMuso/R/assistantFunctions.R b/RBBGCMuso/R/assistantFunctions.R index a8fd3da..04a74a8 100644 --- a/RBBGCMuso/R/assistantFunctions.R +++ b/RBBGCMuso/R/assistantFunctions.R @@ -143,7 +143,7 @@ readValuesFromFile <- function(epc, linums){ #' readMeasuredMuso #' #' MuSo data reader -#' @importFrom data.table fread +#' @importFrom data.table fread data.table #' @export readMeasuredMuso <- function(inFile, diff --git a/RBBGCMuso/R/calibration.R b/RBBGCMuso/R/calibration.R index 0456bb2..a697f7a 100644 --- a/RBBGCMuso/R/calibration.R +++ b/RBBGCMuso/R/calibration.R @@ -26,12 +26,10 @@ #' @importFrom magrittr '%>%' #' @importFrom gridExtra grid.arrange #' @export -optiMuso <- function(measuredDataFile, parameters = NULL, - sep = ",", startDate, +optiMuso <- function(measuredData, parameters = NULL, startDate, endDate, formatString = "%Y-%m-%d", - naString = NULL, leapYear = TRUE, - filterCol = NULL, filterVal = 1, - selVar, outLoc = "./calib", + leapYear = TRUE, + dataVar, outLoc = "./calib", preTag = "cal-", settings = NULL, outVars = NULL, @@ -44,8 +42,8 @@ optiMuso <- function(measuredDataFile, parameters = NULL, }, calPar = 3009) { - measuredData <- readMeasuredMuso(inFile = measuredDataFile, sep = sep, selVar = selVar,filterCol = filterCol, filterVal = filterVal) - + dataCol <- grep(dataVar, colnames(measuredData)) + if(is.null(parameters)){ parameters <- tryCatch(read.csv("parameters.csv", stringsAsFactor=FALSE), error = function (e) { stop("You need to specify a path for the parameters.csv, or a matrix.") @@ -102,7 +100,7 @@ optiMuso <- function(measuredDataFile, parameters = NULL, unlink randValues <- randVals[[2]] settings$calibrationPar <- randVals[[1]] - list2env(alignData(measuredData,dataCol = 8,modellSettings = settings,startDate = startDate,endDate = endDate,leapYear = FALSE),envir=environment()) + list2env(alignData(measuredData,dataCol = dataCol,modellSettings = settings,startDate = startDate,endDate = endDate,leapYear = FALSE),envir=environment()) modellOut <- numeric(iterations + 1) # single variable solution origModellOut <- calibMuso(settings=settings,silent=TRUE) @@ -140,7 +138,7 @@ optiMuso <- function(measuredDataFile, parameters = NULL, } ggsave(plotName,grid.arrange(grobs = p, ncol = floor(sqrt(ncol(preservedCalib)-1))),dpi = 600) - + write.csv(preservedCalib,"preservedCalib.csv") return(preservedCalib[preservedCalib[,"likelihood"]==max(preservedCalib[,"likelihood"]),]) } diff --git a/RBBGCMuso/R/plotMuso.R b/RBBGCMuso/R/plotMuso.R index 36d7fac..cee07c8 100644 --- a/RBBGCMuso/R/plotMuso.R +++ b/RBBGCMuso/R/plotMuso.R @@ -247,40 +247,33 @@ plotMuso <- function(settings = NULL, variable = 1, #' debugging=FALSE, keepEpc=FALSE, #' logfilename=NULL, aggressive=FALSE, #' leapYear=FALSE, export=FALSE) -#' @import ggplot2 +#' @importFrom ggplot2 ggplot geom_line geom_point aes aes_string labs theme element_blank #' @export -plotMusoWithData <- function(csvFile, variable, NACHAR=NA, settings=NULL, sep=",", savePlot=NULL,colour=c("black","blue"), calibrationPar=NULL, parameters=NULL){ - if(!is.na(NACHAR)){ - warning("NACHAR is not implemented yet") - } - if(is.null(settings)){ - settings <- setupMuso() - } - - numberOfYears <- settings$numYears - startYear <- settings$startYear - yearVec <- seq(from = startYear, length=numberOfYears,by=1) +plotMusoWithData <- function(mdata, plotName=NULL, + startDate, endDate, + colour=c("black","blue"),dataVar, modelVar, settings = setupMuso(), silent = TRUE){ - - data <- read.table(csvFile,header = TRUE, sep = ",") %>% - select(variable) - - baseData <- calibMuso(settings,silent=TRUE) %>% - as.data.frame() %>% - rownames_to_column("date") %>% - mutate(date2=date,date=as.Date(date,"%d.%m.%Y"),yearDay=rep(1:365,numberOfYears)) %>% - separate(date2,c("day","month","year"),sep="\\.") - baseData <- cbind(baseData,data) - colnames(baseData)[ncol(baseData)] <- "measuredData" + dataCol<- grep(paste0("^",dataVar,"$"), colnames(mdata)) + selVar <- grep(modelVar,(settings$dailyVarCodes))+4 - p <- baseData %>% - ggplot(aes_string("date",variable)) + + list2env(alignData(mdata, dataCol = dataCol, + modellSettings = settings, + startDate = startDate, + endDate = endDate, leapYear = FALSE),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] + p <- baseData %>% + ggplot(aes_string("date",selVarName)) + geom_line(colour=colour[1]) + geom_point(colour=colour[2], aes(date,measuredData)) + - labs(y = paste0(variable,"_measured"))+ + labs(y = paste0(selVarName,"_measured"))+ theme(axis.title.x = element_blank()) - if(!is.null(savePlot)){ - ggsave(savePlot,p) + if(!is.null(plotName)){ + ggsave(plotName,p) return(p) } else { return(p) diff --git a/RBBGCMuso/man/optiMuso.Rd b/RBBGCMuso/man/optiMuso.Rd index 1decc2c..23b584d 100644 --- a/RBBGCMuso/man/optiMuso.Rd +++ b/RBBGCMuso/man/optiMuso.Rd @@ -5,12 +5,13 @@ \title{optiMuso} \usage{ optiMuso(measuredDataFile, parameters = NULL, sep = ",", startDate, - endDate, formatString = "\%Y-\%m-\%d", naString = NULL, - 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) + 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) } \arguments{ \item{measuredDataFile}{a} diff --git a/RBBGCMuso/man/plotMusoWithData.Rd b/RBBGCMuso/man/plotMusoWithData.Rd index 6bdaa42..d7b8b3d 100644 --- a/RBBGCMuso/man/plotMusoWithData.Rd +++ b/RBBGCMuso/man/plotMusoWithData.Rd @@ -11,18 +11,18 @@ logfilename=NULL, aggressive=FALSE, leapYear=FALSE, export=FALSE) } \arguments{ -\item{csvFile}{This specifies the filename of the measurements. It must contain a header. Typically this is a CSV file.} - -\item{variable}{The name of the output variable to plot} - -\item{NACHAR}{This is not implemented yet} - \item{settings}{RBBGCMuso uses variables that define the entire simulation environment. Those environment variables include the name of the INI files, the name of the meteorology files, the path to the model executable and its file name, the entire output list, the entire output variable matrix, the dependency rules for the EPC parameters etc. Using the runMuso function RBBGCMuso can automatically create those environment variables by inspecting the files in the working directory (this happens through the setupMuso function). It means that by default model setup is performed automatically in the background and the user has nothing to do. With this settings parameter we can force runMuso to skip automatic environment setup as we provide the environment settings to runMuso. In a typical situation the user can skip this option.} \item{sep}{This is the separator symbol used in the measurement file (that is supposed to be a delimited text file)} \item{savePlot}{It it is specified, the plot will be saved in a graphical format specified by the immanent extension. For example, it the savePlot is set to image01.png then a PNG graphics file will be created.} +\item{variable}{The name of the output variable to plot} + +\item{NACHAR}{This is not implemented yet} + +\item{csvFile}{This specifies the filename of the measurements. It must contain a header. Typically this is a CSV file.} + \item{calibrationPar}{You might want to change some parameters in your EPC file before running the model. The function offers possibility for this without editing the EPC file. In this situation you have to select the appropirate model parameters first. You can refer to these parameters with the number of the line in the EPC file. Indexing of lines start from one. You should use a vector for this referencing like c(1,5,8)} \item{parameters}{Using the function it is possible to change some of the EPC parameters prior to model execution. This can be achieved with this option. In the parameters variable you have set the row indices of the variables that you wish to change. In this parameters you can give an exact value for them in a vector form like c(1,2,3,4).}