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

musoMonte function(2)

Browse Source
This commit is contained in:
hollorol 2018-04-18 05:01:35 +02:00
parent 5156c7e0a5
commit 3293f3ee20
2 changed files with 25 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

121
RBBGCMuso/R/#musoMonte.R#
View File

@ -1,121 +0,0 @@
musoMonte <- function(settings=NULL,
parameters,
inputDir = "./",
outLoc = "./calib",
iterations = 10,
preTag = "mont-",
inputName = paste0(pretag,"epcs.csv"),
outputType = "moreCsv",
fun=mean,
varIndex=8,
doSensitivity=FALSE,
onDisk=FALSE,
...){
currDir <- getwd()
tmp <- file.path(outLoc,"tmp/")
if(!dir.exists(outLoc)){
dir.create(outLoc)
warning(paste(outLoc," is not exists, so it was created"))
}
if(dir.exists(tmp){
stop("There is a tmp directory inside the output location, please replace it. tmp is an important temporary directory for the function")
}
dir.create(tmp)
inputFiles <- file.path(inputDir,grep(basename(outLoc),list.files(inputDir),invert = TRUE,value = TRUE))
for(i in inputFiles){
file.copy(i,tmp)
}
setwd(tmp)
if(is.null(settings)){
settings <- setupMuso()
}
parameterNames <- parameters[,1]
parReal <- parameters[,-1]
Otable <- OtableMaker(parReal)
A <- as.matrix(Otable[[1]][,c(2,4,5,6)])
B <- as.matrix(Otable[[2]])
settings$calibrationPar <- A[,1]
pretag <- file.path(outLoc,preTag)
##reading the original epc file at the specified
## row numbers
origEpcFile <- readLines(settings$epcInput[2])
origEpc <- unlist(lapply(settings$calibrationPar, function (x) {
as.numeric(unlist(strsplit(origEpcFile[x],split="[\t ]"))[1])
}))
## Prepare the preservedEpc matrix for the faster
## run.
preservedEpc <- matrix(nrow = (iterations +1 ), ncol = length(settings$calibrationPar))
preservedEpc[1,] <- origEpc
colnames(preservedEpc) <- Otable[[1]][,1]
## Save the backupEpc, while change the settings
## variable and set the output.
file.copy(settings$epc[2],"savedEpc",overwrite = TRUE) # do I need this?
pretag <- file.path(outLoc,preTag)
## Creating function for generating separate
## csv files for each run
a<-1:100000
moreCsv <- function(){
for(i in 1:iterations){
parVar <- musoRandomizer(A,B)[,2]
#preservedEpc[(i+1),] <- parVar
exportName <- paste0(preTag,i,".csv")
tryCatch (calibMuso(settings,debugging = "stamplog",
parameters = parVar,export = exportName,
keepEpc = TRUE),error=function(e) NA )
}
return(preservedEpc)
}
## Creating function for generating one
## csv files for each run
oneCsv <- function () {
numDays <- settings$numdata[1]
if(!onDisk){
for(i in 1:iterations){
parVar <- apply(parameters,1,function (x) {
runif(1, as.numeric(x[3]), as.numeric(x[4]))})
preservedEpc[(i+1),] <- parVar
exportName <- paste0(preTag,".csv")
write.csv(parvar,"preservedEpc.csv",append=TRUE)
calibMuso(settings,debugging = "stamplog",
parameters = parVar,keepEpc = TRUE) %>%
{mutate(.,iD = i)} %>%
{write.csv(.,file=exportName,append=TRUE)}
}
return(preservedEpc)
} else {
}
}
netCDF <- function () {
stop("This function is not inplemented yet")
}
## Call one function according to the outputType
switch(outputType,
"oneCsv" = (preservedEpc <- oneCsv()),
"moreCsv" = (preservedEpc <- moreCsv()),
"netCDF" = (preservedEpc <- netCDF()))
## Change back the epc file to the original
file.copy(savedEpc,settings$epc[2],overwrite = TRUE)
write.csv(preservedEpc,"preservedEpc.csv")
}

43
RBBGCMuso/R/musoMonte.R
View File

@ -10,7 +10,8 @@ musoMonte <- function(settings=NULL,
varIndex=8,
doSensitivity=FALSE,
onDisk=FALSE,
...){
...)
{
currDir <- getwd()
tmp <- file.path(outLoc,"tmp/")
@ -58,7 +59,7 @@ musoMonte <- function(settings=NULL,
preservedEpc <- matrix(nrow = (iterations +1 ), ncol = length(settings$calibrationPar))
preservedEpc[1,] <- origEpc
colnames(preservedEpc) <- Otable[[1]][,1]
write.csv(preservedEpc,"preservedEpc.csv")
## Save the backupEpc, while change the settings
## variable and set the output.
file.copy(settings$epc[2],"savedEpc",overwrite = TRUE) # do I need this?
@ -66,17 +67,21 @@ musoMonte <- function(settings=NULL,
## Creating function for generating separate
## csv files for each run
a<-1:100000
moreCsv <- function(){
for(i in 1:iterations){
parVar <- musoRandomizer(A,B)[,2]
#preservedEpc[(i+1),] <- parVar
exportName <- paste0(preTag,i,".csv")
tryCatch (calibMuso(settings,debugging = "stamplog",
parameters = parVar,export = exportName,
keepEpc = TRUE),error=function(e) NA )
}
return(preservedEpc)
a <- list()
for(i in 1:iterations){
parVar <- musoRandomizer(A,B)[,2]
#preservedEpc[(i+1),] <- parVar
write.csv(x=parVar,file="preservedEpc.csv", append=TRUE)
exportName <- paste0(preTag,i,".csv")
tempData <- calibMuso(settings,debugging = "stamplog",
parameters = parVar,
keepEpc = TRUE)
write.csv(x=tempData,file=exportName)
a[[i]]<-fun(tempData[,varIndex])
}
return(a)
}
## Creating function for generating one
@ -88,7 +93,8 @@ musoMonte <- function(settings=NULL,
for(i in 1:iterations){
parVar <- apply(parameters,1,function (x) {
runif(1, as.numeric(x[3]), as.numeric(x[4]))})
runif(1, as.numeric(x[3]), as.numeric(x[4]))})
preservedEpc[(i+1),] <- parVar
exportName <- paste0(preTag,".csv")
write.csv(parvar,"preservedEpc.csv",append=TRUE)
@ -110,12 +116,13 @@ musoMonte <- function(settings=NULL,
## Call one function according to the outputType
switch(outputType,
"oneCsv" = (preservedEpc <- oneCsv()),
"moreCsv" = (preservedEpc <- moreCsv()),
"netCDF" = (preservedEpc <- netCDF()))
"oneCsv" = (a <- oneCsv()),
"moreCsv" = (a <- moreCsv()),
"netCDF" = (a <- netCDF()))
## Change back the epc file to the original
file.copy(savedEpc,settings$epc[2],overwrite = TRUE)
write.csv(preservedEpc,"preservedEpc.csv")
}
return(do.call("c",a))
}