Merge branch 'master' of https://github.com/hollorol/RBBGCMuso

RBBGCMuso/DESCRIPTION

@@ -1,6 +1,6 @@
 Package: RBBGCMuso
 Title: What the Package Does (one line, title case)
-Version: 0.1.9.0-1
+Version: 0.2.0.0-1
 Authors@R: person("Roland", "Hollos", , "hollorol@gmail.com", role = c("aut", "cre"))
 Description: What the package does (one paragraph)
 License: GPL-2

RBBGCMuso/R/#musoTime.R#

@@ -0,0 +1,105 @@
+
+isLeapyear <- function(year){
+    ##This Boolean function tells us whether the given year is leapyear or not
+
+    if(((year%%4==0)&(year%%100!=0))|(year%%400==0)){
+        return(TRUE)
+    } else {
+        return(FALSE)
+    }
+}
+
+dayOfMonths <- function(year,corrigated=TRUE){
+    ##This function tells us how many days are in the months in the choosen year.
+
+    dayMonths <- c(31,28,31,30,31,30,31,31,30,31,30,31)
+
+    if(corrigated){
+
+        if(isLeapyear(year)==TRUE){
+            dayMonths[2] <-29
+        }
+    }
+
+    return(dayMonths)
+}
+
+dayOfYears <- function(year, corrigated=TRUE){
+    ##This function tells us how many days are in the given year.
+
+    if(corrigated){
+        if(isLeapyear(year)==TRUE){
+            return(366)   
+        } else {
+            return(365)
+        }
+    } else {
+        return(365)
+    }
+
+}
+
+sumDaysOfPeriod <- function(year, periodlen, corrigated=TRUE){
+    ##How many days are from the given date and given period length(periodlen)?    
+
+    years <- year:(year+periodlen)
+
+    if(corrigated){
+        years100 <-length(which(years%%100==0))
+        years400 <-length(which(years%%400==0))
+        years4 <- length(which(years%%4==0))
+        numberOfLeapdays <- years4-years100+years400
+        days <- periodlen*365+numberOfLeapdays
+        return(days)
+    } else {
+        days <- periodlen*365
+    }
+}
+
+musoLeapYears <- function(settings){
+    days <- 365*settings$numyears
+    years <- settings$startyear:(settings$startyear+settings$numyears-1)
+    Leapyears <-unlist(lapply(years,isLeapyear)) 
+    return(Leapyears)
+}
+
+musoDate <- function(settings,timestep="d",combined=TRUE, corrigated=TRUE, format="en"){
+    ##purpose: generate date label for muso
+
+    
+    days <- sumDaysOfPeriod(settings$startyear,settings$numyears, corrigated=corrigated)
+    dates <- matrix(rep(NA,days*3),ncol=3)
+
+        dates[1,] <- c(1,1,settings$startyear)    
+        for(i in 2:days){
+            dates[i,]<-dates[(i-1),]
+            if((dates[i-1,2]==12)&(dates[i-1,1]==31)){
+                dates[i,] <-c(1,1,(dates[(i-1),3]+1)) 
+            } else {
+                
+                if(dates[i-1,1]==(dayOfMonths(dates[(i-1),3],corrigated=corrigated)[dates[(i-1),2]] )){
+                    dates[i,]<-c(1,(dates[(i-1),2]+1),dates[(i-1),3])
+                } else {
+                    dates[i,1]<-dates[(i-1),1]+1   
+                }
+            }
+            
+        }
+    if(format=="en"){
+        
+    } else {
+        if(format=="hu"){
+         dates<-dates[,c(3,2,1)]   
+        } else {
+            cat("format is coerced to english, because I don't know",format)
+        }
+    }
+
+    if(combined==TRUE){
+        dates <- apply(dates,1,function(x) paste(x,collapse="."))
+        return(dates)
+    }
+    
+    return(dates)
+    
+}

RBBGCMuso/R/calibMuso.R

@@ -6,7 +6,7 @@
 
 Linuxp <-(Sys.info()[1]=="Linux")
 
-calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE){
+calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE){
 
 #############################################################
 ############################spinup run############################
@@ -199,6 +199,16 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
             colnames(Reva) <- unlist(settings$outputvars[[2]])
     }
 
+
+if(leapYear){
+        Reva <- corrigMuso(settings,Reva)
+         rownames(Reva) <- musoDate(settings)
+     } else { 
+         rownames(Reva) <- musoDate(settings, corrigated=FALSE)
+    }
+
+
+    
     if(export!=FALSE){
         setwd(whereAmI)
 
@@ -209,7 +219,7 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
                   
             
         ## )
-
+        write.csv(Reva,export)
         
     } else{
         setwd(whereAmI)

RBBGCMuso/R/musoTime.R

@@ -56,6 +56,12 @@ sumDaysOfPeriod <- function(year, periodlen, corrigated=TRUE){
     }
 }
 
+musoLeapYears <- function(settings){
+    days <- 365*settings$numyears
+    years <- settings$startyear:(settings$startyear+settings$numyears-1)
+    Leapyears <-unlist(lapply(years,isLeapyear)) 
+    return(Leapyears)
+}
 
 musoDate <- function(settings,timestep="d",combined=TRUE, corrigated=TRUE, format="en"){
     ##purpose: generate date label for muso

RBBGCMuso/R/otherUsefullFunctions.R

@@ -51,3 +51,29 @@ supportedMuso <- function(x="outputs"){
         return(cat("Supported formats are ",supportedFormats,"If your fileformat is something else, we automaticle coerced it to csv.\n"))
     }
 }
+
+
+insertRow <- function(existingDF, newrow, r){
+    nr <- nrow(existingDF)
+  existingDF <- rbind(existingDF,rep(NA,ncol(existingDF)))
+  existingDF[seq(r+1,nr+1),] <- existingDF[seq(r,nr),]
+  existingDF[r,] <- newrow
+  existingDF
+}
+
+corrigMuso <- function(settings, data){
+    numdays <- nrow(data)
+    data <- data
+    numyears <- settings$numyears
+    leapyears <- musoLeapYears(settings)
+    sylvesters <- data[seq(from=365, to=numdays, by=365),]
+    ind <- 0
+    for(i in 1:numyears){
+        
+        if(leapyears[i]){
+            data <- insertRow(data,sylvesters[i],i*360+ind)
+            ind <- ind+1
+        }
+    }
+    return(data)
+}

RBBGCMuso/R/rungetMuso.R

@@ -6,7 +6,7 @@
 
 Linuxp <-(Sys.info()[1]=="Linux")
 
-rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE){
+rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE){
 
 #############################################################
 ############################spinup run############################
@@ -194,6 +194,13 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
             colnames(Reva) <- unlist(settings$outputvars[[2]])
     }
 
+    if(leapYear){
+        Reva <- corrigMuso(settings,Reva)
+         rownames(Reva) <- musoDate(settings)
+     } else { 
+         rownames(Reva) <- musoDate(settings, corrigated=FALSE)
+    }
+
     if(export!=FALSE){
         setwd(whereAmI)
 
@@ -204,7 +211,7 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
                   
             
         ## )
-
+        write.csv(Reva,export)
         
     } else{
         setwd(whereAmI)