Commit 4ef244a0 authored by smorabit's avatar smorabit
Browse files

added function to change module names & colors

parent f0b44de9

R/WGCNA_functions.R

+9 −5
Original line number Diff line number Diff line
@@ -600,7 +600,6 @@ ModuleConnectivity <- function(seurat_obj, harmonized=TRUE, wgcna_name=NULL, ... 
  # get MEs:

  MEs <- GetMEs(seurat_obj, harmonized, wgcna_name)



  tic("SignedKME")

  kMEs <- WGCNA::signedKME(

    datExpr,

    MEs,
@@ -608,7 +607,6 @@ ModuleConnectivity <- function(seurat_obj, harmonized=TRUE, wgcna_name=NULL, ... 
    corFnc = "bicor",

    ...

  )

  toc()



  # add module color to the kMEs table

  kMEs <- cbind(modules, kMEs)
@@ -759,6 +757,9 @@ OverlapModulesDEGs <- function( 
    overlap_df$Significance

  )



  # set factor levels for modules:

  overlap_df$module <- factor(overlap_df$module, levels=mods)



  # re-arrange columns:

  overlap_df <- overlap_df %>% select(c(module, group, color, odds_ratio, pval, fdr, Significance, Jaccard))
@@ -818,7 +819,7 @@ ProjectModules <- function( 
  }



  # scale the dataset if needed:

  if(sum(genes_use %in% rownames(GetAssayData(seurat_obj, slot='scale.data'))) == length(genes_use)){

  if(!scale_genes & sum(genes_use %in% rownames(GetAssayData(seurat_obj, slot='scale.data'))) == length(genes_use)){

    print("Scaling already done.")

  } else if(scale_genes){

    print("Scaling dataset...")
@@ -858,11 +859,14 @@ ProjectModules <- function( 
#' TransferModuleGenome

TransferModuleGenome <- function(

  modules, gene_mapping,

  genome1_col, genome2_col

  genome1_col=NULL, genome2_col=NULL

){



  # use the first & second columns if these are null

  if(is.null(genome1_col)){genome1_col <- colnames(gene_mapping)[1]}

  if(is.null(genome2_col)){genome2_col <- colnames(gene_mapping)[2]}



  # switch gene names to human:

  gene_mapping <- hg38_mm10_genes

  gene_mapping <- gene_mapping[,c(genome1_col, genome2_col)]



  # only keep genome1 genes that are in the WGCNA gene list:

R/getters_and_setters.R

+128 −0
Original line number Diff line number Diff line
@@ -380,3 +380,131 @@ GetTOM <- function(seurat_obj, wgcna_name=NULL){ 
  TOM



}



############################

# Reset module names:

###########################



ResetModuleNames <- function(

  seurat_obj,

  new_name = "M",

  wgcna_name=NULL

){



  if(is.null(wgcna_name)){wgcna_name <- seurat_obj@misc$active_wgcna}



  # get modules

  modules <- GetModules(seurat_obj, wgcna_name)

  old_mods <- levels(modules$module)



  new_names <- paste0(new_name, 1:(length(old_mods)-1))

  grey_ind <- which(old_mods == 'grey')



  # account for when grey is first / last

  if(grey_ind == 1){

    new_names <- c('grey', new_names)

  } else if(grey_ind == length(old_mods)){

    new_names <- c(new_names, 'grey')

  } else{

    new_names <- c(new_names[1:(grey_ind-1)], 'grey', new_names[grey_ind:length(new_names)])

  }



  # update kMEs

  new_kMEs <- paste0('kME_', new_names)

  colnames(modules) <- c(colnames(modules)[1:3], new_kMEs)



  # update module names

  new_mod_df <- data.frame(

    old = old_mods ,

    new = new_names

  )



  modules$module <- factor(

    new_mod_df[match(modules$module, new_mod_df$old),'new'],

    levels = as.character(new_mod_df$new)

  )



  # set module table

  seurat_obj <- SetModules(seurat_obj, modules, wgcna_name)



  # update hME table:

  hMEs <- GetMEs(seurat_obj, wgcna_name)

  colnames(hMEs) <- new_mod_df$new

  seurat_obj <- SetMEs(seurat_obj, hMEs, harmonized=TRUE, wgcna_name)



  # update ME table

  MEs <- GetMEs(seurat_obj, harmonized=FALSE, wgcna_name)

  colnames(MEs) <- new_mod_df$new

  seurat_obj <- SetMEs(seurat_obj, MEs, harmonized=FALSE, wgcna_name)



  # update module scores:

  module_scores <- GetModuleScores(seurat_obj, wgcna_name)

  if(!("grey" %in% colnames(module_scores))){

    colnames(module_scores) <- new_mod_df$new[new_mod_df$new != 'grey']

  } else {

    colnames(module_scores) <- new_mod_df$new

  }

  seurat_obj <- SetModuleScores(seurat_obj, module_scores, wgcna_name)



  # update average module expression:

  avg_exp <- GetAvgModuleExpr(seurat_obj, wgcna_name)

  if(!("grey" %in% colnames(avg_exp))){

    colnames(avg_exp) <- new_mod_df$new[new_mod_df$new != 'grey']

  } else {

    colnames(avg_exp) <- new_mod_df$new

  }

  seurat_obj <- SetAvgModuleExpr(seurat_obj, avg_exp, wgcna_name)



  # update enrichr table:

  enrich_table <- GetEnrichrTable(seurat_obj, wgcna_name)

  enrich_table$module <- factor(

    new_mod_df[match(enrich_table$module, new_mod_df$old),'new'],

    levels = as.character(new_mod_df$new)

  )

  seurat_obj <- SetEnrichrTable(seurat_obj, enrich_table, wgcna_name)



  seurat_obj



}





############################

# Reset module names:

###########################



ResetModuleColors <- function(

  seurat_obj,

  new_colors,

  wgcna_name=NULL

){



  if(is.null(wgcna_name)){wgcna_name <- seurat_obj@misc$active_wgcna}



  # get modules

  modules <- GetModules(seurat_obj, wgcna_name)

  mod_colors <- select(modules, c(module, color)) %>%

    distinct %>% arrange(module) %>% .$color

  grey_ind <- which(mod_colors == 'grey')



  if(grey_ind == 1){

    new_colors <- c('grey', new_colors)

  } else if(grey_ind == length(mod_colors)){

    new_colors <- c(new_colors, 'grey')

  } else{

    new_colors <- c(new_colors[1:(grey_ind-1)], 'grey', new_colors[grey_ind:length(new_colors)])

  }

  new_colors



  new_color_df <- data.frame(

    old = mod_colors ,

    new = new_colors

  )



  modules$color <- new_color_df[match(modules$color, new_color_df$old),'new']



  # set module table

  seurat_obj <- SetModules(seurat_obj, modules, wgcna_name)



  seurat_obj



}

R/plotting.R

+19 −18
Original line number Diff line number Diff line
@@ -112,12 +112,6 @@ ModuleCorrelogram <- function( 
  }

  res$P[is.na(res$P)] <- 0



  print('right there')

  print(dim(res$P))

  print(dim(resP))

  print(dim(res$r))





  # plot correlogram

  corrplot::corrplot(

    res$r,
@@ -351,11 +345,14 @@ ModuleFeaturePlot<- function( 
  plot_list <- list()

  for(cur_mod in module_names){



    print(cur_mod)



    # get the color for this module:

    cur_color <- modules %>% subset(module == cur_mod) %>% .$color %>% unique



    # reset the range of the plot:

    plot_range <- plot_df[,cur_mod] %>% range

    print(plot_range)

    if(restrict_range){

      if(abs(plot_range[1]) > abs(plot_range[2])){

        plot_range[1] <- -1*plot_range[2]
@@ -368,38 +365,38 @@ ModuleFeaturePlot<- function( 


    # order points:

    if(order == TRUE){

      plot_df <- plot_df %>% dplyr::arrange_(cur_mod)

      plot_df <- plot_df %>% dplyr::arrange(!!cur_mod)

    } else if(order == "shuffle"){

      plot_df <- plot_df[sample(nrow(plot_df)),]

    }



    # label for plot:

    label <- cur_mod

    cur_plot_df <- plot_df[,c(colnames(umap), cur_mod)]

    colnames(cur_plot_df)[3] <- "val"



    # plot with ggplot

     p <- plot_df %>%

      ggplot(aes_string(x=x_name, y=y_name, color=cur_mod)) +

    p <- cur_plot_df %>%

      ggplot(aes_string(x=x_name, y=y_name, color="val")) +

      # ggplot(aes(x=umap1, y=umap2, color=val))

      geom_point(size=point_size, alpha=alpha) +

      ggtitle(label) + umap_theme +

      ggtitle(cur_mod) + umap_theme +

      labs(color="")



    # UCell?

    if(!ucell){

      p <- p + scale_color_gradient2(

        low='grey75', mid='grey95', high=cur_color,

        breaks = c(plot_range[1], plot_range[2]),

        breaks = plot_range,

        labels = c('-', '+'),

        guide = guide_colorbar(ticks=FALSE, barwidth=0.5, barheight=4)

      )

    } else{

      p <- p + scale_color_gradient(

        low='grey95', high=cur_color,

        breaks = c(plot_range[1], plot_range[2]),

        breaks = plot_range,

        labels = c('0', '+'),

        guide = guide_colorbar(ticks=FALSE, barwidth=0.5, barheight=4)

      )

    }



    plot_list[[cur_mod]] <- p



  }
@@ -548,6 +545,10 @@ EnrichrDotPlot <- function( 
  # get Enrichr table

  enrichr_df <- GetEnrichrTable(seurat_obj, wgcna_name)



  # add color to enrich_table

  mod_colors <- select(modules, c(module, color)) %>% distinct

  enrichr_df$color <- mod_colors[match(enrichr_df$module, mod_colors$module), 'color']



  # helper function to wrap text

  wrapText <- function(x, len) {

      sapply(x, function(y) paste(strwrap(y, len), collapse = "\n"), USE.NAMES = FALSE)
@@ -559,8 +560,6 @@ EnrichrDotPlot <- function( 
    group_by(module) %>%

    top_n(n_terms, wt=Combined.Score)



  print(table(plot_df$db))



  # sometimes top_n returns more than the desired number if there are ties. so here

  # we just randomly sample to break ties:

  if(break_ties){
@@ -592,7 +591,7 @@ EnrichrDotPlot <- function( 


  p <- plot_df  %>%

    ggplot(aes(x=module, y=rev(Term))) +

    geom_point(aes(size=Combined.Score), color=plot_df$module) +

    geom_point(aes(size=Combined.Score), color=plot_df$color) +

    RotatedAxis() +

    ylab('') + xlab('') + labs(size=lab) +

    ggtitle(database) +
@@ -838,6 +837,8 @@ HubGeneNetworkPlot <- function( 
  #   algorithm="scWGCNA"

  # )



  # label vertices?



  plot(

    g, layout=l,

    edge.color=adjustcolor(E(g)$color, alpha.f=edge.alpha),

CRA Git | Maintained and supported by SUSTech CRA and CCSE