具有可变宽度的重叠条形图/直方图答案

【问题标题】：Overlapping barplot/histogram with variable widths具有可变宽度的重叠条形图/直方图
【发布时间】：2021-05-17 17:33:00
【问题描述】：

我有

chr  totgenes  FST>0.4  %FST>0.4  exFST>0.4  %exFST>0.4  inFST>0.4  %inFST>0.4  chrtotlen
1    1457      49       3.36307   73         5.0103      54         3.70625     114375790
1A   1153      49       4.24978   72         6.24458     48         4.1630      70879221
2    1765      80       4.53258   132        7.47875     96         5.43909     151896526
3    1495      33       2.20736   56         3.74582     35         2.34114     111449612
4    953       58       6.08604   89         9.33893     56         5.87618     71343966
4A   408       9        2.20588   17         4.16667     11         2.69608     19376786
5    1171      52       4.44065   81         6.91716     44         3.75747     61898265
6    626       48       7.66773   62         9.90415     47         7.50799     34836644
7    636       8        1.25786   24         3.77358     8          1.25786     38159610
8    636       24       3.77358   28         4.40252     27         4.24528     30964699
9    523       18       3.44168   23         4.39771     21         4.0153      25566760

我想做一个条形图，其中 y 是 cols FST>0.4 exFST>0.4 inFST>0.4 的值，x 是 chr col，条形的宽度是 chrtotlen。

我正在尝试使用

data<-read.table("realBFWBM_noNAs.fst.totgenesChrcp", sep="\t", header = TRUE)
myVector <- c("chr", "FST.0.4", "exFST.0.4", "inFST.0.4", "chrtotlen")
melted <-melt(data[,myVector], id = c("chr", "chrtotlen") 
ggplot(melted, aes(x=as.factor(chr), y=value, width=chrtotlen))+ 
  geom_bar(aes(fill=variable), stat = "identity")+
  theme(
    panel.grid.major.x = element_blank(),
    panel.grid.major.y = element_blank(),
    panel.grid.minor.x = element_blank(),
    panel.grid.minor.y = element_blank(),
    legend.title = element_blank(),
    legend.position = c(0.8, 0.8),
    axis.title.x=element_text(size=20),
    text = element_text(size=20),
    axis.text.x = element_text(size=20),
    panel.background = element_blank(),
    axis.text.y = element_text(size=20)
  )

但我得到了一个重叠的情节

我也收到错误"position_stack requires non-overlapping x intervals"

在基础 R 方面取得了一些进展，但仍有工作要做，因为轴的行为不符合预期。

data<-read.table("realBFWBM_noNAs.fst.totgenesChrcp", sep="\t", header = TRUE)
myVector <- c("chr", "FST.0.4", "exFST.0.4", "inFST.0.4", "chrtotlen")
counts = data[,myVector]
par(xpd = TRUE, mar = c(4,4,2,2))
invisible(sapply(2:4, function(x)
  barplot(counts[, x], as.vector(counts$chrtotlen), axes = FALSE, axisnames = FALSE,
          #border = 0.5,
          density = x + 5,
          angle = x ^ 5,
          space=0,
          axis.lty = 1, ylim = c(0, 150), 
          add  = ifelse(x == 2, FALSE, TRUE))))

axis(2, at = seq(0, 100, 150), labels = seq(0, 100 , 150))
axis(1, at = barplot(counts), labels = colnames(counts))

【问题讨论】：

在geom_bar 尝试position = "dodge"。我没有看到直方图代码，只有条形图，没有图重叠。
是的，这是我过去使用不同数据绘制的另外两个图。我刚刚上传以举例说明我要在这里绘制的内容。我也不知道我是否应该在这里为我的目的使用 geom_bar 或 geom_histogram。
看来你想要geom_bar 和geom_histogram。试试看，但是设置透明度alpha = 0.2或者其他小于等于0.5的值。
我不确定，但你的宽度很大？！
是的，它可以成比例（chrtotlen/ 1000000）。不需要是绝对数。但我不认为这是造成问题的原因。

标签： r ggplot2

【解决方案1】：

这不是超级简单，但一个相当直接的解决方法是使用 geom_rect 手动构建绘图。

我无耻地从下面两个线程中改编了想法，这个问题几乎是重复的

轴问题通过用连续轴伪造离散轴来解决。然后将伪离散标签分配给连续中断。

library(tidyverse)
df <- read.table(header = T, text = "    chr  totgenes  FST>0.4  %FST>0.4  exFST>0.4  %exFST>0.4  inFST>0.4  %inFST>0.4  chrtotlen
    1    1457      49       3.36307   73         5.0103      54         3.70625     114375790
    1A   1153      49       4.24978   72         6.24458     48         4.1630      70879221
    2    1765      80       4.53258   132        7.47875     96         5.43909     151896526
    3    1495      33       2.20736   56         3.74582     35         2.34114     111449612
    4    953       58       6.08604   89         9.33893     56         5.87618     71343966
    4A   408       9        2.20588   17         4.16667     11         2.69608     19376786
    5    1171      52       4.44065   81         6.91716     44         3.75747     61898265
    6    626       48       7.66773   62         9.90415     47         7.50799     34836644
    7    636       8        1.25786   24         3.77358     8          1.25786     38159610
    8    636       24       3.77358   28         4.40252     27         4.24528     30964699
    9    523       18       3.44168   23         4.39771     21         4.0153      25566760")

# reshape and rescale the width variable
newdf <- 
  df %>% 
  pivot_longer(cols = matches("^ex|^in|^FST"), values_to = "value", names_to = "key") %>%
  mutate(rel_len = chrtotlen/max(chrtotlen))

# idea from linked thread 1
w <- unique(newdf$rel_len)
xlab <- unique(newdf$chr)
pos <- cumsum(w) + cumsum(c(0, w[-length(w)]))

# This is to calculate the x position for geom_rect
xmin <- zoo::rollmean(c(0, pos), 2)
pos_n <- tail(pos, 1)
xmax <- c(tail(xmin, -1), sum(pos_n, (pos_n - tail(xmin, 1))))
# To know how often to replicate the elements, I am using rle
replen <- rle(newdf$chr)$lengths
newdf$xmin <- rep(xmin, replen)
newdf$xmax <- rep(xmax, replen)
# This is to calculate ymin and ymax
newdf <- newdf %>%
  group_by(chr) %>% 
  mutate(ymax = cumsum(value), ymin = lag(ymax, default = 0))


# Finally, the plot
ggplot(newdf) + 
  geom_rect(aes(xmin = xmin, xmax = xmax, 
                ymin = ymin, ymax = ymax, fill = key)) +
  scale_x_continuous(labels = xlab, breaks = pos)

^{由reprex package (v1.0.0) 于 2021-02-14 创建}

【讨论】：

真的很好！完全符合预期。谢谢！ :)

【解决方案2】：

最终版本：

library(tidyverse)

# your data, colnames changed due to not good practice colnames should not start with number or %
# chr=a, `FST>0.4`=c,  `exFST>0.4`= e, `inFST>0.4`=g,  chrtotlene=i)
# a, c, e, g, i relevant
data <- tribble(
~a, ~b, ~c, ~d, ~e, ~f, ~g, ~h, ~i,
"1", "1457", "49", "336.307", "73", "50.103", "54", "370.625", "114375790", 
"1A", "1153", "49", "424.978", "72", "624.458", "48", "41.630", "70879221", 
"2", "1765", "80", "453.258", "132", "747.875", "96", "543.909", "151896526", 
"3", "1495", "33", "220.736", "56", "374.582", "35", "234.114", "111449612", 
"4", "953", "58", "608.604", "89", "933.893", "56", "587.618", "71343966", 
"4A", "408", "9", "220.588", "17", "416.667", "11", "269.608", "19376786", 
"5", "1171", "52", "444.065", "81", "691.716", "44", "375.747", "61898265", 
"6", "626", "48", "766.773", "62", "990.415", "47", "750.799", "34836644", 
"7", "636", "8", "125.786", "24", "377.358", "8", "125.786", "38159610", 
"8", "636", "24", "377.358", "28", "440.252", "27", "424.528", "30964699", 
"9", "523", "18", "344.168", "23", "439.771", "21", "40.153", "25566760")


# change type of columns and divide chrtotlene by 1.6e+08
data$a <- as.factor(data$a)
data$i <- as.numeric(data$i)
data$i <- data$i/1.6e+08
data$c <- as.numeric(data$c)
data$e <- as.numeric(data$e)
data$g <- as.numeric(data$g)


# data to long format (for ggplot2) with tidyverse package
data1 <- data %>% 
  select(a, c, e, g, i) %>% 
  pivot_longer(
    cols = 2:4,
    names_to = "Label",
    values_to = "Value"
  ) %>% 
  mutate(Label=recode(Label,
                    "c" = "FST>0.4",
                    "e" = "exFST>0.4", 
                    "g" = "inFST>0.4"))

# ggplot
ggplot(data1, aes(x=a, y=Value, width=i))+ 
geom_bar(aes(fill=Label), stat = "identity") + 
  theme(
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
legend.title = element_blank(),
legend.position = c(0.8, 0.8),
axis.title.x=element_text(size=20),
text = element_text(size=20),
axis.text.x = element_text(size=20),
panel.background = element_blank(),
axis.text.y = element_text(size=20)
)

【讨论】：

这个比较像我需要的！我不确定为什么条形之间有空格和重叠。你在为 x 轴做什么？谢谢
问题是宽度。我不明白为什么有必要。查看我的不带宽度参数的编辑图片。
是的，我需要条形与 chrtotlen 成比例。这就是具有挑战性的部分。
我添加了用于制作维度条形图的代码，因为我没有使用 ggplot。
这似乎更正确！除了条之间的空间。你介意分享它的代码吗？谢谢