many changing, restructuring the code

RBBGCMuso/R/calibMuso.R

@@ -34,6 +34,7 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
     iniInput <- settings$iniInput
     epc <- settings$epcInput
     calibrationPar <- settings$calibrationPar
+    binaryPlace <- normalizePath(binaryPlace)
     whereAmI<-getwd()
 
 
@@ -41,6 +42,34 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
     setwd(inputLoc)
 
       
+    if((debugging=="stamplog")|(debugging==TRUE)){#If debugging option turned on
+        #If log or ERROR directory does not exists create it!
+        dirName<-paste(inputLoc,"LOG",sep="") 
+        dirERROR<-paste(inputLoc,"ERROR",sep="")
+        
+        if(!dir.exists(dirName)){
+            dir.create(dirName)
+        }
+
+        if(!dir.exists(dirERROR)){
+            dir.create(dirERROR)
+        }
+    }
+    if(keepEpc) {
+        epcdir <- dirname(epc[1])
+        print(epcdir)
+        WRONGEPC<-file.path(inputLoc,"WRONGEPC")
+        EPCS<-file.path(inputLoc,"EPCS")
+        
+        if(!dir.exists(WRONGEPC)){
+            dir.create(WRONGEPC)
+        }
+        
+        if(!dir.exists(EPCS)){
+            dir.create(EPCS)
+        }
+    }   
+
 ##########################################################################
 ###########################Defining Functions########################
 ########################################################################
@@ -55,20 +84,10 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
 
     
     
-    ##Sometimes a bug occure due to logfiles and controlfiles in the input loc directory
-##alma    
 
-    ## if(silent!=TRUE){
+     if(aggressive==TRUE){
-    ##     if(length(grep("(dayout$)|(log$)",list.files(inputLoc)))>0){    
+         cleanupMuso(location=outputLoc,deep = TRUE)
-    ##         warning("there is a log or dayout file nearby the ini files, that may cause problemes. \n \n If you want to avoid that possible problemes, please copy the log or dayout files into a save place, and after do a cleanupMuso(), or delete these manually, or run the rungetMuso(), with the agressive=TRUE parameter \n \n")
+     }
-
-    ##     }
-        
-    ## }
-    
-    ## if(aggressive==TRUE){
-    ##     cleanupMuso(location=outputLoc,deep = TRUE)
-    ## }
 
     
 
@@ -76,8 +95,10 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
     if(!is.null(parameters)){
 
         switch(fileToChange,
-               "epc"=(changemulline(filename=epc[2],calibrationPar,parameters)),
+               "epc"=tryCatch(changemulline(filename=epc[2],calibrationPar,parameters),
-               "ini"=(changemulline(filename=iniInput[2],calibrationPar,parameters)),
+                              error= function (e) {stop("Cannot change the epc file")}),
+               "ini"=tryCatch(changemulline(filename=iniInput[2],calibrationPar,parameters),
+                              error= function (e) {stop("Cannot change the ini file")}),
                "both"=(stop("This option is not implemented yet, please choose epc or ini"))
                )
     }
@@ -91,10 +112,12 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
     if(silent){#silenc mode
         if(Linuxp){
             #In this case, in linux machines
-            system(paste(executable,iniInput[1],"> /dev/null",sep=" "))
+            tryCatch(system(paste(executable,iniInput[1],"> /dev/null",sep=" ")),
+                   error= function (e){stop("Cannot run the modell-check the executable!")})
         } else {
             #In windows machines there is a show.output.on.console option
-            system(paste(executable,iniInput[1],sep=" "),show.output.on.console = FALSE)
+            tryCatch(system(paste(executable,iniInput[1],sep=" "),show.output.on.console = FALSE),
+                     error= function (e){stop("Cannot run the modell-check the executable!")})
         }
         
     } else {
@@ -103,10 +126,16 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
 
     
     
-    logspinup<-list.files(outputLoc)[grep("log$",list.files(outputLoc))]#load the logfiles
+    logspinup <- grep(paste0(outputNames[1],".log"), list.files(outputLoc),value = TRUE)
+    ## logspinup <- list.files(outputLoc)[grep("log$",list.files(outputLoc))]#load the logfiles
     
     if(length(logspinup)==0){
-        return("Modell Failure")#in that case the modell did not create even a logfile
+        if(keepEpc){
+            stampnum<-stamp(EPCS)
+            lapply(epc,function (x) file.copy(from = x ,to=paste(EPCS,"/",(stampnum+1),"-", basename(x),sep="")))
+            lapply(epc, function (x) file.copy(from = paste(EPCS,"/",(stampnum+1),"-",basename(x),sep=""), to=WRONGEPC))
+        }
+        return("Modell Failure") #in that case the modell did not create even a logfile
     }
 
     if(length(logspinup)>1){
@@ -115,7 +144,7 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
         if(identical(tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1),character(0))){
             spincrash<-TRUE
         } else {
-            spincrash<-(tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1)!=1)
+            spincrash <- (tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1)!=1)
         }
     }
     
@@ -132,32 +161,42 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
 
         if(silent){
             if(Linuxp){
-                system(paste(executable,iniInput[2],"> /dev/null",sep=" "))
+                tryCatch(system(paste(executable,iniInput[2],"> /dev/null",sep=" ")),
+                         error =function (e) {stop("Cannot run the modell-check the executable!")})
             } else {
-                system(paste(executable,iniInput[2],sep=" "),show.output.on.console = FALSE)
+                tryCatch(system(paste(executable,iniInput[2],sep=" "),show.output.on.console = FALSE),
+                        error =function (e) {stop("Cannot run the modell-check the executable!")} )
             }
             
         } else {
-            system(paste(executable,iniInput[2],sep=" "))
+            tryCatch(system(paste(executable,iniInput[2],sep=" ")),
+                     error =function (e) {stop("Cannot run the modell-check the executable!")})
         }
 
 
         ##read the output
          
         switch(timee,
-               "d"=(Reva<-getdailyout(settings)),
+               "d"=(Reva <- tryCatch(getdailyout(settings),
-               "m"=(Reva<-getmonthlyout(settings)),
+               error = function (e) {stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})),
-               "y"=(Reva<-getyearlyout(settings))
+               "m"=(Reva <- tryCatch(getmonthlyout(settings),
+               error = function (e) {stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})),
+               "y"=(Reva <- tryCatch(getyearlyout(settings),
+               error = function (e) {stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")}))
                )
         
         if(keepBinary){
-            file.copy(file.path(outputLoc,grep("out$",list.files(outputLoc),value=TRUE))
+            possibleNames <- grep("out$",grep(paste(paste0(outputNames,"*"), collapse = "|") ,list.files(outputLoc),value=TRUE),value = TRUE)
-                    ,file.path(binaryPlace,paste0(stamp(binaryPlace),"-",grep("out$",list.files(outputLoc),value=TRUE))))
+            
+            print(stamp(binaryPlace))
+            file.copy(file.path(outputLoc,possibleNames)
+                     ,file.path(binaryPlace,paste0((stamp(binaryPlace)+1),"-",possibleNames)))
         }
     }
 
     
-    logfiles <- list.files(outputLoc)[grep("log$",list.files(outputLoc))]#creating a vector for logfilenames
+    logfiles <- grep(paste(paste0(outputNames,".log"), collapse = "|"), list.files(outputLoc),value = TRUE)
+    ## list.files(outputLoc)[grep("log$",list.files(outputLoc))]#creating a vector for logfilenames
 
 ###############################################    
 #############LOG SECTION#######################
@@ -168,20 +207,6 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
     perror<-as.numeric(as.vector(lapply(paste(outputLoc,logfiles,sep="/"),function(x) tail(readLines(x,-1),1))))                                      #vector of spinup and normalrun error
     
   
-    if((debugging=="stamplog")|(debugging==TRUE)){#If debugging option turned on
-        #If log or ERROR directory does not exists create it!
-        dirName<-paste(inputLoc,"LOG",sep="") 
-        dirERROR<-paste(inputLoc,"ERROR",sep="")
-        
-        if(!dir.exists(dirName)){
-            dir.create(dirName)
-        }
-
-        if(!dir.exists(dirERROR)){
-            dir.create(dirERROR)
-        }
-    }
-
     ##if errorsign is 1 there is error, if it is 0 everything ok
     perror[is.na(perror)]<-0
     if(length(perror)>sum(perror)){
@@ -198,29 +223,17 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
     }
 
 
-    if(keepEpc){#if keepepc option tured on
+    if(keepEpc){#if keepepc option turned on
 
         if(length(unique(dirname(epc)))>1){
             print("Why are you playing with my nervs? Seriously? You hold your epc-s in different folders?")
         } else {
-            epcdir <- dirname(epc[1])
 
-            WRONGEPC<-paste(inputLoc,"WRONGEPC",sep="")
+            ## epcfiles <- list.files(epcdir)[grep("epc$",list.files(
-            EPCS<-paste(inputLoc,"EPCS",sep="")
-            
-            if(!dir.exists(WRONGEPC)){
-                dir.create(WRONGEPC)
-            }
-
-            if(!dir.exists(EPCS)){
-                dir.create(EPCS)
-            }
-            
-            epcfiles <- list.files(epcdir)[grep("epc$",list.files(epcdir))]
             stampnum<-stamp(EPCS)
-            lapply(epcfiles,function (x) file.copy(from = paste(epcdir,"/",x,sep=""),to=paste(EPCS,"/",(stampnum+1),"-",x,sep="")))
+            lapply(epc,function (x) file.copy(from = x ,to=paste(EPCS,"/",(stampnum+1),"-", basename(x),sep="")))
             if(errorsign==1){
-                lapply(epcfiles,function (x) file.copy(from = paste(EPCS,"/",(stampnum+1),"-",x,sep=""), to=WRONGEPC))
+                lapply(epc, function (x) file.copy(from = paste(EPCS,"/",(stampnum+1),"-",basename(x),sep=""), to=WRONGEPC))
             }
 
         }
@@ -269,7 +282,7 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
                  
              }}
     
-    cleanupMuso(location=outputLoc,deep = FALSE)
+    #cleanupMuso(location=outputLoc,deep = FALSE)
     if(errorsign==1){
         return("Modell Failure")
     }

RBBGCMuso/R/setupMuso.R

@@ -214,7 +214,7 @@ setupMuso <- function(executable=NULL,
     
     inputFiles<-c(iniInput,epcInput,metInput)
     numData<-rep(NA,3)
-    numYears <-  as.numeric(unlist(strsplit(grep("simulation years",iniFiles[[2]],value=TRUE),"[\ \t]"))[1])
+    numYears <-  as.numeric(unlist(strsplit(grep("simulation years",iniFiles[[2]],value=TRUE),"[\ \t]"))[1])gfrurgc dhxv
     ##    numYears<-unlist(read.table(iniInput[2],skip = 14,nrows = 1)[1])
     numValues <-  as.numeric(unlist(strsplit(grep("number of daily output variables",iniFiles[[2]],value=TRUE),"[\ \t]"))[1])
     ## numValues will be replaced to numVar
@@ -230,8 +230,9 @@ setupMuso <- function(executable=NULL,
     writeLines(iniFiles[[1]],iniInput[1])
     writeLines(iniFiles[[2]],iniInput[2])
 
-    suppressWarnings(file.remove(file.path(outputLoc,outputNames[1])))
+    suppressWarnings(file.remove(paste0(file.path(outputLoc,outputNames[1]),".log")))
-    suppressWarnings(file.remove(file.path(outputLoc,outputNames[2])))
+    ## I use file.path additionally because We do not know if outputLoc ends or not to "/"
+    suppressWarnings(file.remove(paste0(file.path(outputLoc,outputNames[2]),".log")))
     
     settings = list(executable = executable,
                     calibrationPar = calibrationPar,

forarcheologists

@@ -284,3 +284,15 @@ getyearlyout<-function(settings){
   close(d)
   return(yearoutput)
 }
+
+    ##Sometimes a bug occure due to logfiles and controlfiles in the input loc directory
+##alma    
+
+    ## if(silent!=TRUE){
+    ##     if(length(grep("(dayout$)|(log$)",list.files(inputLoc)))>0){    
+    ##         warning("there is a log or dayout file nearby the ini files, that may cause problemes. \n \n If you want to avoid that possible problemes, please copy the log or dayout files into a save place, and after do a cleanupMuso(), or delete these manually, or run the rungetMuso(), with the agressive=TRUE parameter \n \n")
+
+    ##     }
+        
+    ## }
+