基于正负值着色的R图上的Extra Surface问题

Question

我根据阈值 1 使用 ggplot2 对图表进行了着色。表面分数大于 1 呈天蓝色，表面得分小于 1 呈米色。这是我的示例代码。

library(ggplot2)
setwd("F:/SUST_mutation/Graph_input")
d <- read.csv(file = "N.csv", sep = ",", header = TRUE)
ggplot(d, aes(x= Position,y= wild_Score)) + xlab("Positions") + ylab("Scores") +
geom_ribbon(aes(ymin=pmin(wild_Score,1), ymax=1), fill="beige", alpha= 1.5) +  
geom_ribbon(aes(ymin=1, ymax=pmax(wild_Score,1)), fill="azure", alpha= 1.5)

我的问题是，如果我从上表面到下表面，我希望表面线在一条线上。

但是如果你看到这个数字，你会发现他们不是。在阈值线周围，下表面不与上表面相交，而是产生了一些额外的表面。为了方便，我用红圈标记了部分。

靠近阈值的负部分的额外表面：

Position    Wild_Score
4   1.048
5   1.052
6   1.016
7   0.996
8   0.97
9   0.951
10  0.971
11  1.047
12  1.036
13  1.051
14  1.124
15  1.172
16  1.172
17  1.164
18  1.145
19  1.186
20  1.197
21  1.197
22  1.216
23  1.193
24  1.216
25  1.216
26  1.262

问题2：我有一个如下所示的数据框。

Position    Score_1 Score_2
4   1.048   1.048
5   1.052   1.052
6   1.016   1.016
7   0.996   1.433
8   0.97    1.432
9   0.951   1.567
10  0.971   1.231
11  1.047   1.055
12  1.036   1.036
13  1.051   1.051
14  1.124   1.124
15  1.172   1.172
16  1.172   1.172
17  1.164   1.164

我用 Tibble 绘制位置 vs score_1 的表面，并在该表面上绘制具有相同位置 vs score_2 的折线图，如下所示， desired graph 由于这条线在某些点上有所不同，所以我对主数据集（列和行）进行了子集化。我收到以下错误。 “错误：美学必须是长度 1 或与数据 (13) 相同：x” 我猜这是因为我为图表使用了两个不同的数据框。这是我的代码：

d <- read.csv(file = "E.csv", sep = ",", header = TRUE)
d1 <- tibble::tibble(
  x = seq(min(d$Position), max(d$Position), length.out = 1000),
  y = approx(d$Position, d$Score_1, xout = x)$y
)
ggplot(d1, aes(x= x,y= y)) + xlab("Positions") + ylab("Scores") +
  geom_ribbon(aes(ymin=pmin(y,1), ymax=1), fill="red", alpha= 1.5) +  
  geom_ribbon(aes(ymin=1, ymax=pmax(y,1)), fill="blue", alpha= 1.5) +
  geom_line(aes(y=1)) + geom_line(d = d[c(3:10), c(1,3)],aes(y = 
Score_2), color = "blue", size = 1)

我想知道是什么导致了这个问题，我该如何处理？

Answer 1

这是因为例如第3行和第4行的负表面从1开始到0.996，而不是从1.016到0.996。 ggplot2's issue tracker.

中的相关讨论和其他示例

这个问题通常只有在观察的数量很少时才会出现，所以人们克服这个问题的典型方法是对数据进行插值。你可以在下面找到一个例子（我省略了你的颜色，因为它很难看）：

library(ggplot2)
# txt <- "your_example_table" # Omitted for brevity
df <- read.table(text = txt, sep = "\t", header = TRUE)


data2 <- tibble::tibble(
  x = seq(min(df$Position), max(df$Position), length.out = 1000),
  y = approx(df$Position, df$Wild_Score, xout = x)$y
)

ggplot(data2, aes(x= x,y= y)) + xlab("Positions") + ylab("Scores") +
  geom_ribbon(aes(ymin=pmin(y,1), ymax=1, fill = "A")) +  
  geom_ribbon(aes(ymin=1, ymax=pmax(y,1), fill = "B"))

这对于隐藏问题非常有用，但是calculating精确的线交点有点麻烦。我为自我推销道歉，但我运行也参与其中，并将我的解决方案包装在我的包 ggh4x 开发版本的函数中，您可能会发现它很有用。

library(ggh4x) # devtools::install_github("teunbrand/ggh4x")

ggplot(df, aes(x= Position,y= Wild_Score)) +
  stat_difference(aes(ymin = 1, ymax = Wild_Score))

^{由 reprex package (v1.0.0)}

于 2021-08-15 创建

基于正负值着色的R图上的Extra Surface问题

Extra Surface problem on the graph of R colored based on positive and negative value

r

surface

ggplot2