Visualization Guide

library(SCENT)
library(ggplot2)
library(viridis)

# Load data
data(net13Jun12.m)

# Simulate data with known structure
set.seed(2024)
n_genes <- 5500

# Create 3 cell populations with different potency levels
n_per_group <- 50

# High potency (stem-like): broad expression
exp_high <- matrix(rpois(n_genes * n_per_group, 5), nrow = n_genes)

# Medium potency: intermediate
exp_med <- matrix(rpois(n_genes * n_per_group, 3), nrow = n_genes)
exp_med[1:1000, ] <- rpois(1000 * n_per_group, 10)

# Low potency (differentiated): focused expression
exp_low <- matrix(rpois(n_genes * n_per_group, 2), nrow = n_genes)
exp_low[1:500, ] <- rpois(500 * n_per_group, 20)

# Combine
exp_all <- cbind(exp_high, exp_med, exp_low)
rownames(exp_all) <- head(rownames(net13Jun12.m), n_genes)
colnames(exp_all) <- paste0("Cell_", 1:ncol(exp_all))

# Cell annotations
cell_groups <- factor(
  rep(c("High Potency", "Medium Potency", "Low Potency"), each = n_per_group),
  levels = c("High Potency", "Medium Potency", "Low Potency")
)

# Compute scores
integ <- DoIntegPPI(exp_all, net13Jun12.m)
sr <- CompSRana(integ, local = TRUE)
ccat <- CompCCAT(exp_all, net13Jun12.m)

# Create data frame
df <- data.frame(
  Cell = colnames(exp_all),
  Group = cell_groups,
  SR = sr$SR,
  CCAT = ccat
)

cat("Data prepared:", nrow(df), "cells in", length(unique(df$Group)), "groups\n")
#> Data prepared: 150 cells in 3 groups

# Pairwise comparisons
groups <- levels(df$Group)
cat("Statistical Comparisons (Wilcoxon test):\n\n")
#> Statistical Comparisons (Wilcoxon test):

for (i in 1:(length(groups)-1)) {
  for (j in (i+1):length(groups)) {
    g1 <- df$SR[df$Group == groups[i]]
    g2 <- df$SR[df$Group == groups[j]]
    test <- wilcox.test(g1, g2)
    cat(sprintf("%s vs %s: p = %.2e\n", 
                groups[i], groups[j], test$p.value))
  }
}
#> High Potency vs Medium Potency: p = 7.07e-18
#> High Potency vs Low Potency: p = 7.07e-18
#> Medium Potency vs Low Potency: p = 0.00e+00

# Get top variable genes by local entropy variance
locS_var <- apply(sr$locS, 1, var)
top_idx <- order(locS_var, decreasing = TRUE)[1:30]

# Subset and scale
locS_top <- sr$locS[top_idx, ]
locS_scaled <- t(scale(t(locS_top)))

# Reorder columns by group
order_idx <- order(cell_groups)
locS_ordered <- locS_scaled[, order_idx]

# Use base R image for simplicity
image(
  t(locS_ordered),
  col = viridis::viridis(100),
  axes = FALSE,
  main = "Local Entropy Heatmap\n(Top 30 variable genes)",
  xlab = "Cells (ordered by potency)",
  ylab = "Genes"
)

# Summary statistics using base R
summary_list <- lapply(levels(df$Group), function(g) {
  sub <- df[df$Group == g, ]
  data.frame(
    Group = g,
    N = nrow(sub),
    SR_Mean = round(mean(sub$SR), 4),
    SR_SD = round(sd(sub$SR), 4),
    CCAT_Mean = round(mean(sub$CCAT), 4),
    CCAT_SD = round(sd(sub$CCAT), 4)
  )
})
summary_df <- do.call(rbind, summary_list)

knitr::kable(
  summary_df,
  caption = "Summary Statistics by Cell Population"
)

sessionInfo()
#> R version 4.6.0 (2026-04-24)
#> Platform: x86_64-pc-linux-gnu
#> Running under: Ubuntu 24.04.4 LTS
#> 
#> Matrix products: default
#> BLAS:   /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3 
#> LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.26.so;  LAPACK version 3.12.0
#> 
#> locale:
#>  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
#>  [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
#>  [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
#>  [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                 
#>  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
#> [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       
#> 
#> time zone: Etc/UTC
#> tzcode source: system (glibc)
#> 
#> attached base packages:
#> [1] stats     graphics  grDevices utils     datasets  methods   base     
#> 
#> other attached packages:
#> [1] viridis_0.6.5     viridisLite_0.4.3 Matrix_1.7-5      ggplot2_4.0.3    
#> [5] SCENT_2.0.0       rmarkdown_2.31   
#> 
#> loaded via a namespace (and not attached):
#>  [1] gtable_0.3.6       jsonlite_2.0.0     dplyr_1.2.1        compiler_4.6.0    
#>  [5] tidyselect_1.2.1   Rcpp_1.1.1-1.1     gridExtra_2.3      jquerylib_0.1.4   
#>  [9] splines_4.6.0      scales_1.4.0       yaml_2.3.12        fastmap_1.2.0     
#> [13] lattice_0.22-9     R6_2.6.1           labeling_0.4.3     generics_0.1.4    
#> [17] igraph_2.3.2       knitr_1.51         tibble_3.3.1       maketools_1.3.2   
#> [21] bslib_0.11.0       pillar_1.11.1      RColorBrewer_1.1-3 rlang_1.2.0       
#> [25] cachem_1.1.0       xfun_0.59          sass_0.4.10        sys_3.4.3         
#> [29] S7_0.2.2           otel_0.2.0         cli_3.6.6          mgcv_1.9-4        
#> [33] withr_3.0.3        magrittr_2.0.5     digest_0.6.39      grid_4.6.0        
#> [37] nlme_3.1-169       lifecycle_1.0.5    vctrs_0.7.3        evaluate_1.0.5    
#> [41] glue_1.8.1         farver_2.1.2       buildtools_1.0.0   tools_4.6.0       
#> [45] pkgconfig_2.0.3    htmltools_0.5.9