R/evolve.R

In princeew/PFFindR: Identify, evaluate, and visualize enriched Prix Fixe subnetworks

#' Evovle a population of \code{PrixFixeNetwork}s
#'
#' Given a list of \code{PrixFixeNetwork} objects (i.e., a population), evolve the
#' networks by mating and maybe mutating,
#' \code{PrixFixeNetwork}
#' objects of size \code{population_size}.
#'
#' @param population a list of \code{PrixFixeNetwork} objects
#' @param pf_data a \code{PFData} object generated by \code{PFDataLoader}
#' @param min_pct_change the minimum percent change between two generations required to continue optimization.
#' @param mutation_rate float value of percent with which to mutate the network nodes
#' @param plot_fitness boolean to determine whether to plot the mean network densities for each generation.
#' @param plot_fitness_path file path to save fitness plot.
#' @return A list of size \code{population_size} containing \code{PrixFixeNetwork} objects.
#'
#' @examples
#' \dontrun{
#' #' # load example PFData (FA genes)
#' data(PF_FanconiAnemia)
#' # generate population of subnetworks
#' population <- initializePopulation(PF_FanconiAnemia, population_size=100, "true_members")
#' # evolve the network
#' population <- evolve(population, pf_data, min_pct_change = 0.05)
#' }
#'
evolve <- function(population, pf_data, min_pct_change,
                   mutation_rate = 0.05,
                   plot_fitness = TRUE,
                   plot_fitness_path = "./evolution_fitness.png") {

  # Variables to store optimization performance
  mean_densities <- c()
  sd_densities <- c()

  # While early_stop==FALSE, evolve the population
  early_stop = FALSE
  while(!early_stop) {

    # Get mean density of last generation
    previous_population_density <- getNetworkDensity(population)
    gen_sd <- sd(getNetworkDensity(population, return_mean = F))

    # Update performance variables
    mean_densities <- c(mean_densities, previous_population_density)
    sd_densities <- c(sd_densities, previous_population_density)

    # Mate (and maybe mutate) members within the population
    population <- mateNetworks(population, pf_data,
                               num_matings = length(population),
                               mutation_rate = mutation_rate)

    # Get mean density of new generation and determine the percent change
    next_population_density <- getNetworkDensity(population)
    pct_change <- (next_population_density / previous_population_density) - 1

    # If percent change is less than the minimum percent change, stop optimization
    if (pct_change < min_pct_change) {
      early_stop = TRUE
      cat("\nStopping Optimization")
    } else {
      cat(paste0("\nMean Density = ", next_population_density))
    }
  }
  if (plot_fitness) {
    p <- tibble("Generation" = 1:length(mean_densities),
           "MeanDensity" = mean_densities,
           "SD" = sd_densities) %>%
      ggplot(aes(Generation, MeanDensity)) + geom_point() + geom_line() + theme_linedraw()
    ggsave(plot_fitness_path, p)
  }
  return(population)
}