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

generate optimal epc

Browse Source
This commit is contained in:
Roland Hollós 2020-05-28 13:53:37 +02:00
parent 030ad2eba1
commit 72935b75e1
1 changed files with 17 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
RBBGCMuso/R/calibration.R
View File

@ -205,8 +205,15 @@ calcLikelihoodsAndRMSE <- function(dataVar, mod, mes, likelihoods, alignIndexes,
#' @author Roland HOLLOS #' @author Roland HOLLOS
#' @param plotName u #' @param plotName u
#' @export #' @export
musoGlue <- function(preservedCalib, w){ musoGlue <- function(presCalFile, w, delta = 0.17, settings=setupMuso(), parameters=read.csv("parameters.csv",
preservedCalib<- read.csv(preservedCalib) stringsAsFactors=FALSE)){
preservedCalib<- read.csv(presCalFile)
paramIndex <- parameters[(match(colnames(preservedCalib),parameters[,1])),2]
paramIndex <- paramIndex[!is.na(paramIndex)]
paramIndex <- c(paramIndex,
as.numeric(gsub("X","",
grep("X[0-9]{1,}",
colnames(preservedCalib),value=TRUE))))
preservedCalib <- preservedCalib[-1,] #original preservedCalib <- preservedCalib[-1,] #original
likeIndexes <- grep("likelihood",colnames(preservedCalib)) likeIndexes <- grep("likelihood",colnames(preservedCalib))
@ -224,7 +231,7 @@ musoGlue <- function(preservedCalib, w){
preservedCalib[["combined"]] <- preservedCalib[,grep("likelihood",colnames(preservedCalib),value=TRUE)] preservedCalib[["combined"]] <- preservedCalib[,grep("likelihood",colnames(preservedCalib),value=TRUE)]
} }
parameterIndexes <- 1:(min(likeIndexes)) parameterIndexes <- 1:(min(likeIndexes)-1)
preservedCalib <- preservedCalib[!is.na(preservedCalib$combined),] preservedCalib <- preservedCalib[!is.na(preservedCalib$combined),]
unfilteredLikelihood <- preservedCalib$combined unfilteredLikelihood <- preservedCalib$combined
preservedCalibtop5 <- preservedCalib[preservedCalib$combined>quantile(preservedCalib$combined,0.95),] preservedCalibtop5 <- preservedCalib[preservedCalib$combined>quantile(preservedCalib$combined,0.95),]
@ -245,8 +252,13 @@ musoGlue <- function(preservedCalib, w){
par(pari) par(pari)
dev.off() dev.off()
write.csv(optRanges,"optRanges.csv") write.csv(optRanges,"optRanges.csv")
print(head(optRanges)) optInterval <-t(apply(preservedCalibtop5,2,function(x) quantile(x,c(0.5-delta,0.5+delta))))
return(head(optRanges,n=-2)) optParamRange <- cbind.data.frame(rownames(optInterval)[parameterIndexes],as.numeric(paramIndex),optInterval[parameterIndexes,])
optimalEpc <- musoRand(optParamRange,iterations = 2)
optimalEpc[[2]] <- optimalEpc[[2]][1,]
write.csv(as.data.frame(optimalEpc),"epcOptim.csv")
print(head(optRanges,n=-2))
calibMuso(calibrationPar=optimalEpc[[1]],parameters=optimalEpc[[2]])
} }
generateOptEpc <- function(optRanges,delta, maxLikelihood=FALSE){ generateOptEpc <- function(optRanges,delta, maxLikelihood=FALSE){