R/output_helpers.R

In sams25/rcombinator_old: Tools to Simulate the Evolution of Genetic Sequences

create_initial_seq_dump <- function(time, sequences, num_seq_dumps)
{
  num_jumps <- length(time)
  if (num_seq_dumps > 0) {
    seq_dump_frequency <- ceiling(num_jumps/num_seq_dumps)
    seq_dump_indices <- (1:num_jumps) %% seq_dump_frequency == 0
    seq_dump_indices[1] <- TRUE
    seq_dump_indices[num_jumps] <- TRUE

    seq_dump_time <- time[seq_dump_indices]
    seq_dump_data <- data.frame(time=seq_dump_time)
    seq_dump_data$sequences <- rep(list(c()), nrow(seq_dump_data))
    seq_dump_data$sequences[[1]] <- sequences
    seq_dump_data_index <- 2
  }
  else {
    seq_dump_indices <- rep(FALSE, num_jumps)
    seq_dump_data <- data.frame()
    seq_dump_data_index <- NA
  }
  return(list(seq_dump_indices=seq_dump_indices,
              seq_dump_data=seq_dump_data,
              seq_dump_data_index=seq_dump_data_index))
}

create_initial_summary_dump <- function(time, dist_function, copy_numbers,
                                        sequences, initial_sequence,
                                        num_summary_dumps)
{
  num_jumps <- length(time)
  if (num_summary_dumps > 0) {
    summary_dump_frequency <- ceiling(num_jumps/num_summary_dumps)
    summary_dump_indices <- (1:num_jumps) %% summary_dump_frequency == 0
    summary_dump_indices[1] <- TRUE
    summary_dump_indices[num_jumps] <- TRUE

    summary_dump_time <- time[summary_dump_indices]
    summary_dump_num_seqs <- sapply(copy_numbers$sequences[summary_dump_indices], length)
    summary_dump_data <- data.frame(time=summary_dump_time,
                                    num_seq=summary_dump_num_seqs)

    empty_col <- rep(NA, nrow(summary_dump_data))

    summary_dump_data$min_init_dist <- empty_col
    summary_dump_data$max_init_dist <- empty_col
    summary_dump_data$med_init_dist <- empty_col
    summary_dump_data$avg_init_dist <- empty_col
    summary_dump_data$q25_init_dist <- empty_col
    summary_dump_data$q75_init_dist <- empty_col

    summary_dump_data_init_dists <- sapply(sequences,
                                           function(x)
                                             dist_function(list(x, initial_sequence))[1])
    quantile_init_stats <- stats::quantile(summary_dump_data_init_dists, na.rm = TRUE)
    summary_dump_data$avg_init_dist[1] <- mean(summary_dump_data_init_dists, na.rm = TRUE)
    summary_dump_data$min_init_dist[1] <- quantile_init_stats["0%"]
    summary_dump_data$q25_init_dist[1] <- quantile_init_stats["25%"]
    summary_dump_data$med_init_dist[1] <- quantile_init_stats["50%"]
    summary_dump_data$q75_init_dist[1] <- quantile_init_stats["75%"]
    summary_dump_data$max_init_dist[1] <- quantile_init_stats["100%"]

    summary_dump_data_index <- 2
  }
  else {
    summary_dump_indices <- rep(FALSE, num_jumps)
    summary_dump_data <- data.frame()
    summary_dump_data_index <- NA
  }

  return(list(summary_dump_indices=summary_dump_indices,
              summary_dump_data=summary_dump_data,
              summary_dump_data_index=summary_dump_data_index))
}

create_initial_pairmatrix_dump <- function(time, dist_function, sequences, num_pairmatrix_dumps)
{
  num_jumps <- length(time)
  if (num_pairmatrix_dumps > 0) {
    pairmatrix_dump_frequency <- ceiling(num_jumps/num_pairmatrix_dumps)
    pairmatrix_dump_indices <- (1:num_jumps) %% pairmatrix_dump_frequency == 0
    pairmatrix_dump_indices[1] <- TRUE
    pairmatrix_dump_indices[num_jumps] <- TRUE

    pairmatrix_dump_time <- time[pairmatrix_dump_indices]
    pairmatrix_dump_data <- data.frame(time=pairmatrix_dump_time)
    pairmatrix_dump_data$pairmatrix <- rep(list(c()), nrow(pairmatrix_dump_data))
    pairmatrix_dump_data$pairmatrix[[1]] <- dist_function(sequences)

    pairmatrix_dump_data_index <- 2
  }
  else {
    pairmatrix_dump_indices <- rep(FALSE, num_jumps)
    pairmatrix_dump_data <- data.frame()
    pairmatrix_dump_data_index <- NA
  }

  return(list(pairmatrix_dump_indices=pairmatrix_dump_indices,
              pairmatrix_dump_data=pairmatrix_dump_data,
              pairmatrix_dump_data_index=pairmatrix_dump_data_index))
}