R语言 在多面ggplot中自动执行最大和最小刻度

1tuwyuhd  于 2023-11-14  发布在  其他
关注(0)|答案(3)|浏览(152)

我尝试在一个多面ggplot中只标记每个x轴的最大值和最小值。我有几个具有不同x尺度和相同y尺度的面,x轴刻度标签相互重叠。而不是手动确定每个面x轴的限制和中断,我正在寻找一种方法来标记每个面的最小值和最大值。
使用CO2数据集的示例数据的代码(参见?CO2):

CO2$num <- 1:nrow(CO2)
library(reshape2)
CO2.melt <- melt(CO2,
                 id.var=c("Type",
                          "Plant",
                          "Treatment",
                          "num"))
CO2.melt <- CO2.melt[order(CO2.melt$num),]

library(ggplot2)
ggplot(CO2.melt, 
       aes(x = value, 
           y = num)) +
  geom_path(aes(color = Treatment)) +
  facet_wrap( ~ variable, scales = "free_x",nrow=1)

字符串


的数据
目的是复制测井曲线显示,如this one

b09cbbtk

b09cbbtk1#

当你想在tick-labels中实现这个功能时,在一个faceted plot中使用scales = "free_x"很难实现自动化。但是,通过一些修改和其他几个包的帮助,你也可以使用以下方法:

**1)**总结数据,以便了解您需要在x轴上标记哪些标记/断点:

library(data.table)
minmax <- melt(setDT(CO2.melt)[, .(min.val = min(value), max.val = max(value),
                                   floor.end = 10*ceiling(min(value)/10),
                                   ceil.end = 10*floor((max(value)-1)/10)),
                               variable][],
               measure.vars = patterns('.val','.end'),
               variable.name = 'var',
               value.name = c('minmax','ends'))

字符串
其给出:

> minmax
   variable var minmax ends
1:     conc   1   95.0  100
2:   uptake   1    7.7   10
3:     conc   2 1000.0  990
4:   uptake   2   45.5   40

**2)**为每个面创建断裂向量:

brks1 <- c(95,250,500,750,1000)
brks2 <- c(7.7,10,20,30,40,45.5)

**3)**创建面:

p1 <- ggplot(CO2.melt[CO2.melt$variable=="conc",], 
             aes(x = value, y = num, colour = Treatment)) +
  geom_path() +
  scale_x_continuous(breaks = brks1) +
  theme_minimal(base_size = 14) +
  theme(axis.text.x = element_text(colour = c('red','black')[c(1,2,2,2,1)],
                                   face = c('bold','plain')[c(1,2,2,2,1)]),
        axis.title = element_blank(),
        panel.grid.major = element_line(colour = "grey60"),
        panel.grid.minor = element_blank())

p2 <- ggplot(CO2.melt[CO2.melt$variable=="uptake",], 
             aes(x = value, y = num, colour = Treatment)) +
  geom_path() +
  scale_x_continuous(breaks = brks2) +
  theme_minimal(base_size = 14) +
  theme(axis.text.x = element_text(colour = c('red','black')[c(1,2,2,2,2,1)],
                                   face = c('bold','plain')[c(1,2,2,2,2,1)]),
        axis.title = element_blank(),
        panel.grid.major = element_line(colour = "grey60"),
        panel.grid.minor = element_blank())

**4)**将图例提取到一个单独的对象中:

library(grid)
library(gtable)
fill.legend <- gtable_filter(ggplot_gtable(ggplot_build(p2)), "guide-box")
legGrob <- grobTree(fill.legend)

**5)**创建最终图:

library(gridExtra)
grid.arrange(p1 + theme(legend.position="none"), 
             p2 + theme(legend.position="none"), 
             legGrob, ncol=3, widths = c(4,4,1))


其结果是:
x1c 0d1x的数据
一个可能的替代解决方案来自动做到这一点,要么使用geom_textgeom_label。一个例子来展示如何实现这一点:

# create a summary
library(dplyr)
library(tidyr)
minmax <- CO2.melt %>% 
  group_by(variable) %>% 
  summarise(minx = min(value), maxx = max(value)) %>%
  gather(lbl, val, -1)

# create the plot
ggplot(CO2.melt, aes(x = value, y = num, color = Treatment)) +
  geom_path() +
  geom_text(data = minmax, 
            aes(x = val, y = -3, label = val), 
            colour = "red", fontface = "bold", size = 5) +
  facet_wrap( ~ variable, scales = "free_x", nrow=1) +
  theme_minimal()


其给出:



您还可以在ggplot中动态获取最小值和最大值(感谢@eipi10)。另一个使用geom_label的示例:

ggplot(CO2.melt, aes(x = value, y = num, color = Treatment)) +
  geom_path() +
  geom_label(data = CO2.melt %>% 
               group_by(variable) %>% 
               summarise(minx = min(value), maxx = max(value)) %>%
               gather(lbl, val, -1), 
             aes(x = val, y = -3, label = val), 
             colour = "red", fontface = "bold", size = 5) +
  facet_wrap( ~ variable, scales = "free_x", nrow=1) +
  theme_minimal()

其给出:


vof42yt1

vof42yt12#

编辑更新到ggplot2 3.0.0版

这种方法修改了ggplot构建数据中的标签(即ggplot_build(plot))。我已经删除了x轴扩展,以便最大值和最小值落在面板边界上。

# Packages
library(grid)
library(ggplot2)
library(reshape2)

# Data
CO2$num <- 1:nrow(CO2)
library(reshape2)
CO2.melt <- melt(CO2,
                 id.var=c("Type",
                          "Plant",
                          "Treatment",
                          "num"))
CO2.melt <- CO2.melt[order(CO2.melt$num),]

# Plot
(p <- ggplot(CO2.melt, 
       aes(x = value, 
           y = num)) +
  scale_x_continuous(expand = c(0, 0)) +
  geom_path(aes(color = Treatment)) +
  facet_wrap( ~ variable, scales = "free_x", nrow=1)) 

# Get the build data
gb <- ggplot_build(p)

# Get number of panels
panels = length(gb$layout$panel_params)

# Get x tick mark labels
x.labels = lapply(1:panels, function(N)   gb$layout$panel_params[[N]]$x.labels)

# Get range of x values
x.range = lapply(1:panels, function(N) gb$layout$panel_params[[N]]$x.range)

# Get position of x tick mark labels
x.pos = lapply(1:panels, function(N) gb$layout$panel_params[[N]]$x.major)

# Get new x tick mark labels - includes max and min
new.labels = lapply(1:panels, function(N) as.character(sort(unique(c(as.numeric(x.labels[[N]]), x.range[[N]])))))

# Tag min and max values with "min" and "max"
new.labelsC = new.labels
minmax = c("min", "max")
new.labelsC = lapply(1:panels, function(N) {
   x = c(new.labelsC[[N]][1], new.labelsC[[N]][length(new.labels[[N]])])
   x = paste0(x, "\n", minmax)
   c(x[1], new.labelsC[[N]][2:(length(new.labels[[N]])-1)], x[2])
} )

# # Get position of new labels
new.pos = lapply(1:panels, function(N) (as.numeric(new.labels[[N]]) - x.range[[N]][1])/(x.range[[N]][2] - x.range[[N]][1]))

# Put them back into the build data
for(i in 1:panels) {
   gb$layout$panel_params[[i]]$x.labels = new.labelsC[[i]]
   gb$layout$panel_params[[i]]$x.major_source = as.numeric(new.labels[[i]])
   gb$layout$panel_params[[i]]$x.major = new.pos[[i]]
}

# Get the ggplot grob
gp = ggplot_gtable(gb)

# Add some additional space between the panels
pos = gp$layout$l[grep("panel", gp$layout$name)] # Positions of the panels
for(i in 1:(panels-1)) gp$widths[[pos[i]+1]] = unit(1, "cm")

# Colour the min and max labels using `grid` editing functions
for(i in 1:panels) {
   gp = editGrob(grid.force(gp), gPath(paste0("axis-b-", i), "axis", "axis", "GRID.text"), 
         grep = TRUE, gp = gpar(col = c("red", rep("black", length(new.labels[[i]])-2), "red")))
}

# Draw it
grid.newpage()
grid.draw(gp)

字符串


的数据

hfsqlsce

hfsqlsce3#

我想分享这个,因为我需要类似的东西。这里是一个更简单的方法来打印每个方面的最小值和最大值。我不确定,然而,如何改变最小/最大轴文本值的颜色。也许这不是所有应用程序都需要的。

library(ggplot2); library(reshape2)

data(CO2)
CO2$num <- 1:nrow(CO2)

CO2.melt <- reshape2::melt(CO2,
                 id.var=c("Type",
                          "Plant",
                          "Treatment",
                          "num"))

CO2.melt <- CO2.melt[order(CO2.melt$num),]

ggplot(CO2.melt, 
       aes(x = value, 
           y = num)) +
  geom_path(aes(color = Treatment)) +
  scale_x_continuous(breaks = function(k) {
    sort(unique(c(
      pretty(range(k)),
      round(unname(quantile(k, c(0,1))))
    )))
    }
    ) +
  facet_wrap( ~ variable, scales = "free_x",nrow=1) +
  theme(panel.spacing = unit(2, "lines"))

字符串
x1c 0d1x的数据
创建日期:2023年10月31日,使用reprex v2.0.2

相关问题