R/extract_entropy.R

In mxfda: A Functional Data Analysis Package for Spatial Single Cell Data

#' extract_entropy
#'
#' The extract_entropy() is used to compute spatial entropy at each distance
#' interval for all cell types of interest. The goal is to capture the diversity
#' in cellular composition, such as similar proportions across cell types or
#' dominance of a single type, at a specific distance range. Additionally,
#' spatial patterns, including clustered, independent, or regular, among cell
#' types can also be acquired. In this example, we will look at the spatial
#' heterogeneity across T cells, macrophages, and others. To focus on the local
#' cell-to-cell interactions, we set the default maximum of the distance range
#' (i.e., rmax) to be 400 microns. The default number of distance
#' breaks/intervals is set to 50. Then, a sequence of distance breaks is
#' generated by linearly decreasing from rmax to 0 on a log scale. At each
#' distance range, partial spatial entropy and residual entropy are
#' calculated as in Vu et al. (2023), Altieri et al. (2018). These spatial
#' entropy functions can then be used as input functions for FPCA.
#'
#' @param mxFDAobject object of class `mxFDA`
#' @param markvar The name of the variable that denotes cell type(s) of interest. Character.
#' @param marks Character vector that denotes cell types of interest.
#' @param n_break Total number of distance ranges/intervals of interest made from 0 to `rmax` for calculating entropy
#' @param rmax Max distance between pairs of cells
#'
#' @return object of class `mxFDA` with a dataframe in the `multivariate_summaries` slot
#' @export
#'
extract_entropy = function(mxFDAobject,
                           markvar,
                           marks,
                           n_break = 50,
                           rmax = 400){
  #make sure input object is of right class
  if(!inherits(mxFDAobject, "mxFDA"))
    stop("Object must be of class `mxFDA`.")
  #need spatial data to calculate spatial summary functions
  if(nrow(mxFDAobject@Spatial) == 0)
    stop("No summary function to be calculated - missing spatial")
  #check to make sure that there are more than 1 level in the markvar column
  if(!all(marks %in% unique(mxFDAobject@Spatial[[markvar]])))
    stop("One or marks not in markvar column of Spatial data")
  #check to make sure that there are more than 1 level in the markvar column
  if(length(unique(mxFDAobject@Spatial[[markvar]]))<2)
    stop("Calculating entropy requires at least 2 cell types")
  #get only those columns and marks needed
  df_nest = mxFDAobject@Spatial %>%
    dplyr::filter(!!dplyr::sym(markvar) %in% marks) %>%
    dplyr::select(dplyr::all_of(mxFDAobject@sample_key), x, y, dplyr::all_of(markvar)) %>%
    tidyr::nest(data = c(x, y, dplyr::all_of(markvar)))
  r_vec = exp(seq(log(0.05*max(rmax)), log(max(rmax)), length.out = n_break))

  ndat = df_nest %>% dplyr::mutate(sumfuns = purrr::map(df_nest$data, entropy,
                                                        r_vec = r_vec,
                                                        markvar = markvar,
                                                        .progress = TRUE)) %>%
    select(-data) %>%
    unnest(sumfuns)

  mxFDAobject@multivariate_summaries$entropy = ndat
  return(mxFDAobject)
}

#' Entropy
#'
#' @param df data frame with x and y columns, along with a column for point marks
#' @param r_vec vector of length wanted for breaks (will be rescaled) with max value at max for measuring entropy
#' @param markvar The name of the variable that denotes cell type(s) of interest. Character.
#'
#' @details `r lifecycle::badge('experimental')`
#'
#' @return data frame with entropy calculated for `length(r_vec)` bins within 0 to `max(r_vec)`
#'
#' @author Thao Vu \email{`r thaovu_email`}
#' @author Alex Soupir \email{`r alexsoupir_email`}
#'
#' @references Vu, T., Seal, S., Ghosh, T., Ahmadian, M., Wrobel, J., & Ghosh, D. (2023).
#' FunSpace: A functional and spatial analytic approach to cell imaging data using entropy measures.
#' \emph{PLOS Computational Biology}, 19(9), e1011490.
#' @references Altieri, L., Cocchi, D., & Roli, G. (2018).
#' A new approach to spatial entropy measures.
#' \emph{Environmental and ecological statistics}, 25, 95-110.
#'
#' @export
entropy = function(df,
                   r_vec,
                   markvar){
  #if not enough points return NAs
  if(nrow(df) < 3)
    return(data.frame(r = r_vec, spatial_entropy = NA, residual_entropy = NA))
  win = spatstat.geom::convexhull.xy(df$x, df$y)
  X = spatstat.geom::ppp(df$x, df$y, window = win, marks = df[[markvar]])
  breaks = length(r_vec)
  #nnumber of cells for marks
  cells = df %>%
    dplyr::group_by(!!dplyr::sym(markvar)) %>%
    dplyr::summarise(counts = dplyr::n()) %>%
    dplyr::mutate(!!markvar := paste0(get(markvar), " cells")) %>%
    tidyr::spread(key = markvar, value = 'counts')

  # Compute spatial entropy
  spa_entropy <- tryCatch({
    # Try to calculate spatial entropy using SpatEntropy::altieri
    SimDesign::quiet(
      SpatEntropy::altieri(X, distbreak = r_vec[-breaks], verbose = FALSE, plotout = FALSE)
    ) %>% suppressWarnings()
  }, error = function(e) {
    # In case of error, return a fallback data frame
    data.frame(
      r = r_vec,
      spatial_entropy = NA,
      residual_entropy = NA
    )
  })

  if(inherits(spa_entropy, "data.frame")){
    return(spa_entropy)
  }

  if (length(spa_entropy$SPI.terms) < breaks){
    breaks = length(spa_entropy$SPI.terms)
    r = unique(c(spa_entropy$distance.breaks[,1],spa_entropy$distance.breaks[,2]))[-c(1)]
    r[breaks] = max(r_vec)
    r_vec = r
  }
  r_vec = round(r_vec, 2)

  df = data.frame(r = r_vec, spatial_entropy = spa_entropy$SPI.terms,
                  residual_entropy  =  spa_entropy$RES.terms) %>%
    dplyr::full_join(cells %>%
                       dplyr::slice(rep(1:n(), each = length(r_vec))) %>%  # Repeat the row
                       dplyr::mutate(r = r_vec),
                     by = dplyr::join_by(r))

  df

}