Detailed CellChat signalling analysis of Lxn positive vs. Lxn negative astrocytes

Load data and setup parameters

Code

# Load tidyverse infrastructure packages
suppressPackageStartupMessages({
  library(reticulate)
  library(future)
  library(here)
  library(tidyverse)
  library(magrittr)
  library(stringr)
  library(skimr)
  library(RColorBrewer)
})


# Load packages for scRNA-seq analysis and visualisation
suppressPackageStartupMessages({
  library(ggplot2)
  library(ggrepel)
  library(cowplot)
  library(patchwork)
  library(ggstatsplot)
  library(ggupset)
  library(ComplexUpset)
  library(dabestr)
})

Set paths

Code

src_dir <- here("code")
data_dir <- here("data")
output_dir <- here("output")
plots_dir <- here(output_dir, "figures")
tables_dir <- here(output_dir, "tables")

Load helper functions and gene-sets

Code

source(here(src_dir, "genes.R"))
source(here(src_dir, "functions.R"))

Set fixed variables

Code

# set seed
reseed <- 42
set.seed(seed = reseed)

# Parameters for parallel execution
n_cores <- 8
plan("multisession", workers = n_cores)
options(
  future.globals.maxSize = 100000 * 1024^2,
  future.rng.onMisuse = "ignore"
)
plan()

multisession:
- args: function (..., workers = 8, envir = parent.frame())
- tweaked: TRUE
- call: plan("multisession", workers = n_cores)

Code

# ggplot2 theme
theme_set(ggmin::theme_powerpoint())

Load selected astrocytes signalling data estimated using Liana-py and Rank Aggregation method (including CellPhoneDB, CellChat, ICELLNET, connectomeDB2020, and CellTalkDB) for CellChatDB only

Code

lutomska_norm <-
  read_csv(here(
    data_dir,
    "signalling", "lutomska",
    "arc_astro-with_npy_pomc-liana-res-lxn-cellchatdb.csv"
  ))

lutomska_hfhsd <-
  read_csv(here(
    data_dir,
    "signalling", "lutomska",
    "hfd-arc_astro-with_npy_pomc-liana-res-lxn-cellchatdb.csv"
  ))

deng_norm <-
  read_csv(here(
    data_dir,
    "signalling", "deng",
    "arc_astro-with_npy_pomc-liana-res-lxn-cellchatdb.csv"
  ))

deng_hfd <-
  read_csv(here(
    data_dir,
    "signalling", "deng",
    "hfd-arc_astro-with_npy_pomc-liana-res-lxn-cellchatdb.csv"
  ))

lopez_norm <-
  read_csv(here(
    data_dir,
    "signalling", "lopez",
    "pvn_astro-with_npy_pomc-liana-res-lxn-cellchatdb.csv"
  ))

lopez_csds <-
  read_csv(here(
    data_dir,
    "signalling", "lopez",
    "chronic-stress-pvn_astro-with_npy_pomc-liana-res-lxn-cellchatdb.csv"
  ))

Code

skim(lutomska_norm)

Data summary

Name	lutomska_norm
Number of rows	18704
Number of columns	17
_______________________
Column type frequency:
character	4
numeric	13
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
source	0	1	10	16	0	4	0
target	0	1	10	16	0	4	0
ligand_complex	0	1	2	16	0	267	0
receptor_complex	0	1	3	19	0	279	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
…1	0	1	9351.50	5399.52	0.00	4675.75	9351.50	14027.25	18703.00	▇▇▇▇▇
lr_means	0	1	0.12	0.28	0.02	0.02	0.02	0.02	3.54	▇▁▁▁▁
cellphone_pvals	0	1	0.85	0.34	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
expr_prod	0	1	0.06	0.48	0.00	0.00	0.00	0.00	12.23	▇▁▁▁▁
scaled_weight	0	1	-0.88	0.67	-1.21	-1.21	-1.21	-1.21	4.62	▇▂▁▁▁
lr_logfc	0	1	-1.68	0.93	-2.17	-2.17	-2.17	-2.17	3.40	▇▁▁▁▁
spec_weight	0	1	0.03	0.07	0.00	0.00	0.00	0.00	1.00	▇▁▁▁▁
lrscore	0	1	0.22	0.21	0.12	0.12	0.12	0.12	0.96	▇▁▁▁▁
lr_probs	0	1	0.00	0.01	0.00	0.00	0.00	0.00	0.31	▇▁▁▁▁
cellchat_pvals	0	1	0.95	0.22	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
steady_rank	0	1	0.80	0.39	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
specificity_rank	0	1	0.81	0.38	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
magnitude_rank	0	1	0.91	0.26	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇

Code

skim(lutomska_hfhsd)

Data summary

Name	lutomska_hfhsd
Number of rows	20160
Number of columns	17
_______________________
Column type frequency:
character	4
numeric	13
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
source	0	1	10	16	0	4	0
target	0	1	10	16	0	4	0
ligand_complex	0	1	2	16	0	301	0
receptor_complex	0	1	3	19	0	320	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
…1	0	1	10079.50	5819.84	0.00	5039.75	10079.50	15119.25	20159.00	▇▇▇▇▇
lr_means	0	1	0.10	0.26	0.02	0.02	0.02	0.02	3.46	▇▁▁▁▁
cellphone_pvals	0	1	0.87	0.32	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
expr_prod	0	1	0.05	0.42	0.00	0.00	0.00	0.00	11.64	▇▁▁▁▁
scaled_weight	0	1	-1.13	0.70	-1.44	-1.44	-1.44	-1.44	4.86	▇▂▁▁▁
lr_logfc	0	1	-1.86	0.90	-2.28	-2.28	-2.28	-2.28	4.02	▇▂▁▁▁
spec_weight	0	1	0.02	0.07	0.00	0.00	0.00	0.00	0.97	▇▁▁▁▁
lrscore	0	1	0.23	0.19	0.14	0.14	0.14	0.14	0.96	▇▁▁▁▁
lr_probs	0	1	0.00	0.01	0.00	0.00	0.00	0.00	0.31	▇▁▁▁▁
cellchat_pvals	0	1	0.95	0.21	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
steady_rank	0	1	0.83	0.37	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
specificity_rank	0	1	0.84	0.36	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
magnitude_rank	0	1	0.91	0.26	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇

Code

skim(deng_norm)

Data summary

Name	deng_norm
Number of rows	19696
Number of columns	17
_______________________
Column type frequency:
character	4
numeric	13
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
source	0	1	10	16	0	4	0
target	0	1	10	16	0	4	0
ligand_complex	0	1	2	16	0	290	0
receptor_complex	0	1	3	19	0	314	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
…1	0	1	9847.50	5685.89	0.00	4923.75	9847.50	14771.25	19695.00	▇▇▇▇▇
lr_means	0	1	0.12	0.29	0.01	0.01	0.01	0.09	3.72	▇▁▁▁▁
cellphone_pvals	0	1	0.82	0.36	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
expr_prod	0	1	0.06	0.50	0.00	0.00	0.00	0.01	13.45	▇▁▁▁▁
scaled_weight	0	1	-0.88	0.68	-1.30	-1.30	-1.30	-0.18	2.35	▇▂▁▁▁
lr_logfc	0	1	-2.32	1.49	-3.27	-3.27	-3.27	-0.41	4.22	▇▁▂▁▁
spec_weight	0	1	0.03	0.06	0.00	0.00	0.00	0.02	0.91	▇▁▁▁▁
lrscore	0	1	0.20	0.23	0.07	0.07	0.07	0.30	0.95	▇▁▁▁▁
lr_probs	0	1	0.00	0.01	0.00	0.00	0.00	0.00	0.32	▇▁▁▁▁
cellchat_pvals	0	1	0.92	0.26	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
steady_rank	0	1	0.75	0.41	0.00	0.32	1.00	1.00	1.00	▂▁▁▁▇
specificity_rank	0	1	0.77	0.39	0.00	0.49	1.00	1.00	1.00	▂▁▁▁▇
magnitude_rank	0	1	0.89	0.29	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇

Code

skim(deng_hfd)

Data summary

Name	deng_hfd
Number of rows	20208
Number of columns	17
_______________________
Column type frequency:
character	4
numeric	13
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
source	0	1	10	16	0	4	0
target	0	1	10	16	0	4	0
ligand_complex	0	1	2	16	0	298	0
receptor_complex	0	1	3	19	0	318	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
…1	0	1	10103.50	5833.69	0.00	5051.75	10103.50	15155.25	20207.00	▇▇▇▇▇
lr_means	0	1	0.13	0.29	0.02	0.02	0.02	0.09	3.75	▇▁▁▁▁
cellphone_pvals	0	1	0.82	0.35	0.00	0.99	1.00	1.00	1.00	▂▁▁▁▇
expr_prod	0	1	0.07	0.53	0.00	0.00	0.00	0.00	13.78	▇▁▁▁▁
scaled_weight	0	1	-0.70	0.58	-1.05	-1.05	-1.05	-0.19	3.42	▇▂▁▁▁
lr_logfc	0	1	-1.62	1.03	-2.27	-2.27	-2.27	-0.42	2.46	▇▁▂▁▁
spec_weight	0	1	0.03	0.06	0.00	0.00	0.00	0.02	0.80	▇▁▁▁▁
lrscore	0	1	0.21	0.22	0.09	0.09	0.09	0.28	0.96	▇▁▁▁▁
lr_probs	0	1	0.00	0.02	0.00	0.00	0.00	0.00	0.39	▇▁▁▁▁
cellchat_pvals	0	1	0.93	0.25	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
steady_rank	0	1	0.75	0.40	0.00	0.32	1.00	1.00	1.00	▂▁▁▁▇
specificity_rank	0	1	0.77	0.39	0.00	0.50	1.00	1.00	1.00	▂▁▁▁▇
magnitude_rank	0	1	0.89	0.29	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇

Code

skim(lopez_norm)

Data summary

Name	lopez_norm
Number of rows	20368
Number of columns	17
_______________________
Column type frequency:
character	4
numeric	13
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
source	0	1	10	16	0	4	0
target	0	1	10	16	0	4	0
ligand_complex	0	1	2	16	0	306	0
receptor_complex	0	1	3	19	0	321	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
…1	0	1	10183.50	5879.88	0.00	5091.75	10183.50	15275.25	20367.00	▇▇▇▇▇
lr_means	0	1	0.10	0.26	0.01	0.01	0.01	0.01	3.47	▇▁▁▁▁
cellphone_pvals	0	1	0.83	0.36	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
expr_prod	0	1	0.05	0.42	0.00	0.00	0.00	0.00	11.95	▇▁▁▁▁
scaled_weight	0	1	-0.68	0.66	-1.02	-1.02	-1.02	-1.02	3.97	▇▂▁▁▁
lr_logfc	0	1	-1.54	0.89	-2.04	-2.04	-2.04	-2.04	4.66	▇▂▁▁▁
spec_weight	0	1	0.03	0.06	0.00	0.00	0.00	0.00	0.91	▇▁▁▁▁
lrscore	0	1	0.21	0.23	0.09	0.09	0.09	0.09	0.97	▇▁▁▁▁
lr_probs	0	1	0.00	0.01	0.00	0.00	0.00	0.00	0.29	▇▁▁▁▁
cellchat_pvals	0	1	0.93	0.25	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
steady_rank	0	1	0.77	0.40	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
specificity_rank	0	1	0.78	0.39	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
magnitude_rank	0	1	0.90	0.28	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇

Code

skim(lopez_csds)

Data summary

Name	lopez_csds
Number of rows	20624
Number of columns	17
_______________________
Column type frequency:
character	4
numeric	13
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
source	0	1	10	16	0	4	0
target	0	1	10	16	0	4	0
ligand_complex	0	1	2	16	0	311	0
receptor_complex	0	1	3	19	0	322	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
…1	0	1	10311.50	5953.78	0.00	5155.75	10311.50	15467.25	20623.00	▇▇▇▇▇
lr_means	0	1	0.11	0.27	0.02	0.02	0.02	0.02	3.54	▇▁▁▁▁
cellphone_pvals	0	1	0.84	0.35	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
expr_prod	0	1	0.06	0.46	0.00	0.00	0.00	0.00	12.42	▇▁▁▁▁
scaled_weight	0	1	-0.69	0.64	-1.02	-1.02	-1.02	-0.62	5.54	▇▁▁▁▁
lr_logfc	0	1	-1.56	0.90	-2.07	-2.07	-2.07	-1.53	2.64	▇▁▂▁▁
spec_weight	0	1	0.03	0.06	0.00	0.00	0.00	0.00	0.81	▇▁▁▁▁
lrscore	0	1	0.22	0.22	0.11	0.11	0.11	0.14	0.96	▇▁▁▁▁
lr_probs	0	1	0.00	0.01	0.00	0.00	0.00	0.00	0.29	▇▁▁▁▁
cellchat_pvals	0	1	0.94	0.24	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
steady_rank	0	1	0.77	0.40	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
specificity_rank	0	1	0.78	0.39	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
magnitude_rank	0	1	0.90	0.28	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇

Filter by p-values

Code

lutomska_norm <-
  lutomska_norm |>
  filter(
    specificity_rank <= 1,
    magnitude_rank <= 1
  )

lutomska_hfhsd <-
  lutomska_hfhsd |>
  filter(
    specificity_rank <= 1,
    magnitude_rank <= 1
  )

deng_norm <-
  deng_norm |>
  filter(
    specificity_rank <= 1,
    magnitude_rank <= 1
  )

deng_hfd <-
  deng_hfd |>
  filter(
    specificity_rank <= 1,
    magnitude_rank <= 1
  )

lopez_norm <-
  lopez_norm |>
  filter(
    specificity_rank <= 1,
    magnitude_rank <= 1
  )

lopez_csds <-
  lopez_csds |>
  filter(
    specificity_rank <= 1,
    magnitude_rank <= 1
  )

Code

skim(lutomska_norm)

Data summary

Name	lutomska_norm
Number of rows	18704
Number of columns	17
_______________________
Column type frequency:
character	4
numeric	13
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
source	0	1	10	16	0	4	0
target	0	1	10	16	0	4	0
ligand_complex	0	1	2	16	0	267	0
receptor_complex	0	1	3	19	0	279	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
…1	0	1	9351.50	5399.52	0.00	4675.75	9351.50	14027.25	18703.00	▇▇▇▇▇
lr_means	0	1	0.12	0.28	0.02	0.02	0.02	0.02	3.54	▇▁▁▁▁
cellphone_pvals	0	1	0.85	0.34	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
expr_prod	0	1	0.06	0.48	0.00	0.00	0.00	0.00	12.23	▇▁▁▁▁
scaled_weight	0	1	-0.88	0.67	-1.21	-1.21	-1.21	-1.21	4.62	▇▂▁▁▁
lr_logfc	0	1	-1.68	0.93	-2.17	-2.17	-2.17	-2.17	3.40	▇▁▁▁▁
spec_weight	0	1	0.03	0.07	0.00	0.00	0.00	0.00	1.00	▇▁▁▁▁
lrscore	0	1	0.22	0.21	0.12	0.12	0.12	0.12	0.96	▇▁▁▁▁
lr_probs	0	1	0.00	0.01	0.00	0.00	0.00	0.00	0.31	▇▁▁▁▁
cellchat_pvals	0	1	0.95	0.22	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
steady_rank	0	1	0.80	0.39	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
specificity_rank	0	1	0.81	0.38	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
magnitude_rank	0	1	0.91	0.26	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇

Code

skim(lutomska_hfhsd)

Data summary

Name	lutomska_hfhsd
Number of rows	20160
Number of columns	17
_______________________
Column type frequency:
character	4
numeric	13
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
source	0	1	10	16	0	4	0
target	0	1	10	16	0	4	0
ligand_complex	0	1	2	16	0	301	0
receptor_complex	0	1	3	19	0	320	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
…1	0	1	10079.50	5819.84	0.00	5039.75	10079.50	15119.25	20159.00	▇▇▇▇▇
lr_means	0	1	0.10	0.26	0.02	0.02	0.02	0.02	3.46	▇▁▁▁▁
cellphone_pvals	0	1	0.87	0.32	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
expr_prod	0	1	0.05	0.42	0.00	0.00	0.00	0.00	11.64	▇▁▁▁▁
scaled_weight	0	1	-1.13	0.70	-1.44	-1.44	-1.44	-1.44	4.86	▇▂▁▁▁
lr_logfc	0	1	-1.86	0.90	-2.28	-2.28	-2.28	-2.28	4.02	▇▂▁▁▁
spec_weight	0	1	0.02	0.07	0.00	0.00	0.00	0.00	0.97	▇▁▁▁▁
lrscore	0	1	0.23	0.19	0.14	0.14	0.14	0.14	0.96	▇▁▁▁▁
lr_probs	0	1	0.00	0.01	0.00	0.00	0.00	0.00	0.31	▇▁▁▁▁
cellchat_pvals	0	1	0.95	0.21	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
steady_rank	0	1	0.83	0.37	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
specificity_rank	0	1	0.84	0.36	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
magnitude_rank	0	1	0.91	0.26	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇

Code

skim(deng_norm)

Data summary

Name	deng_norm
Number of rows	19696
Number of columns	17
_______________________
Column type frequency:
character	4
numeric	13
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
source	0	1	10	16	0	4	0
target	0	1	10	16	0	4	0
ligand_complex	0	1	2	16	0	290	0
receptor_complex	0	1	3	19	0	314	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
…1	0	1	9847.50	5685.89	0.00	4923.75	9847.50	14771.25	19695.00	▇▇▇▇▇
lr_means	0	1	0.12	0.29	0.01	0.01	0.01	0.09	3.72	▇▁▁▁▁
cellphone_pvals	0	1	0.82	0.36	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
expr_prod	0	1	0.06	0.50	0.00	0.00	0.00	0.01	13.45	▇▁▁▁▁
scaled_weight	0	1	-0.88	0.68	-1.30	-1.30	-1.30	-0.18	2.35	▇▂▁▁▁
lr_logfc	0	1	-2.32	1.49	-3.27	-3.27	-3.27	-0.41	4.22	▇▁▂▁▁
spec_weight	0	1	0.03	0.06	0.00	0.00	0.00	0.02	0.91	▇▁▁▁▁
lrscore	0	1	0.20	0.23	0.07	0.07	0.07	0.30	0.95	▇▁▁▁▁
lr_probs	0	1	0.00	0.01	0.00	0.00	0.00	0.00	0.32	▇▁▁▁▁
cellchat_pvals	0	1	0.92	0.26	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
steady_rank	0	1	0.75	0.41	0.00	0.32	1.00	1.00	1.00	▂▁▁▁▇
specificity_rank	0	1	0.77	0.39	0.00	0.49	1.00	1.00	1.00	▂▁▁▁▇
magnitude_rank	0	1	0.89	0.29	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇

Code

skim(deng_hfd)

Data summary

Name	deng_hfd
Number of rows	20208
Number of columns	17
_______________________
Column type frequency:
character	4
numeric	13
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
source	0	1	10	16	0	4	0
target	0	1	10	16	0	4	0
ligand_complex	0	1	2	16	0	298	0
receptor_complex	0	1	3	19	0	318	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
…1	0	1	10103.50	5833.69	0.00	5051.75	10103.50	15155.25	20207.00	▇▇▇▇▇
lr_means	0	1	0.13	0.29	0.02	0.02	0.02	0.09	3.75	▇▁▁▁▁
cellphone_pvals	0	1	0.82	0.35	0.00	0.99	1.00	1.00	1.00	▂▁▁▁▇
expr_prod	0	1	0.07	0.53	0.00	0.00	0.00	0.00	13.78	▇▁▁▁▁
scaled_weight	0	1	-0.70	0.58	-1.05	-1.05	-1.05	-0.19	3.42	▇▂▁▁▁
lr_logfc	0	1	-1.62	1.03	-2.27	-2.27	-2.27	-0.42	2.46	▇▁▂▁▁
spec_weight	0	1	0.03	0.06	0.00	0.00	0.00	0.02	0.80	▇▁▁▁▁
lrscore	0	1	0.21	0.22	0.09	0.09	0.09	0.28	0.96	▇▁▁▁▁
lr_probs	0	1	0.00	0.02	0.00	0.00	0.00	0.00	0.39	▇▁▁▁▁
cellchat_pvals	0	1	0.93	0.25	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
steady_rank	0	1	0.75	0.40	0.00	0.32	1.00	1.00	1.00	▂▁▁▁▇
specificity_rank	0	1	0.77	0.39	0.00	0.50	1.00	1.00	1.00	▂▁▁▁▇
magnitude_rank	0	1	0.89	0.29	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇

Code

skim(lopez_norm)

Data summary

Name	lopez_norm
Number of rows	20368
Number of columns	17
_______________________
Column type frequency:
character	4
numeric	13
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
source	0	1	10	16	0	4	0
target	0	1	10	16	0	4	0
ligand_complex	0	1	2	16	0	306	0
receptor_complex	0	1	3	19	0	321	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
…1	0	1	10183.50	5879.88	0.00	5091.75	10183.50	15275.25	20367.00	▇▇▇▇▇
lr_means	0	1	0.10	0.26	0.01	0.01	0.01	0.01	3.47	▇▁▁▁▁
cellphone_pvals	0	1	0.83	0.36	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
expr_prod	0	1	0.05	0.42	0.00	0.00	0.00	0.00	11.95	▇▁▁▁▁
scaled_weight	0	1	-0.68	0.66	-1.02	-1.02	-1.02	-1.02	3.97	▇▂▁▁▁
lr_logfc	0	1	-1.54	0.89	-2.04	-2.04	-2.04	-2.04	4.66	▇▂▁▁▁
spec_weight	0	1	0.03	0.06	0.00	0.00	0.00	0.00	0.91	▇▁▁▁▁
lrscore	0	1	0.21	0.23	0.09	0.09	0.09	0.09	0.97	▇▁▁▁▁
lr_probs	0	1	0.00	0.01	0.00	0.00	0.00	0.00	0.29	▇▁▁▁▁
cellchat_pvals	0	1	0.93	0.25	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
steady_rank	0	1	0.77	0.40	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
specificity_rank	0	1	0.78	0.39	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
magnitude_rank	0	1	0.90	0.28	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇

Code

skim(lopez_csds)

Data summary

Name	lopez_csds
Number of rows	20624
Number of columns	17
_______________________
Column type frequency:
character	4
numeric	13
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
source	0	1	10	16	0	4	0
target	0	1	10	16	0	4	0
ligand_complex	0	1	2	16	0	311	0
receptor_complex	0	1	3	19	0	322	0

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
…1	0	1	10311.50	5953.78	0.00	5155.75	10311.50	15467.25	20623.00	▇▇▇▇▇
lr_means	0	1	0.11	0.27	0.02	0.02	0.02	0.02	3.54	▇▁▁▁▁
cellphone_pvals	0	1	0.84	0.35	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
expr_prod	0	1	0.06	0.46	0.00	0.00	0.00	0.00	12.42	▇▁▁▁▁
scaled_weight	0	1	-0.69	0.64	-1.02	-1.02	-1.02	-0.62	5.54	▇▁▁▁▁
lr_logfc	0	1	-1.56	0.90	-2.07	-2.07	-2.07	-1.53	2.64	▇▁▂▁▁
spec_weight	0	1	0.03	0.06	0.00	0.00	0.00	0.00	0.81	▇▁▁▁▁
lrscore	0	1	0.22	0.22	0.11	0.11	0.11	0.14	0.96	▇▁▁▁▁
lr_probs	0	1	0.00	0.01	0.00	0.00	0.00	0.00	0.29	▇▁▁▁▁
cellchat_pvals	0	1	0.94	0.24	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇
steady_rank	0	1	0.77	0.40	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
specificity_rank	0	1	0.78	0.39	0.00	1.00	1.00	1.00	1.00	▂▁▁▁▇
magnitude_rank	0	1	0.90	0.28	0.00	1.00	1.00	1.00	1.00	▁▁▁▁▇

Merge datasets

Code

lutomska_norm <-
  lutomska_norm |>
  mutate(
    region = "ARC",
    condition = "HFHSD",
    control = TRUE
  )

lutomska_hfhsd <-
  lutomska_hfhsd |>
  mutate(
    region = "ARC",
    condition = "HFHSD",
    control = FALSE
  )

deng_norm <-
  deng_norm |>
  mutate(
    region = "ARC",
    condition = "HFD",
    control = TRUE
  )

deng_hfd <-
  deng_hfd |>
  mutate(
    region = "ARC",
    condition = "HFD",
    control = FALSE
  )

lopez_norm <-
  lopez_norm |>
  mutate(
    region = "PVN",
    condition = "CSDS",
    control = TRUE
  )

lopez_csds <-
  lopez_csds |>
  mutate(
    region = "PVN",
    condition = "CSDS",
    control = FALSE
  )

df_complex_conditions <-
  bind_rows(
    lopez_norm,
    lopez_csds,
    lutomska_norm,
    lutomska_hfhsd,
    deng_norm,
    deng_hfd
  )
df_complex_conditions <-
  df_complex_conditions |>
  mutate(pairs = str_c(source, target, sep = "==>")) |>
  filter(
    pairs %in% c(
      "Astro_LXN+==>POMC neurons",
      "Astro_LXN-==>POMC neurons",
      "Astro_LXN+==>AGRP/NPY neurons",
      "Astro_LXN-==>AGRP/NPY neurons",
      "POMC neurons==>Astro_LXN+",
      "AGRP/NPY neurons==>Astro_LXN+",
      "POMC neurons==>Astro_LXN-",
      "AGRP/NPY neurons==>Astro_LXN-"
    ),
    cellchat_pvals < 1, cellphone_pvals < 1
  )

Deng 2020

Signalling pairs

How do latexin positive or negative astrocytes coupled with POMC neurons?

Normal diet

Code

df <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>POMC neurons",
      "Astro_LXN-==>POMC neurons"
    ),
    condition == "HFD",
    control == TRUE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    neg_log10_magnitude_rank = -log10(magnitude_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, lr_probs, control)

df

Code

skim(df)

Data summary

Name	df
Number of rows	127
Number of columns	6
_______________________
Column type frequency:
character	4
logical	1
numeric	1
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
pairs	0	1	25	25	0	2	0
lr_complex	0	1	8	27	0	69	0
ligand_complex	0	1	3	7	0	22	0
receptor_complex	0	1	3	19	0	52	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 127

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
lr_probs	0	1	0.02	0.05	0	0	0.01	0.02	0.29	▇▁▁▁▁

Code

df_specificity <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>POMC neurons",
      "Astro_LXN-==>POMC neurons"
    ),
    condition == "HFD",
    control == TRUE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, neg_log10_specificity_rank, control)

# Reshape the dataframe to a wider format
df_wide <- df %>%
  pivot_wider(names_from = pairs, values_from = lr_probs)

# Calculate the difference and categorize it
df_wide <- df_wide %>%
  mutate(diff_rank = `Astro_LXN+==>POMC neurons` - `Astro_LXN-==>POMC neurons`) %>%
  mutate(diff_category = ifelse(abs(diff_rank) > 0.001 | is.na(abs(diff_rank)), "big difference", "small difference"))

df_wide

Code

skim(df_wide)

Data summary

Name	df_wide
Number of rows	69
Number of columns	8
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	27	0	69	0
ligand_complex	0	1	3	7	0	22	0
receptor_complex	0	1	3	19	0	52	0
diff_category	0	1	14	16	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 69

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Astro_LXN-==>POMC neurons	11	0.84	0.02	0.05	0.00	0	0.01	0.02	0.29	▇▁▁▁▁
Astro_LXN+==>POMC neurons	0	1.00	0.02	0.04	0.00	0	0.00	0.02	0.29	▇▁▁▁▁
diff_rank	11	0.84	0.00	0.00	-0.01	0	0.00	0.00	0.00	▁▁▂▇▁

Code

# Reshape the dataframe back to a long format
df_long <- df_wide %>%
  pivot_longer(cols = c(`Astro_LXN+==>POMC neurons`, `Astro_LXN-==>POMC neurons`), names_to = "pairs", values_to = "lr_probs") %>%
  full_join(df_specificity, by = c("pairs", "lr_complex", "ligand_complex", "receptor_complex", "control"))

df_long

Code

skim(df_long)

Data summary

Name	df_long
Number of rows	138
Number of columns	9
_______________________
Column type frequency:
character	5
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	27	0	69	0
ligand_complex	0	1	3	7	0	22	0
receptor_complex	0	1	3	19	0	52	0
diff_category	0	1	14	16	0	2	0
pairs	0	1	25	25	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 138

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	22	0.84	0.00	0.00	-0.01	0.00	0.00	0.00	0.00	▁▁▂▇▁
lr_probs	11	0.92	0.02	0.05	0.00	0.00	0.01	0.02	0.29	▇▁▁▁▁
neg_log10_specificity_rank	11	0.92	2.54	1.14	1.21	1.48	2.52	3.20	6.62	▇▆▃▁▁

Code

# Prepare the top 20 data
top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 40) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = lr_probs, n = 10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = diff_rank, n = 15) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 60) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 20) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10) %>%
  distinct(lr_complex, diff_category, pairs, .keep_all = TRUE) %>%
  filter(!ligand_complex %in% c("Pomc", "Agrp", "Npy"))

top_bot_10

Code

skim(top_bot_10)

Data summary

Name	top_bot_10
Number of rows	88
Number of columns	9
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	pairs

Variable type: character

skim_variable	pairs	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	Astro_LXN+==>POMC neurons	0	1	8	27	0	48	0
lr_complex	Astro_LXN-==>POMC neurons	0	1	8	27	0	40	0
ligand_complex	Astro_LXN+==>POMC neurons	0	1	3	7	0	20	0
ligand_complex	Astro_LXN-==>POMC neurons	0	1	3	7	0	20	0
receptor_complex	Astro_LXN+==>POMC neurons	0	1	3	19	0	36	0
receptor_complex	Astro_LXN-==>POMC neurons	0	1	3	19	0	32	0
diff_category	Astro_LXN+==>POMC neurons	0	1	14	16	0	2	0
diff_category	Astro_LXN-==>POMC neurons	0	1	14	16	0	2	0

Variable type: logical

skim_variable	pairs	n_missing	complete_rate	mean	count
control	Astro_LXN+==>POMC neurons	0	1	1	TRU: 48
control	Astro_LXN-==>POMC neurons	0	1	1	TRU: 40

Variable type: numeric

skim_variable	pairs	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	Astro_LXN+==>POMC neurons	11	0.77	0.00	0.00	-0.01	0.00	0.00	0.00	0.00	▁▁▂▇▁
diff_rank	Astro_LXN-==>POMC neurons	5	0.88	0.00	0.00	-0.01	0.00	0.00	0.00	0.00	▁▁▃▇▁
lr_probs	Astro_LXN+==>POMC neurons	0	1.00	0.03	0.05	0.00	0.00	0.01	0.02	0.29	▇▁▁▁▁
lr_probs	Astro_LXN-==>POMC neurons	5	0.88	0.04	0.06	0.00	0.00	0.02	0.04	0.29	▇▁▁▁▁
neg_log10_specificity_rank	Astro_LXN+==>POMC neurons	0	1.00	2.76	1.22	1.21	1.53	2.79	3.57	6.62	▇▇▆▂▁
neg_log10_specificity_rank	Astro_LXN-==>POMC neurons	5	0.88	2.89	1.16	1.21	2.09	2.85	3.24	6.62	▅▇▃▁▁

Code

# Generate the plot
pr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pr <- pr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>POMC neurons",
      diff_rank >= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>POMC neurons",
      diff_rank <= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pr)

Code

pl <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pl <- pl + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>POMC neurons",
      diff_rank >= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>POMC neurons",
      diff_rank <= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pl)

Code

plr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
plr <- plr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN+==>POMC neurons" & 
        diff_rank >= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN+==>POMC neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN-==>POMC neurons" & 
        diff_rank <= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN-==>POMC neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(plr)

HFD

Code

df <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>POMC neurons",
      "Astro_LXN-==>POMC neurons"
    ),
    condition == "HFD",
    control == FALSE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    neg_log10_magnitude_rank = -log10(magnitude_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, lr_probs, control)

df

Code

skim(df)

Data summary

Name	df
Number of rows	140
Number of columns	6
_______________________
Column type frequency:
character	4
logical	1
numeric	1
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
pairs	0	1	25	25	0	2	0
lr_complex	0	1	8	20	0	75	0
ligand_complex	0	1	3	7	0	26	0
receptor_complex	0	1	3	13	0	57	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	0	FAL: 140

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
lr_probs	0	1	0.04	0.06	0	0	0.01	0.04	0.39	▇▁▁▁▁

Code

df_specificity <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>POMC neurons",
      "Astro_LXN-==>POMC neurons"
    ),
    condition == "HFD",
    control == FALSE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, neg_log10_specificity_rank, control)

# Reshape the dataframe to a wider format
df_wide <- df %>%
  pivot_wider(names_from = pairs, values_from = lr_probs)

# Calculate the difference and categorize it
df_wide <- df_wide %>%
  mutate(diff_rank = `Astro_LXN+==>POMC neurons` - `Astro_LXN-==>POMC neurons`) %>%
  mutate(diff_category = ifelse(abs(diff_rank) > 0.001 | is.na(abs(diff_rank)), "big difference", "small difference"))

df_wide

Code

skim(df_wide)

Data summary

Name	df_wide
Number of rows	75
Number of columns	8
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	20	0	75	0
ligand_complex	0	1	3	7	0	26	0
receptor_complex	0	1	3	13	0	57	0
diff_category	0	1	14	16	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	0	FAL: 75

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Astro_LXN-==>POMC neurons	9	0.88	0.04	0.07	0.00	0.00	0.01	0.04	0.39	▇▁▁▁▁
Astro_LXN+==>POMC neurons	1	0.99	0.03	0.06	0.00	0.01	0.01	0.03	0.39	▇▁▁▁▁
diff_rank	10	0.87	0.00	0.00	-0.01	0.00	0.00	0.00	0.01	▁▇▃▁▁

Code

# Reshape the dataframe back to a long format
df_long <- df_wide %>%
  pivot_longer(cols = c(`Astro_LXN+==>POMC neurons`, `Astro_LXN-==>POMC neurons`), names_to = "pairs", values_to = "lr_probs") %>%
  full_join(df_specificity, by = c("pairs", "lr_complex", "ligand_complex", "receptor_complex", "control"))

df_long

Code

skim(df_long)

Data summary

Name	df_long
Number of rows	150
Number of columns	9
_______________________
Column type frequency:
character	5
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	20	0	75	0
ligand_complex	0	1	3	7	0	26	0
receptor_complex	0	1	3	13	0	57	0
diff_category	0	1	14	16	0	2	0
pairs	0	1	25	25	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	0	FAL: 150

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	20	0.87	0.00	0.00	-0.01	0.00	0.00	0.00	0.01	▁▇▃▁▁
lr_probs	10	0.93	0.04	0.06	0.00	0.00	0.01	0.04	0.39	▇▁▁▁▁
neg_log10_specificity_rank	10	0.93	2.39	1.12	1.04	1.37	2.28	3.01	6.02	▇▆▃▁▁

Code

# Prepare the top 20 data
top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 40) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = lr_probs, n = 10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = diff_rank, n = 15) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 60) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 20) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10) %>%
  distinct(lr_complex, diff_category, pairs, .keep_all = TRUE) %>%
  filter(!ligand_complex %in% c("Pomc", "Agrp", "Npy"))

top_bot_10

Code

skim(top_bot_10)

Data summary

Name	top_bot_10
Number of rows	91
Number of columns	9
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	pairs

Variable type: character

skim_variable	pairs	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	Astro_LXN+==>POMC neurons	0	1	8	19	0	45	0
lr_complex	Astro_LXN-==>POMC neurons	0	1	8	19	0	46	0
ligand_complex	Astro_LXN+==>POMC neurons	0	1	3	7	0	19	0
ligand_complex	Astro_LXN-==>POMC neurons	0	1	3	7	0	18	0
receptor_complex	Astro_LXN+==>POMC neurons	0	1	3	11	0	38	0
receptor_complex	Astro_LXN-==>POMC neurons	0	1	3	11	0	39	0
diff_category	Astro_LXN+==>POMC neurons	0	1	14	16	0	2	0
diff_category	Astro_LXN-==>POMC neurons	0	1	14	16	0	2	0

Variable type: logical

skim_variable	pairs	n_missing	complete_rate	mean	count
control	Astro_LXN+==>POMC neurons	0	1	0	FAL: 45
control	Astro_LXN-==>POMC neurons	0	1	0	FAL: 46

Variable type: numeric

skim_variable	pairs	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	Astro_LXN+==>POMC neurons	0	1	0.00	0.00	-0.01	0.00	0.00	0.00	0.01	▁▇▃▁▁
diff_rank	Astro_LXN-==>POMC neurons	0	1	0.00	0.00	-0.01	0.00	0.00	0.00	0.01	▁▇▃▁▁
lr_probs	Astro_LXN+==>POMC neurons	0	1	0.05	0.08	0.00	0.01	0.02	0.04	0.39	▇▁▁▁▁
lr_probs	Astro_LXN-==>POMC neurons	0	1	0.05	0.08	0.00	0.01	0.02	0.06	0.39	▇▁▁▁▁
neg_log10_specificity_rank	Astro_LXN+==>POMC neurons	0	1	2.52	1.11	1.05	1.57	2.61	3.24	5.94	▇▇▃▁▁
neg_log10_specificity_rank	Astro_LXN-==>POMC neurons	0	1	2.57	1.24	1.04	1.48	2.54	3.21	6.02	▇▇▆▁▂

Code

# Generate the plot
pr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pr <- pr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>POMC neurons",
      diff_rank >= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>POMC neurons",
      diff_rank <= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pr)

Code

pl <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pl <- pl + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>POMC neurons",
      diff_rank >= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>POMC neurons",
      diff_rank <= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pl)

Code

plr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
plr <- plr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN+==>POMC neurons" & 
        diff_rank >= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN+==>POMC neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN-==>POMC neurons" & 
        diff_rank <= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN-==>POMC neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(plr)

How do latexin positive or negative astrocytes coupled with AGRP/NPY neurons?

Normal diet

Code

df <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>AGRP/NPY neurons",
      "Astro_LXN-==>AGRP/NPY neurons"
    ),
    condition == "HFD",
    control == TRUE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    neg_log10_magnitude_rank = -log10(magnitude_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, lr_probs, control)

df

Code

skim(df)

Data summary

Name	df
Number of rows	132
Number of columns	6
_______________________
Column type frequency:
character	4
logical	1
numeric	1
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
pairs	0	1	29	29	0	2	0
lr_complex	0	1	8	27	0	71	0
ligand_complex	0	1	3	7	0	24	0
receptor_complex	0	1	3	19	0	54	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 132

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
lr_probs	0	1	0.03	0.05	0	0	0.01	0.02	0.32	▇▁▁▁▁

Code

df_specificity <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>AGRP/NPY neurons",
      "Astro_LXN-==>AGRP/NPY neurons"
    ),
    condition == "HFD",
    control == TRUE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, neg_log10_specificity_rank, control)

# Reshape the dataframe to a wider format
df_wide <- df %>%
  pivot_wider(names_from = pairs, values_from = lr_probs)

# Calculate the difference and categorize it
df_wide <- df_wide %>%
  mutate(diff_rank = `Astro_LXN+==>AGRP/NPY neurons` - `Astro_LXN-==>AGRP/NPY neurons`) %>%
  mutate(diff_category = ifelse(abs(diff_rank) > 0.001 | is.na(abs(diff_rank)), "big difference", "small difference"))

df_wide

Code

skim(df_wide)

Data summary

Name	df_wide
Number of rows	71
Number of columns	8
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	27	0	71	0
ligand_complex	0	1	3	7	0	24	0
receptor_complex	0	1	3	19	0	54	0
diff_category	0	1	14	16	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 71

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Astro_LXN-==>AGRP/NPY neurons	10	0.86	0.03	0.05	0.00	0	0.01	0.02	0.32	▇▁▁▁▁
Astro_LXN+==>AGRP/NPY neurons	0	1.00	0.02	0.05	0.00	0	0.01	0.02	0.31	▇▁▁▁▁
diff_rank	10	0.86	0.00	0.00	-0.01	0	0.00	0.00	0.00	▁▁▂▇▁

Code

# Reshape the dataframe back to a long format
df_long <- df_wide %>%
  pivot_longer(cols = c(`Astro_LXN+==>AGRP/NPY neurons`, `Astro_LXN-==>AGRP/NPY neurons`), names_to = "pairs", values_to = "lr_probs") %>%
  full_join(df_specificity, by = c("pairs", "lr_complex", "ligand_complex", "receptor_complex", "control"))

df_long

Code

skim(df_long)

Data summary

Name	df_long
Number of rows	142
Number of columns	9
_______________________
Column type frequency:
character	5
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	27	0	71	0
ligand_complex	0	1	3	7	0	24	0
receptor_complex	0	1	3	19	0	54	0
diff_category	0	1	14	16	0	2	0
pairs	0	1	29	29	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 142

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	20	0.86	0.00	0.00	-0.01	0.00	0.00	0.00	0.00	▁▁▂▇▁
lr_probs	10	0.93	0.03	0.05	0.00	0.00	0.01	0.02	0.32	▇▁▁▁▁
neg_log10_specificity_rank	10	0.93	2.80	1.25	1.15	1.86	2.55	3.39	6.62	▇▇▃▂▁

Code

# Prepare the top 20 data
top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 40) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = lr_probs, n = 10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = diff_rank, n = 15) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 60) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 20) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10) %>%
  distinct(lr_complex, diff_category, pairs, .keep_all = TRUE) %>%
  filter(!ligand_complex %in% c("Pomc", "Agrp", "Npy"))

top_bot_10

Code

skim(top_bot_10)

Data summary

Name	top_bot_10
Number of rows	85
Number of columns	9
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	pairs

Variable type: character

skim_variable	pairs	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	Astro_LXN+==>AGRP/NPY neurons	0	1	8	20	0	46	0
lr_complex	Astro_LXN-==>AGRP/NPY neurons	0	1	8	20	0	39	0
ligand_complex	Astro_LXN+==>AGRP/NPY neurons	0	1	3	7	0	18	0
ligand_complex	Astro_LXN-==>AGRP/NPY neurons	0	1	3	7	0	20	0
receptor_complex	Astro_LXN+==>AGRP/NPY neurons	0	1	3	13	0	34	0
receptor_complex	Astro_LXN-==>AGRP/NPY neurons	0	1	3	13	0	28	0
diff_category	Astro_LXN+==>AGRP/NPY neurons	0	1	14	16	0	2	0
diff_category	Astro_LXN-==>AGRP/NPY neurons	0	1	14	16	0	2	0

Variable type: logical

skim_variable	pairs	n_missing	complete_rate	mean	count
control	Astro_LXN+==>AGRP/NPY neurons	0	1	1	TRU: 46
control	Astro_LXN-==>AGRP/NPY neurons	0	1	1	TRU: 39

Variable type: numeric

skim_variable	pairs	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	Astro_LXN+==>AGRP/NPY neurons	10	0.78	0.00	0.00	-0.01	0.00	0.00	0.00	0.00	▁▁▂▇▂
diff_rank	Astro_LXN-==>AGRP/NPY neurons	4	0.90	0.00	0.00	-0.01	0.00	0.00	0.00	0.00	▁▁▂▇▂
lr_probs	Astro_LXN+==>AGRP/NPY neurons	0	1.00	0.04	0.06	0.00	0.00	0.01	0.05	0.31	▇▁▁▁▁
lr_probs	Astro_LXN-==>AGRP/NPY neurons	4	0.90	0.05	0.07	0.00	0.01	0.02	0.05	0.32	▇▁▁▁▁
neg_log10_specificity_rank	Astro_LXN+==>AGRP/NPY neurons	0	1.00	3.12	1.21	1.15	2.41	2.94	3.77	5.66	▅▇▇▂▃
neg_log10_specificity_rank	Astro_LXN-==>AGRP/NPY neurons	4	0.90	3.35	1.22	1.90	2.51	2.91	4.15	6.62	▇▅▂▂▁

Code

# Generate the plot
pr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pr <- pr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>AGRP/NPY neurons",
      diff_rank >= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>AGRP/NPY neurons",
      diff_rank <= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pr)

Code

pl <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pl <- pl + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>AGRP/NPY neurons",
      diff_rank >= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>AGRP/NPY neurons",
      diff_rank <= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pl)

Code

plr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
plr <- plr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN+==>AGRP/NPY neurons" & 
        diff_rank >= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN+==>AGRP/NPY neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN-==>AGRP/NPY neurons" & 
        diff_rank <= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN-==>AGRP/NPY neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(plr)

HFD

Code

df <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>AGRP/NPY neurons",
      "Astro_LXN-==>AGRP/NPY neurons"
    ),
    condition == "HFD",
    control == FALSE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    neg_log10_magnitude_rank = -log10(magnitude_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, lr_probs, control)

df

Code

skim(df)

Data summary

Name	df
Number of rows	116
Number of columns	6
_______________________
Column type frequency:
character	4
logical	1
numeric	1
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
pairs	0	1	29	29	0	2	0
lr_complex	0	1	8	27	0	65	0
ligand_complex	0	1	3	7	0	23	0
receptor_complex	0	1	3	19	0	50	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	0	FAL: 116

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
lr_probs	0	1	0.04	0.07	0	0	0.02	0.04	0.38	▇▁▁▁▁

Code

df_specificity <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>AGRP/NPY neurons",
      "Astro_LXN-==>AGRP/NPY neurons"
    ),
    condition == "HFD",
    control == FALSE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, neg_log10_specificity_rank, control)

# Reshape the dataframe to a wider format
df_wide <- df %>%
  pivot_wider(names_from = pairs, values_from = lr_probs)

# Calculate the difference and categorize it
df_wide <- df_wide %>%
  mutate(diff_rank = `Astro_LXN+==>AGRP/NPY neurons` - `Astro_LXN-==>AGRP/NPY neurons`) %>%
  mutate(diff_category = ifelse(abs(diff_rank) > 0.001 | is.na(abs(diff_rank)), "big difference", "small difference"))

df_wide

Code

skim(df_wide)

Data summary

Name	df_wide
Number of rows	65
Number of columns	8
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	27	0	65	0
ligand_complex	0	1	3	7	0	23	0
receptor_complex	0	1	3	19	0	50	0
diff_category	0	1	14	16	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	0	FAL: 65

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Astro_LXN-==>AGRP/NPY neurons	14	0.78	0.04	0.07	0.00	0.01	0.02	0.04	0.38	▇▁▁▁▁
Astro_LXN+==>AGRP/NPY neurons	0	1.00	0.03	0.06	0.00	0.00	0.01	0.02	0.38	▇▁▁▁▁
diff_rank	14	0.78	0.00	0.00	-0.01	0.00	0.00	0.00	0.01	▁▇▃▁▁

Code

# Reshape the dataframe back to a long format
df_long <- df_wide %>%
  pivot_longer(cols = c(`Astro_LXN+==>AGRP/NPY neurons`, `Astro_LXN-==>AGRP/NPY neurons`), names_to = "pairs", values_to = "lr_probs") %>%
  full_join(df_specificity, by = c("pairs", "lr_complex", "ligand_complex", "receptor_complex", "control"))

df_long

Code

skim(df_long)

Data summary

Name	df_long
Number of rows	130
Number of columns	9
_______________________
Column type frequency:
character	5
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	27	0	65	0
ligand_complex	0	1	3	7	0	23	0
receptor_complex	0	1	3	19	0	50	0
diff_category	0	1	14	16	0	2	0
pairs	0	1	29	29	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	0	FAL: 130

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	28	0.78	0.00	0.00	-0.01	0.00	0.00	0.00	0.01	▁▇▃▁▁
lr_probs	14	0.89	0.04	0.07	0.00	0.00	0.02	0.04	0.38	▇▁▁▁▁
neg_log10_specificity_rank	14	0.89	2.81	1.20	1.18	1.87	2.52	3.34	6.07	▇▇▃▂▂

Code

# Prepare the top 20 data
top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 40) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = lr_probs, n = 10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = diff_rank, n = 15) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 60) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 20) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10) %>%
  distinct(lr_complex, diff_category, pairs, .keep_all = TRUE) %>%
  filter(!ligand_complex %in% c("Pomc", "Agrp", "Npy"))

top_bot_10

Code

skim(top_bot_10)

Data summary

Name	top_bot_10
Number of rows	76
Number of columns	9
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	pairs

Variable type: character

skim_variable	pairs	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	Astro_LXN+==>AGRP/NPY neurons	0	1	8	19	0	38	0
lr_complex	Astro_LXN-==>AGRP/NPY neurons	0	1	8	19	0	38	0
ligand_complex	Astro_LXN+==>AGRP/NPY neurons	0	1	3	7	0	17	0
ligand_complex	Astro_LXN-==>AGRP/NPY neurons	0	1	3	7	0	17	0
receptor_complex	Astro_LXN+==>AGRP/NPY neurons	0	1	3	11	0	29	0
receptor_complex	Astro_LXN-==>AGRP/NPY neurons	0	1	3	11	0	29	0
diff_category	Astro_LXN+==>AGRP/NPY neurons	0	1	14	16	0	2	0
diff_category	Astro_LXN-==>AGRP/NPY neurons	0	1	14	16	0	2	0

Variable type: logical

skim_variable	pairs	n_missing	complete_rate	mean	count
control	Astro_LXN+==>AGRP/NPY neurons	0	1	0	FAL: 38
control	Astro_LXN-==>AGRP/NPY neurons	0	1	0	FAL: 38

Variable type: numeric

skim_variable	pairs	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	Astro_LXN+==>AGRP/NPY neurons	0	1	0.00	0.00	-0.01	0.00	0.00	0.00	0.01	▁▇▃▁▁
diff_rank	Astro_LXN-==>AGRP/NPY neurons	0	1	0.00	0.00	-0.01	0.00	0.00	0.00	0.01	▁▇▃▁▁
lr_probs	Astro_LXN+==>AGRP/NPY neurons	0	1	0.05	0.08	0.00	0.01	0.02	0.06	0.38	▇▁▁▁▁
lr_probs	Astro_LXN-==>AGRP/NPY neurons	0	1	0.05	0.08	0.00	0.01	0.02	0.06	0.38	▇▁▁▁▁
neg_log10_specificity_rank	Astro_LXN+==>AGRP/NPY neurons	0	1	2.85	1.22	1.30	1.90	2.55	3.30	6.03	▇▆▂▂▂
neg_log10_specificity_rank	Astro_LXN-==>AGRP/NPY neurons	0	1	2.75	1.25	1.21	1.88	2.38	3.29	6.07	▇▆▂▂▂

Code

# Generate the plot
pr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pr <- pr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>AGRP/NPY neurons",
      diff_rank >= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>AGRP/NPY neurons",
      diff_rank <= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pr)

Code

pl <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pl <- pl + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>AGRP/NPY neurons",
      diff_rank >= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>AGRP/NPY neurons",
      diff_rank <= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pl)

Code

plr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
plr <- plr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN+==>AGRP/NPY neurons" & 
        diff_rank >= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN+==>AGRP/NPY neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN-==>AGRP/NPY neurons" & 
        diff_rank <= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN-==>AGRP/NPY neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(plr)

Lutomska 2022

Signalling pairs

How do latexin positive or negative astrocytes coupled with POMC neurons?

Normal diet

Code

df <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>POMC neurons",
      "Astro_LXN-==>POMC neurons"
    ),
    condition == "HFHSD",
    control == TRUE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    neg_log10_magnitude_rank = -log10(magnitude_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, lr_probs, control)

df

Code

skim(df)

Data summary

Name	df
Number of rows	144
Number of columns	6
_______________________
Column type frequency:
character	4
logical	1
numeric	1
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
pairs	0	1	25	25	0	2	0
lr_complex	0	1	8	20	0	88	0
ligand_complex	0	1	3	7	0	30	0
receptor_complex	0	1	3	13	0	48	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 144

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
lr_probs	0	1	0.03	0.05	0	0	0.01	0.02	0.3	▇▁▁▁▁

Code

df_specificity <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>POMC neurons",
      "Astro_LXN-==>POMC neurons"
    ),
    condition == "HFHSD",
    control == TRUE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, neg_log10_specificity_rank, control)

# Reshape the dataframe to a wider format
df_wide <- df %>%
  pivot_wider(names_from = pairs, values_from = lr_probs)

# Calculate the difference and categorize it
df_wide <- df_wide %>%
  mutate(diff_rank = `Astro_LXN+==>POMC neurons` - `Astro_LXN-==>POMC neurons`) %>%
  mutate(diff_category = ifelse(abs(diff_rank) > 0.001 | is.na(abs(diff_rank)), "big difference", "small difference"))

df_wide

Code

skim(df_wide)

Data summary

Name	df_wide
Number of rows	88
Number of columns	8
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	20	0	88	0
ligand_complex	0	1	3	7	0	30	0
receptor_complex	0	1	3	13	0	48	0
diff_category	0	1	14	16	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 88

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Astro_LXN-==>POMC neurons	28	0.68	0.03	0.05	0.00	0	0.01	0.02	0.30	▇▁▁▁▁
Astro_LXN+==>POMC neurons	4	0.95	0.02	0.05	0.00	0	0.01	0.02	0.29	▇▁▁▁▁
diff_rank	32	0.64	0.00	0.01	-0.01	0	0.00	0.01	0.02	▁▇▂▂▁

Code

# Reshape the dataframe back to a long format
df_long <- df_wide %>%
  pivot_longer(cols = c(`Astro_LXN+==>POMC neurons`, `Astro_LXN-==>POMC neurons`), names_to = "pairs", values_to = "lr_probs") %>%
  full_join(df_specificity, by = c("pairs", "lr_complex", "ligand_complex", "receptor_complex", "control"))

df_long

Code

skim(df_long)

Data summary

Name	df_long
Number of rows	176
Number of columns	9
_______________________
Column type frequency:
character	5
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	20	0	88	0
ligand_complex	0	1	3	7	0	30	0
receptor_complex	0	1	3	13	0	48	0
diff_category	0	1	14	16	0	2	0
pairs	0	1	25	25	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 176

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	64	0.64	0.00	0.01	-0.01	0	0.00	0.01	0.02	▁▇▂▂▁
lr_probs	32	0.82	0.03	0.05	0.00	0	0.01	0.02	0.30	▇▁▁▁▁
neg_log10_specificity_rank	32	0.82	3.14	1.26	1.66	2	2.92	4.20	7.05	▇▃▃▁▁

Code

# Prepare the top 20 data
top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 40) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = lr_probs, n = 10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = diff_rank, n = 15) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 60) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 20) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10) %>%
  distinct(lr_complex, diff_category, pairs, .keep_all = TRUE) %>%
  filter(!ligand_complex %in% c("Pomc", "Agrp", "Npy"))

top_bot_10

Code

skim(top_bot_10)

Data summary

Name	top_bot_10
Number of rows	83
Number of columns	9
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	pairs

Variable type: character

skim_variable	pairs	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	Astro_LXN+==>POMC neurons	0	1	8	19	0	42	0
lr_complex	Astro_LXN-==>POMC neurons	0	1	8	19	0	41	0
ligand_complex	Astro_LXN+==>POMC neurons	0	1	3	6	0	18	0
ligand_complex	Astro_LXN-==>POMC neurons	0	1	3	6	0	18	0
receptor_complex	Astro_LXN+==>POMC neurons	0	1	3	11	0	29	0
receptor_complex	Astro_LXN-==>POMC neurons	0	1	3	11	0	29	0
diff_category	Astro_LXN+==>POMC neurons	0	1	14	16	0	2	0
diff_category	Astro_LXN-==>POMC neurons	0	1	14	16	0	2	0

Variable type: logical

skim_variable	pairs	n_missing	complete_rate	mean	count
control	Astro_LXN+==>POMC neurons	0	1	1	TRU: 42
control	Astro_LXN-==>POMC neurons	0	1	1	TRU: 41

Variable type: numeric

skim_variable	pairs	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	Astro_LXN+==>POMC neurons	2	0.95	0.00	0.01	-0.01	0.00	0.00	0.01	0.02	▁▇▁▃▁
diff_rank	Astro_LXN-==>POMC neurons	0	1.00	0.00	0.01	-0.01	0.00	0.00	0.01	0.02	▁▇▁▃▁
lr_probs	Astro_LXN+==>POMC neurons	0	1.00	0.04	0.06	0.00	0.01	0.02	0.05	0.29	▇▁▁▁▁
lr_probs	Astro_LXN-==>POMC neurons	0	1.00	0.04	0.06	0.00	0.01	0.01	0.05	0.30	▇▁▁▁▁
neg_log10_specificity_rank	Astro_LXN+==>POMC neurons	0	1.00	3.15	1.25	1.71	2.07	3.10	3.97	6.32	▇▅▃▂▁
neg_log10_specificity_rank	Astro_LXN-==>POMC neurons	0	1.00	3.05	1.23	1.69	1.89	2.87	3.60	6.45	▇▅▂▂▁

Code

# Generate the plot
pr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pr <- pr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>POMC neurons",
      diff_rank >= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>POMC neurons",
      diff_rank <= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pr)

Code

pl <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pl <- pl + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>POMC neurons",
      diff_rank >= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>POMC neurons",
      diff_rank <= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pl)

Code

plr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
plr <- plr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN+==>POMC neurons" & 
        diff_rank >= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN+==>POMC neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN-==>POMC neurons" & 
        diff_rank <= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN-==>POMC neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(plr)

HFHSD

Code

df <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>POMC neurons",
      "Astro_LXN-==>POMC neurons"
    ),
    condition == "HFHSD",
    control == FALSE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    neg_log10_magnitude_rank = -log10(magnitude_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, lr_probs, control)

df

Code

skim(df)

Data summary

Name	df
Number of rows	161
Number of columns	6
_______________________
Column type frequency:
character	4
logical	1
numeric	1
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
pairs	0	1	25	25	0	2	0
lr_complex	0	1	8	20	0	101	0
ligand_complex	0	1	3	7	0	33	0
receptor_complex	0	1	3	13	0	59	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	0	FAL: 161

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
lr_probs	0	1	0.02	0.05	0	0	0.01	0.02	0.3	▇▁▁▁▁

Code

df_specificity <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>POMC neurons",
      "Astro_LXN-==>POMC neurons"
    ),
    condition == "HFHSD",
    control == FALSE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, neg_log10_specificity_rank, control)

# Reshape the dataframe to a wider format
df_wide <- df %>%
  pivot_wider(names_from = pairs, values_from = lr_probs)

# Calculate the difference and categorize it
df_wide <- df_wide %>%
  mutate(diff_rank = `Astro_LXN+==>POMC neurons` - `Astro_LXN-==>POMC neurons`) %>%
  mutate(diff_category = ifelse(abs(diff_rank) > 0.001 | is.na(abs(diff_rank)), "big difference", "small difference"))

df_wide

Code

skim(df_wide)

Data summary

Name	df_wide
Number of rows	101
Number of columns	8
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	20	0	101	0
ligand_complex	0	1	3	7	0	33	0
receptor_complex	0	1	3	13	0	59	0
diff_category	0	1	14	16	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	0	FAL: 101

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Astro_LXN-==>POMC neurons	41	0.59	0.03	0.05	0.00	0	0.01	0.03	0.30	▇▁▁▁▁
Astro_LXN+==>POMC neurons	0	1.00	0.02	0.04	0.00	0	0.00	0.02	0.29	▇▁▁▁▁
diff_rank	41	0.59	0.00	0.00	-0.01	0	0.00	0.00	0.02	▁▇▁▁▁

Code

# Reshape the dataframe back to a long format
df_long <- df_wide %>%
  pivot_longer(cols = c(`Astro_LXN+==>POMC neurons`, `Astro_LXN-==>POMC neurons`), names_to = "pairs", values_to = "lr_probs") %>%
  full_join(df_specificity, by = c("pairs", "lr_complex", "ligand_complex", "receptor_complex", "control"))

df_long

Code

skim(df_long)

Data summary

Name	df_long
Number of rows	202
Number of columns	9
_______________________
Column type frequency:
character	5
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	20	0	101	0
ligand_complex	0	1	3	7	0	33	0
receptor_complex	0	1	3	13	0	59	0
diff_category	0	1	14	16	0	2	0
pairs	0	1	25	25	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	0	FAL: 202

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	82	0.59	0.00	0.00	-0.01	0.0	0.00	0.00	0.02	▁▇▁▁▁
lr_probs	41	0.80	0.02	0.05	0.00	0.0	0.01	0.02	0.30	▇▁▁▁▁
neg_log10_specificity_rank	41	0.80	3.61	1.27	2.06	2.4	3.48	4.46	6.34	▇▃▅▂▂

Code

# Prepare the top 20 data
top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 40) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = lr_probs, n = 10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = diff_rank, n = 15) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 60) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 20) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10) %>%
  distinct(lr_complex, diff_category, pairs, .keep_all = TRUE) %>%
  filter(!ligand_complex %in% c("Pomc", "Agrp", "Npy"))

top_bot_10

Code

skim(top_bot_10)

Data summary

Name	top_bot_10
Number of rows	83
Number of columns	9
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	pairs

Variable type: character

skim_variable	pairs	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	Astro_LXN+==>POMC neurons	0	1	8	19	0	41	0
lr_complex	Astro_LXN-==>POMC neurons	0	1	8	19	0	42	0
ligand_complex	Astro_LXN+==>POMC neurons	0	1	3	6	0	20	0
ligand_complex	Astro_LXN-==>POMC neurons	0	1	3	6	0	19	0
receptor_complex	Astro_LXN+==>POMC neurons	0	1	3	11	0	28	0
receptor_complex	Astro_LXN-==>POMC neurons	0	1	3	11	0	29	0
diff_category	Astro_LXN+==>POMC neurons	0	1	14	16	0	2	0
diff_category	Astro_LXN-==>POMC neurons	0	1	14	16	0	2	0

Variable type: logical

skim_variable	pairs	n_missing	complete_rate	mean	count
control	Astro_LXN+==>POMC neurons	0	1	0	FAL: 41
control	Astro_LXN-==>POMC neurons	0	1	0	FAL: 42

Variable type: numeric

skim_variable	pairs	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	Astro_LXN+==>POMC neurons	0	1	0.00	0.00	-0.01	0.00	0.00	0.00	0.02	▁▇▁▂▁
diff_rank	Astro_LXN-==>POMC neurons	0	1	0.00	0.00	-0.01	0.00	0.00	0.00	0.02	▁▇▁▂▁
lr_probs	Astro_LXN+==>POMC neurons	0	1	0.04	0.06	0.00	0.01	0.02	0.04	0.29	▇▁▁▁▁
lr_probs	Astro_LXN-==>POMC neurons	0	1	0.04	0.06	0.00	0.00	0.02	0.04	0.30	▇▁▁▁▁
neg_log10_specificity_rank	Astro_LXN+==>POMC neurons	0	1	3.70	1.32	2.11	2.61	3.45	4.48	6.34	▇▅▃▂▃
neg_log10_specificity_rank	Astro_LXN-==>POMC neurons	0	1	3.45	1.12	2.06	2.67	3.14	4.25	6.26	▇▆▃▂▂

Code

# Generate the plot
pr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pr <- pr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>POMC neurons",
      diff_rank >= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>POMC neurons",
      diff_rank <= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pr)

Code

pl <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pl <- pl + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>POMC neurons",
      diff_rank >= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>POMC neurons",
      diff_rank <= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pl)

Code

plr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
plr <- plr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN+==>POMC neurons" & 
        diff_rank >= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN+==>POMC neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN-==>POMC neurons" & 
        diff_rank <= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN-==>POMC neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(plr)

How do latexin positive or negative astrocytes coupled with AGRP/NPY neurons?

Normal diet

Code

df <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>AGRP/NPY neurons",
      "Astro_LXN-==>AGRP/NPY neurons"
    ),
    condition == "HFHSD",
    control == TRUE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    neg_log10_magnitude_rank = -log10(magnitude_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, lr_probs, control)

df

Code

skim(df)

Data summary

Name	df
Number of rows	121
Number of columns	6
_______________________
Column type frequency:
character	4
logical	1
numeric	1
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
pairs	0	1	29	29	0	2	0
lr_complex	0	1	8	20	0	75	0
ligand_complex	0	1	3	6	0	27	0
receptor_complex	0	1	3	13	0	42	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 121

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
lr_probs	0	1	0.02	0.04	0	0	0	0.02	0.25	▇▁▁▁▁

Code

df_specificity <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>AGRP/NPY neurons",
      "Astro_LXN-==>AGRP/NPY neurons"
    ),
    condition == "HFHSD",
    control == TRUE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, neg_log10_specificity_rank, control)

# Reshape the dataframe to a wider format
df_wide <- df %>%
  pivot_wider(names_from = pairs, values_from = lr_probs)

# Calculate the difference and categorize it
df_wide <- df_wide %>%
  mutate(diff_rank = `Astro_LXN+==>AGRP/NPY neurons` - `Astro_LXN-==>AGRP/NPY neurons`) %>%
  mutate(diff_category = ifelse(abs(diff_rank) > 0.001 | is.na(abs(diff_rank)), "big difference", "small difference"))

df_wide

Code

skim(df_wide)

Data summary

Name	df_wide
Number of rows	75
Number of columns	8
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	20	0	75	0
ligand_complex	0	1	3	6	0	27	0
receptor_complex	0	1	3	13	0	42	0
diff_category	0	1	14	16	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 75

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Astro_LXN-==>AGRP/NPY neurons	25	0.67	0.02	0.05	0	0	0.01	0.02	0.25	▇▁▁▁▁
Astro_LXN+==>AGRP/NPY neurons	4	0.95	0.02	0.03	0	0	0.00	0.02	0.21	▇▁▁▁▁
diff_rank	29	0.61	0.00	0.00	0	0	0.00	0.00	0.01	▇▆▂▂▁

Code

# Reshape the dataframe back to a long format
df_long <- df_wide %>%
  pivot_longer(cols = c(`Astro_LXN+==>AGRP/NPY neurons`, `Astro_LXN-==>AGRP/NPY neurons`), names_to = "pairs", values_to = "lr_probs") %>%
  full_join(df_specificity, by = c("pairs", "lr_complex", "ligand_complex", "receptor_complex", "control"))

df_long

Code

skim(df_long)

Data summary

Name	df_long
Number of rows	150
Number of columns	9
_______________________
Column type frequency:
character	5
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	20	0	75	0
ligand_complex	0	1	3	6	0	27	0
receptor_complex	0	1	3	13	0	42	0
diff_category	0	1	14	16	0	2	0
pairs	0	1	29	29	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 150

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	58	0.61	0.00	0.00	0.00	0.00	0.00	0.00	0.01	▇▆▂▂▁
lr_probs	29	0.81	0.02	0.04	0.00	0.00	0.00	0.02	0.25	▇▁▁▁▁
neg_log10_specificity_rank	29	0.81	2.93	1.22	1.63	1.96	2.61	3.35	7.05	▇▅▂▁▁

Code

# Prepare the top 20 data
top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 40) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = lr_probs, n = 10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = diff_rank, n = 15) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 60) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 20) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10) %>%
  distinct(lr_complex, diff_category, pairs, .keep_all = TRUE) %>%
  filter(!ligand_complex %in% c("Pomc", "Agrp", "Npy"))

top_bot_10

Code

skim(top_bot_10)

Data summary

Name	top_bot_10
Number of rows	73
Number of columns	9
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	pairs

Variable type: character

skim_variable	pairs	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	Astro_LXN+==>AGRP/NPY neurons	0	1	8	20	0	37	0
lr_complex	Astro_LXN-==>AGRP/NPY neurons	0	1	8	20	0	36	0
ligand_complex	Astro_LXN+==>AGRP/NPY neurons	0	1	3	6	0	18	0
ligand_complex	Astro_LXN-==>AGRP/NPY neurons	0	1	3	6	0	19	0
receptor_complex	Astro_LXN+==>AGRP/NPY neurons	0	1	3	13	0	26	0
receptor_complex	Astro_LXN-==>AGRP/NPY neurons	0	1	3	13	0	27	0
diff_category	Astro_LXN+==>AGRP/NPY neurons	0	1	14	16	0	2	0
diff_category	Astro_LXN-==>AGRP/NPY neurons	0	1	14	16	0	2	0

Variable type: logical

skim_variable	pairs	n_missing	complete_rate	mean	count
control	Astro_LXN+==>AGRP/NPY neurons	0	1	1	TRU: 37
control	Astro_LXN-==>AGRP/NPY neurons	0	1	1	TRU: 36

Variable type: numeric

skim_variable	pairs	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	Astro_LXN+==>AGRP/NPY neurons	4	0.89	0.00	0.00	0.00	0.00	0.00	0.01	0.01	▇▆▃▃▁
diff_rank	Astro_LXN-==>AGRP/NPY neurons	1	0.97	0.00	0.00	0.00	0.00	0.00	0.00	0.01	▇▅▃▃▁
lr_probs	Astro_LXN+==>AGRP/NPY neurons	0	1.00	0.03	0.04	0.00	0.01	0.01	0.04	0.21	▇▂▁▁▁
lr_probs	Astro_LXN-==>AGRP/NPY neurons	0	1.00	0.03	0.05	0.00	0.00	0.01	0.02	0.25	▇▁▁▁▁
neg_log10_specificity_rank	Astro_LXN+==>AGRP/NPY neurons	0	1.00	2.85	1.06	1.63	2.03	2.58	3.22	5.83	▇▇▁▂▁
neg_log10_specificity_rank	Astro_LXN-==>AGRP/NPY neurons	0	1.00	2.81	1.18	1.63	1.87	2.74	3.22	7.05	▇▇▁▁▁

Code

# Generate the plot
pr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pr <- pr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>AGRP/NPY neurons",
      diff_rank >= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>AGRP/NPY neurons",
      diff_rank <= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pr)

Code

pl <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pl <- pl + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>AGRP/NPY neurons",
      diff_rank >= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>AGRP/NPY neurons",
      diff_rank <= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pl)

Code

plr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
plr <- plr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN+==>AGRP/NPY neurons" & 
        diff_rank >= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN+==>AGRP/NPY neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN-==>AGRP/NPY neurons" & 
        diff_rank <= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN-==>AGRP/NPY neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(plr)

HFHSD

Code

df <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>AGRP/NPY neurons",
      "Astro_LXN-==>AGRP/NPY neurons"
    ),
    condition == "HFHSD",
    control == TRUE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    neg_log10_magnitude_rank = -log10(magnitude_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, lr_probs, control)

df

Code

skim(df)

Data summary

Name	df
Number of rows	121
Number of columns	6
_______________________
Column type frequency:
character	4
logical	1
numeric	1
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
pairs	0	1	29	29	0	2	0
lr_complex	0	1	8	20	0	75	0
ligand_complex	0	1	3	6	0	27	0
receptor_complex	0	1	3	13	0	42	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 121

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
lr_probs	0	1	0.02	0.04	0	0	0	0.02	0.25	▇▁▁▁▁

Code

df_specificity <- df_complex_conditions %>%
  filter(
    pairs %in% c(
      "Astro_LXN+==>AGRP/NPY neurons",
      "Astro_LXN-==>AGRP/NPY neurons"
    ),
    condition == "HFHSD",
    control == TRUE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(pairs, lr_complex, ligand_complex, receptor_complex, neg_log10_specificity_rank, control)

# Reshape the dataframe to a wider format
df_wide <- df %>%
  pivot_wider(names_from = pairs, values_from = lr_probs)

# Calculate the difference and categorize it
df_wide <- df_wide %>%
  mutate(diff_rank = `Astro_LXN+==>AGRP/NPY neurons` - `Astro_LXN-==>AGRP/NPY neurons`) %>%
  mutate(diff_category = ifelse(abs(diff_rank) > 0.001 | is.na(abs(diff_rank)), "big difference", "small difference"))

df_wide

Code

skim(df_wide)

Data summary

Name	df_wide
Number of rows	75
Number of columns	8
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	20	0	75	0
ligand_complex	0	1	3	6	0	27	0
receptor_complex	0	1	3	13	0	42	0
diff_category	0	1	14	16	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 75

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Astro_LXN-==>AGRP/NPY neurons	25	0.67	0.02	0.05	0	0	0.01	0.02	0.25	▇▁▁▁▁
Astro_LXN+==>AGRP/NPY neurons	4	0.95	0.02	0.03	0	0	0.00	0.02	0.21	▇▁▁▁▁
diff_rank	29	0.61	0.00	0.00	0	0	0.00	0.00	0.01	▇▆▂▂▁

Code

# Reshape the dataframe back to a long format
df_long <- df_wide %>%
  pivot_longer(cols = c(`Astro_LXN+==>AGRP/NPY neurons`, `Astro_LXN-==>AGRP/NPY neurons`), names_to = "pairs", values_to = "lr_probs") %>%
  full_join(df_specificity, by = c("pairs", "lr_complex", "ligand_complex", "receptor_complex", "control"))

df_long

Code

skim(df_long)

Data summary

Name	df_long
Number of rows	150
Number of columns	9
_______________________
Column type frequency:
character	5
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	20	0	75	0
ligand_complex	0	1	3	6	0	27	0
receptor_complex	0	1	3	13	0	42	0
diff_category	0	1	14	16	0	2	0
pairs	0	1	29	29	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 150

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	58	0.61	0.00	0.00	0.00	0.00	0.00	0.00	0.01	▇▆▂▂▁
lr_probs	29	0.81	0.02	0.04	0.00	0.00	0.00	0.02	0.25	▇▁▁▁▁
neg_log10_specificity_rank	29	0.81	2.93	1.22	1.63	1.96	2.61	3.35	7.05	▇▅▂▁▁

Code

# Prepare the top 20 data
top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 40) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = lr_probs, n = 10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = diff_rank, n = 15) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 60) %>%
  ungroup() %>%
  group_by(pairs) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 20) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "small difference"
  ) %>%
  group_by(pairs) %>%
  distinct(ligand_complex, diff_category, lr_probs, pairs, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10) %>%
  distinct(lr_complex, diff_category, pairs, .keep_all = TRUE) %>%
  filter(!ligand_complex %in% c("Pomc", "Agrp", "Npy"))

top_bot_10

Code

skim(top_bot_10)

Data summary

Name	top_bot_10
Number of rows	73
Number of columns	9
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	pairs

Variable type: character

skim_variable	pairs	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	Astro_LXN+==>AGRP/NPY neurons	0	1	8	20	0	37	0
lr_complex	Astro_LXN-==>AGRP/NPY neurons	0	1	8	20	0	36	0
ligand_complex	Astro_LXN+==>AGRP/NPY neurons	0	1	3	6	0	18	0
ligand_complex	Astro_LXN-==>AGRP/NPY neurons	0	1	3	6	0	19	0
receptor_complex	Astro_LXN+==>AGRP/NPY neurons	0	1	3	13	0	26	0
receptor_complex	Astro_LXN-==>AGRP/NPY neurons	0	1	3	13	0	27	0
diff_category	Astro_LXN+==>AGRP/NPY neurons	0	1	14	16	0	2	0
diff_category	Astro_LXN-==>AGRP/NPY neurons	0	1	14	16	0	2	0

Variable type: logical

skim_variable	pairs	n_missing	complete_rate	mean	count
control	Astro_LXN+==>AGRP/NPY neurons	0	1	1	TRU: 37
control	Astro_LXN-==>AGRP/NPY neurons	0	1	1	TRU: 36

Variable type: numeric

skim_variable	pairs	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	Astro_LXN+==>AGRP/NPY neurons	4	0.89	0.00	0.00	0.00	0.00	0.00	0.01	0.01	▇▆▃▃▁
diff_rank	Astro_LXN-==>AGRP/NPY neurons	1	0.97	0.00	0.00	0.00	0.00	0.00	0.00	0.01	▇▅▃▃▁
lr_probs	Astro_LXN+==>AGRP/NPY neurons	0	1.00	0.03	0.04	0.00	0.01	0.01	0.04	0.21	▇▂▁▁▁
lr_probs	Astro_LXN-==>AGRP/NPY neurons	0	1.00	0.03	0.05	0.00	0.00	0.01	0.02	0.25	▇▁▁▁▁
neg_log10_specificity_rank	Astro_LXN+==>AGRP/NPY neurons	0	1.00	2.85	1.06	1.63	2.03	2.58	3.22	5.83	▇▇▁▂▁
neg_log10_specificity_rank	Astro_LXN-==>AGRP/NPY neurons	0	1.00	2.81	1.18	1.63	1.87	2.74	3.22	7.05	▇▇▁▁▁

Code

# Generate the plot
pr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pr <- pr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>AGRP/NPY neurons",
      diff_rank >= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>AGRP/NPY neurons",
      diff_rank <= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pr)

Code

pl <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pl <- pl + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN+==>AGRP/NPY neurons",
      diff_rank >= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      pairs == "Astro_LXN-==>AGRP/NPY neurons",
      diff_rank <= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pl)

Code

plr <- ggplot(df_long, aes(x = pairs, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
plr <- plr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN+==>AGRP/NPY neurons" & 
        diff_rank >= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN+==>AGRP/NPY neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (pairs == "Astro_LXN-==>AGRP/NPY neurons" & 
        diff_rank <= 0) |
        (!is.na(lr_probs) &
           pairs == "Astro_LXN-==>AGRP/NPY neurons" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(plr)

ARC vs PVN (Lopez)

Signalling pairs

How do latexin positive or negative astrocytes coupled with POMC neurons?

Code

df <- df_complex_conditions %>%
  filter(
    pairs == "Astro_LXN+==>POMC neurons",
    condition %in% c("CSDS", "HFHSD"),
    control == TRUE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    neg_log10_magnitude_rank = -log10(magnitude_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(region, lr_complex, ligand_complex, receptor_complex, lr_probs, control)

df

Code

skim(df)

Data summary

Name	df
Number of rows	149
Number of columns	6
_______________________
Column type frequency:
character	4
logical	1
numeric	1
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
region	0	1	3	3	0	2	0
lr_complex	0	1	8	27	0	103	0
ligand_complex	0	1	3	7	0	31	0
receptor_complex	0	1	3	19	0	60	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 149

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
lr_probs	0	1	0.02	0.04	0	0	0.01	0.02	0.29	▇▁▁▁▁

Code

df_specificity <- df_complex_conditions %>%
  filter(
    pairs == "Astro_LXN+==>POMC neurons",
    condition %in% c("CSDS", "HFHSD"),
    control == TRUE
  ) %>%
  mutate(
    neg_log10_specificity_rank = -log10(specificity_rank),
    lr_complex = str_c(ligand_complex, receptor_complex, sep = "–>")
  ) %>%
  select(region, lr_complex, ligand_complex, receptor_complex, neg_log10_specificity_rank, control)

# Reshape the dataframe to a wider format
df_wide <- df %>%
  pivot_wider(names_from = region, values_from = lr_probs)

# Calculate the difference and categorize it
df_wide <- df_wide %>%
  mutate(diff_rank = `PVN` - `ARC`) %>%
  mutate(diff_category = ifelse(abs(diff_rank) > 0.002 | is.na(abs(diff_rank)), "big difference", "small difference"))

df_wide

Code

skim(df_wide)

Data summary

Name	df_wide
Number of rows	103
Number of columns	8
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	27	0	103	0
ligand_complex	0	1	3	7	0	31	0
receptor_complex	0	1	3	19	0	60	0
diff_category	0	1	14	16	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 103

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
PVN	38	0.63	0.02	0.04	0.00	0.00	0.01	0.02	0.26	▇▁▁▁▁
ARC	19	0.82	0.02	0.05	0.00	0.00	0.01	0.02	0.29	▇▁▁▁▁
diff_rank	57	0.45	-0.01	0.02	-0.09	-0.02	-0.01	0.00	0.02	▁▁▁▇▁

Code

# Reshape the dataframe back to a long format
df_long <- df_wide %>%
  pivot_longer(cols = c(ARC, PVN), names_to = "region", values_to = "lr_probs") %>%
  full_join(df_specificity, by = c("region", "lr_complex", "ligand_complex", "receptor_complex", "control"))

df_long

Code

skim(df_long)

Data summary

Name	df_long
Number of rows	206
Number of columns	9
_______________________
Column type frequency:
character	5
logical	1
numeric	3
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	0	1	8	27	0	103	0
ligand_complex	0	1	3	7	0	31	0
receptor_complex	0	1	3	19	0	60	0
diff_category	0	1	14	16	0	2	0
region	0	1	3	3	0	2	0

Variable type: logical

skim_variable	n_missing	complete_rate	mean	count
control	0	1	1	TRU: 206

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	114	0.45	-0.01	0.02	-0.09	-0.02	-0.01	0.00	0.02	▁▁▁▇▁
lr_probs	57	0.72	0.02	0.04	0.00	0.00	0.01	0.02	0.29	▇▁▁▁▁
neg_log10_specificity_rank	57	0.72	2.96	1.21	1.43	1.96	2.67	3.49	7.05	▇▆▂▁▁

Code

# Prepare the top 20 data
top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(region) %>%
  distinct(ligand_complex, diff_category, lr_probs, region, .keep_all = TRUE) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 40) %>%
  ungroup() %>%
  group_by(region) %>%
  slice_max(order_by = lr_probs, n = 10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "big difference"
  ) %>%
  group_by(region) %>%
  distinct(ligand_complex, diff_category, lr_probs, region, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "big difference"
  ) %>%
  group_by(region) %>%
  distinct(ligand_complex, diff_category, lr_probs, region, .keep_all = TRUE) %>%
  slice_max(order_by = diff_rank, n = 15) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    !ligand_complex %in% df_long$receptor_complex,
    diff_category == "small difference"
  ) %>%
  group_by(region) %>%
  distinct(ligand_complex, diff_category, lr_probs, region, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 60) %>%
  ungroup() %>%
  group_by(region) %>%
  slice_max(order_by = neg_log10_specificity_rank, n = 20) %>%
  bind_rows(top_bot_10)

top_bot_10 <- df_long %>%
  filter(
    diff_category == "small difference"
  ) %>%
  group_by(region) %>%
  distinct(ligand_complex, diff_category, lr_probs, region, .keep_all = TRUE) %>%
  slice_max(order_by = lr_probs, n = 10) %>%
  bind_rows(top_bot_10) %>%
  distinct(lr_complex, diff_category, region, .keep_all = TRUE) %>%
  filter(!ligand_complex %in% c("Pomc", "Agrp", "Npy"))

top_bot_10

Code

skim(top_bot_10)

Data summary

Name	top_bot_10
Number of rows	65
Number of columns	9
_______________________
Column type frequency:
character	4
logical	1
numeric	3
________________________
Group variables	region

Variable type: character

skim_variable	region	n_missing	complete_rate	min	max	empty	n_unique	whitespace
lr_complex	ARC	0	1	8	19	0	34	0
lr_complex	PVN	0	1	8	19	0	31	0
ligand_complex	ARC	0	1	3	6	0	16	0
ligand_complex	PVN	0	1	3	6	0	16	0
receptor_complex	ARC	0	1	3	11	0	28	0
receptor_complex	PVN	0	1	3	11	0	24	0
diff_category	ARC	0	1	14	16	0	2	0
diff_category	PVN	0	1	14	16	0	2	0

Variable type: logical

skim_variable	region	n_missing	complete_rate	mean	count
control	ARC	0	1	1	TRU: 34
control	PVN	0	1	1	TRU: 31

Variable type: numeric

skim_variable	region	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
diff_rank	ARC	1	0.97	-0.01	0.02	-0.09	-0.02	-0.01	0.00	0.02	▁▁▂▇▂
diff_rank	PVN	0	1.00	-0.01	0.02	-0.09	-0.01	-0.01	0.00	0.02	▁▁▂▇▂
lr_probs	ARC	0	1.00	0.05	0.07	0.00	0.01	0.02	0.06	0.29	▇▂▁▁▁
lr_probs	PVN	0	1.00	0.03	0.05	0.00	0.00	0.01	0.04	0.26	▇▁▁▁▁
neg_log10_specificity_rank	ARC	0	1.00	3.12	1.24	1.68	2.10	2.92	3.63	6.32	▇▃▂▂▁
neg_log10_specificity_rank	PVN	0	1.00	2.74	1.00	1.43	1.92	2.56	3.19	5.59	▆▇▃▁▁

Code

# Generate the plot
pr <- ggplot(df_long, aes(x = region, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pr <- pr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      region == "PVN",
      diff_rank >= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      region == "ARC",
      diff_rank <= 0
    ),
  aes(
    label = receptor_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pr)

Code

pl <- ggplot(df_long, aes(x = region, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
pl <- pl + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      region == "PVN",
      diff_rank >= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      region == "ARC",
      diff_rank <= 0
    ),
  aes(
    label = ligand_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(pl)

Code

plr <- ggplot(df_long, aes(x = region, y = lr_probs, color = as.factor(diff_category), size = neg_log10_specificity_rank)) +
  geom_jitter(width = 0.05) +
  geom_line(aes(group = lr_complex), linetype = "solid", alpha = 0.2) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
  facet_wrap(~diff_category)

# Add text labels for min and max 5 values within each group using ggrepel
plr <- plr + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (region == "PVN" & 
        diff_rank >= 0) |
        (!is.na(lr_probs) &
           region == "PVN" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = 0.2, direction = "y", hjust = "left",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) + geom_text_repel(
  data = top_bot_10 %>%
    filter(
      (region == "ARC" & 
        diff_rank <= 0) |
        (!is.na(lr_probs) &
           region == "ARC" & 
           is.na(diff_rank))
    ),
  aes(
    label = lr_complex,
    point.size = neg_log10_specificity_rank
  ), # data point size
  nudge_x = -.2, direction = "y", hjust = "right",
  size = 6, # font size in the text labels
  point.padding = 0.2, # additional padding around each point
  min.segment.length = 0, # draw all line segments
  max.time = 5, max.iter = 1e6, # stop after 1 second, or after 100,000 iterations
  seed = reseed,
  max.overlaps = Inf,
  box.padding = 0.5
) +
  scale_x_discrete(expand = expansion(add = 2))

print(plr)

Session info

Code

sessioninfo::session_info()

─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.3 (2023-03-15)
 os       macOS 14.0
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       Europe/Vienna
 date     2023-08-01
 pandoc   3.1.1 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/ (via rmarkdown)

─ Packages ───────────────────────────────────────────────────────────────────
 package          * version    date (UTC) lib source
 base64enc          0.1-3      2015-07-28 [1] CRAN (R 4.2.0)
 bayestestR         0.13.1     2023-04-07 [1] RSPM (R 4.2.3)
 bit                4.0.5      2022-11-15 [1] CRAN (R 4.2.0)
 bit64              4.0.5      2020-08-30 [1] CRAN (R 4.2.0)
 boot               1.3-28.1   2022-11-22 [1] CRAN (R 4.2.3)
 cli                3.6.1      2023-03-23 [1] RSPM (R 4.2.3)
 coda               0.19-4     2020-09-30 [1] CRAN (R 4.2.0)
 codetools          0.2-19     2023-02-01 [1] CRAN (R 4.2.3)
 colorspace         2.1-0      2023-01-23 [1] CRAN (R 4.2.0)
 ComplexUpset     * 1.3.5      2022-11-28 [1] Github (krassowski/complex-upset@bb3f10a)
 correlation        0.8.4      2023-04-06 [1] RSPM (R 4.2.3)
 cowplot          * 1.1.1      2020-12-30 [1] CRAN (R 4.2.0)
 crayon             1.5.2      2022-09-29 [1] CRAN (R 4.2.0)
 dabestr          * 0.3.0      2022-05-21 [1] Github (ACCLAB/dabestr@8775899)
 datawizard         0.7.1      2023-04-03 [1] RSPM (R 4.2.3)
 digest             0.6.31     2022-12-11 [1] CRAN (R 4.2.0)
 dplyr            * 1.1.2      2023-04-20 [1] RSPM (R 4.2.3)
 emmeans            1.8.5      2023-03-08 [1] RSPM (R 4.2.3)
 estimability       1.4.1      2022-08-05 [1] CRAN (R 4.2.0)
 evaluate           0.21       2023-05-05 [1] RSPM (R 4.2.3)
 fansi              1.0.4      2023-01-22 [1] CRAN (R 4.2.0)
 farver             2.1.1      2022-07-06 [1] CRAN (R 4.2.0)
 fastmap            1.1.1      2023-02-24 [1] RSPM (R 4.2.3)
 forcats          * 1.0.0      2023-01-29 [1] CRAN (R 4.2.0)
 future           * 1.33.0     2023-07-01 [1] RSPM (R 4.2.3)
 generics           0.1.3      2022-07-05 [1] CRAN (R 4.2.0)
 ggmin              0.0.0.9000 2022-08-12 [1] Github (sjessa/ggmin@8ada274)
 ggplot2          * 3.4.2      2023-04-03 [1] RSPM (R 4.2.3)
 ggrepel          * 0.9.3      2023-02-03 [1] RSPM (R 4.2.3)
 ggstatsplot      * 0.11.1     2023-04-14 [1] RSPM (R 4.2.3)
 ggupset          * 0.3.0.9002 2022-05-21 [1] Github (const-ae/ggupset@2a03c58)
 globals            0.16.2     2022-11-21 [1] CRAN (R 4.2.0)
 glue               1.6.2      2022-02-24 [1] CRAN (R 4.2.0)
 gtable             0.3.3      2023-03-21 [1] RSPM (R 4.2.3)
 here             * 1.0.1      2020-12-13 [1] CRAN (R 4.2.0)
 hms                1.1.3      2023-03-21 [1] RSPM (R 4.2.3)
 htmltools          0.5.5      2023-03-23 [1] RSPM (R 4.2.3)
 htmlwidgets        1.6.2      2023-03-17 [1] RSPM (R 4.2.3)
 insight            0.19.1     2023-03-18 [1] RSPM (R 4.2.3)
 jsonlite           1.8.4      2022-12-06 [1] CRAN (R 4.2.0)
 knitr              1.42       2023-01-25 [1] RSPM
 labeling           0.4.2      2020-10-20 [1] CRAN (R 4.2.0)
 lattice            0.21-8     2023-04-05 [1] RSPM (R 4.2.3)
 lifecycle          1.0.3      2022-10-07 [1] CRAN (R 4.2.0)
 listenv            0.9.0      2022-12-16 [1] CRAN (R 4.2.0)
 lubridate        * 1.9.2      2023-02-10 [1] RSPM (R 4.2.3)
 magrittr         * 2.0.3      2022-03-30 [1] CRAN (R 4.2.0)
 MASS               7.3-58.3   2023-03-07 [1] RSPM (R 4.2.3)
 Matrix             1.5-4      2023-04-04 [1] RSPM (R 4.2.3)
 multcomp           1.4-23     2023-03-09 [1] RSPM (R 4.2.3)
 munsell            0.5.0      2018-06-12 [1] CRAN (R 4.2.0)
 mvtnorm            1.1-3      2021-10-08 [1] CRAN (R 4.2.0)
 paletteer          1.5.0      2022-10-19 [1] CRAN (R 4.2.0)
 parallelly         1.36.0     2023-05-26 [1] RSPM (R 4.2.3)
 parameters         0.21.0     2023-04-19 [1] RSPM (R 4.2.3)
 patchwork        * 1.1.2.9000 2023-02-08 [1] Github (thomasp85/patchwork@c14c960)
 pillar             1.9.0      2023-03-22 [1] RSPM (R 4.2.3)
 pkgconfig          2.0.3      2019-09-22 [1] CRAN (R 4.2.0)
 png                0.1-8      2022-11-29 [1] CRAN (R 4.2.0)
 purrr            * 1.0.1      2023-01-10 [1] CRAN (R 4.2.0)
 R6                 2.5.1      2021-08-19 [1] CRAN (R 4.2.0)
 RColorBrewer     * 1.1-3      2022-04-03 [1] CRAN (R 4.2.0)
 Rcpp               1.0.10     2023-01-22 [1] CRAN (R 4.2.0)
 readr            * 2.1.4      2023-02-10 [1] RSPM (R 4.2.3)
 rematch2           2.1.2      2020-05-01 [1] CRAN (R 4.2.0)
 repr               1.1.6      2023-01-26 [1] CRAN (R 4.2.0)
 reticulate       * 1.30-9000  2023-07-30 [1] Github (rstudio/reticulate@9a1ed79)
 rlang              1.1.0      2023-03-14 [1] RSPM (R 4.2.3)
 rmarkdown          2.21       2023-03-26 [1] RSPM (R 4.2.3)
 rprojroot          2.0.3      2022-04-02 [1] CRAN (R 4.2.0)
 rstudioapi         0.14       2022-08-22 [1] CRAN (R 4.2.0)
 sandwich           3.0-2      2022-06-15 [1] CRAN (R 4.2.0)
 scales             1.2.1      2022-08-20 [1] CRAN (R 4.2.0)
 sessioninfo        1.2.2      2021-12-06 [1] CRAN (R 4.2.0)
 skimr            * 2.1.5      2023-02-08 [1] Github (ropensci/skimr@d5126aa)
 statsExpressions   1.5.0      2023-02-19 [1] RSPM (R 4.2.3)
 stringi            1.7.12     2023-01-11 [1] CRAN (R 4.2.0)
 stringr          * 1.5.0      2022-12-02 [1] CRAN (R 4.2.0)
 survival           3.5-5      2023-03-12 [1] RSPM (R 4.2.3)
 TH.data            1.1-2      2023-04-17 [1] RSPM (R 4.2.3)
 tibble           * 3.2.1      2023-03-20 [1] RSPM (R 4.2.3)
 tidyr            * 1.3.0      2023-01-24 [1] CRAN (R 4.2.0)
 tidyselect         1.2.0      2022-10-10 [1] CRAN (R 4.2.0)
 tidyverse        * 2.0.0      2023-02-22 [1] RSPM (R 4.2.3)
 timechange         0.2.0      2023-01-11 [1] CRAN (R 4.2.0)
 tzdb               0.3.0      2022-03-28 [1] CRAN (R 4.2.0)
 utf8               1.2.3      2023-01-31 [1] CRAN (R 4.2.0)
 vctrs              0.6.2      2023-04-19 [1] RSPM (R 4.2.3)
 vroom              1.6.1      2023-01-22 [1] CRAN (R 4.2.0)
 withr              2.5.0      2022-03-03 [1] CRAN (R 4.2.0)
 xfun               0.39       2023-04-20 [1] RSPM (R 4.2.3)
 xtable             1.8-4      2019-04-21 [1] CRAN (R 4.2.0)
 yaml               2.3.7      2023-01-23 [1] RSPM
 zeallot            0.1.0      2018-01-28 [1] CRAN (R 4.2.0)
 zoo                1.8-12     2023-04-13 [1] RSPM (R 4.2.3)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────