使用由组和比例确定的填充渐变绘制矩形

Question

我正在尝试绘制一堆矩形，其中填充是按比例确定的颜色渐变。

首先，我有一个像这样的数据框：

sampleID 1 2 3 4 5 ... 100
sample1  1 1 1 1 1 ... 1
sample2  1 1 1 1 1 ... 1
sample3  2 2 2 2 2 ... 2
sample4  2 2 1 1 2 ... 2
...

其中整数对应于我进行的 100 次分析的组分配。我希望具有混合组分配的样本具有颜色渐变（例如，样本 4 是 25% 的蓝色和 75% 的红色）。

这是我的代码：


library("RColorBrewer")
library("plotrix")

# Make sampleID column rownames and remove from df
col2rownames <- function(df){
  rownames(df) <- df$sampleID
  df$sampleID <- NULL
  return(df)
}

df <- col2rownames(df)

# Get a list of frequency tables corresponding to each row in df.
df.freq <- apply(df, 1, table)

# Convert list of table() objects to list of data.frames
df.freq <- lapply(df.freq, function(x) { as.data.frame(x, stringsAsFactors = F) } )

# Make color vector
colors <- c(
  "1" = "#808080", # BXCH
  "2" = "purple4", # BXON
  "3" = "yellow3", # BXFL
  "4" = "orange1", # BXEA
  "5" = "mediumaquamarine", # BXFL second cluster
  "6" = "magenta3", # GUFL
  "7" = "blue", # GUMS
  "8" = "red", # BXMX
  "9" = "green2", # BXTT
  "10" = "#00ffff" # BXDS
)

# Subset only colors present in each df.freq data.frame
collist <- list()
collist <- lapply(df.freq, function(x) { 
  colors[x[, 1]]
})

# Convert to list of vectors
collist <- lapply(collist, as.vector)

# Get number of data frames in list
mylen <- length(df.freq)

# Plot an empty box
plot(1:mylen, type="n", axes=F)

# Initialize counters
counter_min <- 0
counter_max <- 1

# Initialize newcollist
newcollist <- list()

# Plot rectangles with color gradient
for (i in 1:length(collist)){ 
  colsubset <- c(collist[[i]])
  newcollist[[i]] <- colsubset
  gradient.rect(xleft = 0, ybottom = counter_min, xright = 5, ytop = counter_max, col = colsubset, gradient = "x")
  counter_min <- counter_max
  counter_max <- counter_min + 1
}

这是我当前的输出：

Rectangle Gradient Plot

但是，>1 种颜色的矩形显示为 50/50，这不是正确的比例。例如，顶部附近的紫色和浅蓝色实际上应该分别为 88% 和 12%。

我被困在这里了。有谁知道按比例绘制颜色填充的方法吗？

非常感谢您的宝贵时间。

Answer 1

好的，所以这更多是 gradient.rect() 函数的问题。它根本不是为您想要的而制作的。无论如何，它总是会产生均等分割的矩形。

然而，这并不意味着你不能制作你的情节。您只需要使用 good'ol rect() 函数并自己计算拆分即可。

我从你的 post...

中得到了我能做的虚拟数据

df <- "sampleID,1,2,3,4,5
sample1,1,1,1,1,1
sample2,1,1,1,1,1
sample3,2,2,2,2,2
sample4,2,2,1,1,2
sample5,3,2,1,1,2
sample6,4,4,4,1,2
sample7,2,2,1,2,2"
df <- read.table(text = df, h = T, sep = ",", row.names = 1)

这一切都没有改变:

col2rownames <- function(df){
  rownames(df) <- df$sampleID
  df$sampleID <- NULL
  return(df)
}
df <- col2rownames(df)
df.freq <- apply(df, 1, table)
df.freq <- lapply(df.freq, function(x) { as.data.frame(x, stringsAsFactors = F) } )
colors <- c(
  "1" = "#808080", # BXCH
  "2" = "purple4", # BXON
  "3" = "yellow3", # BXFL
  "4" = "orange1", # BXEA
  "5" = "mediumaquamarine", # BXFL second cluster
  "6" = "magenta3", # GUFL
  "7" = "blue", # GUMS
  "8" = "red", # BXMX
  "9" = "green2", # BXTT
  "10" = "#00ffff" # BXDS
)
collist <- list()
collist <- lapply(df.freq, function(x) { 
  colors[x[, 1]]
})
collist <- lapply(collist, as.vector)
mylen <- length(df.freq)

这是新内容：

# Plot an empty box
plot(c(0,1), c(0, mylen), type="n", axes=F)

# Initialize counter (you don't really need 2 for this...)
counter <- 0

# Plot rectangles of given colors, split by given freqs
rect_split <- function(freqs, colors, ybot, ytop, xleft = 0, xright = 1, ...){
  freqs <- freqs/sum(freqs) # norm to 1
  xpos <- c(0, cumsum(freqs)) # get splits for colors
  xpos <- (xpos - xleft)/(xright - xleft) # scale between xleft and xright
  sapply(seq_along(freqs), function(i){
    rect(xleft = xpos[i],  xright = xpos[i+1], ybottom = ybot, ytop = ytop, col = colors[i], ...)
  })
}

for (i in 1:length(collist)){ 
  cols <- c(collist[[i]])
  freqs <- df.freq[[i]][, 2] # assuming the freqs are in the order of the colors

  rect_split(freqs, cols, ybot = counter, ytop = counter + 1)
  counter <- counter + 1
}

这个情节：

使用由组和比例确定的填充渐变绘制矩形

Plotting Rectangles with Fill Gradients Determined by Group and Proportions

plot

r

rectangles

percentage

plotrix