diff --git a/NAMESPACE b/NAMESPACE index a402516..13483da 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,7 @@ export(calculate_overlap_directed) export(calculate_overlap_undirected) export(calculate_thresholds) export(colData) +export(create_lr_dataframe) export(directed_scores) export(find_all_hotspots) export(find_hotspots_gmm) @@ -114,8 +115,10 @@ importFrom(SummarizedExperiment,assays) importFrom(SummarizedExperiment,colData) importFrom(SummarizedExperiment,rowData) importFrom(ape,Moran.I) +importFrom(dplyr,inner_join) importFrom(dplyr,mutate) importFrom(dplyr,rename) +importFrom(dplyr,select) importFrom(effsize,cohen.d) importFrom(ggplot2,aes) importFrom(ggplot2,annotation_raster) diff --git a/R/utils.R b/R/utils.R index 439662f..812cfb0 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1019,6 +1019,142 @@ setMethod("calculate_gene_set_specificity", "ANY", for (attr_name in names(saved_attrs)) { attr(result, attr_name) <- saved_attrs[[attr_name]] } - + return(result) } + + +#' @title Combine LR / ligand / receptor score matrices into a long table +#' +#' @description +#' Take the three matrices produced by \code{\link{calculate_lr_scores}} + +#' \code{\link{calculate_gene_set_score}} + +#' \code{\link{calculate_gene_set_specificity}} and reshape them into a +#' single long-format data frame keyed by interaction and source/target +#' cell-type pair. Ligand and receptor gene names are pulled from +#' \code{lrpairs}; multi-gene complexes are flattened with underscores. +#' +#' Column names in \code{ligand_scores} that start with \code{near_} are +#' converted to \code{to_} so they line up with the LR-score columns. +#' +#' Missing LR scores are kept as \code{NA} (not coerced to 0). Callers +#' choosing to plot zero-score interactions should filter or impute +#' explicitly. +#' +#' @note Cell-type names must not contain the substrings \code{"_to_"} or +#' \code{"_and_"}; the function parses cell types out of column-name +#' keys built from those separators. +#' +#' @param lrscores Numeric matrix of LR scores. Rows are interaction IDs +#' (matching \code{rownames(lrpairs)}); columns are +#' \code{source_to_target} cell-type pairs (e.g. \code{"B_to_Plasma"}). +#' @param ligand_scores Numeric matrix of ligand scores; same rows as +#' \code{lrscores}; columns may be \code{near_} or \code{to_}-style and +#' are normalised to \code{to_}. +#' @param receptor_scores Numeric matrix of receptor scores. Rows match +#' \code{lrscores}; columns are single cell-type names (e.g. +#' \code{"Plasma"}). +#' @param lrpairs Data frame with \code{ligand} and \code{receptor} +#' columns and row names equal to interaction IDs. +#' @param complex_sep Separator used inside \code{lrpairs$ligand} and +#' \code{lrpairs$receptor} for multi-gene complexes (e.g. +#' \code{", "}). Replaced with \code{"_"} in the output. +#' +#' @return A data frame with one row per interaction × source/target +#' pair, containing: +#' \describe{ +#' \item{\code{source_cell_type}}{Source cell type.} +#' \item{\code{ligand}}{Ligand gene(s), underscore-separated.} +#' \item{\code{receptor}}{Receptor gene(s), underscore-separated.} +#' \item{\code{target_cell_type}}{Target cell type.} +#' \item{\code{ligand_score}}{From \code{ligand_scores}.} +#' \item{\code{receptor_score}}{From \code{receptor_scores}.} +#' \item{\code{score}}{LR score from \code{lrscores}.} +#' \item{\code{interaction}}{Interaction ID (rowname of +#' \code{lrpairs}).} +#' \item{\code{source_to_target}}{Convenience +#' \code{paste0(source_cell_type, "_to_", target_cell_type)}.} +#' } +#' +#' @examples +#' lrpairs <- data.frame( +#' ligand = c("L1", "L2"), +#' receptor = c("R1, R2", "R3"), +#' row.names = c("L1_R1_R2", "L2_R3")) +#' lr <- matrix(c(0.4, 0.7, 0.1, NA), +#' nrow = 2, dimnames = list(rownames(lrpairs), +#' c("A_to_B", "B_to_A"))) +#' lig <- matrix(c(0.5, 0.6, 0.2, 0.3), +#' nrow = 2, dimnames = list(rownames(lrpairs), +#' c("A_near_B", "B_near_A"))) +#' rec <- matrix(c(0.7, 0.8, 0.9, 0.6), +#' nrow = 2, dimnames = list(rownames(lrpairs), +#' c("A", "B"))) +#' create_lr_dataframe(lr, lig, rec, lrpairs) +#' +#' @importFrom reshape2 melt +#' @importFrom dplyr inner_join select +#' @export +create_lr_dataframe <- function(lrscores, ligand_scores, receptor_scores, + lrpairs, complex_sep = ", ") { + # LR scores -> long + lr_long <- reshape2::melt(as.matrix(lrscores), + varnames = c("interaction", "source_to_target"), + value.name = "score") + lr_long$lr_cell <- paste0(lr_long$interaction, "_and_", + lr_long$source_to_target) + + # Ligand scores -> long; normalise "near_" -> "to_" so the join key + # matches lr_long. + ligand_long <- reshape2::melt(as.matrix(ligand_scores), + varnames = c("interaction", + "source_to_target"), + value.name = "ligand_score") + ligand_long$source_to_target <- gsub("near_", "to_", + ligand_long$source_to_target) + ligand_long$lr_cell <- paste0(ligand_long$interaction, "_and_", + ligand_long$source_to_target) + + lr_ligand <- dplyr::inner_join( + dplyr::select(lr_long, -"source_to_target", -"interaction"), + dplyr::select(ligand_long, -"source_to_target", -"interaction"), + by = "lr_cell") + + # Recover columns from the lr_cell key. + lr_ligand$interaction <- sub("_and_.*$", "", lr_ligand$lr_cell) + lr_ligand$source_cell_type <- sub("^.*_and_(.*)_to_.*$", "\\1", + lr_ligand$lr_cell) + lr_ligand$target_cell_type <- sub("^.*_to_", "", lr_ligand$lr_cell) + + # Receptor scores -> long; merge by (interaction, target_cell_type). + receptor_long <- reshape2::melt(as.matrix(receptor_scores), + varnames = c("interaction", + "target_cell_type"), + value.name = "receptor_score") + receptor_long$lr_target <- paste0(receptor_long$interaction, "_and_", + receptor_long$target_cell_type) + lr_ligand$lr_target <- paste0(lr_ligand$interaction, "_and_", + lr_ligand$target_cell_type) + + lr_receptor <- dplyr::inner_join( + lr_ligand, + dplyr::select(receptor_long, -"target_cell_type", -"interaction"), + by = "lr_target") + + # Attach ligand/receptor gene names from lrpairs. + lrpairs$interaction <- rownames(lrpairs) + final <- dplyr::inner_join(lr_receptor, lrpairs, by = "interaction") + + # Flatten complexes (e.g. "TGFBR1, TGFBR2" -> "TGFBR1_TGFBR2"). + final$ligand <- gsub(complex_sep, "_", final$ligand, fixed = TRUE) + final$receptor <- gsub(complex_sep, "_", final$receptor, fixed = TRUE) + + final <- dplyr::select(final, + "source_cell_type", "ligand", "receptor", + "target_cell_type", + "ligand_score", "receptor_score", + "score", "interaction") + final$source_to_target <- paste0(final$source_cell_type, "_to_", + final$target_cell_type) + final +} diff --git a/man/create_lr_dataframe.Rd b/man/create_lr_dataframe.Rd new file mode 100644 index 0000000..e6391c6 --- /dev/null +++ b/man/create_lr_dataframe.Rd @@ -0,0 +1,88 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{create_lr_dataframe} +\alias{create_lr_dataframe} +\title{Combine LR / ligand / receptor score matrices into a long table} +\usage{ +create_lr_dataframe( + lrscores, + ligand_scores, + receptor_scores, + lrpairs, + complex_sep = ", " +) +} +\arguments{ +\item{lrscores}{Numeric matrix of LR scores. Rows are interaction IDs +(matching \code{rownames(lrpairs)}); columns are +\code{source_to_target} cell-type pairs (e.g. \code{"B_to_Plasma"}).} + +\item{ligand_scores}{Numeric matrix of ligand scores; same rows as +\code{lrscores}; columns may be \code{near_} or \code{to_}-style and +are normalised to \code{to_}.} + +\item{receptor_scores}{Numeric matrix of receptor scores. Rows match +\code{lrscores}; columns are single cell-type names (e.g. +\code{"Plasma"}).} + +\item{lrpairs}{Data frame with \code{ligand} and \code{receptor} +columns and row names equal to interaction IDs.} + +\item{complex_sep}{Separator used inside \code{lrpairs$ligand} and +\code{lrpairs$receptor} for multi-gene complexes (e.g. +\code{", "}). Replaced with \code{"_"} in the output.} +} +\value{ +A data frame with one row per interaction × source/target +pair, containing: +\describe{ +\item{\code{source_cell_type}}{Source cell type.} +\item{\code{ligand}}{Ligand gene(s), underscore-separated.} +\item{\code{receptor}}{Receptor gene(s), underscore-separated.} +\item{\code{target_cell_type}}{Target cell type.} +\item{\code{ligand_score}}{From \code{ligand_scores}.} +\item{\code{receptor_score}}{From \code{receptor_scores}.} +\item{\code{score}}{LR score from \code{lrscores}.} +\item{\code{interaction}}{Interaction ID (rowname of +\code{lrpairs}).} +\item{\code{source_to_target}}{Convenience +\code{paste0(source_cell_type, "_to_", target_cell_type)}.} +} +} +\description{ +Take the three matrices produced by \code{\link{calculate_lr_scores}} + +\code{\link{calculate_gene_set_score}} + +\code{\link{calculate_gene_set_specificity}} and reshape them into a +single long-format data frame keyed by interaction and source/target +cell-type pair. Ligand and receptor gene names are pulled from +\code{lrpairs}; multi-gene complexes are flattened with underscores. + +Column names in \code{ligand_scores} that start with \code{near_} are +converted to \code{to_} so they line up with the LR-score columns. + +Missing LR scores are kept as \code{NA} (not coerced to 0). Callers +choosing to plot zero-score interactions should filter or impute +explicitly. +} +\note{ +Cell-type names must not contain the substrings \code{"_to_"} or +\code{"_and_"}; the function parses cell types out of column-name +keys built from those separators. +} +\examples{ +lrpairs <- data.frame( + ligand = c("L1", "L2"), + receptor = c("R1, R2", "R3"), + row.names = c("L1_R1_R2", "L2_R3")) +lr <- matrix(c(0.4, 0.7, 0.1, NA), + nrow = 2, dimnames = list(rownames(lrpairs), + c("A_to_B", "B_to_A"))) +lig <- matrix(c(0.5, 0.6, 0.2, 0.3), + nrow = 2, dimnames = list(rownames(lrpairs), + c("A_near_B", "B_near_A"))) +rec <- matrix(c(0.7, 0.8, 0.9, 0.6), + nrow = 2, dimnames = list(rownames(lrpairs), + c("A", "B"))) +create_lr_dataframe(lr, lig, rec, lrpairs) + +} diff --git a/tests/testthat/test-create_lr_dataframe.R b/tests/testthat/test-create_lr_dataframe.R new file mode 100644 index 0000000..9a32b05 --- /dev/null +++ b/tests/testthat/test-create_lr_dataframe.R @@ -0,0 +1,45 @@ +test_that("create_lr_dataframe round-trips a small fixture", { + lrpairs <- data.frame( + ligand = c("L1", "L2"), + receptor = c("R1, R2", "R3"), + row.names = c("L1_R1_R2", "L2_R3"), + stringsAsFactors = FALSE) + lr <- matrix(c(0.4, 0.7, 0.1, 0.2), + nrow = 2, + dimnames = list(rownames(lrpairs), c("A_to_B", "B_to_A"))) + lig <- matrix(c(0.5, 0.6, 0.2, 0.3), + nrow = 2, + dimnames = list(rownames(lrpairs), c("A_near_B", "B_near_A"))) + rec <- matrix(c(0.7, 0.8, 0.9, 0.6), + nrow = 2, + dimnames = list(rownames(lrpairs), c("A", "B"))) + + out <- create_lr_dataframe(lr, lig, rec, lrpairs) + + expect_named(out, c("source_cell_type", "ligand", "receptor", + "target_cell_type", "ligand_score", + "receptor_score", "score", "interaction", + "source_to_target")) + expect_equal(nrow(out), 4L) + # complexes flattened with underscore + expect_true("R1_R2" %in% out$receptor) + # source_to_target == "_to_" + expect_equal(out$source_to_target, + paste0(out$source_cell_type, "_to_", out$target_cell_type)) +}) + +test_that("create_lr_dataframe preserves NA in score (no silent NA -> 0)", { + lrpairs <- data.frame(ligand = "L1", receptor = "R1", + row.names = "L1_R1", + stringsAsFactors = FALSE) + lr <- matrix(c(0.5, NA), nrow = 1, + dimnames = list("L1_R1", c("A_to_B", "B_to_A"))) + lig <- matrix(c(0.4, 0.4), nrow = 1, + dimnames = list("L1_R1", c("A_near_B", "B_near_A"))) + rec <- matrix(c(0.7, 0.7), nrow = 1, + dimnames = list("L1_R1", c("A", "B"))) + + out <- create_lr_dataframe(lr, lig, rec, lrpairs) + expect_equal(sum(is.na(out$score)), 1L) + expect_true(any(out$score > 0, na.rm = TRUE)) +})