Skip to content

Commit

Permalink
Fix Optimization Formula
Browse files Browse the repository at this point in the history
  • Loading branch information
@HeleneBlt
HeleneBlt committed Apr 24, 2024
1 parent 8352c77 commit f4367c0
Show file tree
Hide file tree
Showing 2 changed files with 87 additions and 16 deletions.
2 changes: 1 addition & 1 deletion R/bm_RunModelsLoop.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -234,7 +234,7 @@ bm_RunModel <- function(model, run.name, dir.name = '.'
if (model != "MAXENT") { ## ANY MODEL BUT MAXENT ------------------------------------------------

## PRELIMINAR ---------------------------------------------------
if (model %in% c("ANN", "MARS", "RF")) {
if (model %in% c("ANN", "MARS", "RF") & is.null(bm.opt.val$formula)) {
bm.opt.val$formula <- bm_MakeFormula(resp.name = resp_name
, expl.var = head(data_env)
, type = 'simple'
Expand Down
101 changes: 86 additions & 15 deletions R/bm_Tuning.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -415,6 +415,7 @@ bm_Tuning <- function(model,
}
}
tuning.form <- tuning.grid[which.max(tmp[, metric.eval]), ]
if (model == "RF"){tuning.form <- data.frame(mtry = tuning.grid[which.max(tmp[, metric.eval]), ])}

if (model == "CTA") {
tuning.fun = "rpart2"
Expand All @@ -428,31 +429,94 @@ bm_Tuning <- function(model,
}
}
} else { tuning.form <- tuning.grid }

## run formula selection ------------------------------------------------------------------
if (do.formula) {
cat("\n\t\t\t> Tuning formula...")

cmd.form <- sub("tuneGrid = tuning.grid", "tuneGrid = tuning.form", cmd.tuning)
cmd.form <- sub("weights = current.weights,","",cmd.form)
cmd.init <- "form = bm_MakeFormula(resp.name = 'resp', expl.var = myExpl, type = typ, interaction.level = intlev),"
cmd.init <- paste0(cmd.init, " data = cbind(myExpl, resp = myResp),")
cmd.form <- sub("x = myExpl, y = myResp,", cmd.init, cmd.form)
TMP <- foreach (typ = c('simple', 'quadratic', 'polynomial', 's_smoother'), .combine = "rbind") %:%
foreach (intlev = 0:(ncol(myExpl) - 1), .combine = "rbind") %do%
{
tuned.form <- NULL
eval(parse(text = paste0("capture.output("
, "try(tuned.form <- ", sub(")$", ", silent = TRUE)", cmd.form)
, ")")))

if (!is.null(tuned.form)) {
tmp <- tuned.form$results
tmp$TSS <- tmp$Sens + tmp$Spec - 1
formu <- tuned.form$coefnames
formu <- paste0(bm.format@sp.name, " ~ 1 + ", paste0(formu, collapse = " + "))
return(data.frame(tmp, type = typ, interaction.level = intlev, formula = formu))

max.intlev <- min(ncol(myExpl) - 1,3)

if (model %in% c("CTA")){
TMP <- foreach (typ = c('simple', 'quadratic', 'polynomial', 's_smoother'), .combine = "rbind") %do%
{
tuned.form <- NULL
intlev <- 0
eval(parse(text = paste0("capture.output("
, "try(tuned.form <- ", sub(")$", ", silent = TRUE)", cmd.form)
, ")")))
if (!is.null(tuned.form)) {
tmp <- tuned.form$results
tmp$TSS <- tmp$Sens + tmp$Spec - 1
formu <- tuned.form$coefnames
formu <- paste0(bm.format@sp.name, " ~ 1 + ", paste0(formu, collapse = " + "))
return(data.frame(tmp, type = typ, interaction.level = intlev, formula = formu))
}
}
}

} else if (model == "FDA"){
TMP <- foreach (typ = c('simple','s_smoother'), .combine = "rbind") %do%
{
tuned.form <- NULL
intlev <- 0
eval(parse(text = paste0("capture.output("
, "try(tuned.form <- ", sub(")$", ", silent = TRUE)", cmd.form)
, ")")))
if (!is.null(tuned.form)) {
tmp <- tuned.form$results
tmp$TSS <- tmp$Sens + tmp$Spec - 1
formu <- tuned.form$coefnames
formu <- paste0(bm.format@sp.name, " ~ 1 + ", paste0(formu, collapse = " + "))
return(data.frame(tmp, type = typ, interaction.level = intlev, formula = formu))
}
}
} else if (model == "RF"){
TMP <- foreach (typ = c('simple','quadratic', 'polynomial'), .combine = "rbind") %:%
foreach (intlev = 0:max.intlev, .combine = "rbind") %do%
{
tuned.form <- NULL
eval(parse(text = paste0("capture.output("
, "try(tuned.form <- ", sub(")$", ", silent = TRUE)", cmd.form)
, ")")))
if (!is.null(tuned.form)) {
tmp <- tuned.form$results
tmp$TSS <- tmp$Sens + tmp$Spec - 1
formu <- tuned.form$coefnames
formu <- paste0(bm.format@sp.name, " ~ 1 + ", paste0(formu, collapse = " + "))
return(data.frame(tmp, type = typ, interaction.level = intlev, formula = formu))
}
}
} else {
TMP <- foreach (typ = c('simple', 'quadratic', 'polynomial', 's_smoother'), .combine = "rbind") %:%
foreach (intlev = 0:max.intlev, .combine = "rbind") %do%
{
tuned.form <- NULL
eval(parse(text = paste0("capture.output("
, "try(tuned.form <- ", sub(")$", ", silent = TRUE)", cmd.form)
, ")")))
if (!is.null(tuned.form)) {
tmp <- tuned.form$results
tmp$TSS <- tmp$Sens + tmp$Spec - 1
formu <- tuned.form$coefnames
formu <- paste0(bm.format@sp.name, " ~ 1 + ", paste0(formu, collapse = " + "))
return(data.frame(tmp, type = typ, interaction.level = intlev, formula = formu))
}
}
}
argstmp$formula <- TMP[which.max(TMP[, metric.eval]), "formula"]
if (model %in% c("GBM","GAM","MARS","RF","ANN")){argstmp$formula <- formula(argstmp$formula)}
} else {
if (model %in% c("CTA","GAM","FDA","GBM","GLM")){
argstmp$formula <- bm_MakeFormula(resp.name = bm.format@sp.name
, expl.var = myExpl
, type = 'simple'
, interaction.level = 0)
}
}

## run variable selection -----------------------------------------------------------------
Expand Down Expand Up @@ -605,6 +669,12 @@ bm_Tuning <- function(model,
if (model == "CTA") tuning.length <- 30
if (model == "RF") tuning.length <- min(30, ncol(bm.format@data.env.var))

## Do formula ---------------------------------------------------------------
if (model %in% c("MAXENT","MAXNET","SRE","XGBOOST")& do.formula == TRUE){
do.formula <- FALSE
cat("\n No optimization of formula for", model)
}

## get criteria -------------------------------------------------------------
if (do.stepAIC && (model == "GLM" ||
(model == "GAM" && bm.options@package == "gam"))) {
Expand All @@ -617,6 +687,7 @@ bm_Tuning <- function(model,
}

return(list(weights = weights
, do.formula = do.formula
, criteria.AIC = criteria.AIC
, tuning.fun = tuning.fun
, train.params = train.params
Expand Down

0 comments on commit f4367c0

Please sign in to comment.