R语言 将颜色渐变应用于已连接散点图中的轴线

dly7yett  于 2023-01-06  发布在  其他
关注(0)|答案(1)|浏览(134)

好的,我有代码可以生成一个连接的散点图,我希望在图表区的底部和左边缘有一个颜色渐变,我需要渐变的可视部分基于图表中包含的值(渐变所基于的值是静态的)。
在图表中所需的位置添加具有适当权重的线条是没有问题的,而且我可以为线条指定单一颜色(如y轴所示),但是当我尝试使用scale_colour_gradientn()为线条应用渐变时,它什么也不做(提供的代码尝试将渐变应用于图表底部的线条)。
如果有一种方法可以捕捉图表呈现的x和y的极限(不是显示的最小值和最大值,因为标签位置会超过它们),我可以使用其他ggplot特性来做一些工作,但似乎这些都不是已知值。
样本代码:

parent <- c('A','A','A','B','B','B','C','C','C')
pd_identifier <- c('2021_10','2022_03','2022_08','2021_10','2022_03','2022_08','2021_10','2022_03','2022_08')
PtChg <- c(-15.3,-19.4,-16.0,-9.83,-11.9,-13.4,0.876,2.10 ,2.24)
Impact  <- c(-0.684 ,-0.860 ,-0.558 ,-1.55  ,-2.00  ,-2.68  ,-0.165 ,-0.0730,-0.0816)
label <- c(NA,'A',NA,NA,NA,'B',NA,NA,'C')
nudge_x <- c(NA,-0.984,NA,NA,NA,-0.400,NA,NA,0.944)
nudge_y <- c(NA,0.0352,NA,NA,NA,-0.183,NA,NA,0.0659)
df <- as.data.frame(cbind(parent,pd_identifier,label,PtChg,Impact,nudge_x,nudge_y))
df[, 4:ncol(df)] <- lapply(4:ncol(df), function(x) as.numeric(df[[x]]))

ggplot(df, aes(PtChg, Impact)) +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5),
        panel.grid = element_line(linetype = "dashed",colour = "#D3D3D3")) +
  scale_colour_gradientn(
    colors=c("#C00000","#C00000","#FFFF00","#00B050","#00B050"),
    values=c(0,0.425,0.5,0.575,1)) +  
  theme(axis.line.x.bottom = element_line(color = (PtChg + 100)/200,size = 4)) +
  theme(axis.line.y.left = element_line(color = "#D3D3D3",size = 4)) +
  geom_vline(aes(xintercept = 0),size = 1,colour = "#D3D3D3") +
  geom_hline(aes(yintercept = 0),size = 1,colour = "#D3D3D3") +
  
  geom_path(aes(group=parent),
            colour="#E20074",
            arrow = arrow(length=unit(0.3,"cm"),
                          ends="last",
                          type = "closed")) + 
  geom_text_repel(data = df,
                  aes(label = label),
                  min.segment.length = 0.1,
                  nudge_x = df$nudge_x,
                  nudge_y = df$nudge_y,
                  direction = "both",
                  force = 100,
                  force_pull = 1,
                  max.time = 500,
                  max.iter = 1000000,
                  # verbose = TRUE,
                  na.rm = TRUE
  )

解决方案:ggplot(和计算边界)的最终代码:

x_min = if((floor(min(df$PtChg)/5)*5 - min(df$PtChg)) >= 2.5)
{floor(min(df$PtChg)/5)*5} else {floor(min(df$PtChg)/5)*5 - 2.5}
x_max = if((ceiling(max(df$PtChg)/5)*5 - max(df$PtChg)) >= 2.5)
{ceiling(max(df$PtChg)/5)*5} else {ceiling(max(df$PtChg)/5)*5 + 2.5}
y_min = if((floor(min(df$Impact)/.5)*.5 - min(df$Impact)) >= 0.25)
{floor(min(df$Impact)/.5)*.5} else {floor(min(df$Impact)/.5)*.5 - 0.25}
y_max = if((ceiling(max(df$Impact)/.5)*.5 - max(df$Impact)) >= 2.5)
{ceiling(max(df$Impact)/.5)*.5} else {ceiling(max(df$Impact)/.5)*.5 + 0.25}

ggplot(df, aes(PtChg, Impact)) +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5),
        panel.grid = element_line(linetype = "dashed",colour = "#D3D3D3")) +

  geom_vline(aes(xintercept = 0),size = 1,colour = "#D3D3D3") +
  geom_hline(aes(yintercept = 0),size = 1,colour = "#D3D3D3") +
  
  geom_path(aes(group=parent),
            colour="#E20074",
            arrow = arrow(length=unit(0.3,"cm"),
                          ends="last",
                          type = "closed")) + 
    geom_text_repel(data = df,
                  aes(label = label),
                  min.segment.length = 0.1,
                  nudge_x = df$nudge_x,
                  nudge_y = df$nudge_y,
                  direction = "both",
                  force = 100,
                  force_pull = 1,
                  max.time = 500,
                  max.iter = 1000000,
                  na.rm = TRUE
  ) +
  ggforce::geom_link2(data = data.frame(PtChg = seq(-100,100), Impact = y_min),
                      aes(color = (PtChg+100)/200), size = 8) +
  theme(axis.line.x = element_blank()) +
  scale_colour_gradientn(
    colors = c("#C00000","#C00000","#FFFF00","#00B050","#00B050"),
    values = c(0,0.425,0.5,0.575,1), guide = "none") +
  new_scale_color() +
  ggforce::geom_link2(data = data.frame(PtChg = x_min,Impact = seq(-10,10)),
    aes(color = (Impact+10)/20), size = 8) +
    theme(axis.line.y = element_blank()) +
  scale_colour_gradientn(
    colors = c("#C00000","#C00000","#FFFF00","#00B050","#00B050"),
    values=c(0,0.45,0,0.55,1), guide = "none") +
  coord_cartesian(xlim = c(x_min,x_max),ylim = c(y_min,y_max), expand = FALSE)

看起来是这样的

3xiyfsfu

3xiyfsfu1#

可使用coord_cartesian指定图的精确界限,这样便可沿着x轴精确绘制渐变线,例如使用geom_link2ggforce绘制渐变线

ggplot(df, aes(PtChg, Impact)) +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5),
        panel.grid = element_line(linetype = "dashed",colour = "#D3D3D3")) +
  scale_colour_gradientn(
    colors = c("#C00000","#C00000","#FFFF00","#00B050","#00B050"),
    values = c(0,0.425,0.5,0.575,1), guide = "none") +  
  geom_vline(aes(xintercept = 0),size = 1,colour = "#D3D3D3") +
  geom_hline(aes(yintercept = 0),size = 1,colour = "#D3D3D3") +
  
  geom_path(aes(group=parent),
            colour="#E20074",
            arrow = arrow(length=unit(0.3,"cm"),
                          ends="last",
                          type = "closed")) + 
  coord_cartesian(ylim = c(-2.75, 0.1), expand = FALSE) +
  geom_text_repel(data = df,
                  aes(label = label),
                  min.segment.length = 0.1,
                  nudge_x = df$nudge_x,
                  nudge_y = df$nudge_y,
                  direction = "both",
                  force = 100,
                  force_pull = 1,
                  max.time = 500,
                  max.iter = 1000000,
                  na.rm = TRUE
  ) +
  ggforce::geom_link2(data = data.frame(PtChg = seq(-20, 5), Impact = -2.75),
                      aes(color = PtChg), linewidth = 8) +
  theme(axis.line.x = element_blank())

相关问题