Сложите многократные участки решетки

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")

Я хочу создать график, где каждая панель будет выглядеть как панель ниже:

Тем не менее, я хочу, чтобы все панели располагались друг над другом, без промежутков между панелями и только с одной осью 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 ось у и х -осная метка.

Я бы предпочел, чтобы это было выполнено в GGPlot2, если это возможно, но Lattic может быть единственным способом сделать это. Любая помощь, которую вы можете оказать, будет принята с благодарностью!

Answer 1

Я знаю, что это не минимальный ответ, но это настолько близко к ответу, насколько я могу получить. Я должен был разделить данные для каждого мужчины на 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)

Answer 2

Мне интересно, если решетка update Функция - это то, что вы хотите:

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

Answer 3

Вы сказали, что вам нужна только 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]")