Merge the debugging from unstable branch

RBBGCMuso/DESCRIPTION

@@ -17,7 +17,8 @@ Imports:
 	Rcpp,
 	magrittr,
 	dplyr,
-	ggplot2
+	ggplot2,
+	rmarkdown
 LinkingTo: Rcpp
 Maintainer: Roland Hollo's <hollorol@gmail.com>
 RoxygenNote: 6.0.1

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)
-
+  if(nrow(OT0)!=nrow(OTF)){
-  sliced <- constMatrix %>%
+      sliced <- constMatrix %>%
       dplyr::filter(GROUP %in% groupIDs)
-  slicedIndexes<- which(sliced[,"INDEX"] %in% intersect(sliced[,"INDEX"],otfIndexes))
+      slicedIndexes<- which(sliced[,"INDEX"] %in% intersect(sliced[,"INDEX"],otfIndexes))
-  sliced[slicedIndexes,c("MIN","MAX")] <- OTF[which(OTF["GROUP"] == groupIDs),c("MIN","MAX")]
+      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){

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")
 
         }
         

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)
 

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"))
+## }

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")  
+ }
+```

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

RBBGCMuso/man/musoSensi.Rd

@@ -4,10 +4,11 @@
 \alias{musoSensi}
 \title{musoSensi}
 \usage{
-musoSensi(monteCarloFile = NULL, parameters, settings = NULL,
+musoSensi(monteCarloFile = NULL, parameters = NULL, settings = NULL,
-  inputDir = "./", outLoc = "./calib", iterations = 30,
+  parametersFromFile = FALSE, inputDir = "./", outLoc = "./calib",
-  preTag = "mont-", outputType = "moreCsv", fun = mean, varIndex = 1,
+  iterations = 30, preTag = "mont-", outputType = "moreCsv", fun = mean,
-  outputFile = "sensitivity.csv", plotName = "sensitivity")
+  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.}