R/tree2timescape.R

In qingjian1991/MPTevol: Clonal Evolutionary History and Metastatic Routines Analysis for Multiple Primary Tumors

#' tree2timescape
#'
#' This function generates the input of timescape to visual the fisher plot of
#' clonal evolution by using the results of [inferClonalTree()].
#'
#' @param results the clonal trees that generated by [inferClonalTree()].
#' @param samples the samples to show in the fisher plot.
#'
#' @import clonevol
#' @export
tree2timescape <- function(results, samples = NULL) {
  if (is.null(samples)) {
    samples <- names(results$models)
  } else {
    if (!all(samples %in% names(results$models))) {
      stop("check input samplesNames : ", samples[!samples %in% names(results$models)])
    }
  }

  # store the clonevol results in a list
  res <- list(
    samples = samples, clonevol.clone.names = NULL, clonevol.clone.colors = NULL,
    timepoints = seq(1, length(samples)), num.models = nrow(results$matched$index),
    parents = list(), cell.fractions = list(), all = list()
  )

  clonevol.clone.names <- NULL
  clone.nums <- NULL
  clonevol.clone.colors <- NULL

  # create the needed inputs to fishplot
  for (i in 1:nrow(results$matched$index)) {
    vv <- NULL
    for (s in samples) {
      v <- results$models[[s]][[results$matched$index[i, s]]]
      # if (rescale){v = rescale.vaf(v)}
      v <- clonevol:::rescale.vaf(v)
      v <- v[, c("lab", "vaf", "parent", "color")]

      ## scale vaf and make cell.frac
      max.vaf <- max(v$vaf)
      scale <- 0.5 / max.vaf * 2 * 100
      v$vaf <- v$vaf * scale
      v$vaf[v$vaf > 100] <- 100 # safeguard against rounding error making some vaf slightly > 100

      colnames(v) <- c("clone", s, "parent", "color")
      v <- v[!is.na(v$parent) & v$clone != "0", ]
      if (is.null(vv)) {
        vv <- v
      } else {
        vv <- merge(vv, v, all = TRUE)
      }
    }
    for (s in samples) {
      vv[is.na(vv[[s]]), s] <- 0
    }
    vv <- vv[order(as.integer(vv$clone)), ]
    vv$parent[vv$parent == "-1"] <- 0
    rownames(vv) <- vv$clone

    ## fishplot requires clones to be named in sequential order. Do that, but
    ## store the clonevol-generated names and colors for pass-through
    if (is.null(clone.nums)) {
      clone.nums <- c(0, seq(1, nrow(vv)))
      names(clone.nums) <- c(0, vv$clone)

      clonevol.clone.names <- names(clone.nums)
      names(clonevol.clone.names) <- as.character(clone.nums)
      res$clonevol.clone.names <- clonevol.clone.names[-1]

      clonevol.clone.colors <- c("white", vv$color)
      names(clonevol.clone.colors) <- as.character(clone.nums)
      res$clonevol.clone.colors <- clonevol.clone.colors[-1]
    }
    vv$clone <- clone.nums[vv$clone]
    vv$parent <- clone.nums[vv$parent]

    par <- vv$parent
    frac <- vv[, samples]
    res$parents[[i]] <- par
    res$cell.fractions[[i]] <- as.matrix(frac)
    res$all[[i]] <- vv
  }

  ##############################
  # for timescape input

  times <- list(
    clonal_prev = list(),
    tree_edges = list(),
    clone_colours = list()
  )

  for (i in 1:res$num.models) {
    # re-set ancestor clonal prev

    # get sum of prev of certain clone.
    clonal_prev_ancestor <- res$all[[i]] %>%
      dplyr::mutate(clone = rownames(.)) %>%
      data.table::melt(
        id.vars = c("clone", "parent"),
        measure.vars = samples
      ) %>%
      dplyr::group_by(variable, parent) %>%
      dplyr::summarise(sumvalue = sum(value)) %>%
      dplyr::rename(clone = parent) %>%
      dplyr::mutate(clone = as.character(clone))

    # prev = curent - ancestor
    times$clonal_prev[[i]] <- res$all[[i]] %>%
      dplyr::mutate(clone = rownames(.)) %>%
      data.table::melt(
        id.vars = c("clone", "parent"),
        measure.vars = samples
      ) %>%
      dplyr::left_join(clonal_prev_ancestor) %>%
      dplyr::mutate(
        sumvalue = ifelse(is.na(sumvalue), 0, sumvalue),
        value1 = value - sumvalue,
        # set value1 = 0 if value1 <=0
        value1 = ifelse(value1 < 0, 0, value1)
      ) %>%
      dplyr::select(clone, variable, value1) %>%
      dplyr::rename(
        clone_id = clone,
        timepoint = variable,
        clonal_prev = value1
      ) %>% # set arrange of samples.
      dplyr::mutate(timepoint = factor(timepoint, levels = samples)) %>%
      dplyr::arrange(timepoint) %>%
      dplyr::mutate(timepoint = as.character(timepoint))

    # re-mapping clone ids.
    cloneNames <- setNames(
      c(0, rownames(res$all[[i]])),
      nm = c(0, res$all[[i]]$clone)
    )

    times$tree_edges[[i]] <- data.frame(
      source = cloneNames[as.character(res$parents[[i]])],
      target = rownames(res$all[[i]])
    ) %>%
      filter(source != "0")

    times$clone_colours[[i]] <- data.frame(
      clone_id = rownames(res$all[[i]]),
      colour = res$all[[i]]$color
    )
  }

  times
}