两个具有不同 x 轴和标题并排的情节图

Posted 2023-02-18

【中文标题】两个具有不同 x 轴和标题并排的情节图

【英文标题】：Two plotly plots side by side with different x-axis and title

【发布时间】：2021-11-16 20:09:38

【问题描述】：

我有以下数据表dt：

dt <- structure(list(Year = c(2018L, 2018L, 2018L, 2018L, 2018L, 2018L
), GPNRPlan = c(100236L, 111328L, 124213L, 127434L, 128509L, 
130058L), TB.Info = c("Below TB", "In TB", "In TB", "In TB", 
"Below TB", "Over TB"), EV = c(3847.65626027868, 5338.68193802084, 
10300.9948652062, 5038.09710335868, 0, 0), EK = c(3811.92025173996, 
5586.32697111958, 10585.2526883719, 4877.33454328664, 0, 0), 
    EH = c(-35.73600853872, 247.645033098735, 284.257823165694, 
    -160.762560072037, 0, 0), Peff = c(-0.930787702415846, -0.419264793842894, 
    -0.315176223310973, -0.723946352455921, 0, 0), Qeff = c(-0.0743981180665954, 
    -0.0217075309556152, -0.023969783660222, 0.0196407065837463, 
    0, 0), Meff = c(0.00607404848663733, -0.0108666526068035, 
    0.0189664869955087, -0.0462868566408241, 0, 0), G = c(-1.01125986896908, 
    -0.430105672191706, -0.358112493966704, -0.65801878923135, 
    0, 0), D = c(3487.48898679126, 5326.92791504907, 8272.0625456978, 
    4175.52755341498, 0, 0), pP = c(26.5779083308579, 31.6459243502761, 
    39.1575290053625, 29.9663937059302, 0, 0), rP = c(0.920540785888205, 
    0.465754071912363, 0.349539820248902, 0.685445215051006, 
    Inf, Inf), rQ = c(-0.107529139864884, -0.0818682935407816, 
    0.0682873156950798, -0.0888008295761697, -0.0389860414549387, 
    0.0467669873373015), rE = c(-0.365657184074912, -0.611781152528706, 
    -1.01730880485982, -0.576690323218312, Inf, Inf), dEHdD = c(-0.0102469165276418, 
    0.0464892780694693, 0.0343635969379285, -0.0385011374049145, 
    0, 0), dEHdzH = c(149.99469, 174.85475, 249.99943, 157.60337, 
    0, 0), dEHdrP = c(-144.290096406009, 422.437395885851, -628.850053183356, 
    -472.79252131192, 0, 0), dEKdzV = c(133.86589, 160.53969, 
    267.07122, 143.60806, 0, 0), dEKdzTB = c(1.12933099999998, 
    0, 0, 0, 0, 0), dEKdzH = c(133.86589, 160.53969, 267.07122, 
    143.60806, 0, 0), dEKdrQ = c(1735.01286752418, 3382.18207916749, 
    7202.0301280607, 2211.63410470112, 0, 0), dEKdrP = c(142.074325457591, 
    787.786612187459, -1517.82104184232, 88.8075555705551, 0, 
    0), dEKdrE = c(26.2577923587955, 0, 0, 0, 0, 0), dEKdpP = c(131.607228, 
    160.53969, 267.07122, 143.60806, 0, 0), dEKdD = c(1.09351291507554, 
    1.04869580745361, 1.27963886030784, 1.16807624447303, 0, 
    0), dEKdf = c(3527.86009725552, 5080.42688495677, 10457.8490436476, 
    4303.41566530484, 0, 0), dEKdavgPh = c(-196.022806848597, 
    -170.979162713529, -328.165770519213, -170.561078468544, 
    0, 0), dEVdzV = c(-225.012001037922, -261.251748219821, 814.876376507511, 
    -213.186940661405, 0, 0), dEVdzTB = c(1.12933099999998, 0, 
    0, 0, 0, 0), dEVdzH = c(-16.1288, -14.31506, 17.07179, -13.99531, 
    0, 0), dEVdrQ = c(1735.01286752418, 3382.18207916749, 7202.0301280607, 
    2211.63410470112, 0, 0), dEVdrE = c(26.2577923587955, 0, 
    0, 0, 0, 0), dEVdpP = c(131.607228, 160.53969, 267.07122, 
    143.60806, 0, 0), dEVdD = c(1.10375983160318, 1.00220652938414, 
    1.24527526336992, 1.20657738187795, 0, 0), dEVdf = c(3527.86009725552, 
    5080.42688495677, 10457.8490436476, 4303.41566530484, 0, 
    0), dEVdavgPh = c(-159.149177030656, -170.979162713529, -328.165770519213, 
    -170.561078468544, 0, 0), dPeffdrP = c(-1.041373635, -0.920697744999998, 
    -1.07602095, -1.11322941, -0.935816484999999, -1.12774264
    ), dMeffdrP = c(0.0419007850000003, 0.00739610999999998, 
    0.0318154900000001, -0.039115815, -0.05432063, -0.04422305
    ), sumQa = c(133865.89, 160539.69, 267071.22, 143608.06, 
    518910.75, 4605551.27), type = c("J/B", "J/B", "J/B", "J/B", 
    "J/B", "J*/B"), pBu = c(0.1, 0.05, 0.1, 0.1, 0.05, 0.1), 
    pBo = c(0.1, 0.05, 0.1, 0.1, 0.05, 0.1), zTBu = c(1.5, 1.5, 
    1.5, 1.5, 1.5, 1.5), zTBo = c(1.5, 1.5, 1.5, 1.5, 1.5, 1.5
    ), zV = c(1.5, 1.5, 1.5, 1.5, 1, 0.8), TP = c(35.19, 37.24, 
    31.29, 28.73, 27.37, 23.83), externalFactors = c(98.5834226439036, 
    129.823301064071, -557.461008441315, 519.269348053835, 0, 
    0), zPolicy = c(3749.07283763478, 5208.85863695677, 10858.4558736475, 
    4518.82775530484, 0, 0)), class = c("data.table", "data.frame"
), row.names = c(NA, -6L))

我正在创建两个图p1 和p2：

options(scipen = 999)
col <- c("#00943c", "#006551", "#2f52a0", "#fdc300")

p1 <- (dt %>% dplyr::mutate(pBu = as.factor(pBu)) %>%
                      ggplot(aes(x = externalFactors)) +
                      geom_density(aes(y = ..scaled.., color = pBu)) + 
                      ggtitle("External Factors 2018") +
                      ylab("Density") +
                      xlab("D*(rQ*Peff+(1+rQ)*(Qeff-Meff))") +
                      scale_color_manual(values = col) +
                      theme(panel.background = element_blank(), axis.line = element_line(colour = "black"),
                            plot.title = element_text(lineheight = .8, hjust = 0.5, face = "bold"),
                            legend.title = element_blank(), 
                            legend.background = element_rect(fill = "white", size = 0.5, linetype = "solid", colour ="black"),
                            legend.box.background = element_rect(colour = "black"), legend.box.margin = margin(t = 1, l = 1))
) %>%
  ggplotly()
externalFactors


p2 <- (dt %>% dplyr::mutate(pBu = as.factor(pBu)) %>%
              ggplot(aes(x = zPolicy)) +
              geom_density(aes(y = ..scaled.., color = pBu)) + 
              ggtitle("Surcharge Policy 2018") +
              ylab("Density") +
              xlab("EV - D*(rQ*Peff+(1+rQ)*(Qeff-Meff))") +
              scale_color_manual(values = col) +
              theme(panel.background = element_blank(), axis.line = element_line(colour = "black"),
                    plot.title = element_text(lineheight = .8, hjust = 0.5, face = "bold"),
                    legend.title = element_blank(), 
                    legend.background = element_rect(fill = "white", size = 0.5, linetype = "solid", colour ="black"),
                    legend.box.background = element_rect(colour = "black"), legend.box.margin = margin(t = 1, l = 1))
) %>%
  ggplotly()

它们看起来像这样：

如何将这两个并排绘制在一起？ 两个图的标题和 x 轴应该保持不变。是否可以在此并排标题中添加一个名为“Summary 2018”的附加总标题？

我试过了：

subplot(p1, p2)

但这不会产生我想要的情节，因为 x 轴标题已被删除，并且单个情节标题也丢失了。此外，可以总结图例，即 0.05 和 0.1 不必显示两次。

【问题讨论】：

如果您只能使用ggplot2，那么来自ggpubr 的ggarrange 将为您完成这项工作。

【参考方案1】：

这有点棘手，我删除了ggtitles 并在layout 中添加了带有annotations 参数的原生plotlytitles。

然后我删除了一个带有style 的图例；

options(scipen = 999)
col <- c("#00943c", "#006551", "#2f52a0", "#fdc300")

p1 <- (dt %>% dplyr::mutate(pBu = as.factor(pBu)) %>%
                      ggplot(aes(x = externalFactors)) +
                      geom_density(aes(y = ..scaled.., color = pBu)) + 
                      ylab("Density") +
                      xlab("D*(rQ*Peff+(1+rQ)*(Qeff-Meff))") +
                      scale_color_manual(values = col) +
                      theme(panel.background = element_blank(), axis.line = element_line(colour = "black"),
                            plot.title = element_text(lineheight = .8, hjust = 0.5, face = "bold"),
                            legend.title = element_blank(), 
                            legend.background = element_rect(fill = "white", size = 0.5, linetype = "solid", colour ="black"),
                            legend.box.background = element_rect(colour = "black"), legend.box.margin = margin(t = 1, l = 1))
) %>%
  ggplotly() %>% 
  layout(annotations=list(x = 0.3 , y = 1.05, text = "External Factors 2018", showarrow = F, xref='paper', yref='paper'))


p2 <- (dt %>% dplyr::mutate(pBu = as.factor(pBu)) %>%
              ggplot(aes(x = zPolicy)) +
              geom_density(aes(y = ..scaled.., color = pBu)) + 
              ylab("Density") +
              xlab("EV - D*(rQ*Peff+(1+rQ)*(Qeff-Meff))") +
              scale_color_manual(values = col) +
              theme(panel.background = element_blank(), axis.line = element_line(colour = "black"),
                    plot.title = element_text(lineheight = .8, hjust = 0.5, face = "bold"),
                    legend.title = element_blank(), 
                    legend.background = element_rect(fill = "white", size = 0.5, linetype = "solid", colour ="black"),
                    legend.box.background = element_rect(colour = "black"), legend.box.margin = margin(t = 1, l = 1))
) %>%
  ggplotly() %>% 
  layout(annotations=list(x = 0.7 , y = 1.05, text = "Surcharge Policy 2018", showarrow = F, xref='paper', yref='paper'))

subplot(p1,style(p2,showlegend=F)) 

输出；

【讨论】：

感谢您的回答。这里缺少的是整体标题“Summary 2018”和 x 轴的两个特定标签（公式）。