From b6b700a27ab111e779a82a9032100215256c39a9 Mon Sep 17 00:00:00 2001 From: hollorol Date: Mon, 7 May 2018 23:25:12 +0200 Subject: [PATCH] big changes + version upgrade --- RBBGCMuso/DESCRIPTION | 2 +- RBBGCMuso/R/musoMonte.R | 15 ++++++++-- RBBGCMuso/R/musoSensi.R | 61 +++++++++++++++++--------------------- RBBGCMuso/man/musoMonte.Rd | 2 +- RBBGCMuso/man/musoSensi.Rd | 2 +- 5 files changed, 42 insertions(+), 40 deletions(-) diff --git a/RBBGCMuso/DESCRIPTION b/RBBGCMuso/DESCRIPTION index 00f6562..dc35540 100644 --- a/RBBGCMuso/DESCRIPTION +++ b/RBBGCMuso/DESCRIPTION @@ -1,6 +1,6 @@ Package: RBBGCMuso Title: An R package for BiomeBGC-MuSo ecosystem modelling -Version: 0.4.0.0-2 +Version: 0.5.0.0-0 Authors@R: person("Roland", "Hollo's", , "hollorol@gmail.com", role = c("aut", "cre")) Description: What the package does (one paragraph). Depends: R (>= 2.10) diff --git a/RBBGCMuso/R/musoMonte.R b/RBBGCMuso/R/musoMonte.R index a67d6fb..9601817 100644 --- a/RBBGCMuso/R/musoMonte.R +++ b/RBBGCMuso/R/musoMonte.R @@ -22,6 +22,7 @@ musoMonte <- function(settings=NULL, outputType = "moreCsv", fun=mean, varIndex = 1, + silent = TRUE, ...){ outLocPlain <- basename(outLoc) @@ -75,8 +76,12 @@ musoMonte <- function(settings=NULL, ## run. preservedEpc <- matrix(nrow = (iterations +1 ), ncol = npar) preservedEpc[1,] <- origEpc - colnames(preservedEpc) <- Otable[[1]][,1] + Otable[[1]][,1] <- (as.character(Otable[[1]][,1])) + for(i in parameters[,2]){ + Otable[[1]][Otable[[1]][,2]==i,1] <- as.character(parameters[parameters[,2]==i,1]) + } + colnames(preservedEpc) <- Otable[[1]][,1] preservedEpc <- cbind(preservedEpc,rep(NA,(iterations+1))) colnames(preservedEpc)[(npar+1)] <- "y" ## Save the backupEpc, while change the settings @@ -86,9 +91,10 @@ musoMonte <- function(settings=NULL, ## Creating function for generating separate ## csv files for each run + progBar <- txtProgressBar(1,iterations,style=3) moreCsv <- function(){ a <- numeric(iterations+1) - tempData <- calibMuso(settings, debugging = "stamplog", parameters = origEpc,keepEpc = TRUE) + tempData <- calibMuso(settings, debugging = "stamplog", parameters = origEpc,keepEpc = TRUE,silent = silent) a[1] <- tryCatch(fun(tempData[,varIndex]),error=function(e){return(NA)}) preservedEpc[1,(npar+1)] <- a[1] write.table(t(preservedEpc[1,]),row.names = FALSE,"preservedEpc.csv",sep=",") @@ -99,12 +105,15 @@ musoMonte <- function(settings=NULL, exportName <- paste0(preTag,(i+1),".csv") tempData <- calibMuso(settings,debugging = "stamplog", parameters = parVar, - keepEpc = TRUE) + keepEpc = TRUE, + silent=silent) write.csv(x=tempData,file=exportName) preservedEpc[(i+1),(npar+1)] <- a[i+1]<- tryCatch(fun(tempData[,varIndex]),error=function(e){return(NA)}) write.table(t(preservedEpc[(i+1),]),file="preservedEpc.csv",row.names=FALSE,col.names=FALSE, append=TRUE,sep=",") + setTxtProgressBar(progBar,i) } + cat("\n") return(preservedEpc) } diff --git a/RBBGCMuso/R/musoSensi.R b/RBBGCMuso/R/musoSensi.R index 9247f9a..c7681a8 100644 --- a/RBBGCMuso/R/musoSensi.R +++ b/RBBGCMuso/R/musoSensi.R @@ -25,13 +25,36 @@ musoSensi <- function(monteCarloFile = NULL, inputDir = "./", outLoc = "./calib", iterations = 30, - preTag = "mount-", + preTag = "mont-", outputType = "moreCsv", fun = mean, varIndex = 1, outputFile = "sensitivity.csv", plotName = "sensitivity.jpg"){ + doSensi <- function(M){ + npar <- ncol(M)-1 + M <- M[which(!is.na(M[,"y"])),] + y <- M[,(npar+1)] + M <- M[,colnames(M) %in% parameters[,1]] + npar <- ncol(M) + M <- apply(M[,1:npar],2,function(x){x-mean(x)}) + varNames<- colnames(M)[1:npar] + w <- lm(y~M)$coefficients[-1] + Sv <- apply(M,2,var) + overalVar <- sum(Sv^2*w^2) + S=numeric(npar) + for(i in 1:npar){ + S[i] <- ((w[i]^2*Sv[i]^2)/overalVar)*100 + } + names(S)<-varNames + write.csv(file = outputFile, x = S) + barplot(S,las=2) + return(S) + } + + + if(is.null(monteCarloFile)){ M <- musoMonte(parameters = parameters, settings = settings, @@ -43,40 +66,10 @@ musoSensi <- function(monteCarloFile = NULL, fun = fun, varIndex = varIndex ) - npar <- ncol(M)-1 - M <- M[which(!is.na(M$y)),] - y <- M[,(npar+1)] - M <- apply(M[,1:npar],2,function(x){x-mean(x)}) - varNames<- colnames(M)[1:npar] - w <- lm(y~M)$coefficients[-1] - Sv <- apply(M,2,var) - overalVar <- sum(Sv^2*w^2) - S=numeric(npar) - for(i in 1:npar){ - S[i] <- ((w[i]^2*Sv[i]^2)/overalVar)*100 - } - write.csv(file = outputFile, x = S) - names(S)<-varNames - barplot(S,las=2) - return(S) + return(doSensi(M)) + } else { M <- read.csv(monteCarloFile) - - npar <- ncol(M)-1 - M <- M[which(!is.na(M$y)),] - y <- M[,(npar+1)] - M <- apply(M[,1:npar],2,function(x){x-mean(x)}) - varNames<- colnames(M)[1:npar] - w <- lm(y~M)$coefficients[-1] - Sv <- apply(M,2,var) - overalVar <- sum(Sv^2*w^2) - S=numeric(npar) - for(i in 1:npar){ - S[i] <- ((w[i]^2*Sv[i]^2)/overalVar)*100 - } - names(S)<-varNames - write.csv(file = outputFile, x = S) - barplot(S,las=2) - return(S) + return(doSensi(M)) } } diff --git a/RBBGCMuso/man/musoMonte.Rd b/RBBGCMuso/man/musoMonte.Rd index f6baa80..eec9005 100644 --- a/RBBGCMuso/man/musoMonte.Rd +++ b/RBBGCMuso/man/musoMonte.Rd @@ -6,7 +6,7 @@ \usage{ musoMonte(settings = NULL, parameters, inputDir = "./", outLoc = "./calib", iterations = 10, preTag = "mont-", - outputType = "moreCsv", fun = mean, varIndex = 1, ...) + outputType = "moreCsv", fun = mean, varIndex = 1, silent = TRUE, ...) } \arguments{ \item{settings}{A list of montecarlos environmental variables. It is generated by the setupMuso() function. In default the settings parameter is generated automatically.} diff --git a/RBBGCMuso/man/musoSensi.Rd b/RBBGCMuso/man/musoSensi.Rd index 87f25e2..7def8d4 100644 --- a/RBBGCMuso/man/musoSensi.Rd +++ b/RBBGCMuso/man/musoSensi.Rd @@ -6,7 +6,7 @@ \usage{ musoSensi(monteCarloFile = NULL, parameters, settings = NULL, inputDir = "./", outLoc = "./calib", iterations = 30, - preTag = "mount-", outputType = "moreCsv", fun = mean, varIndex = 1, + preTag = "mont-", outputType = "moreCsv", fun = mean, varIndex = 1, outputFile = "sensitivity.csv", plotName = "sensitivity.jpg") } \arguments{