You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

R语言遗传STRUCTURE堆叠条形图封装函数优化求助

自定义STRUCTURE堆叠条形图的问题求助

我制作了一种名为STRUCTURE的堆叠条形图,用于展示概率,这类图在R中暂无合适的封装函数。图中按不同K值(当前及备选分类假设,希望支持最多5行不同K值)分为多行,每行包含属于不同物种分组的种群(如AS、SM、PO等)。

STRUCTURE示例图

我已编写基于ggplot2的STRUCTURE函数,代码如下:

#K=number of rows 
#taxa= can be different from population, meaning the grouping of a set of population
#posterior = a probability matrix
#target_class = populations
STRUCTURE <- function(posteriors, target_class, K, taxa) {
  #capture errors 
  if (!requireNamespace("tidyverse", quietly = TRUE)) {
    stop("The 'tidyverse' package is required. Please install and load it before using this function.")
  }
  library(tidyverse)
  
  if (!requireNamespace("ggthemes", quietly = TRUE)) {
    stop("The 'ggthemes' package is required. Please install and load it before using this function.")
  }
  library(ggthemes)
  
  if (!requireNamespace("ggforce", quietly = TRUE)) {
    stop("The 'ggforce' package is required. Please install and load it before using this function.")
  }
  library(ggforce)
  
  if (!requireNamespace("RColorBrewer", quietly = TRUE)) {
    stop("The 'RColorBrewer' package is required. Please install and load it before using this function.")
  }
  library(RColorBrewer)
  
  if (is.null(posteriors) || is.null(target_class) || length(posteriors) == 0 || length(target_class) == 0) {
    stop("Both 'posteriors' and 'target_class' must contain non-empty data.")
  } #### checking if all arguments contain data
  
  if (!is.data.frame(posteriors)) { 
    if (is.list(posteriors) && "z" %in% names(posteriors)) {
      posteriors <- as.data.frame(posteriors$z)
    } else {
      warning("Invalid posteriors data. Attempting to coerce into a data frame.")
      posteriors <- as.data.frame(posteriors)
    }
  } else if (ncol(posteriors) != length(levels(factor(target_class)))) {
    stop("Number of levels should be the same!")
  } else {
    ####GENERATE INDEXING #####
    n_per_class <- unname(table(target_class))
    n_of_class <- length(levels(factor(target_class)))
    
    # Define a function to generate the codes
    generate_index <- function(n_per_class, n_of_class) {
      codes <- character(0)  # Initialize an empty character vector
      # Loop through classes
      for (class_index in 1:n_of_class) {
        class_code <- LETTERS[class_index]  # Get class code (A, B, C, ...)
        
        # Get the number of individuals for the current class
        n <- n_per_class[class_index]
        # Loop through individuals within the class
        for (individual_index in 1:n) {
          individual_code <- sprintf("%02d", individual_index)  # Format as two digits (01, 02, 03, ...)
          code <- paste0(class_code, individual_code)  # Combine class and individual code
          codes <- c(codes, code)  # Append to the vector
        }
      }
      return(codes)
    }
    index <- generate_index(n_per_class, n_of_class)
    #apply index, taxonomic_hypothesis and species name to the columns
    
    posteriors$Row <- index
    posteriors$subplot <- K
    posteriors$taxa <- taxa
    
    #gather the data 
    STRUCTURE.data <- gather(posteriors, key = "Column", value = "Value", -Row) ##### <- missing a way to add more than 1 K#### 
    
    # Generate a random color palette 
    selected_colors <- brewer.pal(length(levels(factor(target_class))), "RdYlGn")  ##### <- missing a way to specify colors if default are ugly K#### 
    
    #create the plot 
    STRUCPLOT <- ggplot(STRUCTURE.data, aes(x=Row, y=Value, fill = Column)) +
      geom_bar(stat = "identity", position = "fill", width = 1) +
      scale_fill_manual(values = selected_colors)+
      facet_grid(subplot ~ fct_inorder(target_class)+taxa, scales = "free", space = "free")+ ##### <- missing a way to write to the bottom the species names on all subplots #### 
      labs(y = "Posterior probability", x = NULL) +
      scale_y_continuous(limits = c(0,1), expand = c(0, 0)) +
      guides(fill = FALSE) + 
      theme_tufte(base_size = 15, base_family = "sans") +
      theme(legend.title = element_blank(),
            panel.grid.major = element_blank(),
            panel.grid.minor = element_blank(),
            panel.background = element_rect(fill = 'transparent'),
            plot.background = element_rect(fill = 'transparent', color = NA),
            legend.background = element_rect(fill = 'transparent'),
            legend.box.background = element_rect(fill = 'transparent'),
            legend.key = element_rect(fill = 'transparent'),
            axis.title.x = element_blank(), 
            axis.text.x = element_blank(),
            axis.ticks.x = element_blank(),
            axis.text.y = element_text(size = 10),# regulate the size of values of posteriors in y 
            axis.title.y = element_text(size = 15),#regulate the size of "posterior Prob"
            strip.text.x = element_text(size = 8), #regulate the size of pop name
            plot.margin = unit(c(0,0,1,0.5), "cm"),#regulate margin of the whole plot
            panel.spacing = unit(0,'lines'), #regulate margin distance of the facet columns
            panel.spacing.x=unit(0, "lines"),
            panel.spacing.y=unit(2.5, "lines"),
            panel.border = element_rect(color = "black", fill = NA, size = 1))
    
    print(STRUCPLOT)
  }
}

目前存在三个无法解决的问题:

  • 无法在每个子图行底部显示物种名称(尝试labeller无效,推测需用ggrob)
  • 无法支持用户自定义配色
  • 不知道如何处理多K值的输入数据

以下是用于测试的示例数据代码:

set.seed(123)

#K=1
# Generate some dummy data of random probabilities in a 100x5 matrix 
n_rows <- 100
n_cols <- 5
fake_prob_matrix <- matrix(runif(n_rows * n_cols), nrow = n_rows, ncol = n_cols)
# Normalize the values in each column to sum up to 1
fake_prob_matrix <- data.frame(fake_prob_matrix / rowSums(fake_prob_matrix))
colnames(fake_prob_matrix) <- c("Pop1","Pop2","Pop3","Pop4","Pop5")
species_k1 <- factor(c("Specie1","Specie2","Specie3","Specie4","Specie5"))

#K=2 melting some species to assess cluster purity
n_rows <- 100
n_cols <- 5
fake_prob_matrix <- matrix(runif(n_rows * n_cols), nrow = n_rows, ncol = n_cols)
# Normalize the values in each column to sum up to 1
fake_prob_matrix <- data.frame(fake_prob_matrix / rowSums(fake_prob_matrix))
colnames(fake_prob_matrix) <- c("Pop1","Pop2","Pop3","Pop4","Pop5")
species_k2 <- factor(c("Specie1","Specie2","Specie3+Specie4+Specie5"))

恳请各位提供解决方案,非常感谢!

内容的提问来源于stack exchange,提问作者Manuel Tiburtini

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.09 14:25:56