R/terga2.R
In predomics/predomicspkg: Interpretable Prediction in Omics Data
Defines functions
terga2_fit
terga2
Documented in
terga2
terga2_fit
################################################################
# _____ _ ____ _ #
# |_ _| | | / __ \ (_) #
# | | _ __ | |_ ___ __ _ _ __| | | |_ __ ___ _ ___ ___ #
# | | | '_ \| __/ _ \/ _` | '__| | | | '_ ` _ \| |/ __/ __| #
# | |_| | | | || __| (_| | | | |__| | | | | | | | (__\__ \ #
# |_____|_| |_|\__\___|\__, |_| \____/|_| |_| |_|_|\___|___/ #
# __/ | #
# |___/ #
################################################################
################################################################
# @script: terga2.R
# @author: Edi Prifti
# @author: Lucas Robin
# @date: August 2016
################################################################
#' Model search algorithm based on genetic algorithms (GA).
#' @description TerGA is a model search algorithm based on genetic algorithms (GA).
#' An “individual” (i.e. genome) in this context is a combination of features that
#' will be associated together using a selected "language" to compute a score that
#' will constitute the prediction model. Depending on the type of fitting (i.e. evaluation)
#' function that is maximized, the fatures are weighed by specific coefficients.
#' In short the algorithm is based on different operations such as crossing, mutating
#' and evolving different “individuals” and evaluating their fitness to the “environment”
#' which is represented by the variable to be predicted.
#' @param sparsity: number of features in a given model (default:1:10).
#' This is a vector with the model-size range (number of features used by a model).
#' @param language is the language that is used by the different algorithms
#' {bin, bininter, ter, terinter}, (default:"terinter")
#' @param objective: This is the task that is to be learned and can be either classification
#' (auc) or can be a regression (cor) (default:auc).
#' @param evalToFit: The model performance attribute to use as fitting score (default:"accuracy_").
#' Other choices are c("accuracy_", "auc_", "precision_","recall_","f_score_") for the
#' classification task. It can be either rho, rho-squared or minimizing the
#' standar error of the regression for the regression task.
#' @param k_penalty: Model-size penalization effect applied on the fit scpre (default: 0).
#' @param estimate_coefs: _deprecated_ A particular option for the regression mode
#' with the aic objective (default:FALSE)
#' @param max.nb.features: If this number is smaller than the number of variables in the
#' dataset, the max.nb.features most significant features will be selected and the
#' dataset will be restricted (default:1000).
#' @param size_pop: the number of individuals in a population to be evolved (default:100)
#' @param size_pop_random the number of individuals initialized randomly. This is used
#' by the metal algorithm (i.e. aggregator method).
#' @param final.pop.perc: What percentage of the final population should be returned (default:100)
#' @param in_pop: a specific population of models that can be evolved. This is particulary
#' useful for the metal algorithm
#' @param popSourceFile: It is possible to load a population of models that has been
#' already learned before. With this option we can specify such file (default:NULL).
#' @param popSaveFile: Once the population of models evolved, we can store it in
#' another file (default:NULL).
#' @param scoreFormula: a Function that contains the ratio Formula or other specific ones
#' @param epsilon: a very small value to be used with the ratio language
#' (useCustomLanguage) (default: NULL). When null it is going to be calculated by the
#' minimum value of X divided by 10.
#' @param individual_vec: The function that is used to generate an individual
#' (default:individual_vec_v2).
#' @param randomSigns: When generating an individual composed of a set of features, we
#' can set the coefficients of the variables from -1 or 1 randomly (default:FALSE).
#' @param unique_vars: When performing operations on multiple individuals it can be
#' that in an individual we have multiple time the same feature. If set to TRUE this
#' individual will be destroyed (default:FALSE)
#' @param select_perc: The percentage of the population to be selected for crossing/mutation
#' (default:50)
#' @param selector: During the selection process, the parent population can be
#' selected using different strategies. For instance the default process is performed
#' using both elite and random selection (default:list(selector_v1, selector_v2)).
#' @param select_percByMethod: A list contaning the percentage of individuals that
#' each of the methods specified in selector should get.
#' @param cross: A swithch, which activates the crossing operator (default:TRUE).
#' @param crosser: The method that should be applied to cross individuals
#' together (default:crossingIndividual_v4).
#' @param mutate: A swithch, which activates the mutation operator (default:TRUE).
#' @param mutate_size: The percentage of individuals in the population to be mutated (default:70).
#' @param mutate_rate: The percentage of features in an individual to be mutated (default:50).
#' @param mutator: The method that should be applied to mutate individuals (default:mutator_v2).
#' The operations can be, deletion, insertion or changing the coeffiecient (from -1 to 1
#' and vice-versa).
#' @param evolver: The method that will be used to evolve the individuals together.
#' This is the core of the algorithm and can be one of different implementations
#' c("v1", "v2", "v3","v4") where the default one is "v4".
#' @param nb_generations: The maximum number of generations to evolve the population.
#' @param convergence: A switch which activates the automatic convergence of the algorithm
#' when the best individual is not improving (default:TRUE).
#' @param convergence_steps: The number of generations after which we consider
#' convergence (default:10).
#' @param evolve_k1: Whether or not to evaluate exhaustively the features for
#' model size = 1. This will take a lot of time if the dataset is large, thus the
#' possibility to evolve this using the GA is interesting. (default:TRUE)
#' @param plot: Plot graphics indicating the evolution of the simulation (default:FALSE)
#' @param verbose: Print out information on the progress of the algorithm (default:FALSE).
#' @param warnings: Print out warnings when runnig (default:FALSE).
#' @param debug: Print out detailed information on the progress of the algorithm
#' (default:FALSE)
#' @param print_ind_method: One of c("short","graphical") indicates how to print
#' a model and subsequently a population during the run (default:"short").
#' @param parallelize.folds: parallelize folds when cross-validating (default:TRUE).
#' @param nCores: The number of cores to execute the program. If nCores = 1 than
#' the program runs in a non parallel mode
#' @param seed: The seed to be used for reproductibility. If seed=NULL than it is
#' not taken into account (default:NULL).
#' @param maxTime: We can use a time limit to evolve a population (default:Inf).
#' @param experiment.id: The id of the experiment that is to be used in the plots
#' and comparitive analyses (default is the learner's name, when not specified)
#' @param experiment.description: A longer description of the experiment. This is
#' important when many experiments are run and can also be printed in by the
#' printExperiment function.
#' @param experiment.save: Data from an experiment can be saved with different
#' levels of completness, with options to be selected from
#' c("nothing", "minimal", "full"), default is "minimal"
#' @return an object of the classifier class, containing a list of parameters
#' @export
terga2 <- function(sparsity = c(1:10), max.nb.features = 1000,
# language in {bin, bininter, ter, terinter, ratio}
language = "terinter",
# evaluation options
objective = "auc", evalToFit = "accuracy_", k_penalty = 0, estimate_coefs = FALSE,
# ratio formula (or other future specific)
scoreFormula = scoreRatio, epsilon = "NULL",
# population options
size_pop = 100, size_pop_random = size_pop, final.pop.perc = 100,
in_pop = "NULL", popSourceFile = "NULL", popSaveFile = "NULL",
# individual options
individual_vec = individual_vec_v2, randomSigns = FALSE, unique_vars = FALSE,
# selection options
select_perc = 25, selector = list(selector_v1, selector_v2), select_percByMethod = list(50, 50),
# crossing options
cross = TRUE, crosser = crossingIndividual_v3,
# mutation options
mutate = TRUE, mutate_size = 75, mutate_rate = 50, mutator = mutator_v2,
# evoluion options
evolver = "v2m", nb_generations = 100, convergence = TRUE, convergence_steps = 10, evolve_k1 = TRUE,
# output options
plot = FALSE, verbose = FALSE, warnings = FALSE, debug = FALSE, print_ind_method = "short", parallelize.folds = TRUE,
# computing options
nCores = 4, seed = "NULL", maxTime = Inf,
# experiment options
experiment.id = "NULL", experiment.description = "NULL", experiment.save = "nothing")
{
# some paramters need to be added to the description
clf <- list() # create a classifier object
clf$learner <- "terga2" # name of the method
clf$params <- list() # parameter list
clf$experiment <- list() # information about the experiment
# POPULATION
clf$params$sparsity <- sparsity # number of non zero variables in the model
clf$params$sparsity.min <- min(sparsity)
clf$params$sparsity.max <- max(sparsity)
clf$params$sparsity.mean <- mean(sparsity)
clf$params$current_sparsity <- NA # number of non zero variables in the model
# Feature space information
clf$params$max.nb.features <- max.nb.features
clf$params$size_world <- "NULL" # total number of variables
clf$params$unique_vars <- unique_vars # weather in a model we can have one variable more than once
clf$params$testAllSigns <- FALSE # _deprecated_
clf$params$randomSigns <- randomSigns
# FITTING
clf$params$objective <- objective # prediction (roc) or regression (cor)
clf$params$estimate_coefs <- estimate_coefs # integer or real estimated coefficients.
clf$params$language <- language
clf$params$evalToFit <- evalToFit
clf$params$k_penalty <- k_penalty
clf$params$epsilon <- epsilon
clf$params$scoreFormula <- scoreFormula
clf$params$intercept <- "NULL"
# POPULATION
clf$functions$individual_vec <- individual_vec # The function that will be used to make individuals
clf$params$in_pop <- in_pop
clf$params$popSourceFile <- popSourceFile
clf$params$popSaveFile <- popSaveFile
clf$params$size_pop <- size_pop # how many models in the population to evolve
clf$params$size_pop_random <- size_pop_random
clf$params$final.pop.perc <- final.pop.perc
# SELECTION
clf$functions$selector <- selector # il faudra vérifier que cette liste est de la même longueur que select_ByMethod
clf$params$select_perc <- select_perc # the percentage of the population to be selected
clf$params$select_percByMethod<- select_percByMethod # how much each selector should select
if(length(selector) != length(clf$params$select_percByMethod))
{
stop("terga2: please verify that select_percByMethod is a list indicating a percentage for each selector function provided")
}
if(sum(unlist(clf$params$select_percByMethod)) != 100)
{
stop("terga2: please verify that select_percByMethod is a list containing percentages whose sum should be 100 percent")
}
# CROSSING
clf$params$cross <- cross # do we activate the crossing process
clf$functions$crosser <- crosser # The function that will be applied to cross
# MUTATION
clf$params$mutate <- mutate # do we activate the mutation process
clf$params$mutate_size <- mutate_size # what percentage of models in the population are mutated
clf$params$mutate_rate <- mutate_rate # what percentage of the variables in the model are mutated
clf$functions$mutator <- mutator # The function that will be applied
# CONVERGENCE
clf$params$evolver <- evolver # The method be used during the evolution process
# TODO make this a function as for the rest
clf$params$nb_generations <- nb_generations # number of generation to evolve
clf$params$convergence <- convergence # what should the simulation stop when convergence ?
# TODO this needs to be tested
clf$params$convergence_steps <- convergence_steps # after how many steps without improvement do we consider convergence?
clf$params$evolve_k1 <- evolve_k1 # weather to evolve models with k_1 or to search them exhaustively.
# print out intermediary results
clf$params$plot <- plot # plot results?
clf$params$verbose <- verbose # print out logs.
clf$params$warnings <- warnings # print out warnings
clf$params$debug <- debug # print out logs.
clf$params$print_ind_method <- print_ind_method # method to print individual
# Computing options
clf$params$nCores <- nCores # parallel computing
clf$params$parallel <- nCores > 1 # parallel computing
clf$params$parallelize_folds <- parallelize.folds
clf$params$parallel.local <- FALSE
clf$params$seed <- seed # fix the seed to be able to reproduce results
clf$params$maxTime <- maxTime
# Experiment information
if(!(experiment.id=="NULL"))
{
clf$experiment$id <- experiment.id
}else
{
clf$experiment$id <- clf$learner
}
if(!(experiment.description=="NULL"))
{
clf$experiment$description <- experiment.description
} else
{
clf$experiment$description <- paste(clf$learner, date() , sep = " ")
}
#match.arg(experiment.save)
clf$experiment$save <- experiment.save
# set the class
class(clf) <- c("classifier", "predomics")
return(clf)
}
#######################################################
## New Version of the terga_fit function : ##
#######################################################
#' Fit a Model Using an Evolutionary Algorithm with Controlled Parameters
#'
#' This function fits a model to the data using an evolutionary algorithm,
#' allowing for controlled sparsity, fitness evaluation, and multiple evolution
#' strategies. The function iteratively evolves a population of models,
#' optimizing for accuracy or correlation, and terminates based on specified
#' conditions.
#'
#' @param X A matrix or data frame of feature values, where each row represents
#' a feature and each column represents a sample.
#' @param y A response vector or target variable for supervised learning. The
#' length of \code{y} should match the number of columns in \code{X}.
#' @param clf A classifier object containing parameters for fitting, including:
#' - `params`: A list of parameters for fitting, such as `language`, `objective`, `evalToFit`, `sparsity`, `size_pop`, `nb_generations`, `maxTime`, and `evolver`.
#' - `feature.cor`: A matrix of feature correlations for pre-selection of features based on correlation.
#' - `functions`: A list of functions to be used within the fitting process, such as `evolve`, `mutate`, and `cross`.
#'
#' @details The function performs the following steps:
#'
#' 1. **Parameter Initialization**: Sets parameters based on the specified
#' `language` and adjusts `evalToFit` based on the `objective`. 2. **Feature
#' Pre-selection**: Optionally restricts `X` to the most significant features
#' based on `clf$feature.cor` if `max.nb.features` is specified. 3. **Population
#' Initialization**: Initializes a population of models based on `in_pop` (if
#' available) or generates a new population with random individuals. 4.
#' **Evolutionary Process**:
#' - Iteratively evolves the population over generations, evaluating and ranking individuals by fitness.
#' - Applies selection, crossover, and mutation strategies to generate new models.
#' - Stores the best models by sparsity level for each generation.
#' 5. **Termination**: Stops when the maximum number of generations or specified
#' execution time (`maxTime`) is reached.
#'
#' The function returns a collection of the best models, sorted by fitness, and
#' allows for plotting evolution if `plot` is set to `TRUE`.
#'
#' @return A list representing a model collection of the best individuals from
#' the final population, each evaluated by fitness and sparsity level.
#'
#' @examples
#' \dontrun{
#' X <- matrix(rnorm(1000), nrow = 10) # Random features
#' y <- sample(c(0, 1), 100, replace = TRUE) # Random binary response
#' clf <- list(
#' params = list(language = "bin", objective = "accuracy", evalToFit = "accuracy_", size_pop = 20,
#' nb_generations = 50, maxTime = 3600, evolver = "v2m"),
#' feature.cor = data.frame(p = runif(10)),
#' functions = list(evolver = evolve2m)
#' )
#' best_models <- terga2_fit(X, y, clf)
#' print(best_models)
#' }
#'
#' @export
terga2_fit <- function(X, y, clf)
{
startingTime <- Sys.time()
# NOTE: for speed and simplicty purposes we decided to use accuracy_ as the
# variable to fit the models. We noticed that when you optimize with auc_ the
# best models are not necessarely the best in accuracy. We hypothesize that
# when optimizing in accuracy the models will be rather good also in auc_
# based on how the intercept evaluation is performed is very similar to AUC.
# For ter and bin languages the threshold will be set to zero.
switch(clf$params$language,
ter=
{
# ternary language without intercept (maximize the accuracy)
if(clf$params$verbose){cat("... ... Setting environment for the language 'ter'\n")}
if(clf$params$objective == "cor")
{
clf$params$evalToFit <- "cor_"
}else
{
# note that here with the ter language we could not use auc to fit since the intercept should be 0
clf$params$intercept = 0
if(clf$params$evalToFit == "auc_")
{
clf$params$evalToFit <- "accuracy_"
if(clf$params$warnings) warning("terga1_fit: changing evalToFit from auc_ to accuracy_ because of the language.")
}
}
},
terinter=
{
# ternary language without intercept (maximize the auc)
if(clf$params$verbose){cat("... ... Setting environment for the language 'terinter'\n")}
if(clf$params$objective == "cor")
{
clf$params$evalToFit <- "cor_"
}
},
bin=
{
# ternary language without intercept (maximize the accuracy)
if(clf$params$verbose){cat("... ... Setting environment for the language 'bin'\n")}
if(clf$params$objective == "cor")
{
clf$params$evalToFit <- "cor_"
}else
{
# note that here with the ter language we could not use auc to fit since the intercept should be 0
clf$params$intercept = 0
if(clf$params$evalToFit == "auc_")
{
clf$params$evalToFit <- "accuracy_"
if(clf$params$warnings) warning("terga1_fit: changing evalToFit from auc_ to accuracy_ because of the language.")
}
}
},
bininter=
{
# ternary language without intercept (maximize the auc)
if(clf$params$verbose){cat("... ... Setting environment for the language 'bininter'\n")}
if(clf$params$objective == "cor")
{
clf$params$evalToFit <- "cor_"
}
},
ratio=
{
# ternary language without intercept (maximize the auc)
if(clf$params$verbose){cat("... ... Setting environment for the language 'ratio'\n")}
if(clf$params$objective == "cor")
{
clf$params$evalToFit <- "cor_"
}
},
{
stop(paste("The language",clf$params$language, "is not implemented !"))
}
)
if(clf$params$verbose) print(paste("... ... parameters are checked and set"))
if(clf$params$max.nb.features < nrow(X))
{
if(clf$params$verbose) print(paste("... ... restricting X to the",clf$params$max.nb.features,"most significant variables"))
selected.features <- rownames(clf$feature.cor[order(clf$feature.cor$p),][1:min(clf$params$max.nb.features, nrow(X)),])
X <- X[selected.features,]
clf$coeffs_ <- clf$coeffs_[selected.features]
clf$feature.cor <- clf$feature.cor[selected.features,]
}
# set the size of the world
clf$params$size_world <- nrow(X)
# Print the experiment configuration
if(clf$params$verbose) printClassifier(obj = clf)
featEval <-rep(NA, length(rownames(X)))
names(featEval) <- rownames(X)
# parallel switch
if(clf$params$parallel)
{
parfold <- TRUE
}else
{
parfold <- FALSE
}
if(isPopulation(clf$params$in_pop))
{
# starting population
pop <- clf$params$in_pop
if(clf$params$verbose) cat(paste("... ... using seeding population",length(pop),"\n"))
}else
{
# otherwise start fresh
pop <- population2(X, y, clf, featEval) # We generate randomly a first population
if(clf$params$verbose) cat(paste("... ... using generated population",length(pop),"\n"))
}
if(clf$params$debug)
{
print(paste("population:", length(pop)))
}
# it may happen that the population is empty, in this case return NULL
if(is.null(pop))
{
return(NULL)
}
if(clf$params$debug)
{
v <- populationGet_X(element2get = "fit_", toVec = TRUE, na.rm = TRUE)(pop)
summary(v)
}
featEval <- rankFeatures(X, y, clf, pop, featEval)
stop <- FALSE # En utilisant une variable pour la condition d'arrêt on peut calculer l'arrêt du fit
# via une fonction qui elle même pourra être un paramêtre donné dans le clf
generation <- 0
doWeStopHere <- function(X, y, clf, pop, generation, startingTime) #{ifelse(generation == clf$params$nb_generations, TRUE, FALSE)}
{
if(is.finite(clf$params$maxTime))
{
execTime <- Sys.time() - startingTime
print(execTime)
if(execTime > clf$params$maxTime)
return(TRUE)
return(FALSE)
} else
{
ifelse(generation == clf$params$nb_generations, TRUE, FALSE)
}
}
# initiate variables
trace_evolution <- list()
evaluation <- c()
while(!stop)
{
if(clf$params$verbose)
{
print(paste("Generation", generation))
}else
{
# print a heartbeat
cat(".")
}
pop <- cleanPopulation(pop, clf)
if(clf$params$debug)
{
print(paste("population after clean:", length(pop)))
}
pop <- evaluatePopulation(X, y, clf, pop, force.re.evaluation = TRUE, eval.all = FALSE)
# Let's keep the best models of each sparsity in a buffer structured as modelCollection
pop2keep.mc <- listOfModels2ModelCollection(pop = pop, nBest = 5)
# keep valid populations and omit those in the mc that are no ok
valid.pops <- unlist(lapply(pop2keep.mc, isPopulation))
if(any(!valid.pops))
{
pop2keep.mc <-pop2keep.mc[valid.pops]
}
# restrain if bigger than the given size but by keeping the best for each sparsity
# sometimes the best models will be in high sparsity setting
if(length(pop) > clf$params$size_pop)
{
nBest <- round(length(pop)/length(clf$params$sparsity))
pop.restrict <- listOfModels2ModelCollection(pop = pop, nBest = nBest)
pop <- modelCollectionToPopulation(pop.restrict)
}
# print the best for each sparsity
if(clf$params$verbose)
{
print("Best individuals kept for the next generation :")
lapply(pop2keep.mc, function(x)
{
if(!is.null(x))
{
try(cat("\t", printModel(mod = x[[1]], method = clf$params$print_ind_method, score = "fit_"), "\n"), silent = TRUE)
} else
{
cat("No individual found for this sparsity")
}
})
spar <- populationGet_X(element2get = "eval.sparsity", toVec = TRUE, na.rm = TRUE)(pop)
print(table(spar))
}
# Evolve methods
switch (clf$params$evolver,
v1 = {pop <- evolve1(X, y, clf, pop, featEval)},
v2m = {pop <- evolve2m(X, y, clf, pop, featEval, generation)},
v3m = {pop <- evolve3m(X, y, clf, pop, featEval)},
{pop <- evolve2m(X, y, clf, pop, featEval)} # default is v2
)
if(clf$params$debug)
{
print(paste("population after evolver:", length(pop)))
}
if(clf$params$evolver %in% list('v2m') && generation == 0)
{
clf$params$size_pop <- round(clf$params$size_pop*3/2)
}
# transform the bugger onto a population
pop2keep <- modelCollectionToPopulation(pop2keep.mc)
# and add it to the evolved pop
#pop[(length(pop) +1):(length(pop) + length(pop2keep))] <- pop2keep
pop <- c(pop, pop2keep)
pop <- unique(pop) # delete dupplicates for efficiency
# sort the population
pop <- sortPopulation(pop, evalToOrder = "fit_")
# DEBUG and trace evolution
best <- pop[[1]]
if(clf$params$debug)
{
printy(best)
}
trace_evolution[[generation+1]] <- best ## A utiliser pour tester la convergence
evaluation <- populationGet_X(element2get = "fit_", toVec = TRUE, na.rm = TRUE)(pop = trace_evolution)
if(clf$params$debug)
{
print(paste("population end generation:", summary(evaluation)))
}
# # to be updated by the app
# if(clf$params$plot)
# {
# plot(evaluation, xlim=c(1,clf$params$nb_generations), type = "b", col = "red", ylim = c(0.5,1), cex = 0.5, pch = 19)
# abline(h = max(table(y)/sum(table(y))), lty=2)
# }
featEval <- rankFeatures(X, y, clf, pop, featEval)
#========> TODO add convergence early stopping and also print out evolution through epochs
# # Test convergence and exit if atteint
# if (clf$params$convergence)
# { # if we are testing convergence
# trace.nona <- trace_evolution[!is.na(trace_evolution)]
# if (length(trace.nona) > clf$params$convergence_steps)
# { # run at least enough steps to test the convergence
# if (convergence.test(x = trace.nona, steps = clf$params$convergence_steps))
# { # if convergence atteint
# break("")
# }
# }
# }
#========> TODO
# #add again the best individuels in case that they are changed
# if(!(length(clf$params$in_pop)==1 && clf$params$in_pop=="NULL"))
# {
# pop_add <- clf$params$in_pop
# pop[(length(pop) +1):(length(pop) + length(pop_add))] <- pop_add
# pop <- unique(pop)
# }
# if(generation == 47)
# {
# print("*********************************HERE*********************************")
# }
# CAUTION: we revaluate the population forcing the score after all the modifications of the indices during crossing, mutation etc...
# clean the population
#pop <- cleanPopulation(pop, clf)
#pop <- evaluatePopulation(X, y, clf, pop, force.re.evaluation = TRUE, eval.all = TRUE)
# if(!(clf$params$popSaveFile=="NULL"))
# {
# savePopulation(pop, paste("generation", generation, clf$params$popSaveFile, sep = "_"))
# }
# increase generation
generation <- generation + 1
stop <- doWeStopHere(X, y, clf, pop, generation, startingTime) # temporary fonction name, this could be latter something like
# clf$params$stopCondition(X, y, clf, pop, generation)
} # end while
# end the heartbeat
if(!clf$params$verbose) cat("\n")
# to be updated by the app
if(clf$params$plot)
{
plot(evaluation, xlim=c(1,clf$params$nb_generations), type = "b", col = "red", ylim = c(0.5,1), cex = 0.5, pch = 19)
abline(h = max(table(y)/sum(table(y))), lty=2)
}
# We revaluate the population preparing for final result
# clean the population
pop <- cleanPopulation(pop, clf)
pop <- evaluatePopulation(X, y, clf, pop, force.re.evaluation = TRUE, eval.all = TRUE)
pop <- unique(pop) # keep only unique models
# At the end we revaluate the population forcing the scores and everything else
# pop <- evaluatePopulation(X, y, clf, pop, force.re.evaluation = TRUE, eval.all = FALSE)
if(clf$params$final.pop.perc == 100)
{
res <- listOfModels2ModelCollection(pop)
} else
{
res <- listOfModels2ModelCollection(pop, nBest = 10)
}
if(clf$params$verbose) print(paste("... ... models are coverted onto a model collection"))
return(res)
}
predomics/predomicspkg documentation built on Dec. 11, 2024, 11:06 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions terga2_fit terga2
Documented in terga2 terga2_fit
################################################################
# _____ _ ____ _ #
# |_ _| | | / __ \ (_) #
# | | _ __ | |_ ___ __ _ _ __| | | |_ __ ___ _ ___ ___ #
# | | | '_ \| __/ _ \/ _` | '__| | | | '_ ` _ \| |/ __/ __| #
# | |_| | | | || __| (_| | | | |__| | | | | | | | (__\__ \ #
# |_____|_| |_|\__\___|\__, |_| \____/|_| |_| |_|_|\___|___/ #
# __/ | #
# |___/ #
################################################################
################################################################
# @script: terga2.R
# @author: Edi Prifti
# @author: Lucas Robin
# @date: August 2016
################################################################
#' Model search algorithm based on genetic algorithms (GA).
#' @description TerGA is a model search algorithm based on genetic algorithms (GA).
#' An “individual” (i.e. genome) in this context is a combination of features that
#' will be associated together using a selected "language" to compute a score that
#' will constitute the prediction model. Depending on the type of fitting (i.e. evaluation)
#' function that is maximized, the fatures are weighed by specific coefficients.
#' In short the algorithm is based on different operations such as crossing, mutating
#' and evolving different “individuals” and evaluating their fitness to the “environment”
#' which is represented by the variable to be predicted.
#' @param sparsity: number of features in a given model (default:1:10).
#' This is a vector with the model-size range (number of features used by a model).
#' @param language is the language that is used by the different algorithms
#' {bin, bininter, ter, terinter}, (default:"terinter")
#' @param objective: This is the task that is to be learned and can be either classification
#' (auc) or can be a regression (cor) (default:auc).
#' @param evalToFit: The model performance attribute to use as fitting score (default:"accuracy_").
#' Other choices are c("accuracy_", "auc_", "precision_","recall_","f_score_") for the
#' classification task. It can be either rho, rho-squared or minimizing the
#' standar error of the regression for the regression task.
#' @param k_penalty: Model-size penalization effect applied on the fit scpre (default: 0).
#' @param estimate_coefs: _deprecated_ A particular option for the regression mode
#' with the aic objective (default:FALSE)
#' @param max.nb.features: If this number is smaller than the number of variables in the
#' dataset, the max.nb.features most significant features will be selected and the
#' dataset will be restricted (default:1000).
#' @param size_pop: the number of individuals in a population to be evolved (default:100)
#' @param size_pop_random the number of individuals initialized randomly. This is used
#' by the metal algorithm (i.e. aggregator method).
#' @param final.pop.perc: What percentage of the final population should be returned (default:100)
#' @param in_pop: a specific population of models that can be evolved. This is particulary
#' useful for the metal algorithm
#' @param popSourceFile: It is possible to load a population of models that has been
#' already learned before. With this option we can specify such file (default:NULL).
#' @param popSaveFile: Once the population of models evolved, we can store it in
#' another file (default:NULL).
#' @param scoreFormula: a Function that contains the ratio Formula or other specific ones
#' @param epsilon: a very small value to be used with the ratio language
#' (useCustomLanguage) (default: NULL). When null it is going to be calculated by the
#' minimum value of X divided by 10.
#' @param individual_vec: The function that is used to generate an individual
#' (default:individual_vec_v2).
#' @param randomSigns: When generating an individual composed of a set of features, we
#' can set the coefficients of the variables from -1 or 1 randomly (default:FALSE).
#' @param unique_vars: When performing operations on multiple individuals it can be
#' that in an individual we have multiple time the same feature. If set to TRUE this
#' individual will be destroyed (default:FALSE)
#' @param select_perc: The percentage of the population to be selected for crossing/mutation
#' (default:50)
#' @param selector: During the selection process, the parent population can be
#' selected using different strategies. For instance the default process is performed
#' using both elite and random selection (default:list(selector_v1, selector_v2)).
#' @param select_percByMethod: A list contaning the percentage of individuals that
#' each of the methods specified in selector should get.
#' @param cross: A swithch, which activates the crossing operator (default:TRUE).
#' @param crosser: The method that should be applied to cross individuals
#' together (default:crossingIndividual_v4).
#' @param mutate: A swithch, which activates the mutation operator (default:TRUE).
#' @param mutate_size: The percentage of individuals in the population to be mutated (default:70).
#' @param mutate_rate: The percentage of features in an individual to be mutated (default:50).
#' @param mutator: The method that should be applied to mutate individuals (default:mutator_v2).
#' The operations can be, deletion, insertion or changing the coeffiecient (from -1 to 1
#' and vice-versa).
#' @param evolver: The method that will be used to evolve the individuals together.
#' This is the core of the algorithm and can be one of different implementations
#' c("v1", "v2", "v3","v4") where the default one is "v4".
#' @param nb_generations: The maximum number of generations to evolve the population.
#' @param convergence: A switch which activates the automatic convergence of the algorithm
#' when the best individual is not improving (default:TRUE).
#' @param convergence_steps: The number of generations after which we consider
#' convergence (default:10).
#' @param evolve_k1: Whether or not to evaluate exhaustively the features for
#' model size = 1. This will take a lot of time if the dataset is large, thus the
#' possibility to evolve this using the GA is interesting. (default:TRUE)
#' @param plot: Plot graphics indicating the evolution of the simulation (default:FALSE)
#' @param verbose: Print out information on the progress of the algorithm (default:FALSE).
#' @param warnings: Print out warnings when runnig (default:FALSE).
#' @param debug: Print out detailed information on the progress of the algorithm
#' (default:FALSE)
#' @param print_ind_method: One of c("short","graphical") indicates how to print
#' a model and subsequently a population during the run (default:"short").
#' @param parallelize.folds: parallelize folds when cross-validating (default:TRUE).
#' @param nCores: The number of cores to execute the program. If nCores = 1 than
#' the program runs in a non parallel mode
#' @param seed: The seed to be used for reproductibility. If seed=NULL than it is
#' not taken into account (default:NULL).
#' @param maxTime: We can use a time limit to evolve a population (default:Inf).
#' @param experiment.id: The id of the experiment that is to be used in the plots
#' and comparitive analyses (default is the learner's name, when not specified)
#' @param experiment.description: A longer description of the experiment. This is
#' important when many experiments are run and can also be printed in by the
#' printExperiment function.
#' @param experiment.save: Data from an experiment can be saved with different
#' levels of completness, with options to be selected from
#' c("nothing", "minimal", "full"), default is "minimal"
#' @return an object of the classifier class, containing a list of parameters
#' @export
terga2 <- function(sparsity = c(1:10), max.nb.features = 1000,
# language in {bin, bininter, ter, terinter, ratio}
language = "terinter",
# evaluation options
objective = "auc", evalToFit = "accuracy_", k_penalty = 0, estimate_coefs = FALSE,
# ratio formula (or other future specific)
scoreFormula = scoreRatio, epsilon = "NULL",
# population options
size_pop = 100, size_pop_random = size_pop, final.pop.perc = 100,
in_pop = "NULL", popSourceFile = "NULL", popSaveFile = "NULL",
# individual options
individual_vec = individual_vec_v2, randomSigns = FALSE, unique_vars = FALSE,
# selection options
select_perc = 25, selector = list(selector_v1, selector_v2), select_percByMethod = list(50, 50),
# crossing options
cross = TRUE, crosser = crossingIndividual_v3,
# mutation options
mutate = TRUE, mutate_size = 75, mutate_rate = 50, mutator = mutator_v2,
# evoluion options
evolver = "v2m", nb_generations = 100, convergence = TRUE, convergence_steps = 10, evolve_k1 = TRUE,
# output options
plot = FALSE, verbose = FALSE, warnings = FALSE, debug = FALSE, print_ind_method = "short", parallelize.folds = TRUE,
# computing options
nCores = 4, seed = "NULL", maxTime = Inf,
# experiment options
experiment.id = "NULL", experiment.description = "NULL", experiment.save = "nothing")
{
# some paramters need to be added to the description
clf <- list() # create a classifier object
clf$learner <- "terga2" # name of the method
clf$params <- list() # parameter list
clf$experiment <- list() # information about the experiment
# POPULATION
clf$params$sparsity <- sparsity # number of non zero variables in the model
clf$params$sparsity.min <- min(sparsity)
clf$params$sparsity.max <- max(sparsity)
clf$params$sparsity.mean <- mean(sparsity)
clf$params$current_sparsity <- NA # number of non zero variables in the model
# Feature space information
clf$params$max.nb.features <- max.nb.features
clf$params$size_world <- "NULL" # total number of variables
clf$params$unique_vars <- unique_vars # weather in a model we can have one variable more than once
clf$params$testAllSigns <- FALSE # _deprecated_
clf$params$randomSigns <- randomSigns
# FITTING
clf$params$objective <- objective # prediction (roc) or regression (cor)
clf$params$estimate_coefs <- estimate_coefs # integer or real estimated coefficients.
clf$params$language <- language
clf$params$evalToFit <- evalToFit
clf$params$k_penalty <- k_penalty
clf$params$epsilon <- epsilon
clf$params$scoreFormula <- scoreFormula
clf$params$intercept <- "NULL"
# POPULATION
clf$functions$individual_vec <- individual_vec # The function that will be used to make individuals
clf$params$in_pop <- in_pop
clf$params$popSourceFile <- popSourceFile
clf$params$popSaveFile <- popSaveFile
clf$params$size_pop <- size_pop # how many models in the population to evolve
clf$params$size_pop_random <- size_pop_random
clf$params$final.pop.perc <- final.pop.perc
# SELECTION
clf$functions$selector <- selector # il faudra vérifier que cette liste est de la même longueur que select_ByMethod
clf$params$select_perc <- select_perc # the percentage of the population to be selected
clf$params$select_percByMethod<- select_percByMethod # how much each selector should select
if(length(selector) != length(clf$params$select_percByMethod))
{
stop("terga2: please verify that select_percByMethod is a list indicating a percentage for each selector function provided")
}
if(sum(unlist(clf$params$select_percByMethod)) != 100)
{
stop("terga2: please verify that select_percByMethod is a list containing percentages whose sum should be 100 percent")
}
# CROSSING
clf$params$cross <- cross # do we activate the crossing process
clf$functions$crosser <- crosser # The function that will be applied to cross
# MUTATION
clf$params$mutate <- mutate # do we activate the mutation process
clf$params$mutate_size <- mutate_size # what percentage of models in the population are mutated
clf$params$mutate_rate <- mutate_rate # what percentage of the variables in the model are mutated
clf$functions$mutator <- mutator # The function that will be applied
# CONVERGENCE
clf$params$evolver <- evolver # The method be used during the evolution process
# TODO make this a function as for the rest
clf$params$nb_generations <- nb_generations # number of generation to evolve
clf$params$convergence <- convergence # what should the simulation stop when convergence ?
# TODO this needs to be tested
clf$params$convergence_steps <- convergence_steps # after how many steps without improvement do we consider convergence?
clf$params$evolve_k1 <- evolve_k1 # weather to evolve models with k_1 or to search them exhaustively.
# print out intermediary results
clf$params$plot <- plot # plot results?
clf$params$verbose <- verbose # print out logs.
clf$params$warnings <- warnings # print out warnings
clf$params$debug <- debug # print out logs.
clf$params$print_ind_method <- print_ind_method # method to print individual
# Computing options
clf$params$nCores <- nCores # parallel computing
clf$params$parallel <- nCores > 1 # parallel computing
clf$params$parallelize_folds <- parallelize.folds
clf$params$parallel.local <- FALSE
clf$params$seed <- seed # fix the seed to be able to reproduce results
clf$params$maxTime <- maxTime
# Experiment information
if(!(experiment.id=="NULL"))
{
clf$experiment$id <- experiment.id
}else
{
clf$experiment$id <- clf$learner
}
if(!(experiment.description=="NULL"))
{
clf$experiment$description <- experiment.description
} else
{
clf$experiment$description <- paste(clf$learner, date() , sep = " ")
}
#match.arg(experiment.save)
clf$experiment$save <- experiment.save
# set the class
class(clf) <- c("classifier", "predomics")
return(clf)
}
#######################################################
## New Version of the terga_fit function : ##
#######################################################
#' Fit a Model Using an Evolutionary Algorithm with Controlled Parameters
#'
#' This function fits a model to the data using an evolutionary algorithm,
#' allowing for controlled sparsity, fitness evaluation, and multiple evolution
#' strategies. The function iteratively evolves a population of models,
#' optimizing for accuracy or correlation, and terminates based on specified
#' conditions.
#'
#' @param X A matrix or data frame of feature values, where each row represents
#' a feature and each column represents a sample.
#' @param y A response vector or target variable for supervised learning. The
#' length of \code{y} should match the number of columns in \code{X}.
#' @param clf A classifier object containing parameters for fitting, including:
#' - `params`: A list of parameters for fitting, such as `language`, `objective`, `evalToFit`, `sparsity`, `size_pop`, `nb_generations`, `maxTime`, and `evolver`.
#' - `feature.cor`: A matrix of feature correlations for pre-selection of features based on correlation.
#' - `functions`: A list of functions to be used within the fitting process, such as `evolve`, `mutate`, and `cross`.
#'
#' @details The function performs the following steps:
#'
#' 1. **Parameter Initialization**: Sets parameters based on the specified
#' `language` and adjusts `evalToFit` based on the `objective`. 2. **Feature
#' Pre-selection**: Optionally restricts `X` to the most significant features
#' based on `clf$feature.cor` if `max.nb.features` is specified. 3. **Population
#' Initialization**: Initializes a population of models based on `in_pop` (if
#' available) or generates a new population with random individuals. 4.
#' **Evolutionary Process**:
#' - Iteratively evolves the population over generations, evaluating and ranking individuals by fitness.
#' - Applies selection, crossover, and mutation strategies to generate new models.
#' - Stores the best models by sparsity level for each generation.
#' 5. **Termination**: Stops when the maximum number of generations or specified
#' execution time (`maxTime`) is reached.
#'
#' The function returns a collection of the best models, sorted by fitness, and
#' allows for plotting evolution if `plot` is set to `TRUE`.
#'
#' @return A list representing a model collection of the best individuals from
#' the final population, each evaluated by fitness and sparsity level.
#'
#' @examples
#' \dontrun{
#' X <- matrix(rnorm(1000), nrow = 10) # Random features
#' y <- sample(c(0, 1), 100, replace = TRUE) # Random binary response
#' clf <- list(
#' params = list(language = "bin", objective = "accuracy", evalToFit = "accuracy_", size_pop = 20,
#' nb_generations = 50, maxTime = 3600, evolver = "v2m"),
#' feature.cor = data.frame(p = runif(10)),
#' functions = list(evolver = evolve2m)
#' )
#' best_models <- terga2_fit(X, y, clf)
#' print(best_models)
#' }
#'
#' @export
terga2_fit <- function(X, y, clf)
{
startingTime <- Sys.time()
# NOTE: for speed and simplicty purposes we decided to use accuracy_ as the
# variable to fit the models. We noticed that when you optimize with auc_ the
# best models are not necessarely the best in accuracy. We hypothesize that
# when optimizing in accuracy the models will be rather good also in auc_
# based on how the intercept evaluation is performed is very similar to AUC.
# For ter and bin languages the threshold will be set to zero.
switch(clf$params$language,
ter=
{
# ternary language without intercept (maximize the accuracy)
if(clf$params$verbose){cat("... ... Setting environment for the language 'ter'\n")}
if(clf$params$objective == "cor")
{
clf$params$evalToFit <- "cor_"
}else
{
# note that here with the ter language we could not use auc to fit since the intercept should be 0
clf$params$intercept = 0
if(clf$params$evalToFit == "auc_")
{
clf$params$evalToFit <- "accuracy_"
if(clf$params$warnings) warning("terga1_fit: changing evalToFit from auc_ to accuracy_ because of the language.")
}
}
},
terinter=
{
# ternary language without intercept (maximize the auc)
if(clf$params$verbose){cat("... ... Setting environment for the language 'terinter'\n")}
if(clf$params$objective == "cor")
{
clf$params$evalToFit <- "cor_"
}
},
bin=
{
# ternary language without intercept (maximize the accuracy)
if(clf$params$verbose){cat("... ... Setting environment for the language 'bin'\n")}
if(clf$params$objective == "cor")
{
clf$params$evalToFit <- "cor_"
}else
{
# note that here with the ter language we could not use auc to fit since the intercept should be 0
clf$params$intercept = 0
if(clf$params$evalToFit == "auc_")
{
clf$params$evalToFit <- "accuracy_"
if(clf$params$warnings) warning("terga1_fit: changing evalToFit from auc_ to accuracy_ because of the language.")
}
}
},
bininter=
{
# ternary language without intercept (maximize the auc)
if(clf$params$verbose){cat("... ... Setting environment for the language 'bininter'\n")}
if(clf$params$objective == "cor")
{
clf$params$evalToFit <- "cor_"
}
},
ratio=
{
# ternary language without intercept (maximize the auc)
if(clf$params$verbose){cat("... ... Setting environment for the language 'ratio'\n")}
if(clf$params$objective == "cor")
{
clf$params$evalToFit <- "cor_"
}
},
{
stop(paste("The language",clf$params$language, "is not implemented !"))
}
)
if(clf$params$verbose) print(paste("... ... parameters are checked and set"))
if(clf$params$max.nb.features < nrow(X))
{
if(clf$params$verbose) print(paste("... ... restricting X to the",clf$params$max.nb.features,"most significant variables"))
selected.features <- rownames(clf$feature.cor[order(clf$feature.cor$p),][1:min(clf$params$max.nb.features, nrow(X)),])
X <- X[selected.features,]
clf$coeffs_ <- clf$coeffs_[selected.features]
clf$feature.cor <- clf$feature.cor[selected.features,]
}
# set the size of the world
clf$params$size_world <- nrow(X)
# Print the experiment configuration
if(clf$params$verbose) printClassifier(obj = clf)
featEval <-rep(NA, length(rownames(X)))
names(featEval) <- rownames(X)
# parallel switch
if(clf$params$parallel)
{
parfold <- TRUE
}else
{
parfold <- FALSE
}
if(isPopulation(clf$params$in_pop))
{
# starting population
pop <- clf$params$in_pop
if(clf$params$verbose) cat(paste("... ... using seeding population",length(pop),"\n"))
}else
{
# otherwise start fresh
pop <- population2(X, y, clf, featEval) # We generate randomly a first population
if(clf$params$verbose) cat(paste("... ... using generated population",length(pop),"\n"))
}
if(clf$params$debug)
{
print(paste("population:", length(pop)))
}
# it may happen that the population is empty, in this case return NULL
if(is.null(pop))
{
return(NULL)
}
if(clf$params$debug)
{
v <- populationGet_X(element2get = "fit_", toVec = TRUE, na.rm = TRUE)(pop)
summary(v)
}
featEval <- rankFeatures(X, y, clf, pop, featEval)
stop <- FALSE # En utilisant une variable pour la condition d'arrêt on peut calculer l'arrêt du fit
# via une fonction qui elle même pourra être un paramêtre donné dans le clf
generation <- 0
doWeStopHere <- function(X, y, clf, pop, generation, startingTime) #{ifelse(generation == clf$params$nb_generations, TRUE, FALSE)}
{
if(is.finite(clf$params$maxTime))
{
execTime <- Sys.time() - startingTime
print(execTime)
if(execTime > clf$params$maxTime)
return(TRUE)
return(FALSE)
} else
{
ifelse(generation == clf$params$nb_generations, TRUE, FALSE)
}
}
# initiate variables
trace_evolution <- list()
evaluation <- c()
while(!stop)
{
if(clf$params$verbose)
{
print(paste("Generation", generation))
}else
{
# print a heartbeat
cat(".")
}
pop <- cleanPopulation(pop, clf)
if(clf$params$debug)
{
print(paste("population after clean:", length(pop)))
}
pop <- evaluatePopulation(X, y, clf, pop, force.re.evaluation = TRUE, eval.all = FALSE)
# Let's keep the best models of each sparsity in a buffer structured as modelCollection
pop2keep.mc <- listOfModels2ModelCollection(pop = pop, nBest = 5)
# keep valid populations and omit those in the mc that are no ok
valid.pops <- unlist(lapply(pop2keep.mc, isPopulation))
if(any(!valid.pops))
{
pop2keep.mc <-pop2keep.mc[valid.pops]
}
# restrain if bigger than the given size but by keeping the best for each sparsity
# sometimes the best models will be in high sparsity setting
if(length(pop) > clf$params$size_pop)
{
nBest <- round(length(pop)/length(clf$params$sparsity))
pop.restrict <- listOfModels2ModelCollection(pop = pop, nBest = nBest)
pop <- modelCollectionToPopulation(pop.restrict)
}
# print the best for each sparsity
if(clf$params$verbose)
{
print("Best individuals kept for the next generation :")
lapply(pop2keep.mc, function(x)
{
if(!is.null(x))
{
try(cat("\t", printModel(mod = x[[1]], method = clf$params$print_ind_method, score = "fit_"), "\n"), silent = TRUE)
} else
{
cat("No individual found for this sparsity")
}
})
spar <- populationGet_X(element2get = "eval.sparsity", toVec = TRUE, na.rm = TRUE)(pop)
print(table(spar))
}
# Evolve methods
switch (clf$params$evolver,
v1 = {pop <- evolve1(X, y, clf, pop, featEval)},
v2m = {pop <- evolve2m(X, y, clf, pop, featEval, generation)},
v3m = {pop <- evolve3m(X, y, clf, pop, featEval)},
{pop <- evolve2m(X, y, clf, pop, featEval)} # default is v2
)
if(clf$params$debug)
{
print(paste("population after evolver:", length(pop)))
}
if(clf$params$evolver %in% list('v2m') && generation == 0)
{
clf$params$size_pop <- round(clf$params$size_pop*3/2)
}
# transform the bugger onto a population
pop2keep <- modelCollectionToPopulation(pop2keep.mc)
# and add it to the evolved pop
#pop[(length(pop) +1):(length(pop) + length(pop2keep))] <- pop2keep
pop <- c(pop, pop2keep)
pop <- unique(pop) # delete dupplicates for efficiency
# sort the population
pop <- sortPopulation(pop, evalToOrder = "fit_")
# DEBUG and trace evolution
best <- pop[[1]]
if(clf$params$debug)
{
printy(best)
}
trace_evolution[[generation+1]] <- best ## A utiliser pour tester la convergence
evaluation <- populationGet_X(element2get = "fit_", toVec = TRUE, na.rm = TRUE)(pop = trace_evolution)
if(clf$params$debug)
{
print(paste("population end generation:", summary(evaluation)))
}
# # to be updated by the app
# if(clf$params$plot)
# {
# plot(evaluation, xlim=c(1,clf$params$nb_generations), type = "b", col = "red", ylim = c(0.5,1), cex = 0.5, pch = 19)
# abline(h = max(table(y)/sum(table(y))), lty=2)
# }
featEval <- rankFeatures(X, y, clf, pop, featEval)
#========> TODO add convergence early stopping and also print out evolution through epochs
# # Test convergence and exit if atteint
# if (clf$params$convergence)
# { # if we are testing convergence
# trace.nona <- trace_evolution[!is.na(trace_evolution)]
# if (length(trace.nona) > clf$params$convergence_steps)
# { # run at least enough steps to test the convergence
# if (convergence.test(x = trace.nona, steps = clf$params$convergence_steps))
# { # if convergence atteint
# break("")
# }
# }
# }
#========> TODO
# #add again the best individuels in case that they are changed
# if(!(length(clf$params$in_pop)==1 && clf$params$in_pop=="NULL"))
# {
# pop_add <- clf$params$in_pop
# pop[(length(pop) +1):(length(pop) + length(pop_add))] <- pop_add
# pop <- unique(pop)
# }
# if(generation == 47)
# {
# print("*********************************HERE*********************************")
# }
# CAUTION: we revaluate the population forcing the score after all the modifications of the indices during crossing, mutation etc...
# clean the population
#pop <- cleanPopulation(pop, clf)
#pop <- evaluatePopulation(X, y, clf, pop, force.re.evaluation = TRUE, eval.all = TRUE)
# if(!(clf$params$popSaveFile=="NULL"))
# {
# savePopulation(pop, paste("generation", generation, clf$params$popSaveFile, sep = "_"))
# }
# increase generation
generation <- generation + 1
stop <- doWeStopHere(X, y, clf, pop, generation, startingTime) # temporary fonction name, this could be latter something like
# clf$params$stopCondition(X, y, clf, pop, generation)
} # end while
# end the heartbeat
if(!clf$params$verbose) cat("\n")
# to be updated by the app
if(clf$params$plot)
{
plot(evaluation, xlim=c(1,clf$params$nb_generations), type = "b", col = "red", ylim = c(0.5,1), cex = 0.5, pch = 19)
abline(h = max(table(y)/sum(table(y))), lty=2)
}
# We revaluate the population preparing for final result
# clean the population
pop <- cleanPopulation(pop, clf)
pop <- evaluatePopulation(X, y, clf, pop, force.re.evaluation = TRUE, eval.all = TRUE)
pop <- unique(pop) # keep only unique models
# At the end we revaluate the population forcing the scores and everything else
# pop <- evaluatePopulation(X, y, clf, pop, force.re.evaluation = TRUE, eval.all = FALSE)
if(clf$params$final.pop.perc == 100)
{
res <- listOfModels2ModelCollection(pop)
} else
{
res <- listOfModels2ModelCollection(pop, nBest = 10)
}
if(clf$params$verbose) print(paste("... ... models are coverted onto a model collection"))
return(res)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.