Load Libraries

library(Seurat)
library(WGCNA)
library(cluster)
library(genefilter)
library(tidyverse)
library(tidygraph)
library(ggraph)
library(reshape2)
library(parallelDist)
library(ggsci)
library(emmeans)
library(lme4)
library(ggbeeswarm)
library(ggpubr)
library(igraph)
library(RColorBrewer)
library(gProfileR)
library(here)
library(eulerr)
library(ggExtra)
library(cowplot)

Extract Astrocytes for WGCNA

Calculate softpower

enableWGCNAThreads()

Allowing parallel execution with up to 79 working processes.

datExpr <- as.matrix(t(astro[["SCT"]]@scale.data[astro[["SCT"]]@var.features,]))
gsg <- goodSamplesGenes(datExpr, verbose = 3)

 Flagging genes and samples with too many missing values...
  ..step 1

gsg$allOK

[1] TRUE

sampleTree2 <- hclust(parDist(datExpr), method = "average")
plot(sampleTree2, label = F)

Past versions of unnamed-chunk-4-1.png

powers <- c(c(1:10), seq(from = 12, to = 40, by = 2))
sft <- pickSoftThreshold(datExpr,
  dataIsExpr = TRUE, powerVector = powers, corOptions = list(use = "p"),
  networkType = "signed"
)

   Power SFT.R.sq  slope truncated.R.sq  mean.k. median.k.   max.k.
1      1  0.15300 105.00          0.626 2.50e+03  2.50e+03 2520.000
2      2  0.00719 -13.00          0.916 1.25e+03  1.25e+03 1280.000
3      3  0.49400 -62.20          0.691 6.29e+02  6.28e+02  658.000
4      4  0.76800 -48.60          0.749 3.16e+02  3.15e+02  349.000
5      5  0.96800 -34.90          0.963 1.59e+02  1.58e+02  190.000
6      6  0.97600 -23.30          0.988 8.05e+01  7.96e+01  107.000
7      7  0.95800 -15.70          0.974 4.07e+01  4.00e+01   62.600
8      8  0.94600 -11.40          0.951 2.07e+01  2.02e+01   38.300
9      9  0.48400 -13.50          0.347 1.06e+01  1.02e+01   24.600
10    10  0.48700 -10.40          0.358 5.41e+00  5.14e+00   16.500
11    12  0.48800  -6.67          0.376 1.45e+00  1.31e+00    8.350
12    14  0.96000  -3.21          0.951 4.03e-01  3.38e-01    4.770
13    16  0.93900  -2.50          0.922 1.20e-01  8.73e-02    2.950
14    18  0.97900  -2.00          0.973 3.99e-02  2.27e-02    1.940
15    20  0.97200  -1.65          0.964 1.55e-02  5.95e-03    1.330
16    22  0.91200  -1.49          0.891 7.22e-03  1.57e-03    0.949
17    24  0.31500  -2.03          0.122 3.97e-03  4.18e-04    0.768
18    26  0.94700  -1.27          0.941 2.48e-03  1.12e-04    0.630
19    28  0.40600  -1.58          0.302 1.68e-03  3.04e-05    0.521
20    30  0.40500  -1.50          0.299 1.21e-03  8.32e-06    0.434
21    32  0.40800  -1.44          0.297 9.15e-04  2.30e-06    0.363
22    34  0.37200  -1.33          0.192 7.10e-04  6.44e-07    0.305
23    36  0.37300  -1.32          0.195 5.65e-04  1.82e-07    0.256
24    38  0.35400  -1.59          0.224 4.58e-04  5.22e-08    0.216
25    40  0.33900  -1.85          0.153 3.77e-04  1.52e-08    0.190

cex1 <- 0.9
plot(sft$fitIndices[, 1], -sign(sft$fitIndices[, 3]) * sft$fitIndices[, 2], xlab = "Soft Threshold (power)", ylab = "Scale Free Topology Model Fit, signed R^2", type = "n", main = paste("Scale independence"))
text(sft$fitIndices[, 1], -sign(sft$fitIndices[, 3]) * sft$fitIndices[, 2], labels = powers, cex = cex1, col = "red")
abline(h = 0.80, col = "red")

Past versions of unnamed-chunk-4-2.png

# Mean Connectivity Plot
plot(sft$fitIndices[, 1], sft$fitIndices[, 5], xlab = "Soft Threshold (power)", ylab = "Mean Connectivity", type = "n", main = paste("Mean connectivity"))
text(sft$fitIndices[, 1], sft$fitIndices[, 5], labels = powers, cex = cex1, col = "red")

Past versions of unnamed-chunk-4-3.png

Generate TOM

softPower <- 5
SubGeneNames <- colnames(datExpr)
adj <- adjacency(datExpr, type = "signed", power = softPower)
diag(adj) <- 0
TOM <- TOMsimilarityFromExpr(datExpr, networkType = "signed", TOMType = "signed", power = softPower, maxPOutliers = 0.05)

TOM calculation: adjacency..
..will use 79 parallel threads.
 Fraction of slow calculations: 0.000000
..connectivity..
..matrix multiplication (system BLAS)..
..normalization..
..done.

colnames(TOM) <- rownames(TOM) <- SubGeneNames
dissTOM <- 1 - TOM
geneTree <- hclust(as.dist(dissTOM), method = "average") # use complete for method rather than average (gives better results)
plot(geneTree, xlab = "", sub = "", cex = .5, main = "Gene clustering", hang = .001)

Past versions of unnamed-chunk-5-1.png

Identify Modules

minModuleSize <- 15
x <- 4
dynamicMods <- cutreeDynamic(
  dendro = geneTree, distM = as.matrix(dissTOM),
  method = "hybrid", pamStage = F, deepSplit = x,
  minClusterSize = minModuleSize
)

 ..cutHeight not given, setting it to 0.968  ===>  99% of the (truncated) height range in dendro.
 ..done.

dynamicColors <- labels2colors(dynamicMods) # label each module with a unique color
plotDendroAndColors(geneTree, dynamicColors, "Dynamic Tree Cut",
  dendroLabels = FALSE, hang = 0.03, addGuide = TRUE, guideHang = 0.05,
  main = "Gene dendrogram and module colors"
) # plot the modules with colors

Past versions of “Cut Gene Tree-1.png”

#Calculate Eigengenes and Merge Close Modules

MEs <- moduleEigengenes(datExpr, dynamicColors)$eigengenes # this matrix gives correlations between cells and module eigengenes (a high value indicates that the cell is highly correlated with the genes in that module)
ME1 <- MEs
row.names(ME1) <- row.names(datExpr)
# Calculate dissimilarity of module eigengenes
MEDiss <- 1 - cor(MEs)
# Cluster module eigengenes
METree <- hclust(as.dist(MEDiss), method = "average")
# Plot the result
plot(METree, main = "Clustering of module eigengenes", xlab = "", sub = "")
MEDissThres <- 0.2
# Plot the cut line into the dendrogram
abline(h = MEDissThres, col = "red")

Past versions of “merge close modules-1.png”

The merged module colors

merge <- mergeCloseModules(datExpr, dynamicColors, cutHeight = MEDissThres, verbose = 3)

 mergeCloseModules: Merging modules whose distance is less than 0.2
   multiSetMEs: Calculating module MEs.
     Working on set 1 ...
     moduleEigengenes: Calculating 9 module eigengenes in given set.
   Calculating new MEs...
   multiSetMEs: Calculating module MEs.
     Working on set 1 ...
     moduleEigengenes: Calculating 9 module eigengenes in given set.

mergedColors <- merge$colors
mergedMEs <- merge$newMEs
moduleColors <- mergedColors
MEs <- mergedMEs
modulekME <- signedKME(datExpr, MEs)

plotDendroAndColors(geneTree, cbind(dynamicColors, mergedColors),
  c("Dynamic Tree Cut", "Merged dynamic"),
  dendroLabels = FALSE, hang = 0.03,
  addGuide = TRUE, guideHang = 0.05
)

Past versions of unnamed-chunk-7-1.png

# Rename to moduleColors
moduleColors <- mergedColors
# Construct numerical labels corresponding to the colors
# colorOrder = c("grey", standardColors(50));
# moduleLabels = match(moduleColors, colorOrder)-1
MEs <- mergedMEs
modulekME <- signedKME(datExpr, MEs)

# type gene name, prints out gene names also in that module
modules <- MEs
c_modules <- data.frame(moduleColors)
row.names(c_modules) <- colnames(datExpr) # assign gene names as row names
module.list.set1 <- substring(colnames(modules), 3) # removes ME from start of module names
index.set1 <- 0
Network <- list() # create lists of genes for each module
for (i in 1:length(module.list.set1)) {
  index.set1 <- which(c_modules == module.list.set1[i])
  Network[[i]] <- row.names(c_modules)[index.set1]
}
names(Network) <- module.list.set1
lookup <- function(gene, network) {
  return(network[names(network)[grep(gene, network)]])
} # load function

Get hubgenes and kME

hubgenes <- lapply(seq_len(length(Network)), function(x) {
  dat <- modulekME[Network[[x]], ]
  dat <- dat[order(-dat[paste0("kME", names(Network)[x])]), ]
  gene <- data.frame(gene=rownames(dat),kme=dat[,x]) 
  return(gene)
})

names(hubgenes) <- names(Network)
d <- bind_rows(hubgenes, .id="id")

Warning in bind_rows_(x, .id): Unequal factor levels: coercing to character

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

write_csv(d, path = here("output/glia/wgcna/astro_wgcna_genemodules.csv"))

MEs %>% select(-MEgrey) -> MEs
data <- data.frame(MEs,
  day = astro$day, trt = astro$trt,
  sample = as.factor(astro$sample), group = astro$group,
  batch = astro$batch, celltype = Idents(astro),
  groupall = paste0(Idents(astro), astro$group)
)


mod<-lapply(colnames(MEs), function(me) {
  mod<-lmer(MEs[[me]] ~ group + (1|batch) + (1|sample), data=data)
  pairwise<-emmeans(mod, pairwise ~ group)
  plot<-data.frame(plot(pairwise, plotIt=F)$data)
  sig<-as.data.frame(pairwise$contrasts)
  sig%>%separate(contrast, c("start", "end"), sep = " - ") -> sig
  yvals<-unlist(lapply(unique(sig$celltype), function(x) {
    x<-as.character(x)
    y<-data[data$celltype==x,]
    z<-max(as.numeric(y[[me]]))
    names(z)<-x
    return(z)
  }))
  sig$yvals<-yvals[match(sig$celltype, names(yvals))]
  sig$yvals[duplicated(sig$yvals)]<-sig$yvals[duplicated(sig$yvals)]+.004
  sig$yvals[duplicated(sig$yvals)]<-sig$yvals[duplicated(sig$yvals)]+.004
  sig$yvals[duplicated(sig$yvals)]<-sig$yvals[duplicated(sig$yvals)]+.004
  return(sig)
})

names(mod) <- colnames(MEs)
sig <- bind_rows(mod, .id="id")
sig$symbol <- sig$p.value
sig$symbol[findInterval(sig$symbol, c(0.1,2)) == 1L] <-NA
sig$symbol[findInterval(sig$symbol, c(0.01,0.1)) == 1L] <- "*"
sig$symbol[findInterval(sig$symbol, c(0.001,0.01)) == 1L] <- "**"

Warning in findInterval(sig$symbol, c(0.001, 0.01)): NAs introduced by
coercion

sig$symbol[findInterval(sig$symbol, c(1e-200,0.001)) == 1L] <- "***" 

Warning in findInterval(sig$symbol, c(1e-200, 0.001)): NAs introduced by
coercion

lapply(unique(colnames(MEs)), function(me) {
  tryCatch({
   print(ggplot(data = data[sample(nrow(data)), ], aes(x = group, y = get(me))) +
      geom_quasirandom(aes(fill = sample), shape = 21, size = 2, alpha = .75) +
      scale_fill_manual(values = pal_jco()(10)) + ylab(NULL) + xlab(NULL) +
      theme_pubr() + theme(
        axis.text.x = element_text(angle = 45, hjust = 1, face = "bold"),
        plot.title = element_text(hjust = 0.5)
      ) +
      scale_y_continuous(aes(name = "", limits = c(min(get(me)) - .02, max(get(me))) + .02)) +
      ggtitle(me))
  },
  error = function(err) {
    print(err)
  }
  )
})

Past versions of unnamed-chunk-10-1.png

Past versions of unnamed-chunk-10-2.png

Past versions of unnamed-chunk-10-3.png

Past versions of unnamed-chunk-10-4.png

Past versions of unnamed-chunk-10-5.png

Past versions of unnamed-chunk-10-6.png

Past versions of unnamed-chunk-10-7.png

Past versions of unnamed-chunk-10-8.png

[[1]]

Past versions of unnamed-chunk-10-9.png

[[2]]

Past versions of unnamed-chunk-10-10.png

[[3]]

Past versions of unnamed-chunk-10-11.png

[[4]]

Past versions of unnamed-chunk-10-12.png

[[5]]

Past versions of unnamed-chunk-10-13.png

[[6]]

Past versions of unnamed-chunk-10-14.png

[[7]]

Past versions of unnamed-chunk-10-15.png

[[8]]

Past versions of unnamed-chunk-10-16.png

# moddat <- bind_rows(mod, .id="id")
write_csv(sig, path=here("output/glia/wgcna/astro_wgcna_linearmodel_testing.csv"))

#Filter metadata table and correlate with eigengenes

nGenes <- ncol(datExpr)
nSamples <- nrow(datExpr) # datExpr[,c((nrow(datExpr)-9):nrow(datExpr))]
# Recalculate MEs with color labels
MEs <- orderMEs(MEs)
astro$group <- paste0(astro$trt, "_", astro$day)
var <- model.matrix(~ 0 + astro$group)
# colnames(var)<-c("DV","FGF1","FGF19", "V")
moduleTraitCor <- cor(MEs, var, use = "p")
moduleTraitPvalue <- corPvalueStudent(moduleTraitCor, nSamples)
cor <- melt(moduleTraitCor)
cor$Var2 <- str_split(cor$Var2, "group", n = 2, simplify = T)[, 2]
MEs %>%
  as.data.frame() %>%
  mutate(sample = astro$sample, day = astro$day) %>%
  melt() %>%
  dplyr::group_by(sample, variable) %>%
  dplyr::summarise(mean_mod = median(value)) %>%
  filter(variable != "MEgrey") -> me_heatmap
me_heatmap %>%
  dplyr::group_by(variable) %>%
  mutate(scaled_mod = scale(mean_mod)) -> me_heatmap
me_heatmap$day <- as.character(astro$day[match(me_heatmap$sample, astro$sample)])
me_heatmap$trt <- as.character(astro$trt[match(me_heatmap$sample, astro$sample)])
me_heatmap$sample <- fct_relevel(me_heatmap$sample, "1_FGF", "2_FGF", "3_FGF", "1_PF", "2_PF", "3_PF", "37_FGF", "45_FGF", "28_PF", "38_PF")
me_heatmap <- me_heatmap[me_heatmap$variable %in% c("MEgreen", "MEred", "MEblue", "MEblack"), ]
me_heatmap$variable <- as.factor(as.character(me_heatmap$variable))
me_heatmap$variable <- str_to_title(sapply(strsplit(as.character(me_heatmap$variable), "ME"),"[", 2))
me_heatmap$variable <- fct_relevel(me_heatmap$variable, "Red", "Black", "Green", "Blue")
diffmod_heatmap <- ggplot(me_heatmap, aes(sample, variable)) +
  geom_tile(aes(fill = scaled_mod), colour = "white", size=.5) + ylab(NULL) + xlab(NULL) +
  scale_fill_gsea(limits=c(-2,3), name="Scaled\nExpression") +
  facet_grid(. ~ day + trt, scales = "free_x") + theme_pubr(border = T, legend="right") + ggpubr::labs_pubr() +
  theme(axis.text.x = element_blank(), panel.spacing = unit(.25, "lines"),  axis.ticks.x = element_blank())
diffmod_heatmap

Past versions of unnamed-chunk-11-1.png

Calculate GO enrichment

goterms <- lapply(hubgenes[c("red", "green", "blue", "black")], function(x) {
  x <- gprofiler(x,
    ordered_query = T, organism = "mmusculus", significant = T, custom_bg = colnames(datExpr),
    src_filter = c("GO:BP", "GO:MF", "REAC", "KEGG"), hier_filtering = "strong",
    min_isect_size = 2,
    sort_by_structure = T, exclude_iea = T,
    min_set_size = 10, max_set_size = 300, correction_method = "fdr"
  )
  x <- x[order(x$p.value), ]
  return(x)
})

goterms %>% bind_rows(.id="id") %>%
  mutate(padj=p.adjust(p.value, "fdr")) -> godat

write_csv(godat, path=here("output/glia/wgcna/astrocyte_wgcna_goterms.csv"))

goterms %>%
  bind_rows(.id = "id") %>%
  mutate(padj = p.adjust(p.value, "fdr")) %>%
  group_by(id) %>%
  top_n(5, -padj) %>%
  select(p.value, padj, term.name, domain, id) %>%
  arrange(id) -> goplot

goplot$id <- str_to_title(fct_relevel(goplot$id, "red", "green", "black"," blue"))

Warning: Unknown levels in `f`: blue

goterm <- ggplot(goplot, aes(x = str_to_title(str_wrap(term.name, 15)), y = -log10(padj), fill = domain)) + 
  geom_col() + scale_fill_npg() +
  facet_wrap(. ~ id, scales = "free_x", ncol = 2) + 
  theme_pubr(legend = "right") + 
  theme(
    text = element_text(size = 8),
    legend.text = element_text(size=8, face="bold"),
    legend.title = element_text(size=12, face="bold"), 
    axis.text.x = element_text(angle = 45, hjust = 1),
    strip.text.x = element_text(face="bold", size=8)
  ) +
  xlab(NULL) + geom_hline(yintercept = -log10(0.05), linetype = "dashed", size = .75)

Plot gene networks

color <- c("red","green","blue","black")
lapply(color, function(col) {
  maxsize <- 15
  hubs <- data.frame(genes=hubgenes[[col]]$gene[1:maxsize], kme = hubgenes[[col]]$kme[1:maxsize], mod = rep(col,15))
}) %>% bind_rows() -> hub_plot 

Warning in bind_rows_(x, .id): Unequal factor levels: coercing to character

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): Unequal factor levels: coercing to character

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

Warning in bind_rows_(x, .id): binding character and factor vector,
coercing into character vector

adj[hub_plot$genes, hub_plot$genes] %>% 
  graph.adjacency(mode = "undirected", weighted = T, diag = FALSE) %>%
  as_tbl_graph(g1) %>% upgrade_graph() %>% activate(nodes) %>% dplyr::mutate(mod=hub_plot$mod) %>% 
  dplyr::mutate(kme=hub_plot$kme) %>% activate(edges) %>% dplyr::filter(weight>.15) %>% activate(nodes) %>% filter(!node_is_isolated()) -> hub_plot

geneplot <- ggraph(hub_plot,  layout = 'kk') + 
  geom_edge_link(color="darkgrey", aes(alpha = weight), show.legend = F)  + 
  scale_edge_width(range = c(0.2, 1)) + geom_node_text(aes(label = name), fontface="bold", size=3) +
  geom_node_point(aes(fill=mod, size=kme), shape=21, alpha=0.5) + 
  scale_size(range = c(2,15), name = "kME") + 
  scale_fill_manual(values = c("black","blue","green","red"), name = "Module") +
  guides(fill = guide_legend(override.aes = list(size=5)),
         size = guide_legend(override.aes = list(size=c(5,7,9,11)))) + 
  theme_graph() + theme(legend.title.align=0.5,
                        legend.box = "horizontal", legend.position = c(0.8, 0.3))
geneplot

ggsave(geneplot, filename=here("output/mod_graph.png"), h=7, w=7)

Read in gene sets

lps1 <- read_tsv(here("data/lps1.txt"))
mcao1 <- read_tsv(here("data/mcao1.txt"))
mcao3 <- read_tsv(here("data/mcao_d3.txt"))
mcao7 <- read_tsv(here("data/mcaod7.txt"))
nr <- readxl::read_xlsx(here("data/neur_astro_induce.xlsx"))
sr <- readxl::read_xlsx(here("data/synaptic_activity_induced.xlsx"))

nr %>%
  select(gene_name, `Fold Change`, padj_deseq2) %>%
  filter(`Fold Change` > 2, padj_deseq2 < 0.05) -> nr
sr %>%
  select(gene_name, Fold_Change, DESeq2_padj) %>%
  filter(Fold_Change > 2, DESeq2_padj < 0.05) -> sr


mcao1 %>%
  filter(logFC < (-2)) %>%
  arrange(logFC) %>%
  distinct(Gene.symbol) %>%
  filter(!grepl("///", Gene.symbol)) -> mcao_gene

lps1 %>%
  filter(logFC < (-2)) %>%
  arrange(logFC) %>%
  distinct(Gene.symbol) %>%
  filter(!grepl("///", Gene.symbol)) -> lps_gene

mcao3 %>%
  filter(logFC < (-2)) %>%
  arrange(logFC) %>%
  distinct(Gene.symbol) %>%
  filter(!grepl("///", Gene.symbol)) -> mcao3_gene

mcao7 %>%
  filter(logFC < (-2)) %>%
  arrange(logFC) %>%
  distinct(Gene.symbol) %>%
  filter(!grepl("///", Gene.symbol)) -> mcao7_gene

Filter gene sets

intersect(lps_gene$Gene.symbol, mcao_gene$Gene.symbol) -> panreact
lps_uniq <- lps_gene$Gene.symbol[!lps_gene$Gene.symbol %in% mcao_gene$Gene.symbol]
mcao_uniq <- mcao_gene$Gene.symbol[!mcao_gene$Gene.symbol %in% lps_gene$Gene.symbol]
mcao3_uniq <- mcao3_gene$Gene.symbol[!mcao3_gene$Gene.symbol %in% lps_gene$Gene.symbol]
mcao7_uniq <- mcao7_gene$Gene.symbol[!mcao7_gene$Gene.symbol %in% lps_gene$Gene.symbol]

Test module enrichment in gene sets

d %>%
  filter(id %in% c("red", "green","blue","black")) %>%
  group_by(id) -> astro_mod
astro_mod %>%
  group_split() %>%
  map("gene") -> astro_gene
group_keys(astro_mod) %>% pull(id) -> mod_names

lapply(astro_gene, function(x) {
  a <- 1 - phyper(sum(x %in% lps_uniq), length(lps_uniq), 5000, length(x), log.p = F)
  b <- 1 - phyper(sum(x %in% mcao_uniq), length(mcao_uniq), 5000, length(x), log.p = F)
  c <- 1 - phyper(sum(x %in% mcao3_uniq), length(mcao3_uniq), 5000, length(x), log.p = F)
  d <- 1 - phyper(sum(x %in% mcao7_uniq), length(mcao7_uniq), 5000, length(x), log.p = F)
  e <- 1 - phyper(sum(x %in% panreact), length(panreact), 5000, length(x), log.p = F)
  f <- 1 - phyper(sum(x %in% nr$gene_name), length(nr$gene_name), 5000, length(x), log.p = F)
  g <- 1 - phyper(sum(x %in% sr$gene_name), length(sr$gene_name), 5000, length(x), log.p = F)
  return(data.frame(A1 = a, A2 = b, PAN = e, NR = f, SR = g))
}) %>% bind_rows() -> overlap_test

as.data.frame(sapply(overlap_test, function(x) p.adjust(x, n = dim(overlap_test)[1] * dim(overlap_test)[2]))) -> overlap_test
overlap_test$mod <- mod_names
overlap_pval <- reshape2::melt(overlap_test)
set_plot <- ggplot(overlap_pval, aes(x = fct_relevel(mod, "red", "black", "green","blue"), y = variable)) + geom_tile(size = 1, color = "white", fill="grey99") +
  geom_point(aes(size = if_else(-log10(value)<1.3,true = 0, false = -log10(value)), fill = if_else(-log10(value)<1.3,true = "black", false = "red")), shape=21) + 
  scale_size(name= expression(-log[10] ~ pvalue)) + 
  scale_fill_manual(values=c("black","red"), guide=F) + coord_flip() + theme_pubr(legend = "right") + xlab(NULL) + ylab(NULL) + labs_pubr() + 
  theme(axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.text.x = element_text(angle=45, hjust=1)) 
set_plot

Past versions of unnamed-chunk-16-1.png

plot_grid(diffmod_heatmap, set_plot, align = "hv", axis="tb", rel_widths = c(1.5,1))

Past versions of unnamed-chunk-17-1.png

ggsave(here("output/astro_charact.png"), h=3,w=10)

Session information

sessionInfo()

R version 3.5.3 (2019-03-11)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Storage

Matrix products: default
BLAS/LAPACK: /usr/lib64/libopenblas-r0.3.3.so

locale:
 [1] LC_CTYPE=en_DK.UTF-8       LC_NUMERIC=C              
 [3] LC_TIME=en_DK.UTF-8        LC_COLLATE=en_DK.UTF-8    
 [5] LC_MONETARY=en_DK.UTF-8    LC_MESSAGES=en_DK.UTF-8   
 [7] LC_PAPER=en_DK.UTF-8       LC_NAME=C                 
 [9] LC_ADDRESS=C               LC_TELEPHONE=C            
[11] LC_MEASUREMENT=en_DK.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] cowplot_1.0.0         ggExtra_0.9           eulerr_5.1.0         
 [4] here_0.1              gProfileR_0.6.7       RColorBrewer_1.1-2   
 [7] igraph_1.2.4.1        ggpubr_0.2.1          magrittr_1.5         
[10] ggbeeswarm_0.6.0      lme4_1.1-21           Matrix_1.2-17        
[13] emmeans_1.3.5.1       ggsci_2.9             parallelDist_0.2.4   
[16] reshape2_1.4.3        ggraph_1.0.2          tidygraph_1.1.2      
[19] forcats_0.4.0         stringr_1.4.0         dplyr_0.8.3          
[22] purrr_0.3.2           readr_1.3.1.9000      tidyr_0.8.3          
[25] tibble_2.1.3          ggplot2_3.2.1         tidyverse_1.2.1      
[28] genefilter_1.64.0     cluster_2.1.0         WGCNA_1.68           
[31] fastcluster_1.1.25    dynamicTreeCut_1.63-1 Seurat_3.0.3.9036    

loaded via a namespace (and not attached):
  [1] estimability_1.3      R.methodsS3_1.7.1     coda_0.19-3          
  [4] acepack_1.4.1         bit64_0.9-7           knitr_1.23           
  [7] irlba_2.3.3           multcomp_1.4-10       R.utils_2.9.0        
 [10] data.table_1.12.2     rpart_4.1-15          RCurl_1.95-4.12      
 [13] doParallel_1.0.14     generics_0.0.2        metap_1.1            
 [16] BiocGenerics_0.28.0   preprocessCore_1.44.0 TH.data_1.0-10       
 [19] RSQLite_2.1.1         RANN_2.6.1            future_1.14.0        
 [22] bit_1.1-14            xml2_1.2.0            lubridate_1.7.4      
 [25] httpuv_1.5.1          assertthat_0.2.1      viridis_0.5.1        
 [28] xfun_0.8              hms_0.5.0             evaluate_0.14        
 [31] promises_1.0.1        DEoptimR_1.0-8        caTools_1.17.1.2     
 [34] readxl_1.3.1          DBI_1.0.0             htmlwidgets_1.3      
 [37] stats4_3.5.3          backports_1.1.4       annotate_1.60.1      
 [40] gbRd_0.4-11           RcppParallel_4.4.3    vctrs_0.2.0          
 [43] Biobase_2.42.0        ROCR_1.0-7            withr_2.1.2          
 [46] ggforce_0.3.0.9000    robustbase_0.93-5     checkmate_1.9.4      
 [49] sctransform_0.2.0     ape_5.3               lazyeval_0.2.2       
 [52] crayon_1.3.4          labeling_0.3          pkgconfig_2.0.2      
 [55] tweenr_1.0.1          nlme_3.1-140          vipor_0.4.5          
 [58] nnet_7.3-12           rlang_0.4.0           globals_0.12.4       
 [61] miniUI_0.1.1.1        sandwich_2.5-1        modelr_0.1.4         
 [64] rsvd_1.0.2            cellranger_1.1.0      rprojroot_1.3-2      
 [67] polyclip_1.10-0       matrixStats_0.54.0    lmtest_0.9-37        
 [70] boot_1.3-22           zoo_1.8-6             base64enc_0.1-3      
 [73] beeswarm_0.2.3        whisker_0.3-2         ggridges_0.5.1       
 [76] png_0.1-7             viridisLite_0.3.0     bitops_1.0-6         
 [79] R.oo_1.22.0           KernSmooth_2.23-15    blob_1.1.1           
 [82] workflowr_1.4.0       robust_0.4-18.1       S4Vectors_0.20.1     
 [85] ggsignif_0.5.0        scales_1.0.0          memoise_1.1.0        
 [88] plyr_1.8.4            ica_1.0-2             gplots_3.0.1.1       
 [91] bibtex_0.4.2          gdata_2.18.0          compiler_3.5.3       
 [94] lsei_1.2-0            rrcov_1.4-7           fitdistrplus_1.0-14  
 [97] cli_1.1.0             listenv_0.7.0         pbapply_1.4-1        
[100] htmlTable_1.13.1      Formula_1.2-3         MASS_7.3-51.4        
[103] tidyselect_0.2.5      stringi_1.4.3         highr_0.8            
[106] yaml_2.2.0            latticeExtra_0.6-28   ggrepel_0.8.1        
[109] grid_3.5.3            tools_3.5.3           future.apply_1.3.0   
[112] parallel_3.5.3        rstudioapi_0.10       foreach_1.4.4        
[115] foreign_0.8-71        git2r_0.25.2          gridExtra_2.3        
[118] farver_1.1.0          Rtsne_0.15            digest_0.6.20        
[121] shiny_1.3.2           Rcpp_1.0.2            broom_0.5.2          
[124] SDMTools_1.1-221.1    later_0.8.0           RcppAnnoy_0.0.12     
[127] httr_1.4.1            AnnotationDbi_1.44.0  npsurv_0.4-0         
[130] Rdpack_0.11-0         colorspace_1.4-1      rvest_0.3.4          
[133] XML_3.98-1.20         fs_1.3.1              reticulate_1.13      
[136] IRanges_2.16.0        splines_3.5.3         uwot_0.1.3           
[139] plotly_4.9.0          fit.models_0.5-14     xtable_1.8-4         
[142] jsonlite_1.6          nloptr_1.2.1          zeallot_0.1.0        
[145] R6_2.4.0              Hmisc_4.2-0           pillar_1.4.2         
[148] htmltools_0.3.6       mime_0.7              glue_1.3.1           
[151] minqa_1.2.4           codetools_0.2-16      tsne_0.1-3           
[154] pcaPP_1.9-73          mvtnorm_1.0-11        lattice_0.20-38      
[157] pbkrtest_0.4-7        leiden_0.3.1          gtools_3.8.1         
[160] GO.db_3.7.0           survival_2.44-1.1     rmarkdown_1.13       
[163] munsell_0.5.0         iterators_1.0.10      impute_1.56.0        
[166] haven_2.1.0           gtable_0.3.0