In githubz0r/SecretUtils: Some utils for Conos

Introduction

library(conos)
library(pheatmap)
devtools::load_all('/home/larsc/SecretUtils')
require(pagoda2)
library(dplyr)
library(stringr)
library(tidyr)
library(ggplot2)
library(cowplot)
library(igraph)
con <- readRDS(file.path('/home/larsc/data/10x_preproced_graphed.rds'))
annot <- readRDS(file.path('/home/demharters/R/projects/UPF9_14_17_19_22_23_24_32_33/metadata_10x_final.rds'))

annot <- annot %>% mutate(cellid = rownames(annot)) # turn rownames into a col for convenience
annot <- annot %>% mutate(subtype_condition = paste(annot$subtype, annot$condition, sep='_'))
annot <- annot %>% mutate(subtype_sample = paste(annot$subtype, annot$sample, sep='-'))
conos_distances <- Matrix::readMM('/home/larsc/data/scan_stuff/graph_distances.mtx')

mem_levels <- factor(annot$subtype_sample) %>% levels
subtype_order <- gsub(".*-","", mem_levels) %>% unique
subtype_order2 <- (paste0(annot$subtype) %>% unique)[order(paste0(annot$subtype) %>% unique)]
membership_vec <- as.numeric(factor(annot$subtype_condition))
membership_levels <- factor(annot$subtype_sample) %>% levels
membership_vec_subsamp <- as.numeric(factor(annot$subtype_sample))

Paga statistics, subtype-condition

#source("/d0/home/larsc/SecretUtils/R/graph_stuff.R")

connectivities <- GetPagaMatrix(conos_distances, membership_vec, scale=F)

linearized_stats <- seq(1, dim(connectivities)[1], 2) %>% sapply(function(i){connectivities[i,i+1]})

paga_df <- bind_cols(value=linearized_stats, subtype=subtype_order2)
ggplot(paga_df, aes(y=-linearized_stats, x=subtype)) +geom_point()+
  theme(axis.text.x = element_text(angle = -90, hjust = 1))

Let's incorporate the samples

connectivities <- GetPagaMatrix(conos_distances, membership_vec_subsamp, scale=F)

GenerateFactorVectors <- function(subtype.vector, sample.vector, condition.vector) {
  conc <- paste0(subtype.vector, "-;;-", sample.vector, ";__;" , condition.vector) %>% as.factor %>% levels
  subtypes <- gsub("-;;-.*", "", conc)
  samples <- gsub(".*-;;-", "", conc)
  samples <- gsub(';__;.*', "", samples)
  condition <- gsub('.*;__;', "", conc)
  return(bind_cols(subtypes=subtypes, samples=samples, condition=condition, concatenated=conc))
}
factor_vectors <- GenerateFactorVectors(annot$subtype, annot$sample, annot$condition)
sub_cond_indices <- as.factor(factor_vectors$concatenated) %>% as.numeric %>% 
  split(list(factor_vectors$subtypes, factor_vectors$condition))
sub_cond_indices <- sub_cond_indices[order(sub_cond_indices %>% names)]

sub_samp_factor <- as.factor(factor_vectors$samples) %>% 
  split(list(factor_vectors$subtypes, factor_vectors$condition))
sub_samp_factor <- sub_samp_factor[order(sub_samp_factor %>% names)]

sub_cond_factor <- as.factor(factor_vectors$condition) %>% 
  split(list(factor_vectors$subtypes, factor_vectors$condition))
sub_cond_factor <- sub_cond_factor[order(sub_cond_factor %>% names)]

GetSubConnectivity <- function(indices1, indices2, connectivity.matrix){
  return(connectivity.matrix[indices1, indices2])
}

factor1_mats <- seq(1, length(sub_cond_indices), 2) %>% 
  lapply(function(i){sub.mat <- GetSubConnectivity(sub_cond_indices[[i]], sub_cond_indices[[i]], connectivities);
    rownames(sub.mat) <- sub_samp_factor[[i]]; colnames(sub.mat) <- sub_samp_factor[[i]]; return(sub.mat)})
names(factor1_mats) <- factor_vectors$subtypes %>% as.factor %>% levels

factor2_mats <- seq(2, length(sub_cond_indices), 2) %>% 
  lapply(function(i){sub.mat <- GetSubConnectivity(sub_cond_indices[[i]], sub_cond_indices[[i]], connectivities);
    rownames(sub.mat) <- sub_samp_factor[[i]]; colnames(sub.mat) <- sub_samp_factor[[i]]; return(sub.mat)})
names(factor2_mats) <- factor_vectors$subtypes %>% as.factor %>% levels

between_mats <- seq(1, length(sub_cond_indices), 2) %>% 
  lapply(function(i){sub.mat <- GetSubConnectivity(sub_cond_indices[[i]], sub_cond_indices[[i+1]], connectivities);
    rownames(sub.mat) <- sub_samp_factor[[i]]; colnames(sub.mat) <- sub_samp_factor[[i+1]]; return(sub.mat)})
names(between_mats) <- factor_vectors$subtypes %>% as.factor %>% levels

factor1_identity <- sub_cond_factor[[1]] %>% unique %>% as.character
factor2_identity <- sub_cond_factor[[2]] %>% unique %>% as.character

MeltMatrix <- function(x, symmetric){
  if (symmetric) {
    x[lower.tri(x)] <- NA; diag(x) <- NA
    df <- na.omit(reshape2::melt(as.matrix(x)))
  } else {
    df <- reshape2::melt(as.matrix(x))
  }
  df <- bind_cols(value=df$value, comparison=paste0(df$Var1, '-', df$Var2))
  return(df)
}

MeltAndAppend <- function(mat.list, factor.identity, symmetric=TRUE) {
  molten.mats <- mat.list %>% lapply(MeltMatrix, symmetric)
  AppendCols <- function(df, subtype.name, factor.identity){
    df$subtype = subtype.name
    df$condition = factor.identity
    return(df)
  }
  extended.dfs <- Map(AppendCols, molten.mats, names(mat.list), MoreArgs=list(factor.identity))
  return(extended.dfs)
}

epilepsy_dfs <- MeltAndAppend(factor1_mats, factor1_identity)
healthy_dfs <- MeltAndAppend(factor2_mats, factor2_identity)
between_dfs <- MeltAndAppend(between_mats, 'between', symmetric = FALSE)

(connectivities[1:4, 5:7] %>%  as.matrix %>% melt)$value %in% between_dfs[[1]]$value # seems to be true

plot_df <- bind_rows(epilepsy_dfs, healthy_dfs, between_dfs)
plot_df %>% ggplot(aes(x=subtype, y=-value ,dodge=condition,fill=condition))+
    geom_boxplot() + theme(axis.text.x = element_text(angle = 90, hjust = 1), 
                           axis.text.y = element_text(angle = 90, hjust = 0.5))+
  theme(legend.position="top")#+ylim(-50,0)