R/mutateNetworks.R

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

#' (Maybe) mutate network nodes
#'
#' Based on mutation_rate probability, resample network nodes (i.e., genes from
#' pf_data). This is to help with local minima issues.
#'
#' @param population a list of \code{PrixFixeNetwork} objects
#' @param pf_data a \code{PFData} object generated by \code{PFDataLoader}
#' @param mutation_rate float value of percent with which to mutate the network nodes
#' @return A \code{PrixFixeNetwork} object
#'
mutateNetworks <- function(population, pf_data, mutation_rate = 0.05) {
  mutated_population <- lapply(population, .mutateNetwork, pf_data = pf_data, mutation_rate = mutation_rate)
  return(mutated_population)
}

.mutateNetwork <- function(network, pf_data, mutation_rate) {
  # Help function for mutateNetworks (for lapply to call)
  network_genes <- unlist(lapply(pf_data@loci_data, .maybeMutateLocus,
                                 network = network, pf_data = pf_data,
                                 mutation_rate = mutation_rate))
  network@genes <- network_genes
  return(network)
}


.maybeMutateLocus <- function(locus, network, pf_data, mutation_rate) {
  # Helper function for .mutateNetwork

  # identify which locus to maybe mutate
  mutation_index <- grep(locus@locus_id, network@loci)

  # determine if we mutate using the mutation_rate. 1=mutate.
  mutate <- sample(0:1, 1, prob = c((1 - mutation_rate), mutation_rate))
  if (mutate) {
    mutated_gene <- sample(attr(pf_data@loci_data[[mutation_index]], "true_members"), 1)
    return(mutated_gene)
  } else {
    return(network@genes[mutation_index])
  }
}