ggplot2：当重叠两个图以获得右侧的轴时，不显示第二个图的图例
ggplot2: When overlapping two plots to get axes on the right, legend from second plot isn't displayed
我正在使用 How can I put a transformed scale on the right side of a ggplot2? 的 Stack Overflow 答案中的 ggplot_dual_axis() 函数来显示两个 Y 轴，一个在右边，一个在左边。该函数是一个大的 hacky 混乱，基本上将两个图叠加在一起，一个在左边有一个 Y 轴，一个在右边有一个 Y 轴。但是，它似乎并没有从正确的情节中提取所有元素，尤其是图例。这很重要的原因是它首先显示左边的图，导致网格线被写在图例上。我对 ggplot_dual_axis() 中的代码理解不够，无法修复它。懂的人可以帮帮我吗？
这是我的代码：
library(ggplot2)
library(reshape2)
library(scales) # for format_format
# See
ggplot_dual_axis <- function(lhs, rhs, axis.title.y.rhs = "rotate") {
# 1. Fix the right y-axis label justification
rhs <- rhs + theme(axis.text.y = element_text(hjust = 0))
# 2. Rotate the right y-axis label by 270 degrees by default
if (missing(axis.title.y.rhs) |
axis.title.y.rhs %in% c("rotate", "rotated")) {
rhs <- rhs + theme(axis.title.y = element_text(angle = 270))
}
# 3a. Use only major grid lines for the left axis
lhs <- lhs + theme(panel.grid.minor = element_blank())
# 3b. Use only major grid lines for the right axis
# force transparency of the backgrounds to allow grid lines to show
rhs <- rhs + theme(panel.grid.minor = element_blank(),
panel.background = element_rect(fill = "transparent", colour = NA),
plot.background = element_rect(fill = "transparent", colour = NA))
# Process gtable objects
# 4. Extract gtable
library("gtable") # loads the grid package
g1 <- ggplot_gtable(ggplot_build(lhs))
g2 <- ggplot_gtable(ggplot_build(rhs))
# 5. Overlap the panel of the rhs plot on that of the lhs plot
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)
# Tweak axis position and labels
ia <- which(g2$layout$name == "axis-l")
ga <- g2$grobs[[ia]]
ax <- ga$children[["axis"]] # 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$grobs[[7]], pp$t, length(g$widths), pp$b)
# Display plot with arrangeGrob wrapper arrangeGrob(g)
library("gridExtra")
grid.newpage()
return(arrangeGrob(g))
}
####### Set up data
t = read.table("beadle-enwiki-norestrict-50-50.nb.uniform.dat", header=TRUE)
colnames(t) = c("acc", "mean", "median", "degrees")
t2 = read.table("beadle-enwiki-restrict-50-50.nb.uniform.dat", header=TRUE)
colnames(t2) = c("acc.restrict", "mean.restrict", "median.restrict", "degrees")
# Convert from wide to long format (opposite is 'cast');
# cols will be 'x', 'metric' and 'value'
data = melt(unique(t), id = "degrees", variable.name="metric", value.name="value", na.rm=T)
data2 = melt(unique(t2), id = "degrees", variable.name="metric", value.name="value", na.rm=T)
data = rbind(data, data2)
data[data$metric == "acc","value"] = 3000 - data[data$metric == "acc","value"] * 100
data[data$metric == "acc.restrict","value"] = 3000 - data[data$metric == "acc.restrict","value"] * 100
# Extract only those where metric is Acc or Median
data = subset(data, metric=="acc" | metric=="median" | metric=="acc.restrict" |
metric=="median.restrict")
# Create a data frame to simulate a horizontal line for Naive Bayes
# instead of geom_hline(), which produces two legends in a messed-up way,
# with metric values 1 and 2 duplicated in the two. You can eliminate the
# duplication by taking out 'linetype=metric' in the call to 'ggplot' below.
#newdf = data.frame(degrees=c(-Inf, Inf), value=84.49, metric="Naive Bayes")
create_ggplot = function() {
return(ggplot(data, aes(degrees, value, group=metric, color=metric, shape=metric, linetype=metric)) +
scale_x_sqrt(breaks=c(0.1,0.25,0.5,1,2,3,4,5), labels=format_format(drop0trailing=TRUE)) +
# Override line types; not totally necessary
scale_linetype_manual(values = c(1,3,1,3)) +
# Override shapes; important to have NA for third (Naive Bayes) shape
scale_shape_manual(values = c(16,17,18,21)) +
# Override colors; not totally necessary
scale_color_manual(values = c("red", "blue","orange","black")) +
# Set the title on the legend. All three have to agree or we get multiple legends.
# We can also set these as the first parameters to scale_*_manual(), e.g.
# scale_linetype_manual("metric", values = c(1,3,1,3))
labs(color = "metric", shape = "metric", linetype = "metric")
)
}
####### Plot data
p1 = (create_ggplot()
+ xlab(NULL)
+ ylab("Kilometers")
+ scale_y_continuous(trans="reverse", breaks = seq(from = 0, to = 3000, by = 500))
+ geom_line(linetype = "blank")
+ geom_point() # Draw points for same
# Put the legend inside of the plot ...
+ theme(legend.position=c(0.85,0.82))
# ... and make the background transparent.
+ theme(legend.background=element_blank())
)
p2 = (create_ggplot()
+ xlab("K-d subdivision factor")
+ ylab("Acc@161 (pct)")
+ scale_y_continuous(trans = "reverse",
labels = c("30%", "25%", "20%", "15%", "10%", "5%", "0%"),
breaks = seq(from = 0, to = 3000, by = 500))
+ geom_point()
+ geom_smooth(se = FALSE, span=0.2)
#+ theme(legend.position=c(0.8,0.4))
)
p <- ggplot_dual_axis(lhs = p1, rhs = p2)
print(p)
以下是获得的内容：
注意网格线如何穿过图例；在文字中尤为明显。
此外，当我使用 pdf() 和 dev.off() 将图像另存为 PDF 时，我得到 3 页，其中前两页是空白的。知道如何解决这个问题并只获得一页吗？
谢谢！！
顺便说一句，这是文件 beadle-enwiki-restrict-50-50.nb.uniform.dat:
Acc@161 Mean Median Param
26.47 1196.18 876.86 0.10
25.98 1248.06 876.86 0.15
26.47 1220.19 895.41 0.25
25.00 1160.03 828.01 0.35
28.92 1070.64 718.03 0.50
29.41 1017.81 714.61 0.60
30.39 1045.87 658.71 0.70
31.37 970.27 670.57 0.75
31.86 970.59 615.73 0.80
31.37 1034.13 693.35 0.85
32.84 1006.79 580.53 0.90
30.39 970.15 670.58 0.95
28.43 1043.27 734.25 1.05
30.39 948.51 556.36 1.10
29.90 961.27 628.30 1.15
33.33 1025.30 655.12 1.20
33.33 1025.30 655.12 1.20
33.82 905.29 531.95 1.25
29.90 1015.78 625.00 1.30
28.43 959.12 570.56 1.35
29.90 951.32 600.57 1.40
28.92 920.92 603.40 1.45
28.43 973.23 627.40 1.50
31.86 905.70 504.89 1.55
31.86 923.96 629.65 1.60
32.84 948.97 576.03 1.65
30.88 895.25 540.52 1.70
29.41 929.82 655.11 1.75
28.43 1001.63 698.88 1.80
25.98 1002.50 639.88 1.85
29.90 916.08 618.93 1.90
28.92 912.40 571.47 1.95
29.41 1013.34 652.83 1
27.45 890.13 552.36 2.50
27.45 890.13 552.36 2.50
27.45 916.58 603.20 2
27.45 916.58 603.20 2
23.53 964.79 687.81 3.50
26.96 933.72 634.51 3
26.96 933.72 634.51 3
15.69 998.84 671.73 4.50
15.69 998.84 671.73 4.50
18.63 1002.80 759.07 4
18.63 1002.80 759.07 4
13.73 981.85 662.07 5
这是文件 beadle-enwiki-norestrict-50-50.nb.uniform.dat:
Acc@161 Mean Median Param
23.04 3922.81 1825.83 0.10
22.06 3888.09 1806.71 0.15
24.51 3490.37 1648.58 0.25
22.55 4039.88 1758.75 0.35
25.49 4125.88 1748.56 0.50
25.49 4180.57 1757.72 0.60
25.98 4320.85 1762.17 0.70
27.94 3915.26 1110.75 0.75
27.94 3895.97 1215.07 0.80
25.00 4269.12 1765.45 0.85
28.43 3877.07 1264.86 0.90
26.47 4010.01 1261.95 0.95
25.98 4338.20 1640.40 1.05
25.98 3800.07 1115.98 1.10
26.47 3924.18 1134.45 1.15
25.98 3992.77 1400.51 1
28.43 3966.25 1581.52 1.20
29.90 3946.38 1169.55 1.25
26.96 4036.76 1570.82 1.30
25.00 4128.11 1597.96 1.35
24.51 4293.44 1556.12 1.40
23.04 4448.78 1725.62 1.45
21.57 4401.99 1773.66 1.50
26.96 3697.66 1066.88 1.55
26.96 4033.89 1144.61 1.60
27.45 3982.82 1081.80 1.65
26.96 4050.45 1251.99 1.70
25.49 3942.11 1117.52 1.75
24.51 4265.03 1238.81 1.80
23.53 3835.24 1250.52 1.85
23.53 4123.50 1563.50 1.90
24.02 4138.78 1258.69 1.95
24.51 4321.01 1623.01 2
24.02 4099.53 1216.75 2.50
23.04 4294.64 1280.79 3
20.59 4097.54 1262.57 3.50
14.71 4612.40 1500.24 4
11.76 5001.09 2029.41 4.50
11.76 4913.45 1811.31 5
您可以使用 gtable_add_grob 在图的顶部添加 lhs 图的 guide-box。看起来像这样
dimGB1 <- c(subset(g1$layout, name == "guide-box", se = t:r))
g <- gtable_add_grob(g,
g1$grobs[[which(g1$layout$name == "guide-box")]],
dimGB1$t, dimGB1$l, dimGB1$b, dimGB1$l, z=-Inf)
请注意 z = -Inf 将新的 grob 置于顶部。整个函数将如下所示：
##' function named ggplot_dual_axis()
##' Takes 2 ggplot plots and makes a dual y-axis plot
##' function takes 2 compulsory arguments and 1 optional argument
##' arg lhs is the ggplot whose y-axis is to be displayed on the left
##' arg rhs is the ggplot whose y-axis is to be displayed on the right
##' arg 'axis.title.y.rhs' takes value "rotate" to rotate right y-axis label
##' The function does as little as possible, namely:
##' # display the lhs plot without minor grid lines and with a
##' transparent background to allow grid lines to show
##' # display the rhs plot without minor grid lines and with a
##' secondary y axis, a rotated axis label, without minor grid lines
##' # justify the y-axis label by setting 'hjust = 0' in 'axis.text.y'
##' # rotate the right plot 'axis.title.y' by 270 degrees, for symmetry
##' # rotation can be turned off with 'axis.title.y.rhs' option
##' Source:
##'
ggplot_dual_axis <- function(lhs, rhs, axis.title.y.rhs = "rotate") {
# 1. Fix the right y-axis label justification
rhs <- rhs + theme(axis.text.y = element_text(hjust = 0))
# 2. Rotate the right y-axis label by 270 degrees by default
if (missing(axis.title.y.rhs) |
axis.title.y.rhs %in% c("rotate", "rotated")) {
rhs <- rhs + theme(axis.title.y = element_text(angle = 270))
}
# 3a. Use only major grid lines for the left axis
lhs <- lhs + theme(panel.grid.minor = element_blank())
# 3b. Use only major grid lines for the right axis
# force transparency of the backgrounds to allow grid lines to show
rhs <- rhs + theme(panel.grid.minor = element_blank(),
panel.background = element_rect(fill = "transparent", colour = NA),
plot.background = element_rect(fill = "transparent", colour = NA))
# Process gtable objects
# 4. Extract gtable
library("gtable") # loads the grid package
g1 <- ggplot_gtable(ggplot_build(lhs))
g2 <- ggplot_gtable(ggplot_build(rhs))
# 5. Overlap the panel of the rhs plot on that of the lhs plot
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)
# Tweak axis position and labels
ia <- which(g2$layout$name == "axis-l")
ga <- g2$grobs[[ia]]
ax <- ga$children[["axis"]] # 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$grobs[[7]], pp$t, length(g$widths), pp$b)
# add legend on top
if ("guide-box" %in% g1$layout$name){
dimGB1 <- c(subset(g1$layout, name == "guide-box", se = t:r))
g <- gtable_add_grob(g,
g1$grobs[[which(g1$layout$name == "guide-box")]],
dimGB1$t, dimGB1$l, dimGB1$b, dimGB1$l, z=-Inf)
}
# Display plot with arrangeGrob wrapper arrangeGrob(g)
library("gridExtra")
grid.newpage()
return(arrangeGrob(g))
}
我正在使用 How can I put a transformed scale on the right side of a ggplot2? 的 Stack Overflow 答案中的 ggplot_dual_axis() 函数来显示两个 Y 轴，一个在右边，一个在左边。该函数是一个大的 hacky 混乱，基本上将两个图叠加在一起，一个在左边有一个 Y 轴，一个在右边有一个 Y 轴。但是，它似乎并没有从正确的情节中提取所有元素，尤其是图例。这很重要的原因是它首先显示左边的图，导致网格线被写在图例上。我对 ggplot_dual_axis() 中的代码理解不够，无法修复它。懂的人可以帮帮我吗？
这是我的代码：
library(ggplot2)
library(reshape2)
library(scales) # for format_format
# See
ggplot_dual_axis <- function(lhs, rhs, axis.title.y.rhs = "rotate") {
# 1. Fix the right y-axis label justification
rhs <- rhs + theme(axis.text.y = element_text(hjust = 0))
# 2. Rotate the right y-axis label by 270 degrees by default
if (missing(axis.title.y.rhs) |
axis.title.y.rhs %in% c("rotate", "rotated")) {
rhs <- rhs + theme(axis.title.y = element_text(angle = 270))
}
# 3a. Use only major grid lines for the left axis
lhs <- lhs + theme(panel.grid.minor = element_blank())
# 3b. Use only major grid lines for the right axis
# force transparency of the backgrounds to allow grid lines to show
rhs <- rhs + theme(panel.grid.minor = element_blank(),
panel.background = element_rect(fill = "transparent", colour = NA),
plot.background = element_rect(fill = "transparent", colour = NA))
# Process gtable objects
# 4. Extract gtable
library("gtable") # loads the grid package
g1 <- ggplot_gtable(ggplot_build(lhs))
g2 <- ggplot_gtable(ggplot_build(rhs))
# 5. Overlap the panel of the rhs plot on that of the lhs plot
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)
# Tweak axis position and labels
ia <- which(g2$layout$name == "axis-l")
ga <- g2$grobs[[ia]]
ax <- ga$children[["axis"]] # 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$grobs[[7]], pp$t, length(g$widths), pp$b)
# Display plot with arrangeGrob wrapper arrangeGrob(g)
library("gridExtra")
grid.newpage()
return(arrangeGrob(g))
}
####### Set up data
t = read.table("beadle-enwiki-norestrict-50-50.nb.uniform.dat", header=TRUE)
colnames(t) = c("acc", "mean", "median", "degrees")
t2 = read.table("beadle-enwiki-restrict-50-50.nb.uniform.dat", header=TRUE)
colnames(t2) = c("acc.restrict", "mean.restrict", "median.restrict", "degrees")
# Convert from wide to long format (opposite is 'cast');
# cols will be 'x', 'metric' and 'value'
data = melt(unique(t), id = "degrees", variable.name="metric", value.name="value", na.rm=T)
data2 = melt(unique(t2), id = "degrees", variable.name="metric", value.name="value", na.rm=T)
data = rbind(data, data2)
data[data$metric == "acc","value"] = 3000 - data[data$metric == "acc","value"] * 100
data[data$metric == "acc.restrict","value"] = 3000 - data[data$metric == "acc.restrict","value"] * 100
# Extract only those where metric is Acc or Median
data = subset(data, metric=="acc" | metric=="median" | metric=="acc.restrict" |
metric=="median.restrict")
# Create a data frame to simulate a horizontal line for Naive Bayes
# instead of geom_hline(), which produces two legends in a messed-up way,
# with metric values 1 and 2 duplicated in the two. You can eliminate the
# duplication by taking out 'linetype=metric' in the call to 'ggplot' below.
#newdf = data.frame(degrees=c(-Inf, Inf), value=84.49, metric="Naive Bayes")
create_ggplot = function() {
return(ggplot(data, aes(degrees, value, group=metric, color=metric, shape=metric, linetype=metric)) +
scale_x_sqrt(breaks=c(0.1,0.25,0.5,1,2,3,4,5), labels=format_format(drop0trailing=TRUE)) +
# Override line types; not totally necessary
scale_linetype_manual(values = c(1,3,1,3)) +
# Override shapes; important to have NA for third (Naive Bayes) shape
scale_shape_manual(values = c(16,17,18,21)) +
# Override colors; not totally necessary
scale_color_manual(values = c("red", "blue","orange","black")) +
# Set the title on the legend. All three have to agree or we get multiple legends.
# We can also set these as the first parameters to scale_*_manual(), e.g.
# scale_linetype_manual("metric", values = c(1,3,1,3))
labs(color = "metric", shape = "metric", linetype = "metric")
)
}
####### Plot data
p1 = (create_ggplot()
+ xlab(NULL)
+ ylab("Kilometers")
+ scale_y_continuous(trans="reverse", breaks = seq(from = 0, to = 3000, by = 500))
+ geom_line(linetype = "blank")
+ geom_point() # Draw points for same
# Put the legend inside of the plot ...
+ theme(legend.position=c(0.85,0.82))
# ... and make the background transparent.
+ theme(legend.background=element_blank())
)
p2 = (create_ggplot()
+ xlab("K-d subdivision factor")
+ ylab("Acc@161 (pct)")
+ scale_y_continuous(trans = "reverse",
labels = c("30%", "25%", "20%", "15%", "10%", "5%", "0%"),
breaks = seq(from = 0, to = 3000, by = 500))
+ geom_point()
+ geom_smooth(se = FALSE, span=0.2)
#+ theme(legend.position=c(0.8,0.4))
)
p <- ggplot_dual_axis(lhs = p1, rhs = p2)
print(p)
以下是获得的内容：
注意网格线如何穿过图例；在文字中尤为明显。
此外，当我使用 pdf() 和 dev.off() 将图像另存为 PDF 时，我得到 3 页，其中前两页是空白的。知道如何解决这个问题并只获得一页吗？
谢谢！！
顺便说一句，这是文件 beadle-enwiki-restrict-50-50.nb.uniform.dat:
Acc@161 Mean Median Param
26.47 1196.18 876.86 0.10
25.98 1248.06 876.86 0.15
26.47 1220.19 895.41 0.25
25.00 1160.03 828.01 0.35
28.92 1070.64 718.03 0.50
29.41 1017.81 714.61 0.60
30.39 1045.87 658.71 0.70
31.37 970.27 670.57 0.75
31.86 970.59 615.73 0.80
31.37 1034.13 693.35 0.85
32.84 1006.79 580.53 0.90
30.39 970.15 670.58 0.95
28.43 1043.27 734.25 1.05
30.39 948.51 556.36 1.10
29.90 961.27 628.30 1.15
33.33 1025.30 655.12 1.20
33.33 1025.30 655.12 1.20
33.82 905.29 531.95 1.25
29.90 1015.78 625.00 1.30
28.43 959.12 570.56 1.35
29.90 951.32 600.57 1.40
28.92 920.92 603.40 1.45
28.43 973.23 627.40 1.50
31.86 905.70 504.89 1.55
31.86 923.96 629.65 1.60
32.84 948.97 576.03 1.65
30.88 895.25 540.52 1.70
29.41 929.82 655.11 1.75
28.43 1001.63 698.88 1.80
25.98 1002.50 639.88 1.85
29.90 916.08 618.93 1.90
28.92 912.40 571.47 1.95
29.41 1013.34 652.83 1
27.45 890.13 552.36 2.50
27.45 890.13 552.36 2.50
27.45 916.58 603.20 2
27.45 916.58 603.20 2
23.53 964.79 687.81 3.50
26.96 933.72 634.51 3
26.96 933.72 634.51 3
15.69 998.84 671.73 4.50
15.69 998.84 671.73 4.50
18.63 1002.80 759.07 4
18.63 1002.80 759.07 4
13.73 981.85 662.07 5
这是文件 beadle-enwiki-norestrict-50-50.nb.uniform.dat:
Acc@161 Mean Median Param
23.04 3922.81 1825.83 0.10
22.06 3888.09 1806.71 0.15
24.51 3490.37 1648.58 0.25
22.55 4039.88 1758.75 0.35
25.49 4125.88 1748.56 0.50
25.49 4180.57 1757.72 0.60
25.98 4320.85 1762.17 0.70
27.94 3915.26 1110.75 0.75
27.94 3895.97 1215.07 0.80
25.00 4269.12 1765.45 0.85
28.43 3877.07 1264.86 0.90
26.47 4010.01 1261.95 0.95
25.98 4338.20 1640.40 1.05
25.98 3800.07 1115.98 1.10
26.47 3924.18 1134.45 1.15
25.98 3992.77 1400.51 1
28.43 3966.25 1581.52 1.20
29.90 3946.38 1169.55 1.25
26.96 4036.76 1570.82 1.30
25.00 4128.11 1597.96 1.35
24.51 4293.44 1556.12 1.40
23.04 4448.78 1725.62 1.45
21.57 4401.99 1773.66 1.50
26.96 3697.66 1066.88 1.55
26.96 4033.89 1144.61 1.60
27.45 3982.82 1081.80 1.65
26.96 4050.45 1251.99 1.70
25.49 3942.11 1117.52 1.75
24.51 4265.03 1238.81 1.80
23.53 3835.24 1250.52 1.85
23.53 4123.50 1563.50 1.90
24.02 4138.78 1258.69 1.95
24.51 4321.01 1623.01 2
24.02 4099.53 1216.75 2.50
23.04 4294.64 1280.79 3
20.59 4097.54 1262.57 3.50
14.71 4612.40 1500.24 4
11.76 5001.09 2029.41 4.50
11.76 4913.45 1811.31 5
您可以使用 gtable_add_grob 在图的顶部添加 lhs 图的 guide-box。看起来像这样
dimGB1 <- c(subset(g1$layout, name == "guide-box", se = t:r))
g <- gtable_add_grob(g,
g1$grobs[[which(g1$layout$name == "guide-box")]],
dimGB1$t, dimGB1$l, dimGB1$b, dimGB1$l, z=-Inf)
请注意 z = -Inf 将新的 grob 置于顶部。整个函数将如下所示：
##' function named ggplot_dual_axis()
##' Takes 2 ggplot plots and makes a dual y-axis plot
##' function takes 2 compulsory arguments and 1 optional argument
##' arg lhs is the ggplot whose y-axis is to be displayed on the left
##' arg rhs is the ggplot whose y-axis is to be displayed on the right
##' arg 'axis.title.y.rhs' takes value "rotate" to rotate right y-axis label
##' The function does as little as possible, namely:
##' # display the lhs plot without minor grid lines and with a
##' transparent background to allow grid lines to show
##' # display the rhs plot without minor grid lines and with a
##' secondary y axis, a rotated axis label, without minor grid lines
##' # justify the y-axis label by setting 'hjust = 0' in 'axis.text.y'
##' # rotate the right plot 'axis.title.y' by 270 degrees, for symmetry
##' # rotation can be turned off with 'axis.title.y.rhs' option
##' Source:
##'
ggplot_dual_axis <- function(lhs, rhs, axis.title.y.rhs = "rotate") {
# 1. Fix the right y-axis label justification
rhs <- rhs + theme(axis.text.y = element_text(hjust = 0))
# 2. Rotate the right y-axis label by 270 degrees by default
if (missing(axis.title.y.rhs) |
axis.title.y.rhs %in% c("rotate", "rotated")) {
rhs <- rhs + theme(axis.title.y = element_text(angle = 270))
}
# 3a. Use only major grid lines for the left axis
lhs <- lhs + theme(panel.grid.minor = element_blank())
# 3b. Use only major grid lines for the right axis
# force transparency of the backgrounds to allow grid lines to show
rhs <- rhs + theme(panel.grid.minor = element_blank(),
panel.background = element_rect(fill = "transparent", colour = NA),
plot.background = element_rect(fill = "transparent", colour = NA))
# Process gtable objects
# 4. Extract gtable
library("gtable") # loads the grid package
g1 <- ggplot_gtable(ggplot_build(lhs))
g2 <- ggplot_gtable(ggplot_build(rhs))
# 5. Overlap the panel of the rhs plot on that of the lhs plot
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)
# Tweak axis position and labels
ia <- which(g2$layout$name == "axis-l")
ga <- g2$grobs[[ia]]
ax <- ga$children[["axis"]] # 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$grobs[[7]], pp$t, length(g$widths), pp$b)
# add legend on top
if ("guide-box" %in% g1$layout$name){
dimGB1 <- c(subset(g1$layout, name == "guide-box", se = t:r))
g <- gtable_add_grob(g,
g1$grobs[[which(g1$layout$name == "guide-box")]],
dimGB1$t, dimGB1$l, dimGB1$b, dimGB1$l, z=-Inf)
}
# Display plot with arrangeGrob wrapper arrangeGrob(g)
library("gridExtra")
grid.newpage()
return(arrangeGrob(g))
}