From 2239a27b14e3ae51c14ff94fcb84164fc45c53d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Zrinyi=20N=C3=A1ndor?= Date: Tue, 15 Oct 2024 12:34:58 +0200 Subject: [PATCH 1/5] Changes to spinup, tune --- RBBGCMuso/R/spinupMuso.R | 41 ++++++++------- RBBGCMuso/R/tuner.R | 110 ++++++++++++++++++--------------------- 2 files changed, 71 insertions(+), 80 deletions(-) diff --git a/RBBGCMuso/R/spinupMuso.R b/RBBGCMuso/R/spinupMuso.R index a867e68..6b2191a 100644 --- a/RBBGCMuso/R/spinupMuso.R +++ b/RBBGCMuso/R/spinupMuso.R @@ -44,7 +44,7 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen ############################spinup run############################ ########################################################## - ## obsolete feature, but there can be cases in wich this option is helpfull + ## obsolete feature, but there can be cases in wich this option is helpful if(aggressive==TRUE){ cleanupMuso(location=outputLoc,deep=TRUE)} #(:INSIDE: cleanup.R) @@ -66,25 +66,30 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen ##Run the spinup modell - if(silent){#silenc mode + if(silent){ #silent mode + if(Linuxp){ - #In this case, in linux machines - 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 - tryCatch(system(paste(executable,iniInput[1],sep=" "),show.output.on.console = FALSE), - error= function (e){stop("Cannot run the modell-check the executable!")}) - }} else { - system(paste(executable,iniInput[1],sep=" ")) + #On Linux machines + tryCatch(system(paste(executable, iniInput[1], "> /dev/null")), + error = function(e) stop("Cannot run the model - check the executable!") + ) + return() + } + + #On Windows machines + tryCatch(system(paste(executable, iniInput[1]), show.output.on.console = FALSE), + error = function(e) stop("Cannot run the model - check the executable!") + ) + return() } + ############################################### #############LOG SECTION####################### ############################################### - logspinup <- getLogs(outputLoc,outputNames,type="spinup") #(:INSIDE: assistantFunctions.R) + logspinup <- getLogs(outputLoc,outputNames,type="spinup") #(:INSIDE: assistantFunctions.R) - if(length(logspinup)==0){ + if(length(logspinup)==0){ if(keepEpc){ stampnum<-stamp(EPCS) lapply(epc,function (x) file.copy(from = x ,to=paste(EPCS,"/",(stampnum+1),"-", basename(x),sep=""))) @@ -93,7 +98,7 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen stop("Modell Failure") } setwd(whereAmI) - stop("Modell Failure") #in that case the modell did not create even a logfile + stop("Modell Failure") #in that case the model didn't even create a logfile } if(length(logspinup)>1){ @@ -103,8 +108,8 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen spincrash<-TRUE } else { spincrash <- (tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1)!=1) - } - } + } + } dirName<-normalizePath(paste(inputLoc,"/LOG",sep="")) dirERROR<-paste0(inputLoc,"/ERROR") @@ -120,14 +125,10 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen } else { errorsign <- 0} - - if(debugging==TRUE){ stampAndDir(outputLoc=outputLoc,stampDir=dirName, names=logspinup, type="output") #(:INSIDE: assistantFunctions.R) } - - if(errorsign==1){ stop("Modell Failure") } diff --git a/RBBGCMuso/R/tuner.R b/RBBGCMuso/R/tuner.R index 8ce54c2..716ff02 100644 --- a/RBBGCMuso/R/tuner.R +++ b/RBBGCMuso/R/tuner.R @@ -19,7 +19,6 @@ tuneMusoUI <- function(parameterFile = NULL, ...){ settings <- setupMuso(...) defaultValues <- musoGetValues(settings$epcInput[2],parameters[,2]) fluidPage( - # tags$head(tags$style(HTML("#iniContainer {width: 80vw;}"))), tags$head(tags$style(HTML("#contolp {height: 80vh;overflow-y:scroll;}"))), titlePanel("Biome-BGCMuSo parameter tuner"), sidebarLayout( @@ -32,22 +31,22 @@ tuneMusoUI <- function(parameterFile = NULL, ...){ width="40%" ), do.call(tagList,lapply(1:nrow(parameters),function(x){ - numericInput(paste0("param_",x), + numericInput(paste0("param_",x), parameters[x,1], defaultValues[x], step=defaultValues[x]/10, width="40%" ) -}))), - tags$div(actionButton(inputId="runModel","Run MuSo"), - radioButtons(inputId="destination", + }))), + tags$div(actionButton(inputId="runModel","Run MuSo"), + radioButtons(inputId="destination", label="reference or modified", choiceValues=c("auto","prev","next"), choiceNames=c("automatic","reference","modified")))), tabPanel("ini",tags$div(id="iniContainer", textAreaInput("inifile","Normal Ini file", - value=paste(readLines(settings$iniInput[2]), - collapse="\n"))), + value=paste(readLines(settings$iniInput[2]), + collapse="\n"))), actionButton(inputId="getOriginalIni", "Load original"), actionButton(inputId="overwriteIni", "overwrite") @@ -85,72 +84,61 @@ tuneMusoServer <- function(input, output, session){ observeEvent(input$runModel,{ - paramVal <- sapply(1:nrow(parameters),function(x){ - input[[paste0("param_", x)]] - }) + paramVal <- sapply(1:nrow(parameters),function(x) input[[paste0("param_", x)]]) + destination <- isolate(input$destination) + result <- calibMuso( + settings = settings, + calibrationPar = parameters[,2], + parameters = paramVal + ) - if(isolate(input$destination) == "auto"){ - outputList[['prev']] <- isolate(outputList[['next']]) - outputList[['next']] <- calibMuso(settings = settings, - calibrationPar = parameters[,2], - parameters = paramVal) - } else { - outputList[[isolate(input$destination)]] <- calibMuso(settings = settings, - calibrationPar = parameters[,2], - parameters = paramVal) - - } - + if (destination == "auto"){ + outputList[['prev']] <- isolate(outputList[['next']]) + outputList[['next']] <- result + } + outputList[[destination]] <- result - }) observe({ - if(input$autoupdate){ - paramVal <- sapply(1:nrow(parameters),function(x){ - input[[paste0("param_", x)]] - }) - - - if(isolate(input$destination) == "auto"){ - outputList[['prev']] <- isolate(outputList[['next']]) - outputList[['next']] <- calibMuso(settings = settings, - calibrationPar = parameters[,2], - parameters = paramVal) - } else { - outputList[[isolate(input$destination)]] <- calibMuso(settings = settings, - calibrationPar = parameters[,2], - parameters = paramVal) - - } - + if(!input$autoupdate){ + return() } - }) + paramVal <- sapply(1:nrow(parameters), function(x) input[[paste0("param_", x)]]) - observe({ - if(length(outputList[['next']])!=0){ - output$Result <- renderPlotly( - { - p <- plot_ly() - if(length(outputList[['prev']])!=0){ - p <- add_trace(p, x=dates, y=outputList[['prev']][,input$ovar], type='scatter', - mode='lines') - } - add_trace(p, x=dates, y=outputList[['next']][,input$ovar], color="red", type='scatter', - mode='lines') - } - ) + destination <- isolate(input$destination) + result <- calibMuso( + settings = settings, + calibrationPar = parameters[,2], + parameters = paramVal + ) + if(destination == "auto"){ + outputList[['prev']] <- isolate(outputList[['next']]) + outputList[['next']] <- result + } + outputList[[destination]] <- result + }) + + + observe({ + if(length(outputList[['next']])!=0){ + output$Result <- renderPlotly({ + p <- plot_ly() + if(length(outputList[['prev']])!=0){ + p <- add_trace(p, x=dates, y=outputList[['prev']][,input$ovar], type='scatter', mode='lines') + } + add_trace(p, x=dates, y=outputList[['next']][,input$ovar], color="red", type='scatter', mode='lines') + }) } }) observeEvent(input$getOriginalIni,{ - updateTextAreaInput(session, "inifile", value=paste(readLines("bck/n.ini"), - collapse="\n") ) + updateTextAreaInput(session, "inifile", value=paste(readLines("bck/n.ini"), collapse="\n") ) }) } @@ -164,10 +152,12 @@ tuneMusoServer <- function(input, output, session){ #' @export tuneMuso <- function(directory = NULL,...){ shinyOptions(workdir = getwd()) + if(is.null(directory)){ shinyOptions(musoRoot = ".") - } else { - shinyOptions(musoRoot = normalizePath(directory)) + return(shinyApp(ui = tuneMusoUI(), server = tuneMusoServer, options = list(...))) } - shinyApp(ui = tuneMusoUI(), server = tuneMusoServer, options = list(...)) + + shinyOptions(musoRoot = normalizePath(directory)) + return(shinyApp(ui = tuneMusoUI(), server = tuneMusoServer, options = list(...))) } From 9491fb966ab22c7f994fc2384c4e96da09f2b867 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Zrinyi=20N=C3=A1ndor?= Date: Sun, 3 Nov 2024 09:51:28 +0100 Subject: [PATCH 2/5] First version look, will further change --- RBBGCMuso/R/calibMuso.R | 2 +- RBBGCMuso/R/changeMuso.R | 7 ++- RBBGCMuso/R/spinupMuso.R | 101 ++++++++++++++++++++--------------- RBBGCMuso/R/tuner.R | 110 +++++++++++++++++++++------------------ 4 files changed, 123 insertions(+), 97 deletions(-) diff --git a/RBBGCMuso/R/calibMuso.R b/RBBGCMuso/R/calibMuso.R index 7366f19..7870a7d 100644 --- a/RBBGCMuso/R/calibMuso.R +++ b/RBBGCMuso/R/calibMuso.R @@ -1,6 +1,6 @@ #' calibMuso #' -#' This function changes the epc file and after that runs the BBGC-MuSo model and reads in its outputfile in a well-structured way. +#' This function changes the epc file and after that runs the BBGC-MuSo model and reads in its outputfile in a well-structured way. #' #' @author Roland Hollos #' @param settings You have to run the setupMuso function before calibMuso. It is its output which contains all of the necessary system variables. It sets the whole running environment diff --git a/RBBGCMuso/R/changeMuso.R b/RBBGCMuso/R/changeMuso.R index a0b4789..1757218 100644 --- a/RBBGCMuso/R/changeMuso.R +++ b/RBBGCMuso/R/changeMuso.R @@ -6,7 +6,7 @@ #' @export changemulline <- function(filePaths, calibrationPar, contents, src=NULL, outFiles=filePaths){ - # browser() + if(is.null(src)){ src <- filePaths } @@ -17,10 +17,9 @@ changemulline <- function(filePaths, calibrationPar, contents, src=NULL, outFile }, calibrationPar, contents) writeLines(fileStringVector, outFiles) - } -changeNth <- function (string,place,replacement) { +changeNth <- function (string,place,replacement){ trimws(gsub(sprintf("^((.*?\\s+){%s})(.*?\\s+)", place), sprintf("\\1%s ", replacement), paste0(string," "), perl=TRUE), which="right") } @@ -48,7 +47,7 @@ musoGetValues <- function(filename, indices){ rowIndex <- as.integer(index) as.numeric(unlist(strsplit(readLines(filename)[rowIndex],split="\\s+"))[colIndex]) -}) + }) } #' musoCompareFiles diff --git a/RBBGCMuso/R/spinupMuso.R b/RBBGCMuso/R/spinupMuso.R index 6b2191a..2f41f77 100644 --- a/RBBGCMuso/R/spinupMuso.R +++ b/RBBGCMuso/R/spinupMuso.R @@ -17,17 +17,17 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilename=NULL, keepEpc=FALSE, silent=FALSE, aggressive=FALSE, fileToChange="epc"){ -########################################################################## -###########################Set local variables######################## -######################################################################## +######################################################################### +###########################Set local variables########################### +######################################################################### if(is.null(settings)){ settings <- setupMuso() #(:INSIDE: setupMuso.R) - } - # The software works on Linux or Windows, Mac is not implemented yet, so with this simple dichotomy we can determine wich system is running + + ## The software works on Linux or Windows, Mac is not implemented yet, so with this simple dichotomy we can determine which system is running Linuxp <-(Sys.info()[1]=="Linux") - ##Copy the variables from settings for the sake of easy + ## Copy the variables from settings for the sake of easy inputLoc <- settings$inputLoc outputLoc <- settings$outputLoc outputNames <- settings$outputNames @@ -36,60 +36,73 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen epc <- settings$epcInput calibrationPar <- settings$calibrationPar - ## We want to minimize the number of sideeffects so we store the state to restore in the end. + ## We want to minimize the number of side effects so we store the state to restore it in the end whereAmI<-getwd() -############################################################# -############################spinup run############################ -########################################################## +################################################################## +############################Spinup run############################ +################################################################## ## obsolete feature, but there can be cases in wich this option is helpful - if(aggressive==TRUE){ - cleanupMuso(location=outputLoc,deep=TRUE)} #(:INSIDE: cleanup.R) + if(aggressive){ + cleanupMuso(location = outputLoc,deep = TRUE) #(:INSIDE: cleanup.R) + } + + ## + change_parameters <- function(file_path, params) { + tryCatch( + changemulline(filePaths = file_path, calibrationPar, params), + error = function(e) stop("Cannot change the file: ", file_path) + ) + } - ## If parameters given, use changemulline, else leave this steps - - if(!is.null(parameters)){ + ## If parameters are given, use changemulline, else leave these steps + if (!is.null(parameters)){ switch(fileToChange, - "epc" = tryCatch(changemulline(filePaths = epc[1],calibrationPar,parameters), #(:INSIDE: changeMuso.R) - error = function (e) {stop("Cannot change the epc file")}), - "ini" = tryCatch(changemulline(filePaths = iniInput[1],calibrationPar,parameters), #(:INSIDE: changeMuso.R) - error = function (e) {stop("Cannot change the ini file")}), - "both" = (stop("This option is not implemented yet, please choose epc or ini")) - ) + "epc" = change_parameters(settings$epc[1], parameters), + "ini" = change_parameters(settings$iniInput[1], parameters), + stop("This option is not implemented yet, please choose epc or ini") + ) } + + + + #if(!is.null(parameters)){ + # switch(fileToChange, + # "epc" = tryCatch(changemulline(filePaths = epc[1],calibrationPar,parameters), #(:INSIDE: changeMuso.R) + # error = function (e) {stop("Cannot change the epc file")}), + # "ini" = tryCatch(changemulline(filePaths = iniInput[1],calibrationPar,parameters), #(:INSIDE: changeMuso.R) + # error = function (e) {stop("Cannot change the ini file")}), + # "both" = (stop("This option is not implemented yet, please choose epc or ini")) + # ) + #} ## Set the working directory to the inputLoc temporary. setwd(inputLoc) - ##Run the spinup modell - - if(silent){ #silent mode + ## Run the spinup modell + if(silent){ #silent mode if(Linuxp){ - #On Linux machines - tryCatch(system(paste(executable, iniInput[1], "> /dev/null")), - error = function(e) stop("Cannot run the model - check the executable!") - ) - return() - } - - #On Windows machines - tryCatch(system(paste(executable, iniInput[1]), show.output.on.console = FALSE), - error = function(e) stop("Cannot run the model - check the executable!") - ) - return() + #In this case, in linux machines + 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 + tryCatch(system(paste(executable,iniInput[1],sep=" "),show.output.on.console = FALSE), + error= function (e){stop("Cannot run the modell-check the executable!")}) + }} else { + system(paste(executable,iniInput[1],sep=" ")) } - ############################################### #############LOG SECTION####################### ############################################### - logspinup <- getLogs(outputLoc,outputNames,type="spinup") #(:INSIDE: assistantFunctions.R) + logspinup <- getLogs(outputLoc,outputNames,type="spinup") #(:INSIDE: assistantFunctions.R) - if(length(logspinup)==0){ + if(length(logspinup)==0){ if(keepEpc){ stampnum<-stamp(EPCS) lapply(epc,function (x) file.copy(from = x ,to=paste(EPCS,"/",(stampnum+1),"-", basename(x),sep=""))) @@ -98,7 +111,7 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen stop("Modell Failure") } setwd(whereAmI) - stop("Modell Failure") #in that case the model didn't even create a logfile + stop("Modell Failure") #in that case the modell did not create even a logfile } if(length(logspinup)>1){ @@ -108,8 +121,8 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen spincrash<-TRUE } else { spincrash <- (tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1)!=1) - } - } + } + } dirName<-normalizePath(paste(inputLoc,"/LOG",sep="")) dirERROR<-paste0(inputLoc,"/ERROR") @@ -125,10 +138,14 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen } else { errorsign <- 0} + + if(debugging==TRUE){ stampAndDir(outputLoc=outputLoc,stampDir=dirName, names=logspinup, type="output") #(:INSIDE: assistantFunctions.R) } + + if(errorsign==1){ stop("Modell Failure") } diff --git a/RBBGCMuso/R/tuner.R b/RBBGCMuso/R/tuner.R index 716ff02..8ce54c2 100644 --- a/RBBGCMuso/R/tuner.R +++ b/RBBGCMuso/R/tuner.R @@ -19,6 +19,7 @@ tuneMusoUI <- function(parameterFile = NULL, ...){ settings <- setupMuso(...) defaultValues <- musoGetValues(settings$epcInput[2],parameters[,2]) fluidPage( + # tags$head(tags$style(HTML("#iniContainer {width: 80vw;}"))), tags$head(tags$style(HTML("#contolp {height: 80vh;overflow-y:scroll;}"))), titlePanel("Biome-BGCMuSo parameter tuner"), sidebarLayout( @@ -31,22 +32,22 @@ tuneMusoUI <- function(parameterFile = NULL, ...){ width="40%" ), do.call(tagList,lapply(1:nrow(parameters),function(x){ - numericInput(paste0("param_",x), + numericInput(paste0("param_",x), parameters[x,1], defaultValues[x], step=defaultValues[x]/10, width="40%" ) - }))), - tags$div(actionButton(inputId="runModel","Run MuSo"), - radioButtons(inputId="destination", +}))), + tags$div(actionButton(inputId="runModel","Run MuSo"), + radioButtons(inputId="destination", label="reference or modified", choiceValues=c("auto","prev","next"), choiceNames=c("automatic","reference","modified")))), tabPanel("ini",tags$div(id="iniContainer", textAreaInput("inifile","Normal Ini file", - value=paste(readLines(settings$iniInput[2]), - collapse="\n"))), + value=paste(readLines(settings$iniInput[2]), + collapse="\n"))), actionButton(inputId="getOriginalIni", "Load original"), actionButton(inputId="overwriteIni", "overwrite") @@ -84,61 +85,72 @@ tuneMusoServer <- function(input, output, session){ observeEvent(input$runModel,{ - paramVal <- sapply(1:nrow(parameters),function(x) input[[paste0("param_", x)]]) + paramVal <- sapply(1:nrow(parameters),function(x){ + input[[paste0("param_", x)]] + }) - destination <- isolate(input$destination) - result <- calibMuso( - settings = settings, - calibrationPar = parameters[,2], - parameters = paramVal - ) - if (destination == "auto"){ - outputList[['prev']] <- isolate(outputList[['next']]) - outputList[['next']] <- result - } - - outputList[[destination]] <- result + if(isolate(input$destination) == "auto"){ + outputList[['prev']] <- isolate(outputList[['next']]) + outputList[['next']] <- calibMuso(settings = settings, + calibrationPar = parameters[,2], + parameters = paramVal) + } else { + outputList[[isolate(input$destination)]] <- calibMuso(settings = settings, + calibrationPar = parameters[,2], + parameters = paramVal) - }) + } - observe({ - if(!input$autoupdate){ - return() - } - paramVal <- sapply(1:nrow(parameters), function(x) input[[paste0("param_", x)]]) - destination <- isolate(input$destination) - result <- calibMuso( - settings = settings, - calibrationPar = parameters[,2], - parameters = paramVal - ) + + }) - if(destination == "auto"){ - outputList[['prev']] <- isolate(outputList[['next']]) - outputList[['next']] <- result + observe({ + if(input$autoupdate){ + paramVal <- sapply(1:nrow(parameters),function(x){ + input[[paste0("param_", x)]] + }) + + + if(isolate(input$destination) == "auto"){ + outputList[['prev']] <- isolate(outputList[['next']]) + outputList[['next']] <- calibMuso(settings = settings, + calibrationPar = parameters[,2], + parameters = paramVal) + } else { + outputList[[isolate(input$destination)]] <- calibMuso(settings = settings, + calibrationPar = parameters[,2], + parameters = paramVal) + + } + } - - outputList[[destination]] <- result }) - + observe({ if(length(outputList[['next']])!=0){ - output$Result <- renderPlotly({ - p <- plot_ly() - if(length(outputList[['prev']])!=0){ - p <- add_trace(p, x=dates, y=outputList[['prev']][,input$ovar], type='scatter', mode='lines') - } - add_trace(p, x=dates, y=outputList[['next']][,input$ovar], color="red", type='scatter', mode='lines') - }) + output$Result <- renderPlotly( + { + p <- plot_ly() + if(length(outputList[['prev']])!=0){ + p <- add_trace(p, x=dates, y=outputList[['prev']][,input$ovar], type='scatter', + mode='lines') + } + add_trace(p, x=dates, y=outputList[['next']][,input$ovar], color="red", type='scatter', + mode='lines') + } + ) + + } }) observeEvent(input$getOriginalIni,{ - updateTextAreaInput(session, "inifile", value=paste(readLines("bck/n.ini"), collapse="\n") ) + updateTextAreaInput(session, "inifile", value=paste(readLines("bck/n.ini"), + collapse="\n") ) }) } @@ -152,12 +164,10 @@ tuneMusoServer <- function(input, output, session){ #' @export tuneMuso <- function(directory = NULL,...){ shinyOptions(workdir = getwd()) - if(is.null(directory)){ shinyOptions(musoRoot = ".") - return(shinyApp(ui = tuneMusoUI(), server = tuneMusoServer, options = list(...))) + } else { + shinyOptions(musoRoot = normalizePath(directory)) } - - shinyOptions(musoRoot = normalizePath(directory)) - return(shinyApp(ui = tuneMusoUI(), server = tuneMusoServer, options = list(...))) + shinyApp(ui = tuneMusoUI(), server = tuneMusoServer, options = list(...)) } From 9f764f6ad4de34875228fa8d98ec03d243642aaa Mon Sep 17 00:00:00 2001 From: Cyb3rNani Date: Sun, 3 Nov 2024 18:36:33 +0100 Subject: [PATCH 3/5] Trying to spin-up the elegance --- RBBGCMuso/R/spinupMuso.R | 105 ++++++++++++++++----------------------- RBBGCMuso/R/tuner.R | 20 ++++---- 2 files changed, 52 insertions(+), 73 deletions(-) diff --git a/RBBGCMuso/R/spinupMuso.R b/RBBGCMuso/R/spinupMuso.R index 2f41f77..8af4124 100644 --- a/RBBGCMuso/R/spinupMuso.R +++ b/RBBGCMuso/R/spinupMuso.R @@ -17,9 +17,9 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilename=NULL, keepEpc=FALSE, silent=FALSE, aggressive=FALSE, fileToChange="epc"){ -######################################################################### -###########################Set local variables########################### -######################################################################### + ######################################################################### + ########################### Set local variables ######################### + ######################################################################### if(is.null(settings)){ settings <- setupMuso() #(:INSIDE: setupMuso.R) @@ -27,7 +27,7 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen ## The software works on Linux or Windows, Mac is not implemented yet, so with this simple dichotomy we can determine which system is running Linuxp <-(Sys.info()[1]=="Linux") - ## Copy the variables from settings for the sake of easy + ## Copy the variables from settings for the sake of easier handling inputLoc <- settings$inputLoc outputLoc <- settings$outputLoc outputNames <- settings$outputNames @@ -40,115 +40,94 @@ spinupMuso <- function(settings=NULL, parameters=NULL, debugging=FALSE, logfilen whereAmI<-getwd() -################################################################## -############################Spinup run############################ -################################################################## + ######################################################################### + ############################# Spinup run ################################ + ######################################################################### ## obsolete feature, but there can be cases in wich this option is helpful if(aggressive){ cleanupMuso(location = outputLoc,deep = TRUE) #(:INSIDE: cleanup.R) } - ## - change_parameters <- function(file_path, params) { + choose_parameters <- function(file_path, params) { tryCatch( changemulline(filePaths = file_path, calibrationPar, params), error = function(e) stop("Cannot change the file: ", file_path) ) } - ## If parameters are given, use changemulline, else leave these steps - if (!is.null(parameters)){ + ## We apply choose_parameters. If parameters are given, use changemulline (from changeMuso.R), else leave these steps + if(!is.null(parameters)){ switch(fileToChange, - "epc" = change_parameters(settings$epc[1], parameters), - "ini" = change_parameters(settings$iniInput[1], parameters), + "epc" = choose_parameters(settings$epc[1], parameters), + "ini" = choose_parameters(settings$iniInput[1], parameters), stop("This option is not implemented yet, please choose epc or ini") ) } - - - - #if(!is.null(parameters)){ - # switch(fileToChange, - # "epc" = tryCatch(changemulline(filePaths = epc[1],calibrationPar,parameters), #(:INSIDE: changeMuso.R) - # error = function (e) {stop("Cannot change the epc file")}), - # "ini" = tryCatch(changemulline(filePaths = iniInput[1],calibrationPar,parameters), #(:INSIDE: changeMuso.R) - # error = function (e) {stop("Cannot change the ini file")}), - # "both" = (stop("This option is not implemented yet, please choose epc or ini")) - # ) - #} ## Set the working directory to the inputLoc temporary. setwd(inputLoc) ## Run the spinup modell - if(silent){ #silent mode if(Linuxp){ #In this case, in linux machines - tryCatch(system(paste(executable,iniInput[1],"> /dev/null",sep=" ")), - error= function (e){stop("Cannot run the modell-check the executable!")}) + 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 - tryCatch(system(paste(executable,iniInput[1],sep=" "),show.output.on.console = FALSE), - error= function (e){stop("Cannot run the modell-check the executable!")}) + tryCatch(system(paste(executable,iniInput[1],sep=" "), show.output.on.console = FALSE), + error = function (e) {stop("Cannot run the modell-check the executable!")}) }} else { system(paste(executable,iniInput[1],sep=" ")) } -############################################### -#############LOG SECTION####################### -############################################### + + ######################################################################### + ############################# Log Section ############################### + ######################################################################### - logspinup <- getLogs(outputLoc,outputNames,type="spinup") #(:INSIDE: assistantFunctions.R) - - if(length(logspinup)==0){ + logspinup <- getLogs(outputLoc, outputNames, type="spinup") #(:INSIDE: assistantFunctions.R) + + if(length(logspinup) == 0){ 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)) + stampnum <- stamp(EPCS) + lapply(epc, function (x) file.copy(from = x , to = paste0(EPCS, "/", (stampnum + 1), "-", basename(x)))) + lapply(epc, function (x) file.copy(from = paste0(EPCS, "/", (stampnum + 1), "-", basename(x)), to = WRONGEPC)) setwd(whereAmI) stop("Modell Failure") } setwd(whereAmI) - stop("Modell Failure") #in that case the modell did not create even a logfile + stop("Modell Failure") #in that case the modell didn't even create a logfile } - if(length(logspinup)>1){ - spincrash<-TRUE + + if (length(logspinup) > 1) { + spincrash <- TRUE } else { - 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) - } + last_line <- tail(readLines(file.path(outputLoc, logspinup)), 1) + spincrash <- identical(last_line, character(0)) || last_line != "1" } - dirName<-normalizePath(paste(inputLoc,"/LOG",sep="")) - dirERROR<-paste0(inputLoc,"/ERROR") + dirName <- normalizePath(paste0(inputLoc,"/LOG")) + dirERROR <- paste0(inputLoc,"/ERROR") if(!dir.exists(dirName)){ - dir.create(dirName)} + dir.create(dirName) + } if(!dir.exists(dirERROR)){ - dir.create(dirERROR)} - - if(spincrash){ - errorsign <- 1 - } else { - errorsign <- 0} - + dir.create(dirERROR) + } + errorsign <- ifelse(spincrash, 1, 0) - if(debugging==TRUE){ - stampAndDir(outputLoc=outputLoc,stampDir=dirName, names=logspinup, type="output") #(:INSIDE: assistantFunctions.R) + if(debugging == TRUE){ + stampAndDir(outputLoc = outputLoc, stampDir = dirName, names = logspinup, type = "output") #(:INSIDE: assistantFunctions.R) } - - - if(errorsign==1){ + if(errorsign == 1){ stop("Modell Failure") } - } diff --git a/RBBGCMuso/R/tuner.R b/RBBGCMuso/R/tuner.R index 8ce54c2..4ea8dcf 100644 --- a/RBBGCMuso/R/tuner.R +++ b/RBBGCMuso/R/tuner.R @@ -10,14 +10,14 @@ tuneMusoUI <- function(parameterFile = NULL, ...){ setwd(getShinyOption("musoRoot")) - dir.create("bck",showWarnings = FALSE) - file.copy("n.ini","bck/n.ini", overwrite=FALSE) + dir.create("bck", showWarnings = FALSE) + file.copy("n.ini", "bck/n.ini", overwrite=FALSE) if(is.null(parameterFile)){ parameterFile <- "parameters.csv" } - parameters <- read.csv(parameterFile, stringsAsFactors=FALSE) + parameters <- read.csv(parameterFile, stringsAsFactors = FALSE) settings <- setupMuso(...) - defaultValues <- musoGetValues(settings$epcInput[2],parameters[,2]) + defaultValues <- musoGetValues(settings$epcInput[2], parameters[,2]) fluidPage( # tags$head(tags$style(HTML("#iniContainer {width: 80vw;}"))), tags$head(tags$style(HTML("#contolp {height: 80vh;overflow-y:scroll;}"))), @@ -75,7 +75,7 @@ tuneMusoServer <- function(input, output, session){ settings <- setupMuso() dates <- as.Date(musoDate(settings$startYear, numYears=settings$numYears),"%d.%m.%Y") - parameters <- read.csv("parameters.csv", stringsAsFactors=FALSE) + parameters <- read.csv("parameters.csv", stringsAsFactors = FALSE) outputList <- vector(mode = "list", length = 2) outputList <- reactiveValues() @@ -136,11 +136,11 @@ tuneMusoServer <- function(input, output, session){ { p <- plot_ly() if(length(outputList[['prev']])!=0){ - p <- add_trace(p, x=dates, y=outputList[['prev']][,input$ovar], type='scatter', + p <- add_trace(p, x = dates, y =o utputList[['prev']][,input$ovar], type = 'scatter', mode='lines') } - add_trace(p, x=dates, y=outputList[['next']][,input$ovar], color="red", type='scatter', - mode='lines') + add_trace(p, x = dates, y = outputList[['next']][,input$ovar], color = "red", type = 'scatter', + mode = 'lines') } ) @@ -149,8 +149,8 @@ tuneMusoServer <- function(input, output, session){ }) observeEvent(input$getOriginalIni,{ - updateTextAreaInput(session, "inifile", value=paste(readLines("bck/n.ini"), - collapse="\n") ) + updateTextAreaInput(session, "inifile", value = paste(readLines("bck/n.ini"), + collapse = "\n") ) }) } From 07694e44de56237670cc3f4a25ab24c3d93b31ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Zrinyi=20N=C3=A1ndor?= Date: Wed, 6 Nov 2024 15:24:21 +0100 Subject: [PATCH 4/5] Trying to calibrate the elegance --- RBBGCMuso/R/calibMuso.R | 431 ++++++++++++++-------------------------- 1 file changed, 151 insertions(+), 280 deletions(-) diff --git a/RBBGCMuso/R/calibMuso.R b/RBBGCMuso/R/calibMuso.R index 7870a7d..b7ae657 100644 --- a/RBBGCMuso/R/calibMuso.R +++ b/RBBGCMuso/R/calibMuso.R @@ -4,12 +4,12 @@ #' #' @author Roland Hollos #' @param settings You have to run the setupMuso function before calibMuso. It is its output which contains all of the necessary system variables. It sets the whole running environment -#' @param timee The required timesteps in the modell output. It can be "d", if it is daily, "m", if it's monthly, "y", it it is yearly. I recommend to use daily data, the yearly and monthly data is not well-tested yet. +#' @param timee The required timesteps in the model output. It can be "d", if it is daily, "m", if it's monthly, "y", it it is yearly. I recommend to use daily data, the yearly and monthly data is not well-tested yet. #' @param debugging If it is TRUE, it copies the log file to a Log directory to store it, if it is stamplog it contatenate a number before the logfile, which is one more than the maximum of the represented ones in the LOG directory. If it is true or stamplog it collects the "wrong" logfiles -#' @param keepEpc If TRUE, it keeps the epc file and stamp it, after these copies it to the EPCS directory. If debugging True or false, it copies the wrong epc files to the wrong epc directory. +#' @param keepEpc If TRUE, it keeps the epc file and stamp it. After these it copies it to the EPCS directory. If debugging True or false, it copies the wrong epc files to the wrong epc directory. #' @param export if it is yes or you give a filename here, it converts the ouxtput to the specific extension. For example, if you set export to "example.csv", it converts the output to "csv", if you set it to "example.xls" it converts to example.xls with the xlsx package. If it is not installed it gives back a warning message and converts it to csv. #' @param silent If you set it TRUE all off the modells output to the screen will be suppressed. It can be usefull, because it increases the model-speed. -#' @param aggressive It deletes every possible modell-outputs from the previous modell runs. +#' @param aggressive It deletes every possible modell-outputs from the previous model runs. #' @param parameters In the settings variable you have set the row indexes of the variables, you wish to change. In this parameter you can give an exact value for them in a vector like: c(1,2,3,4) #' @param logfilename If you want to set a specific name for your logfiles you can set this via logfile parameter #' @param leapYear Should the function do a leapyear correction on the outputdata? If TRUE, then the 31.12 day will be doubled. @@ -24,355 +24,226 @@ #' @import utils #' @export -calibMuso <- function(settings=setupMuso(), calibrationPar=NULL, - parameters=NULL, outVars = NULL, timee="d", - debugging=FALSE, logfilename=NULL, - keepEpc=FALSE, export=FALSE, - silent=FALSE, aggressive=FALSE, - keepBinary=FALSE, +calibMuso <- function(settings = setupMuso(), calibrationPar = NULL, + parameters = NULL, outVars = NULL, timee = "d", + debugging = FALSE, logfilename = NULL, + keepEpc = FALSE, export = FALSE, + silent = FALSE, aggressive = FALSE, + keepBinary = FALSE, binaryPlace = "./", fileToChange = "epc", skipSpinup = TRUE, modifyOriginal = FALSE, prettyOut = FALSE, postProcString = NULL, - doBackup=TRUE, - backupDir="bck", - fixAlloc=FALSE - ){ # -######################################################################## -###########################Set local variables and places############### -######################################################################## + doBackup = TRUE, + backupDir ="bck", + fixAlloc = FALSE + ){ + + ###################################################################### + ################### Set local variables and places ################### + ###################################################################### + ## Bro functions ('helper' but they are bros for doing it), maybe they'll be a part of a more complex debugger function in the future + createDirIfNotExist <- function(path) { + if (!dir.exists(path)) dir.create(path) + } + + stopWithError <- function(errorMsg, whereAmI) { + setwd(whereAmI) + stop(errorMsg) + } + + if(doBackup){ for(epc in settings$epcInput){ - file.copy(epc, file.path(settings$inputLoc, backupDir), overwrite=FALSE) + file.copy(epc, file.path(settings$inputLoc, backupDir), overwrite = FALSE) } for(soi in settings$soilFile){ - file.copy(soi, file.path(settings$inputLoc, backupDir), overwrite=FALSE) + file.copy(soi, file.path(settings$inputLoc, backupDir), overwrite = FALSE) } } + + bck <- file.path(settings$inputLoc, "bck", basename(settings[[paste0(fileToChange, "Input")]][2])) - bck <- file.path(settings$inputLoc, "bck", - basename(eval(parse(text = sprintf("settings$%sInput[2]", fileToChange))))) - - if(!silent){ - cat("Biome-BGC simulation started\n") # ZOLI - } + if (!silent) cat("Biome-BGC simulation started\n") # ZOLI - Linuxp <-(Sys.info()[1]=="Linux") - ##Copy the variables from settings + + Linuxp <- Sys.info()[1] == "Linux" + ## Copy the variables from settings inputLoc <- settings$inputLoc outputLoc <- settings$outputLoc outputNames <- settings$outputNames executable <- settings$executable iniInput <- settings$iniInput epc <- settings$epcInput - - if(is.null(calibrationPar)){ - calibrationPar <- settings$calibrationPar - } + if(is.null(calibrationPar)) calibrationPar <- settings$calibrationPar #for simple ifs I'll use this formatting binaryPlace <- normalizePath(binaryPlace) - whereAmI<-getwd() - + whereAmI <- getwd() - ## Set the working directory to the inputLoc temporarly. + ## Set the working directory to the inputLoc temporarily. setwd(inputLoc) + - - if(debugging){#If debugging option turned on - #If log or ERROR directory does not exists create it! - dirName<-file.path(inputLoc,"LOG") - dirERROR<-file.path(inputLoc,"ERROR") - - if(!dir.exists(dirName)){ - dir.create(dirName) - } - - if(!dir.exists(dirERROR)){ - dir.create(dirERROR) - } + ## If debugging option is turned on + if (debugging) { # If log or ERROR directory does not exist create it! + createDirIfNotExists(file.path(inputLoc, "LOG")) + createDirIfNotExists(file.path(inputLoc, "ERROR")) } - - 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) - } - } -############################################################# -############################spinup run############################ - ########################################################## + if (keepEpc) { + WRONGEPC <- file.path(inputLoc, "WRONGEPC") + EPCS <- file.path(inputLoc, "EPCS") + createDirIfNotExists(WRONGEPC) + createDirIfNotExists(EPCS) + } + ################################################## + ################### SPINUP RUN ################### + ################################################## - - - if(aggressive == TRUE){ - cleanupMuso(location = outputLoc,deep = TRUE) - } + if(aggressive) cleanupMuso(location = outputLoc, deep = TRUE) - - ##change the epc file if and only if there are given parameters - + ## Change the epc file if and only if there are given parameters if(!is.null(parameters)){ changemulline(filePaths = epc[2], - calibrationPar = calibrationPar, + calibrationPar = calibrationPar, contents = parameters, - src = if(file.exists(bck)){ - bck - } else { - NULL - }) - if(fixAlloc){ - fixAlloc(settings) - } - # fileToChange = fileToChange,) + src = if(file.exists(bck)) bck else NULL) + if(fixAlloc) fixAlloc(settings) } - - - ##We change the working directory becase of the model, but we want to avoid sideeffects, so we save the current location and after that we will change everything to it. - - if(!skipSpinup) { - - ##Run the model for the spinup run. - if(silent){#silenc mode - if(Linuxp){ - #In this case, in linux machines - tryCatch(system(paste(executable,iniInput[1],"> /dev/null",sep=" ")), - error= function (e){ - setwd((whereAmI)) - stop("Cannot run the modell-check the executable!")}) - } else { - #In windows machines there is a show.output.on.console option - tryCatch(system(paste(executable,iniInput[1],sep=" "),show.output.on.console = FALSE), - error= function (e){ - setwd((whereAmI)) - stop("Cannot run the modell-check the executable!")}) - } - - } else { - system(paste(executable,iniInput[1],sep=" ")) - } + # do we need this comment this place: + ## We change the working directory because of the model, but we want to avoid side-effects, so we save the current location and after that we will change everything to it. - logspinup <- getLogs(outputLoc,outputNames,type="spinup") - ## 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){ - 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)) - setwd(whereAmI) - stop("Modell Failure") - } - setwd(whereAmI) - stop("Modell Failure") #in that case the modell did not create even a logfile - } - - if(length(logspinup)>1){ - spincrash<-TRUE - } else { - if(identical(tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1),character(0))){ - spincrash<-TRUE + ## Bro function for spinup and normal run + runModel <- function() { + if (silent) { + command <- paste(executable, iniInput[1], if (Linuxp) "> /dev/null" else "") + tryCatch(system(command, show.output.on.console = !Linuxp), + error = function(e) stopWithError("Cannot run the model - check the executable!", whereAmI)) } else { - spincrash <- (tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1)!=1) + system(paste(executable, iniInput[1])) } } - } else {spincrash <- FALSE} - #If the last line in the logfile is 0 There are mistakes so the spinup crashes - - if(!spincrash){##If spinup did not crashed, run the normal run. - - ##################################################################### - ###########################normal run######################### - ################################################################# - ##for the sake of safe we set the location again - setwd(inputLoc) - if(silent){ - if(Linuxp){ - tryCatch(system(paste(executable,iniInput[2],"> /dev/null",sep=" ")), - error =function (e){ - setwd((whereAmI)) - stop("Cannot run the modell-check the executable!")}) - } else { - tryCatch(system(paste(executable,iniInput[2],sep=" "),show.output.on.console = FALSE), - error =function (e){ - setwd((whereAmI)) - stop("Cannot run the modell-check the executable!")} ) + if(!skipSpinup) { + runModel() # Perform the spinup run. + logspinup <- getLogs(outputLoc, outputNames, type = "spinup") + if (length(logspinup) == 0) { + 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)) } - - } else { - tryCatch(system(paste(executable,iniInput[2],sep=" ")), - error =function (e){ - setwd((whereAmI)) - stop("Cannot run the modell-check the executable!")}) + stopWithError("Model Failure", whereAmI) } + } + + ################################################## + ################### NORMAL RUN ################### + ################################################## - ##read the output - - switch(timee, - "d"=(Reva <- tryCatch(getdailyout(settings), #(:INSIDE: getOutput.R ) - error = function (e){ - setwd((whereAmI)) - stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})), - "m"=(Reva <- tryCatch(getmonthlyout(settings), #(:INSIDE: getOutput.R ) - error = function (e){ - setwd((whereAmI)) - stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})), - "y"=(Reva <- tryCatch(getyearlyout(settings), #(:INSIDE: getOutput.R ) - error = function (e){ - setwd((whereAmI)) - stop("Cannot read binary output, please check if the output type is set 2 in the ini files!")})) - ) - if(keepBinary){ - possibleNames <- tryCatch(getOutFiles(outputLoc = outputLoc,outputNames = outputNames), - error=function (e){ - setwd((whereAmI)) - stop("Cannot find output files")}) - stampAndDir(outputLoc = outputLoc,names = possibleNames,stampDir=binaryPlace,type="output") + ## If spinup run didn't crash, we continue to normal run + if (!spincrash) { + setwd(inputLoc) + runModel() + + ## Read the output + Reva <- switch(timee, + "d" = tryCatch(getdailyout(settings), + error = function(e) stopWithError("Cannot read binary output, check output type in ini files!", whereAmI)), + "m" = tryCatch(getmonthlyout(settings), + error = function(e) stopWithError("Cannot read binary output, check output type in ini files!", whereAmI)), + "y" = tryCatch(getyearlyout(settings), + error = function(e) stopWithError("Cannot read binary output, check output type in ini files!", whereAmI)) + ) + + if (keepBinary) { + possibleNames <- tryCatch(getOutFiles(outputLoc = outputLoc, outputNames = outputNames), + error = function(e) stopWithError("Cannot find output files", whereAmI)) + stampAndDir(outputLoc = outputLoc, names = possibleNames, stampDir = binaryPlace, type = "output") } } - - if(skipSpinup){ - logfiles <- tryCatch(getLogs(outputLoc,outputNames,type="normal"), - error = function (e){ - setwd(whereAmI) - stop("Cannot find log files, something went wrong")}) - } else { - logfiles <- tryCatch(getLogs(outputLoc,outputNames,type="both"), - error = function (e){ - setwd(whereAmI) - stop("Cannot find log files, something went wrong")}) - } - ## list.files(outputLoc)[grep("log$",list.files(outputLoc))]#creating a vector for logfilenames + #################################################### + ################### LOG SECTION #################### + #################################################### -############################################### -#############LOG SECTION####################### -############################################### + logfiles <- tryCatch(getLogs(outputLoc, outputNames, type = ifelse(skipSpinup, "normal", "both")), + error = function(e) stopWithError("Cannot find log files", whereAmI)) - if(skipSpinup){ - errorsign <- readErrors(outputLoc=outputLoc,logfiles=logfiles,type="normal") - } else { - perror <- readErrors(outputLoc=outputLoc,logfiles=logfiles) #vector of spinup and normalrun error - + errorsign <- if(skipSpinup){ + readErrors(outputLoc = outputLoc, logfiles = logfiles, type = "normal") + } else { + ## Obtain both spinup and normal run errors + perror <- readErrors(outputLoc = outputLoc, logfiles = logfiles) # vector of spinup and normal run error - ##if errorsign is 1 there is error, if it is 0 everything ok - perror[is.na(perror)]<-0 - if(length(perror)>sum(perror)){ - errorsign <- 1 + ## If errorsign is 1 there is an error, if it is 0 everything's ok + perror[is.na(perror)] <- 0 + if(length(perror) > sum(perror) || length(perror) == 1 || spincrash){ + 1 } else { - if(length(perror)==1){ - errorsign <- 1 - } else { - if(spincrash){ - errorsign <- 1 - } else { - errorsign <- 0 - } } + 0 } - - - } - - - if(keepEpc){#if keepepc option turned on + if(keepEpc){ # if keepepc option is turned on - if(length(unique(dirname(epc)))>1){ - stop("Why are you playing with my nervs? Seriously? You hold your epc-s in different folders?") + if(length(unique(dirname(epc))) > 1){ + stop("Why are you playing with my nerves? Seriously? You hold your epc-s in different folders? Please don't do that <333") } else { - if(skipSpinup){ - stampAndDir(stampDir=EPCS, wrongDir=WRONGEPC, names=epc[2], type="general", errorsign=errorsign, logfiles=logfiles) - } - stampAndDir(stampDir=EPCS, wrongDir=WRONGEPC, names=epc, type="general", errorsign=errorsign, logfiles=logfiles) - + epc_names <- if (skipSpinup) epc[2] else epc + stampAndDir(stampDir = EPCS, wrongDir = WRONGEPC, names = epc[2], + type = "general", errorsign = errorsign, logfiles = logfiles) } } - if(debugging){ #debugging is boolean - logfiles <- file.path(outputLoc,logfiles) - - stampAndDir(stampDir=dirName, wrongDir=dirERROR, names=logfiles, type="general",errorsign=errorsign,logfiles=logfiles)} - - - #cleanupMuso(location=outputLoc,deep = FALSE) - if(errorsign==1){ - stop("Modell Failure") + if(debugging){ # debugging is boolean + logfiles <- file.path(outputLoc, logfiles) + stampAndDir(stampDir = dirName, wrongDir = dirERROR, names = logfiles, + type = "general", errorsign = errorsign, logfiles = logfiles) } + - + if(errorsign == 1) stop("Modell Failure") - if(timee=="d"){ - if(!prettyOut){ - colnames(Reva) <- unlist(settings$outputVars[[1]]) - } else{ + Reva <- switch( + timee, + "d" = { + if (prettyOut) { Reva <- cbind.data.frame( - musoDate(startYear = settings$startYear, - numYears = settings$numYears, - combined = FALSE, prettyOut = TRUE), - Reva) - colnames(Reva) <- as.character(c("date","day","month","year",unlist(settings$outputVars[[1]])) ) - + musoDate(startYear = settings$startYear, numYears = settings$numYears, combined = FALSE, + prettyOut = TRUE), + Reva + ) + colnames(Reva) <- c("date", "day", "month", "year", unlist(settings$outputVars[[1]])) + } else { + colnames(Reva) <- unlist(settings$outputVars[[1]]) } - } else { - if(timee=="y") - colnames(Reva) <- unlist(settings$outputVars[[2]]) - } - - if(!is.null(postProcString)){ - Reva <- postProcMuso(Reva,postProcString) - } - - ## if(leapYear){ - ## Reva <- corrigMuso(settings,Reva) - ## if(!prettyOut){ - ## rownames(Reva) <- musoDate(settings$startYear,settings$numYears) - ## } + Reva + }, + "y" = { + colnames(Reva) <- unlist(settings$outputVars[[2]]) + Reva + }, + Reva # Default case if 'timee' is not "d" or "y" + ) - ## } else { - ## if(!prettyOut){ - ## rownames(Reva) <- musoDate(settings$startYear, settings$numYears) - ## } - - ## } - - if(!prettyOut){ - rownames(Reva) <- musoDate(settings$startYear, numYears = settings$numYears) - } + if(!is.null(postProcString)) Reva <- postProcMuso(Reva, postProcString) + if(!prettyOut) rownames(Reva) <- musoDate(settings$startYear, numYears = settings$numYears) - if(export!=FALSE){ + if(export){ setwd(whereAmI) - - ## switch(fextension(export), - ## "csv"=(write.csv(Reva,export)), - ## "xlsx"=(), - ## "odt"= - - - ## ) - write.csv(Reva,export) - - } else{ + write.csv(Reva, export) + } else { setwd(whereAmI) return(Reva) } From c9a985030c6a46b6cc3796b4512115aa8c4ebe60 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Zrinyi=20N=C3=A1ndor?= Date: Wed, 6 Nov 2024 15:34:53 +0100 Subject: [PATCH 5/5] Recalibrating further elegance --- RBBGCMuso/R/calibMuso.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/RBBGCMuso/R/calibMuso.R b/RBBGCMuso/R/calibMuso.R index b7ae657..6aacd9c 100644 --- a/RBBGCMuso/R/calibMuso.R +++ b/RBBGCMuso/R/calibMuso.R @@ -37,7 +37,7 @@ calibMuso <- function(settings = setupMuso(), calibrationPar = NULL, backupDir ="bck", fixAlloc = FALSE ){ - + ###################################################################### ################### Set local variables and places ################### ###################################################################### @@ -85,15 +85,15 @@ calibMuso <- function(settings = setupMuso(), calibrationPar = NULL, ## If debugging option is turned on if (debugging) { # If log or ERROR directory does not exist create it! - createDirIfNotExists(file.path(inputLoc, "LOG")) - createDirIfNotExists(file.path(inputLoc, "ERROR")) + createDirIfNotExist(file.path(inputLoc, "LOG")) + createDirIfNotExist(file.path(inputLoc, "ERROR")) } if (keepEpc) { WRONGEPC <- file.path(inputLoc, "WRONGEPC") EPCS <- file.path(inputLoc, "EPCS") - createDirIfNotExists(WRONGEPC) - createDirIfNotExists(EPCS) + createDirIfNotExist(WRONGEPC) + createDirIfNotExist(EPCS) } ##################################################