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)

33
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"),
@ -203,9 +199,14 @@ plotMuso <- function(settings = NULL, variable = 1,
} else { } else {
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 {
if(!is.null(postProcString)){
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.") 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(length(variableName)>8){ if(length(variableName)>8){

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}