R/model_magellan.R

In YoannAnciaux/inferenceFitnessLandscape: What the Package Does (One Line, Title Case)

#' Functions generating the fitness of the mutants' genotypes in \code{genotype_table}
#' The mutants are generated by a call to the fl_generate binary from MAGELLAN. See
#' \href{http://rstudio.com}{Rstudio}.
#' Warning : These functions return malthusian fitnesses (also called log fitnesses).
#' i.e. they use the argument "-L" in MAGELLAN.
#'
#' @inheritParams fl_generate_magellan
#' @inheritParams scale_to_wt_fitness
#' @param path2_fl_generate File path to the binary fl_generate of MAGELLAN.
#' @return A vector of real numbers. Each element is the fitness of the corresponding
#' random mutants in \code{genotype_table}. They are in the same order as the rows of
#' \code{genotype_table}.
#' @name magellan
NULL
#> NULL

#' @rdname magellan
#' @param f A real number. Add a fixed contribution
model_Fix <- function(nb_mut, genotype_table, fitness_wt, f, path2_fl_generate) {
  #### check arguments ####
  arg_required <- c("nb_mut", "genotype_table", "fitness_wt", "f", "path2_fl_generate")
  arg_passed <- names(as.list(match.call())[-1])
  coll1 <- checkmate::makeAssertCollection()
  if (!checkmate::test_subset(x = arg_required,
                              choices = names(as.list(match.call())[-1]))) {
    coll1$push(paste0("Missing values for ", paste(setdiff(arg_required, arg_passed), collapse=", ")))
  }
  checkmate::reportAssertions(coll1)
  coll <- checkmate::makeAssertCollection()
  checkmate::assert_number(f, na.ok = F, finite = T, null.ok = F)
  checkmate::assert_file(path2_fl_generate, access = "x")
  checkmate::reportAssertions(coll)

  #### generate fitnesses ####
  #only deal with the case 2 allele per loci now
  command <- paste(path2_fl_generate, "-L", "-f", f, nb_mut, 2, sep = " ")
  fl <- fl_generate_magellan(nb_mut, genotype_table, command)
  scale_to_wt_fitness(nb_mut, genotype_table, fitness_wt, fl)
}
#' @rdname magellan
#' @param s A real number. Mean fitness selection coefficient per locus (fitness
#' is then fitness_wt + s)
#' @param S A real number. Stdev for fitness for each locus (if 0 use fix fitness)
#' @param d A real number. Can set a diminishing (negative) or increasing (positive) return as you approach the peak
model_Mult <- function(nb_mut, genotype_table, fitness_wt, s, S, d, path2_fl_generate) {
  #### check arguments ####
  arg_required <- c("nb_mut", "genotype_table", "fitness_wt", "s", "S", "d", "path2_fl_generate")
  arg_passed <- names(as.list(match.call())[-1])
  coll1 <- checkmate::makeAssertCollection()
  if (!checkmate::test_subset(x = arg_required,
                              choices = names(as.list(match.call())[-1]))) {
    coll1$push(paste0("Missing values for ", paste(setdiff(arg_required, arg_passed), collapse=", ")))
  }
  checkmate::reportAssertions(coll1)
  coll <- checkmate::makeAssertCollection()
  checkmate::assert_number(s, na.ok = F, finite = T, null.ok = F)
  checkmate::assert_number(S, na.ok = F, lower = 0,
                           finite = T, null.ok = F)
  checkmate::assert_number(d, na.ok = F, finite = T, null.ok = F)
  checkmate::assert_file(path2_fl_generate, access = "x")
  checkmate::reportAssertions(coll)

  #### generate fitnesses ####
  #only deal with the case 2 allele per loci now
  command <- paste(path2_fl_generate, "-L",  "-s", s, "-S", S, "-d", d, nb_mut, 2, sep = " ")
  fl <- fl_generate_magellan(nb_mut, genotype_table, command)
  scale_to_wt_fitness(nb_mut, genotype_table, fitness_wt, fl)
}
#' @rdname magellan
#' @param H A positive real number. Stdev for fitness for House-of-Cards (normal centered on 0)
model_HoC <- function(nb_mut, genotype_table, fitness_wt, H, path2_fl_generate) {
  #### check arguments ####
  arg_required <- c("nb_mut", "genotype_table", "fitness_wt", "H", "path2_fl_generate")
  arg_passed <- names(as.list(match.call())[-1])
  coll1 <- checkmate::makeAssertCollection()
  if (!checkmate::test_subset(x = arg_required,
                              choices = names(as.list(match.call())[-1]))) {
    coll1$push(paste0("Missing values for ", paste(setdiff(arg_required, arg_passed), collapse=", ")))
  }
  checkmate::reportAssertions(coll1)
  coll <- checkmate::makeAssertCollection()
  checkmate::assert_number(H, na.ok = F, lower = 0, finite = T, null.ok = F)
  checkmate::assert_file(path2_fl_generate, access = "x")
  checkmate::reportAssertions(coll)

  #### generate fitnesses ####
  #only deal with the case 2 allele per loci now
  command <- paste(path2_fl_generate, "-L",  "-H", H, nb_mut, 2, sep = " ")
  fl <- fl_generate_magellan(nb_mut, genotype_table, command)
  scale_to_wt_fitness(nb_mut, genotype_table, fitness_wt, fl)
}
#' @rdname magellan
#' @param K A positive integer. Kaufman NK with N=\code{nb_mut} and K<=N
#' @param r A logical value. If TRUE interacting loci are chosen at random. If FALSE
#' they are the neighbors.
model_NK <- function(nb_mut, genotype_table, fitness_wt, K, r, path2_fl_generate) {
  #### check arguments ####
  arg_required <- c("nb_mut", "genotype_table", "fitness_wt", "K", "r", "path2_fl_generate")
  arg_passed <- names(as.list(match.call())[-1])
  coll1 <- checkmate::makeAssertCollection()
  if (!checkmate::test_subset(x = arg_required,
                              choices = names(as.list(match.call())[-1]))) {
    coll1$push(paste0("Missing values for ", paste(setdiff(arg_required, arg_passed), collapse=", ")))
  }
  checkmate::reportAssertions(coll1)
  coll <- checkmate::makeAssertCollection()
  checkmate::assert_int(K, na.ok = F, lower = 0, upper = nb_mut, add = coll)
  checkmate::assert_flag(r, add = coll)
  checkmate::assert_file(path2_fl_generate, access = "x")
  checkmate::reportAssertions(coll)

  #### generate fitnesses ####
  #only deal with the case 2 allele per loci now
  if (r) {
    command <- paste(path2_fl_generate, "-L",  "-K", K, "-r", nb_mut, 2, sep = " ")
  } else {
    command <- paste(path2_fl_generate, "-L",  "-K", K, nb_mut, 2, sep = " ")
  }
  fl <- fl_generate_magellan(nb_mut, genotype_table, command)
  scale_to_wt_fitness(nb_mut, genotype_table, fitness_wt, fl)
}
#' @rdname magellan
#' @param i A real number. Mean cost for incompatibility.
#' @param I A positive real number. Stdev cost for incompatibility (if 0 use fix cost)
#' @param c A logical value. If TRUE last interacs with first (loci are arranged on a circle).
model_Ising <- function(nb_mut, genotype_table, fitness_wt, i, I, c, path2_fl_generate) {
  #### check arguments ####
  arg_required <- c("nb_mut", "genotype_table", "fitness_wt", "i", "I", "c", "path2_fl_generate")
  arg_passed <- names(as.list(match.call())[-1])
  coll1 <- checkmate::makeAssertCollection()
  if (!checkmate::test_subset(x = arg_required,
                              choices = names(as.list(match.call())[-1]))) {
    coll1$push(paste0("Missing values for ", paste(setdiff(arg_required, arg_passed), collapse=", ")))
  }
  checkmate::reportAssertions(coll1)
  coll <- checkmate::makeAssertCollection()
  checkmate::assert_number(i, na.ok = F, finite = T, null.ok = F)
  checkmate::assert_number(I, na.ok = F, lower = 0,
                           finite = T, null.ok = F)
  checkmate::assert_flag(c)
  checkmate::assert_file(path2_fl_generate, access = "x")
  checkmate::reportAssertions(coll)

  #### generate fitnesses ####
  #only deal with the case 2 allele per loci now
  if (c) {
    command <- paste(path2_fl_generate, "-L",  "-i", i, "-I", I, "-c", nb_mut, 2, sep = " ")
  } else {
    command <- paste(path2_fl_generate, "-L",  "-i", i, "-I", I, nb_mut, 2, sep = " ")
  }
  fl <- fl_generate_magellan(nb_mut, genotype_table, command)
  scale_to_wt_fitness(nb_mut, genotype_table, fitness_wt, fl)
}
#' @rdname magellan
#' @param e A real number. Every other genotype is +/- e
#' @param E A positive real number. Add noise on the mean effect for eggbox
model_EggBox <- function(nb_mut, genotype_table, fitness_wt, e, E, path2_fl_generate) {
  #### check arguments ####
  arg_required <- c("nb_mut", "genotype_table", "fitness_wt", "e", "E", "path2_fl_generate")
  arg_passed <- names(as.list(match.call())[-1])
  coll1 <- checkmate::makeAssertCollection()
  if (!checkmate::test_subset(x = arg_required,
                              choices = names(as.list(match.call())[-1]))) {
    coll1$push(paste0("Missing values for ", paste(setdiff(arg_required, arg_passed), collapse=", ")))
  }
  checkmate::reportAssertions(coll1)
  coll <- checkmate::makeAssertCollection()
  checkmate::assert_number(e, na.ok = F, finite = T, null.ok = F)
  checkmate::assert_number(E, na.ok = F, lower = 0, finite = T, null.ok = F)
  checkmate::assert_file(path2_fl_generate, access = "x")
  checkmate::reportAssertions(coll)

  #### generate fitnesses ####
  #only deal with the case 2 allele per loci now
  command <- paste(path2_fl_generate, "-L",  "-e", e, "-E", E, nb_mut, 2, sep = " ")
  fl <- fl_generate_magellan(nb_mut, genotype_table, command)
  scale_to_wt_fitness(nb_mut, genotype_table, fitness_wt, fl)
}
#' @rdname magellan
#' @param o A real number. Optimum to target.
#' @param O A positive real number. The spread around the optimal point, the larger
#' the less selection for optimum
#' @param p A real number. The mean production value for each non 0 allele.
#' @param P A positive real number. The associated stdev.
model_Optimum <- function(nb_mut, genotype_table, fitness_wt, o, O, p, P, path2_fl_generate) {

  #### check arguments ####
  arg_required <- c("nb_mut", "genotype_table", "fitness_wt", "o", "O", "p", "P", "path2_fl_generate")
  arg_passed <- names(as.list(match.call())[-1])
  coll1 <- checkmate::makeAssertCollection()
  if (!checkmate::test_subset(x = arg_required,
                              choices = names(as.list(match.call())[-1]))) {
    coll1$push(paste0("Missing values for ", paste(setdiff(arg_required, arg_passed), collapse=", ")))
  }
  checkmate::reportAssertions(coll1)
  coll <- checkmate::makeAssertCollection()
  checkmate::assert_number(o, na.ok = F, finite = T, null.ok = F)
  checkmate::assert_number(O, na.ok = F, lower = 0, finite = T, null.ok = F)
  checkmate::assert_number(p, na.ok = F, finite = T, null.ok = F)
  checkmate::assert_number(P, na.ok = F, lower = 0, finite = T, null.ok = F)
  checkmate::assert_file(path2_fl_generate, access = "x")
  checkmate::reportAssertions(coll)

  #### generate fitnesses ####  #only deal with the case 2 allele per loci now
  command <- paste(path2_fl_generate, "-L",  "-o", o, "-O", O, "-p", p, "-P", P, nb_mut, 2, sep = " ")
  fl <- fl_generate_magellan(nb_mut, genotype_table, command)
  scale_to_wt_fitness(nb_mut, genotype_table, fitness_wt, fl)
}

#' Calls the fl_generate binary from MAGELLAN using system(\code{command}), and return
#' a fitness landscape generated by MAGELLAN reordered as \code{genotype_table}.
#'
#' @param nb_mut A natural number. Number of mutations (or loci in MAGELLAN) used to
#' form the different genotypes from \code{genotype_table}.
#' @inheritParams fitness_mutant_genotype
#' @param command A command with the file path to the binary fl_generate and argument
#' accepted by this binary.
#' @return A fitness landscape with the \code{nb_mut} first columns corresponding
#' to the \code{genotype_table} and the \code{nb_mut}+1 column corresponding to
#' the fitness of the genotype of each row.
fl_generate_magellan <- function(nb_mut, genotype_table, command){
  #### check arguments ####
  arg_required <- c("nb_mut", "genotype_table", "command")
  arg_passed <- names(as.list(match.call())[-1])
  coll1 <- checkmate::makeAssertCollection()
  if (!checkmate::test_subset(x = arg_required,
                              choices = names(as.list(match.call())[-1]))) {
    coll1$push(paste0("Missing values for ", paste(setdiff(arg_required, arg_passed), collapse=", ")))
  }
  checkmate::reportAssertions(coll1)
  checkmate::assert_string(command)

  #### call MAGELLAN fl_generate and return fl ####
  fl <- system(command, intern = T)
  fl <- matrix(as.numeric(unlist(strsplit(fl[-1], "\\s+"))), nrow = 2^nb_mut, ncol = nb_mut + 1, byrow = T)
  equalize_row_order(genotype_table = genotype_table, fl = fl)
}
#' Reorder the rows of a fitness landscape according to \code{genotype_table}.
#'
#' @inheritParams fitness_mutant_genotype
#' @param fl A matrix of logical and a last colum of reals. A fitness landscape
#' with the first columns corresponding to a genotype_table and the last column
#' to the fitness of the genotype of each row.
#' @return A fitness landscape similar to \code{fl} with the rows reordered according to
#' \code{genotype_table}.
equalize_row_order <- function(genotype_table, fl){
  #### check arguments ####
  arg_required <- c("genotype_table", "fl")
  arg_passed <- names(as.list(match.call())[-1])
  coll1 <- checkmate::makeAssertCollection()
  if (!checkmate::test_subset(x = arg_required,
                              choices = names(as.list(match.call())[-1]))) {
    coll1$push(paste0("Missing values for ", paste(setdiff(arg_required, arg_passed), collapse=", ")))
  }
  checkmate::reportAssertions(coll1)
  coll <- checkmate::makeAssertCollection()
  checkmate::assert_matrix(genotype_table, mode = "numeric", add = coll)
  assert_genotype_table(genotype_table, add = coll)
  checkmate::assert_matrix(fl, mode = "numeric", any.missing = F,
                           nrows = nrow(genotype_table), ncols = ncol(genotype_table) + 1,
                           add = coll)
  checkmate::reportAssertions(coll)

  #### reorder table ####
  index_reorder_genotype <- apply(fl[,-dim(fl)[2]], MARGIN = 1,
                                  FUN = function(g){which(apply(genotype_table, MARGIN = 1, FUN = function(gt) {all.equal(unname(g), unname(gt))==TRUE}))})
  fl[order(index_reorder_genotype),]
}

#' Function generating the fitness of the mutants' genotypes in \code{genotype_table}
#' The mutants are produced by combining \code{nb_mut} selected mutations generated
#' from the wt with fitness \code{fitness_wt}. Fitnesses are computed using an
#' isotropic FGM with the parameter \code{n}, \code{lambda}, \code{maxfitness},
#' \code{alpha}, \code{Q}, \code{m}. See \code{\link{generate_selected_mutation}}
#' for more information on the selected mutations and \code{\link{fitness_mutant_genotype}}
#' for the fitness of the genotypes.
#'

#' Calls the fl_generate binary from MAGELLAN using system(\code{command}), and return
#' a fitness landscape generated by MAGELLAN reordered as \code{genotype_table}.
#'
#' @inheritParams fl_generate_magellan
#' @inheritParams equalize_row_order
#' @param fitness_wt A real number. Fitness of the wild type used as reference.
#' @return A vector of fitnesses with the fisrt element equal to \code{fitness_wt}
#' and the other scaled to correspond to mutants with a wild type with fitness
#' \code{fitness_wt}.
scale_to_wt_fitness <- function(nb_mut, genotype_table, fitness_wt, fl) {
  #### check arguments ####
  arg_required <- c("nb_mut", "genotype_table", "fitness_wt", "fl")
  arg_passed <- names(as.list(match.call())[-1])
  coll1 <- checkmate::makeAssertCollection()
  if (!checkmate::test_subset(x = arg_required,
                              choices = names(as.list(match.call())[-1]))) {
    coll1$push(paste0("Missing values for ", paste(setdiff(arg_required, arg_passed), collapse=", ")))
  }
  checkmate::reportAssertions(coll1)
  coll <- checkmate::makeAssertCollection()
  checkmate::assert_count(nb_mut, na.ok = F, positive = T, null.ok = F, add = coll)
  checkmate::assert_matrix(genotype_table, mode = "numeric", ncols = nb_mut, add = coll)
  assert_genotype_table(genotype_table, add = coll)
  checkmate::assert_number(fitness_wt, na.ok = F, finite = T, null.ok = F,
                           add = coll)
  checkmate::assert_matrix(fl, mode = "numeric", any.missing = F,
                           nrows = nrow(genotype_table), ncols = nb_mut + 1,
                           add = coll)
  checkmate::reportAssertions(coll)

  #### scale fitnesses ####
  fl[, nb_mut + 1] - (fl[which(rowSums(genotype_table) == 0), nb_mut + 1] - fitness_wt)
}