r - 堆叠多个格点图

Question

我有以下数据集：

structure(list(Male = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L), .Label = c("126", "331", "548"), class = "factor"), 
    Urban = c(43.36, 44.52, 44.77, 49.08, 47.88, 39.24, 41.75, 
    48.63, 49.95, 43.57, 41.94, 37.74, 40.97, 45.56, 45.65, 53.62, 
    58.19, 51.29, 51.85, 55.28, 55.66, 54.14, 49.4, 49.87, 44.81, 
    44.23, 47.99, 45.46, 44.9, 42.09, 57.23, 51.97, 46.85, 51.02, 
    41.56, 51.23, 44.79, 50.87, 46.6, 56.22, 46.98, 49.04, 50.07, 
    46.32, 48.75), LowFreq = c(3640, 3360.8, 3309.4, 3101.1, 
    3263.3, 3070, 3153.3, 3594, 4220, 3670, 3367.9, 3156.7, 3431, 
    3440.5, 3276.7, 3526.7, 3592.9, 3588.2, 3614.1, 3619.2, 3625.8, 
    3574.8, 3650, 3678.2, 3655.6, 3675.3, 3681.3, 3680.7, 3647.5, 
    3670, 2973.9, 2948.8, 2715.2, 2980.4, 2693.6, 2888.4, 2718.5, 
    2971, 2752.2, 3008.5, 2718.4, 2860.2, 2848, 2893.3, 2940.2
    ), idx = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 
    15, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1, 
    2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)), .Names = c("Male", 
"Urban", "LowFreq", "idx"), row.names = c(NA, -45L), class = "data.frame")

我想创建每个面板看起来有点像下面的面板的情节：

但是，我希望将所有面板堆叠在一起，面板之间没有空间，并且只有 1 个 x 轴，因为它们都共享一个共同的 x 轴。我使用以下代码来生成此图：

awesome$idx<-ave(rep(1,nrow(awesome)),awesome$Male,FUN=seq_along)
free.y<-list(y=list(relation="free"))
require(lattice)
mA<-xyplot(Urban~idx|Male,data=awesome,type="l",scales=free.y)
mB<-xyplot(LowFreq~idx|Male,data=awesome,type="l",scales=free.y)
require(latticeExtra)
comb<-doubleYScale(mA,mB)
comb$x.between<-5
comb

我还希望从每个图的顶部删除标签“548”、“331”和“126”，将线条颜色更改为黑色并将其中一条线更改为虚线，并且只有 1 个 y 轴和 x -轴标签。

如果可能的话，我希望这在 GGPlot2 中完成，但 Lattic 可能是做到这一点的唯一方法。您可以提供的任何帮助将不胜感激！

Answer 1

我想知道格子update函数是否是您想要的：

update(comb, layout=c(1,3))

Answer 2

您说您只需要 1 个 y 轴，这意味着Urban如果两者都显示在单个 y 轴及其实际数据上，您将看不到很多变量（只有一条水平线）。我的建议是缩放数据，以便可以轻松地显示和比较。但是，由于实际值以这种方式不可见，我不知道这是否对您有帮助。不管怎样，既然我写了代码，那我就贴一下吧。此外，网格之间的空间很小 - 我不知道是否或如何改变它。也许您可以根据需要进一步调整它。

library(dplyr)
library(ggplot2)
library(reshape2)

df %>% 
  group_by(Male) %>%
  mutate(idx = 1:n(),
         Urban_scaled = (Urban - min(Urban))/max((Urban - min(Urban)))*100,
         LowFreq_scaled = (LowFreq - min(LowFreq)) / max((LowFreq - min(LowFreq)))*100) %>%
  select(-c(Urban, LowFreq)) %>%
  melt(., id = c("Male", "idx")) %>%
  ggplot(., aes(x = idx, y = value)) + 
  geom_line(aes(linetype = variable)) + 
  facet_grid(Male ~.) +
  ylab("Urban and LowFreq [scaled to 0 - 100]")

Answer 3

我知道这不是最低答案，但这与我能得到的答案最接近。我不得不将每个男性的数据分成 3 个数据框来完成这个。我将这个问题的答案、其他问题的答案、手册和我自己的探索放在一起。我取出了轴标签、字体和字体大小的代码，以稍微减少代码。我希望这对外面的人有用。

library(ggplot2)
library(gtable)
library(grid)
library(gridExtra) 

##Create Plot1 for Male 331
q1<-ggplot(m331,aes(Count,Urban))+geom_line(linetype="dashed",size=1)+theme_bw()+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+theme(axis.title.x = element_blank())+theme(axis.title.y = element_blank())+scale_x_continuous(breaks = round(seq(min(m331$Count), max(m331$Count), by = 2),1))+scale_y_continuous(breaks = round(seq(min(m331$Urban), max(m331$Urban), by = 5),0))+theme(plot.margin=unit(c(1,1,0,1), "cm"))
    q2<-ggplot(m331,aes(Count,LowFreq))+geom_line(linetype="solid",size=1)+theme_bw()%+replace%theme(panel.background = element_rect(fill = NA))+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+theme(axis.title.x = element_blank())+scale_y_continuous(breaks = round(seq(min(3400), max(3700), by = 50),0))+theme(plot.margin=unit(c(1,1,0,1), "cm"))
    h1<-ggplot_gtable(ggplot_build(q1))
    h2<-ggplot_gtable(ggplot_build(q2))
    qq<-c(subset(h1$layout,name=="panel",se=t:r))
    h<-gtable_add_grob(h1,h2$grobs[[which(h2$layout$name=="panel")]],qq$t,qq$l,qq$b,qq$l)

    ia <- which(h2$layout$name == "axis-l")
    ga <- h2$grobs[[ia]]
    ax <- ga$children[[2]]
    ax$widths <- rev(ax$widths)
    ax$grobs <- rev(ax$grobs)
    ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15,"cm")
    h <- gtable_add_cols(h, h2$widths[h2$layout[ia, ]$l], length(h$widths) - 1)
    h <- gtable_add_grob(h, ax, qq$t, length(h$widths) - 1, qq$b)

    grid.draw(h)


    ##Create Plot2 for Male 126
    p1<-ggplot(m126,aes(Count,Urban))+geom_line(linetype="dashed",size=1)+theme_bw()+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+theme(axis.title.x = element_blank())+scale_x_continuous(breaks = round(seq(min(m126$Count), max(m126$Count), by = 2),1))+scale_y_continuous(breaks = round(seq(min(m126$Urban), max(m126$Urban), by = 5),0))+theme(plot.margin=unit(c(0,1,0,1), "cm"))
    p2<-ggplot(m126,aes(Count,LowFreq))+geom_line(linetype="solid",size=1)+theme_bw()%+replace%theme(panel.background = element_rect(fill = NA))+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+ theme(axis.title.x = element_blank())+scale_y_continuous(breaks = round(seq(min(3000), max(4200), by = 400),0))+theme(plot.margin=unit(c(0,1,0,1), "cm"))
    g1<-ggplot_gtable(ggplot_build(p1))
    g2<-ggplot_gtable(ggplot_build(p2))
    pp<-c(subset(g1$layout,name=="panel",se=t:r))
    g<-gtable_add_grob(g1,g2$grobs[[which(g2$layout$name=="panel")]],pp$t,pp$l,pp$b,pp$l)

    ia <- which(g2$layout$name == "axis-l")
    ga <- g2$grobs[[ia]]
    ax <- ga$children[[2]]
    ax$widths <- rev(ax$widths)
    ax$grobs <- rev(ax$grobs)
    ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15,"cm")
    g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
    g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)
    g <- gtable_add_grob(g, g2$grob[[7]], pp$t, length(g$widths), pp$b)

    grid.draw(g)


    ##Create Plot3 for Male 548
    r1<-ggplot(m548,aes(Count,Urban))+geom_line(linetype="dashed",size=1)+theme_bw()+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+theme(axis.title.y = element_blank())+scale_x_continuous(breaks = round(seq(min(m548$Count), max(m548$Count), by = 2),1))+scale_y_continuous(breaks = round(seq(min(m548$Urban), max(m548$Urban), by = 5),0))+theme(plot.margin=unit(c(0,1,1,1), "cm"))
    r2<-ggplot(m548,aes(Count,LowFreq))+geom_line(linetype="solid",size=1)+theme_bw()%+replace%theme(panel.background = element_rect(fill = NA))+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+theme(axis.title.y = element_blank())+scale_y_continuous(breaks = round(seq(min(2700), max(3000), by = 100),0))+theme(plot.margin=unit(c(0,1,1,1), "cm"))
    i1<-ggplot_gtable(ggplot_build(r1))
    i2<-ggplot_gtable(ggplot_build(r2))
    rr<-c(subset(i1$layout,name=="panel",se=t:r))
    i<-gtable_add_grob(i1,i2$grobs[[which(i2$layout$name=="panel")]],rr$t,rr$l,rr$b,rr$l)

    ia <- which(i2$layout$name == "axis-l")
    ga <- i2$grobs[[ia]]
    ax <- ga$children[[2]]
    ax$widths <- rev(ax$widths)
    ax$grobs <- rev(ax$grobs)
    ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15,"cm")
    i <- gtable_add_cols(i, i2$widths[i2$layout[ia, ]$l], length(i$widths) - 1)
    i <- gtable_add_grob(i, ax, rr$t, length(i$widths) - 1, rr$b)

    grid.draw(i)


    ##Combine Graphs
    grid.arrange(h, g, i, nrow=3)