如何创建具有特定于每个方面的标题和副标题的分面图？

Posted 2023-03-07

【中文标题】如何创建具有特定于每个方面的标题和副标题的分面图？

【英文标题】：How to create a facetted plot with title and subtitle specific to each facet?

【发布时间】：2017-11-17 14:27:13

【问题描述】：

为带有标题和副标题的每列生成一个带有单独的图的图，并为每个图生成一条垂直线：

我使用直方图创建了带有垂直线的列。

library(ggplot2)
library(gridExtra)
library(tidyr)

actualIris <- data.frame(Sepal.Length=6.1, Sepal.Width=3.1, Petal.Length=5.0, Petal.Width=1.7)

# Sepal Length
oneTailed <- sum(actualIris$Sepal.Length < iris$Sepal.Length)/nrow(iris)

plot1SL <- ggplot(iris, aes(x=Sepal.Length)) + geom_histogram() + 
  geom_vline(xintercept = actualIris$Sepal.Length, col = "blue", lwd = 2) + 
  labs(title='Distribution of Sepal Length', x='Sepal Length', y='Frequency',
       subtitle=paste('one-tailed test=', oneTailed, sep='')) + theme_bw()

以下代码只是对其他三列的重复。 （你可以忽略它）。

# Sepal Width
oneTailed <- sum(actualIris$Sepal.Width < iris$Sepal.Width)/nrow(iris)

plot1SW <- ggplot(iris, aes(x=Sepal.Width)) + geom_histogram() + 
  geom_vline(xintercept = actualIris$Sepal.Width, col = "blue", lwd = 2) + 
  labs(title='Distribution of Sepal Width', x='Sepal Width', y='Frequency',
       subtitle=paste('one-tailed test=', oneTailed, sep='')) + theme_bw()

# Petal Length
oneTailed <- sum(actualIris$Petal.Length < iris$Petal.Length)/nrow(iris)

plot1PL <- ggplot(iris, aes(x=Petal.Length)) + geom_histogram() + 
  geom_vline(xintercept = actualIris$Petal.Length, col = "blue", lwd = 2) + 
  labs(title='Distribution of Petal Length', x='Petal Length', y='Frequency',
       subtitle=paste('one-tailed test=', oneTailed, sep='')) + theme_bw()

# Petal Width
oneTailed <- sum(actualIris$Petal.Width < iris$Petal.Width)/nrow(iris)

plot1PW <- ggplot(iris, aes(x=Petal.Width)) + geom_histogram() + 
  geom_vline(xintercept = actualIris$Petal.Width, col = "blue", lwd = 2) + 
  labs(title='Distribution of Petal Width', x='Petal Width', y='Frequency',
       subtitle=paste('one-tailed test=', oneTailed, sep='')) + theme_bw()

# Combine the plots
grid.arrange(plot1SL, plot1SW, plot1PL, plot1PW, nrow=1)

结果如下图：

在创建长数据后，我尝试使用 facet_wrap 创建单个图，而不是组合多个单个图。

tmp <- iris[,-5] %>% gather(Type, value)
#actualIris <- data.frame(Sepal.Length=6.1, Sepal.Width=3.1, Petal.Length=5.0, Petal.Width=1.7)
actuals <- data.frame(col1=colnames(actualIris), col2=as.numeric(actualIris[1,]))
tmp$Actual <- actuals$col2[match(tmp$Type, actuals$col1)]
tmp$Type <- factor(tmp$Type, levels = c('Petal.Length', 'Petal.Width', 'Sepal.Length', 'Sepal.Width'), 
                   labels = c('Petal Length', 'Petal Width', 'Sepal Length', 'Sepal Width'))
ggplot(tmp, aes(value)) + facet_wrap(~Type, scales="free", nrow = 1) + geom_histogram() + 
  geom_vline(aes(xintercept=Actual), colour="blue", lwd=2) 

我尝试使用labeller 选项更改构面标签，但没有成功。 （不过，这不是主要问题。）

ggplot(tmp, aes(value)) + geom_histogram() + 
  facet_wrap(~Type, scales="free", nrow = 1, 
             labeller = as_labeller(paste('Distribution of ', levels(~Type), sep=''))) + 
  geom_vline(aes(xintercept=Actual), colour="blue", lwd=2) 

如何使用创建的长数据tmp创建类似于第一个图的图？

【参考方案1】：

您可以定制两行标签：

labels <- c(paste('Petal Length\none-tailed test=', round(sum(actualIris$Sepal.Length < iris$Sepal.Length)/nrow(iris), 2)),
            paste('Petal Width\none-tailed test=', round(sum(actualIris$Sepal.Width < iris$Sepal.Width)/nrow(iris), 2)),
            paste('Sepal Length\none-tailed test=', round(sum(actualIris$Petal.Length < iris$Petal.Length)/nrow(iris), 2)),
            paste('Sepal Width\none-tailed test=', round(sum(actualIris$Petal.Width < iris$Petal.Width)/nrow(iris), 2)))

tmp <- iris[,-5] %>% gather(Type, value)
actuals <- data.frame(col1=colnames(actualIris), col2=as.numeric(actualIris[1,]))
tmp$Actual <- actuals$col2[match(tmp$Type, actuals$col1)]
tmp$Type <- factor(tmp$Type, levels = c('Petal.Length', 'Petal.Width', 'Sepal.Length', 'Sepal.Width'), 
                   labels = labels)
ggplot(tmp, aes(value)) + facet_wrap(~Type, scales="free", nrow = 1) + geom_histogram() + 
  geom_vline(aes(xintercept=Actual), colour="blue", lwd=2) 

得到这个：