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

Fixing grouping

Browse Source
This commit is contained in:
hollorol 2019-02-21 10:32:05 +01:00
parent eb23330d13
commit 2bfe5d6dba
3 changed files with 21 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
RBBGCMuso/NAMESPACE
View File

@ -34,6 +34,7 @@ export(updateMusoMapping)
import(ggplot2) import(ggplot2)
import(utils) import(utils)
importFrom(Rcpp,evalCpp) importFrom(Rcpp,evalCpp)
importFrom(data.table,':=')
importFrom(data.table,data.table) importFrom(data.table,data.table)
importFrom(data.table,fread) importFrom(data.table,fread)
importFrom(digest,digest) importFrom(digest,digest)

35
RBBGCMuso/R/plotMuso.R
View File

@ -25,6 +25,7 @@
#' @importFrom dplyr filter group_by summarize mutate '%>%' #' @importFrom dplyr filter group_by summarize mutate '%>%'
#' @importFrom tibble rownames_to_column #' @importFrom tibble rownames_to_column
#' @importFrom tidyr separate gather #' @importFrom tidyr separate gather
#' @importFrom data.table ':=' data.table
#' @export #' @export
plotMuso <- function(settings = NULL, variable = 1, plotMuso <- function(settings = NULL, variable = 1,
@ -38,7 +39,7 @@ plotMuso <- function(settings = NULL, variable = 1,
layerPlot = FALSE, colour = "blue", layerPlot = FALSE, colour = "blue",
skipSpinup = TRUE, fromData = FALSE, skipSpinup = TRUE, fromData = FALSE,
timeFrame = "day", selectYear = NULL, timeFrame = "day", selectYear = NULL,
groupFun = mean, separateFile = FALSE, dpi=300){ groupFun = mean, separateFile = FALSE, dpi=300, postProcString = NULL){
if( plotType!="cts" && plotType != "dts"){ if( plotType!="cts" && plotType != "dts"){
warning(paste0("The plotType ", plotType," is not implemented, plotType is set to cts")) warning(paste0("The plotType ", plotType," is not implemented, plotType is set to cts"))
@ -60,13 +61,12 @@ plotMuso <- function(settings = NULL, variable = 1,
## logfilename=logfilename, ## logfilename=logfilename,
## export=export) ## export=export)
groupByTimeFrame <- function(data, timeFrame, groupFun){ groupByTimeFrame <- function(Data, timeFrame, groupFun){
datas <- data %>% Data <- data.table(Data)
group_by(eval(parse(text=timeFrame))) %>% Data[,c(variable):=groupFun(get(variable)),get(timeFrame)]
summarize(variable=groupFun(eval(parse(text=variable)))) Data <- as.data.frame(Data)
datas[,1]<-as.numeric(unlist(datas[,1])) Data[,1] <- as.Date(Data[,1],"%d.%m.%Y")
colnames(datas) <- c("date",variable) Data
datas
} }
if(fromData){ if(fromData){
@ -84,20 +84,16 @@ plotMuso <- function(settings = NULL, variable = 1,
mutate(date=as.Date(as.character(date),"%d.%m.%Y")) mutate(date=as.Date(as.character(date),"%d.%m.%Y"))
} else { } else {
if(!is.element("cum_yieldC_HRV",unlist(settings$outputVars[[1]]))){ if(!is.element("cum_yieldC_HRV",unlist(settings$outputVars[[1]]))){
musoData <- calibMuso(settings,silent = TRUE,skipSpinup=skipSpinup) %>% musoData <- calibMuso(postProcString = postProcString,settings,silent = TRUE,skipSpinup=skipSpinup,prettyOut = TRUE)
as.data.frame() %>%
rownames_to_column("date") %>%
mutate(date2=date,date=as.Date(date,"%d.%m.%Y")) %>%
separate(date2,c("day","month","year"),sep="\\.")
if(!is.null(selectYear)){ if(!is.null(selectYear)){
musoData <- musoData %>% filter(year == get("selectYear")) musoData <- musoData %>% filter(year == get("selectYear"))
} }
if(timeFrame!="day"){ if(timeFrame!="day"){
musoData <- tryCatch(groupByTimeFrame(data=musoData, timeFrame = timeFrame, groupFun = groupFun), musoData <- tryCatch(groupByTimeFrame(Data=musoData, timeFrame = timeFrame, groupFun = groupFun),
error=function(e){stop("The timeFrame or the gropFun is not found")}) error=function(e){stop("The timeFrame or the groupFun is not found")})
}} else { }} else {
musoData <- calibMuso(settings,silent = TRUE,skipSpinup=skipSpinup,parameters = parameters, calibrationPar = calibrationPar,fileToChange = fileToChange) %>% musoData <- calibMuso(postProcString = postProcString,settings,silent = TRUE,skipSpinup=skipSpinup,parameters = parameters, calibrationPar = calibrationPar,fileToChange = fileToChange) %>%
as.data.frame() %>% as.data.frame() %>%
rownames_to_column("date") %>% rownames_to_column("date") %>%
mutate(date2=date,date=as.Date(date,"%d.%m.%Y"), mutate(date2=date,date=as.Date(date,"%d.%m.%Y"),
@ -204,7 +200,12 @@ plotMuso <- function(settings = NULL, variable = 1,
if(identical(character(0),setdiff(variable,as.character(settings$outputVars[[1]])))){ if(identical(character(0),setdiff(variable,as.character(settings$outputVars[[1]])))){
variableName <- variable variableName <- variable
} else { } else {
stop("The symmetric difference of the set of the output variables specified in the ini files and the set specified with your variable parameter is not the empty set.") if(!is.null(postProcString)){
variableName <- variable
} else {
stop("The symmetric difference of the set of the output variables specified in the ini files and the set specified with your variable parameter is not the empty set.")
}
} }
} }

3
RBBGCMuso/man/optiMuso.Rd
View File

@ -9,7 +9,8 @@ optiMuso(measuredData, parameters = NULL, startDate, endDate,
outLoc = "./calib", preTag = "cal-", settings = NULL, outLoc = "./calib", preTag = "cal-", settings = NULL,
outVars = NULL, iterations = 30, skipSpinup = TRUE, outVars = NULL, iterations = 30, skipSpinup = TRUE,
constrains = NULL, plotName = "calib.jpg", likelihood = function(x, constrains = NULL, plotName = "calib.jpg", likelihood = function(x,
y) { exp(-sqrt(mean((x - y)^2))) }, continious, modelVar = 3009) y) { exp(-sqrt(mean((x - y)^2))) }, continious, modelVar = 3009,
postProcString = NULL)
} }
\arguments{ \arguments{
\item{parameters}{b} \item{parameters}{b}