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

我已编写基于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
相关产品推荐
相关产品推荐

