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

revert the old state

Browse Source
This commit is contained in:
Hollos Roland 2020-10-01 08:46:06 +02:00
parent 24f055dd5f
commit 02dfa70309
2 changed files with 19 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
RBBGCMuso/R/calibrateMuso.R
View File

@ -340,7 +340,7 @@ prepareFromAgroMo <- function(fName){
calcLikelihoodsAndRMSE <- function(dataVar, mod, mes, likelihoods, alignIndexes, musoCodeToIndex, uncert){ calcLikelihoodsAndRMSE <- function(dataVar, mod, mes, likelihoods, alignIndexes, musoCodeToIndex, uncert){
# browser()
# NOT COMPATIBLE WITH OLD MEASUREMENT DATA, mes have to be a matrix # NOT COMPATIBLE WITH OLD MEASUREMENT DATA, mes have to be a matrix
likelihoodRMSE <- sapply(names(dataVar),function(key){ likelihoodRMSE <- sapply(names(dataVar),function(key){
# browser() # browser()
@ -348,20 +348,28 @@ calcLikelihoodsAndRMSE <- function(dataVar, mod, mes, likelihoods, alignIndexes,
selected <- grep(sprintf("%s$", key), colnames(mes)) selected <- grep(sprintf("%s$", key), colnames(mes))
# browser() # browser()
measured <- mes[alignIndexes$meas,selected] measured <- mes[alignIndexes$meas,selected]
notNA <- sapply(1:nrow(measured), function(x){!any(is.na(measured[x,]))}) if(is.data.frame(measured)){
modelled <- modelled[notNA] notNA <- sapply(1:nrow(measured), function(x){!any(is.na(measured[x,]))})
measured <- measured[notNA,] modelled <- modelled[notNA]
measured <- measured[notNA,]
} else {
notNA <- !(is.na(measured))
modelled <- modelled[notNA]
measured <- measured[notNA]
}
# uncert <- uncert[!is.na(measured)] # uncert <- uncert[!is.na(measured)]
# measured <- measured[!is.na(measured)] # measured <- measured[!is.na(measured)]
apply(measured, 1, function(x){!any(is.na(x))}) # measured <- t(apply(measured, 1, function(x){if(!any(is.na(x))){x}} ))
measured <- t(apply(measured, 1, function(x){if(!any(is.na(x))){x}} )) if(!is.null(ncol(measured))){
if(ncol(measured)!=1){
m <- measured[,grep("^mean", colnames(measured))] m <- measured[,grep("^mean", colnames(measured))]
res <- c(likelihoods[[key]](modelled, measured),
sqrt(mean((modelled-m)^2)))
} else {
res <- c(likelihoods[[key]](modelled, measured),
sqrt(mean((modelled-measured)^2)))
} }
res <- c(likelihoods[[key]](modelled, measured),
sqrt(mean((modelled-m)^2))
)
# browser() # browser()
res res
}) })

1
RBBGCMuso/R/calibration.R
View File

@ -123,6 +123,7 @@ optiMuso <- function(measuredData, parameters = NULL, startDate = NULL,
uncert <- NULL uncert <- NULL
} }
# browser() # browser()
browser()
origModellOut <- calibMuso(settings=settings, silent=TRUE, skipSpinup = skipSpinup, postProcString=postProcString, modifyOriginal=modifyOriginal) origModellOut <- calibMuso(settings=settings, silent=TRUE, skipSpinup = skipSpinup, postProcString=postProcString, modifyOriginal=modifyOriginal)
partialResult[,resultRange] <- calcLikelihoodsAndRMSE(dataVar=dataVar, partialResult[,resultRange] <- calcLikelihoodsAndRMSE(dataVar=dataVar,
mod=origModellOut, mod=origModellOut,