diff --git a/RBBGCMuso/DESCRIPTION b/RBBGCMuso/DESCRIPTION index 748f386..0e7bbcb 100644 --- a/RBBGCMuso/DESCRIPTION +++ b/RBBGCMuso/DESCRIPTION @@ -17,7 +17,8 @@ Imports: Rcpp, magrittr, dplyr, - ggplot2 + ggplot2, + rmarkdown LinkingTo: Rcpp Maintainer: Roland Hollo's RoxygenNote: 6.0.1 diff --git a/RBBGCMuso/R/OtableMaker.R b/RBBGCMuso/R/OtableMaker.R index 5893a3d..9cde899 100644 --- a/RBBGCMuso/R/OtableMaker.R +++ b/RBBGCMuso/R/OtableMaker.R @@ -25,13 +25,17 @@ OtableMaker <- function(parametersReal){ OTFzero <- OTF[OTF$GROUP==0,] OT0 <- constMatrix [constMatrix$INDEX %in% zeroIndexes,] %>% mutate(MIN=OTFzero$MIN,MAX=OTFzero$MAX) - - sliced <- constMatrix %>% + if(nrow(OT0)!=nrow(OTF)){ + sliced <- constMatrix %>% dplyr::filter(GROUP %in% groupIDs) - slicedIndexes<- which(sliced[,"INDEX"] %in% intersect(sliced[,"INDEX"],otfIndexes)) - sliced[slicedIndexes,c("MIN","MAX")] <- OTF[which(OTF["GROUP"] == groupIDs),c("MIN","MAX")] + slicedIndexes<- which(sliced[,"INDEX"] %in% intersect(sliced[,"INDEX"],otfIndexes)) + sliced[slicedIndexes,c("MIN","MAX")] <- OTF[which(OTF["GROUP"] == groupIDs),c("MIN","MAX")] + + OTbig <- rbind(OT0,sliced) %>% data.frame() + } else { + OTbig <- OT0 %>% data.frame() + } - OTbig <- rbind(OT0,sliced) %>% data.frame() parnumbers <- nrow(OTbig) for(i in 1:parnumbers){ diff --git a/RBBGCMuso/R/calibMuso.R b/RBBGCMuso/R/calibMuso.R index c284ff9..1c08443 100644 --- a/RBBGCMuso/R/calibMuso.R +++ b/RBBGCMuso/R/calibMuso.R @@ -57,7 +57,7 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf if(silent!=TRUE){ if(length(grep("(dayout$)|(log$)",list.files(inputLoc)))>0){ - cat(" \n \n WARMING: 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") + 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") } diff --git a/RBBGCMuso/R/musoSensi.R b/RBBGCMuso/R/musoSensi.R index 12bf097..76b15d6 100644 --- a/RBBGCMuso/R/musoSensi.R +++ b/RBBGCMuso/R/musoSensi.R @@ -25,7 +25,7 @@ musoSensi <- function(monteCarloFile = NULL, settings = NULL, parametersFromFile=FALSE, inputDir = "./", - outLoc = "./calib", + outLoc = "./calib", iterations = 30, preTag = "mont-", outputType = "moreCsv", @@ -56,12 +56,14 @@ musoSensi <- function(monteCarloFile = NULL, varNames<- colnames(M)[1:npar] w <- lm(y~M)$coefficients[-1] Sv <- apply(M,2,var) - overalVar <- sum(Sv^2*w^2) + overalVar <- sum(Sv*w^2) S=numeric(npar) + for(i in 1:npar){ - S[i] <- ((w[i]^2*Sv[i]^2)/overalVar)*100 + S[i] <- ((w[i]^2*Sv[i])/(overalVar))*100 } - S <- round(S) + + S <- round(S,digits=2) names(S)<-varNames write.csv(file = outputFile, x = S) diff --git a/RBBGCMuso/R/parametersweep.R b/RBBGCMuso/R/parametersweep.R new file mode 100644 index 0000000..647bc80 --- /dev/null +++ b/RBBGCMuso/R/parametersweep.R @@ -0,0 +1,13 @@ +## #' paramsweep +## #' +## #' This function update the the muso outputcode-variable matrix +## #' @author Roland Hollos +## #' @return The outputcode-variable matrix, and also change the global variable +## #' @import rmarkdown +## #' @export + +## paramSweep <- function(inputDir="./",parameters=NULL,outputDir=NULL){ + + +## read.csv(system.file("markdowns","parameters.csv",package="RBBGCMuso")) +## } diff --git a/RBBGCMuso/inst/markdowns/parameterSweep.rmd b/RBBGCMuso/inst/markdowns/parameterSweep.rmd new file mode 100644 index 0000000..0651036 --- /dev/null +++ b/RBBGCMuso/inst/markdowns/parameterSweep.rmd @@ -0,0 +1,115 @@ +--- +title: "ParameterSweep" +auth or: "" +date: "`r format(Sys.time(), '%d %B, %Y')`" +output: html_document +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +``` + +```{r,echo=FALSE} +library("RBBGCMuso") + +quickAndDirty <- function(settings, parameters, inputDir= "./", outLoc, iterations=2, outVar=8,){ + + + + outLocPlain <- basename(outLoc) + currDir <- getwd() + inputDir <- normalizePath(inputDir) + 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) + outLoc <- normalizePath(outLoc) + tmp <- normalizePath(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() + } + + + + file.copy(settings$epcInput[2],"epc-save",overwrite = TRUE) + calibrationPar <- matrix[,"INDEX"] + npar <- nrow(matrix) + paramMatrices <- list() + parameters <- matrix(nrow = npar,ncol = iterations) + paramtest <- parameters + rownames(paramtest) <- matrix[,1] + + for(i in 1:npar){ + parameters[i,] <- seq(from=matrix[i,5],to=matrix[i,6],length=iterations) + #print(parameters[i,]) + settings$calibrationPar <- calibrationPar[i] + for(j in 1:iterations){ + p <- try(calibMuso(settings,parameters =parameters[i,j],silent=TRUE)) + + if(length(p)>1){ + paramtest[i,j] <- max(p[,outVar]) + # print(paramtest) + } else { + paramtest[i,j] <- NA + # print(paramtest) + } + } + file.copy("epc-save",settings$epcInput[2],overwrite = TRUE) + } + + print("###################################################") + paramMatrices <- (function(){ + for(i in 1:nrow(paramtest)){ + matrx <- matrix(ncol = 2,nrow=iterations) + matrx[,1] <- parameters[i,] + matrx[,2] <- paramtest[i,] + paramMatrices[[i]] <- matrx + names(paramMatrices)[i] <- rownames(paramtest)[i] + } + return(paramMatrices) + })() + + + return(list(paramtest,paramMatrices)) + + +} + +``` + + +```{r, echo=FALSE,cache=TRUE} +parconstrains <- read.csv("parconstrains_extended.csv") +settings <- setupMuso() +parSeq<-quickAndDirty(settings = settings,matrix = parconstrains,outVar = 8,iterations = 5) +``` + +```{r} +parSeq +``` + +```{r,echo=FALSE} + parlist<-parSeq[[2]] + lparlist<-length(parlist) + for(i in 1:lparlist){ + title<-names(parlist)[i] + plot(x = parlist[[i]][,1], y= parlist[[i]][,2], ylim=c(0,15), main=title,ylab="LAI") + } +``` diff --git a/RBBGCMuso/inst/markdowns/parameters.csv b/RBBGCMuso/inst/markdowns/parameters.csv new file mode 100644 index 0000000..6848451 --- /dev/null +++ b/RBBGCMuso/inst/markdowns/parameters.csv @@ -0,0 +1,14 @@ +NAME,INDEX,MIN,MAX +BASETEMP,25,3,9 +WPM,36,0,0.1 +CN_lv,38,10,50 +CN_li,39,32,70 +CN_root,40,20,70 +CN_fruit,41,10.50,70 +CN_stem,42,0,70 +CLEC,55,0.4,0.8 +FLNR,61,0.05,0.8 +STOMA,63,0.003,0.015 +ROOTDEPTH,74,0.3,2. +SWCGERMIN,87,0.2,0.9 +NH4MOBILEPROP,120,0.05,0.7 diff --git a/RBBGCMuso/man/musoSensi.Rd b/RBBGCMuso/man/musoSensi.Rd index 5c06675..7e14ea5 100644 --- a/RBBGCMuso/man/musoSensi.Rd +++ b/RBBGCMuso/man/musoSensi.Rd @@ -4,10 +4,11 @@ \alias{musoSensi} \title{musoSensi} \usage{ -musoSensi(monteCarloFile = NULL, parameters, settings = NULL, - inputDir = "./", outLoc = "./calib", iterations = 30, - preTag = "mont-", outputType = "moreCsv", fun = mean, varIndex = 1, - outputFile = "sensitivity.csv", plotName = "sensitivity") +musoSensi(monteCarloFile = NULL, parameters = NULL, settings = NULL, + parametersFromFile = FALSE, inputDir = "./", outLoc = "./calib", + iterations = 30, preTag = "mont-", outputType = "moreCsv", fun = mean, + varIndex = 1, outputFile = "sensitivity.csv", + plotName = "sensitivity.png", plotTitle = "Sensitivity", dpi = 300) } \arguments{ \item{monteCarloFile}{If you run musoMonte function previously, you did not have to rerun the monteCarlo, just provide the preservedEpc.csv file with its path. If you do not set this parameter, musoSensi will fun the musoMonte function to get all of the information.}