Fatal编程技术网
  • r/
  • R 叠加多个点阵图

R 叠加多个点阵图

r plot

R 叠加多个点阵图,r,plot,ggplot2,lattice,stacked-chart,R,Plot,Ggplot2,Lattice,Stacked Chart,我有以下数据集： 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"

我有以下数据集：

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

awesome$idx您说过您只需要一个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]")



您说过您只需要一个y轴，这意味着如果两个变量都显示在一个y轴上，并且带有实际数据，您将看不到太多的
Urban
变量（只有一条水平线）。我的建议是对数据进行缩放，以便能够轻松显示和比较。但是，由于实际值不能以这种方式显示，我不知道这是否对您有任何帮助。不管怎样，既然是我写的代码，我就发布它。此外，网格在绘图之间的空间很小，我不知道这是否可以改变，也不知道如何改变。也许你可以进一步调整它以适应你的需要


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



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


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



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


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



我知道这不是一个最低限度的答案，但这是我能得到的最接近的答案。我必须将每个男性的数据分成3个数据帧才能完成这一个。我用这个问题的答案、其他问题的答案、手册和我自己的探索把这些放在一起。我取出了axis标签、字体和字体大小的代码，以便在某种程度上减少代码。我希望这对其他人有用


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)



库（ggplot2）
图书馆（gtable）
图书馆（网格）
图书馆（gridExtra）
##为公螺纹331创建Plot1

q1我知道这不是一个最小的答案，但这是我能得到的最接近的答案。我必须将每个男性的数据分成3个数据帧才能完成这一个。我用这个问题的答案、其他问题的答案、手册和我自己的探索把这些放在一起。我取出了axis标签、字体和字体大小的代码，以便在某种程度上减少代码。我希望这对其他人有用


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)



库（ggplot2）
图书馆（gtable）
图书馆（网格）
图书馆（gridExtra）
##为公螺纹331创建Plot1

Q1那么您希望使用哪个y轴？这似乎只适用于两个数据集中的一个，因为它们的比例如此不同。那么，您希望使用哪个y轴？这似乎只适用于这两个数据集中的一个，因为它们在如此不同的尺度上。这是最接近我所寻找的。我对这个解决方案唯一不感兴趣的是，它是使用Lattice完成的，尽管这不是你的错，因为这是我所要求的。我需要解决一些小的格式问题，但我想我可以做到。非常感谢您的回答！然而，@初学者答案也很吸引人，因为它是使用ggplot2完成的。还有，有没有办法将“LowFreq”放在中间面板旁边的y轴上？更新只是将“LowFreq”替换为“Urban”，而不是将“LowFreq”放在面板2的右侧。这一直是我最大的问题，试图在面板的两侧有两个y轴标签。您应该使用
mtext（）
。如果您希望条带消失，则在原始调用或更新中使用
strip=FALSE
即可。这与我要查找的最接近。我对这个解决方案唯一不感兴趣的是，它是使用Lattice完成的，尽管这不是你的错，因为这是我所要求的。我需要解决一些小的格式问题，但我想我可以做到。非常感谢您的回答！然而，@初学者答案也很吸引人，因为它是使用ggplot2完成的。还有，有没有办法将“LowFreq”放在中间面板旁边的y轴上？更新只是将“LowFreq”替换为“Urban”，而不是将“LowFreq”放在面板2的右侧。这一直是我最大的问题，试图在面板的两侧有两个y轴标签。您应该使用
mtext（）
。如果您希望条带消失，则在原始调用或更新中使用
strip=FALSE
即可。这个答案非常吸引人，因为它是使用GGplot完成的，但是缺少第二个y轴，显示“低频”的范围，这对我来说至关重要。我还希望“城市”y轴上的比例能够反映实际数据的范围。情节之间的小空间看起来一点也不差，实际上我很喜欢。谢谢你在这方面的工作。如果您能解决我的进一步问题，将不胜感激！另外，当我说我只想要一个y轴标签时，我指的是轴的实际标签。在每个面板旁边放置“市区”或“低频”是多余的。相反，将这些标签放在中间面板的两侧将是最理想的。@用户3494534请查看hadley的答案，并在评论中讨论为什么在
ggplot2
中不可能有第二个y轴，而不是另一个y轴的变换。如果您遵循，这似乎是可能的。我自己绘制了这些图，但似乎无法堆叠它们，然后正确标记轴。我不熟悉
gtable
和
grid
，因此我无法进一步帮助您。很遗憾，这个答案是错误的