6

少し前に、ggplot に二次変換された x 軸を追加することについて問い合わせたところ、Nate Pope が ggplot2 で説明されている優れた解決策を提供してくれました。

そのソリューションは私にとって非常にうまく機能し、新しいプロジェクトで機能することを期待して戻ってきました. 残念ながら、ソリューションは ggplot2 の最新バージョンでは正しく機能しません。ここで、まったく同じコードを実行すると、軸のタイトルが「クリッピング」され、目盛りとラベルが重なります。以下に例を示します。問題は青色で強調表示されています。

ここに画像の説明を入力

この例は、次のコードで再現できます (これは、以前に素晴らしく機能した Nate Pope のコードの正確なコピーです)。

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

LakeLevels<-data.frame(Day=c(1:365),Elevation=sin(seq(0,2*pi,2*pi/364))*10+100)

## 'base' plot
p1 <- ggplot(data=LakeLevels) + geom_line(aes(x=Elevation,y=Day)) + 
  scale_x_continuous(name="Elevation (m)",limits=c(75,125)) +
  ggtitle("stuff") +
  theme(legend.position="none", plot.title=element_text(hjust=0.94, margin = margin(t = 20, b = -20)))

## plot with "transformed" axis
p2<-ggplot(data=LakeLevels)+geom_line(aes(x=Elevation, y=Day))+
  scale_x_continuous(name="Elevation (ft)", limits=c(75,125),
                     breaks=c(90,101,120),
                     labels=round(c(90,101,120)*3.24084) ## labels convert to feet
  )

## extract gtable
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))

## overlap the panel of the 2nd plot on that of the 1st 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)

g <- gtable_add_grob(g1, g1$grobs[[which(g1$layout$name=="panel")]], pp$t, pp$l, pp$b, pp$l)

## steal axis from second plot and modify
ia <- which(g2$layout$name == "axis-b")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]

## switch position of ticks and labels
ax$heights <- rev(ax$heights)
ax$grobs <- rev(ax$grobs)
ax$grobs[[2]]$y <- ax$grobs[[2]]$y - unit(1, "npc") + unit(0.15, "cm")

## modify existing row to be tall enough for axis
g$heights[[2]] <- g$heights[g2$layout[ia,]$t]

## add new axis
g <- gtable_add_grob(g, ax, 2, 4, 2, 4)

## add new row for upper axis label
g <- gtable_add_rows(g, g2$heights[1], 1)
g <- gtable_add_grob(g, g2$grob[[6]], 2, 4, 2, 4)

# draw it
grid.draw(g)

上記のコードを実行すると、解決しようとしている 2 つの重大な問題が発生します。

1)プロットの上部に追加された x 軸を調整して、「クリッピング」とオーバーラップの問題を修正するにはどうすればよいですか?

2)ggtitle("stuff")最初のプロットに追加されp1たものを最終プロットに含める方法は?

私は午後中ずっとこれらの問題を解決しようとしてきましたが、解決できないようです。どんな助けでも大歓迎です。ありがとう！

4

3 に答える 3

5

ggplot2 v 2.2.1 に更新されましたが、使いやすくなりましたsec.axis- こちらをご覧ください

オリジナル

軸の移動はggplot2、バージョン 2.1.0 からより複雑になりました。このソリューションは、古いソリューションのコードとcowplotパッケージ内のコードを利用しています。

2番目の問題に関しては、「スタッフ」タイトル用に別のテキストグロブを作成する方が簡単でした（ggtitleマージンを処理するよりも）。

library(ggplot2) #v 2.2.1
library(gtable)  #v 0.2.0
library(grid)

LakeLevels <- data.frame(Day = c(1:365), Elevation = sin(seq(0, 2*pi, 2 * pi/364)) * 10 + 100)

## 'base' plot
p1 <- ggplot(data = LakeLevels) + 
  geom_path(aes(x = Elevation, y = Day)) + 
  scale_x_continuous(name = "Elevation (m)", limits = c(75, 125)) + 
  theme_bw() 

## plot with "transformed" axis
p2 <- ggplot(data = LakeLevels) +
  geom_path(aes(x = Elevation, y = Day))+
  scale_x_continuous(name = "Elevation (ft)", limits = c(75, 125),
                     breaks = c(80, 90, 100, 110, 120),
                     labels = round(c(80, 90, 100, 110, 120) * 3.28084)) +   ## labels convert to feet
theme_bw()

## Get gtable
g1 <- ggplotGrob(p1)    
g2 <- ggplotGrob(p2)

## Get the position of the plot panel in g1
pp <- c(subset(g1$layout, name == "panel", se = t:r))

# Title grobs have margins. 
# The margins need to be swapped.
# Function to swap margins - 
# taken from the cowplot package:
# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R
vinvert_title_grob <- function(grob) {
  heights <- grob$heights
  grob$heights[1] <- heights[3]
  grob$heights[3] <- heights[1]
  grob$vp[[1]]$layout$heights[1] <- heights[3]
  grob$vp[[1]]$layout$heights[3] <- heights[1]

  grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust 
  grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust 
  grob$children[[1]]$y <- unit(1, "npc") - grob$children[[1]]$y
  grob
}

# Copy "Elevation (ft)" xlab from g2 and swap margins
index <- which(g2$layout$name == "xlab-b")
xlab <- g2$grobs[[index]]
xlab <- vinvert_title_grob(xlab)

# Put xlab at the top of g1
g1 <- gtable_add_rows(g1, g2$heights[g2$layout[index, ]$t], pp$t-1)
g1 <- gtable_add_grob(g1, xlab, pp$t, pp$l, pp$t, pp$r, clip = "off", name="topxlab")

# Get "feet" axis (axis line, tick marks and tick mark labels) from g2
index <- which(g2$layout$name == "axis-b")
xaxis <- g2$grobs[[index]]

# Move the axis line to the bottom (Not needed in your example)
xaxis$children[[1]]$y <- unit.c(unit(0, "npc"), unit(0, "npc"))

# Swap axis ticks and tick mark labels
ticks <- xaxis$children[[2]]
ticks$heights <- rev(ticks$heights)
ticks$grobs <- rev(ticks$grobs)

# Move tick marks
ticks$grobs[[2]]$y <- ticks$grobs[[2]]$y - unit(1, "npc") + unit(3, "pt")

# Sswap tick mark labels' margins
ticks$grobs[[1]] <- vinvert_title_grob(ticks$grobs[[1]])

# Put ticks and tick mark labels back into xaxis
xaxis$children[[2]] <- ticks

# Add axis to top of g1
g1 <- gtable_add_rows(g1, g2$heights[g2$layout[index, ]$t], pp$t)
g1 <- gtable_add_grob(g1, xaxis, pp$t+1, pp$l, pp$t+1, pp$r, clip = "off", name = "axis-t")

# Add "Stuff" title
titleGrob = textGrob("Stuff", x = 0.9, y = 0.95, gp = gpar(cex = 1.5, fontface = "bold"))
g1 <- gtable_add_grob(g1, titleGrob, pp$t+2, pp$l, pp$t+2, pp$r, name = "Title")

# Draw it
grid.newpage()
grid.draw(g1)

ここに画像の説明を入力

于 2016-04-21T06:54:34.983 に答える
0

しばらく考えた結果、問題 1 が ggplot2 の最近のバージョンへの変更に起因することを確認しました。また、古いバージョンの ggplot2 をインストールするという一時的な回避策も考え出しました。

古いバージョンの R パッケージをインストールして ggplot2 1.0.0 をインストールした後、次を使用して ggplot2 1.0.0 をインストールしました

packageurl <- "http://cran.r-project.org/src/contrib/Archive/ggplot2/ggplot2_1.0.0.tar.gz"
install.packages(packageurl, repos=NULL, type="source")

私が確認した

packageDescription("ggplot2")$Version

次に、上記の正確なコードを再実行すると、追加された x 軸が正しく表示されたプロットを作成できました。

ここに画像の説明を入力

これは明らかに満足のいく答えではありませんが、少なくとも、最近のバージョンのggplot2でこのアプローチが機能しない理由を私が説明できるよりも賢い人までは機能します。:)

したがって、上記の問題 #1 は解決されました。 上記の問題＃2をまだ解決していないので、それについての洞察をいただければ幸いです。

于 2016-04-08T13:26:05.750 に答える
0

上記のように、sec_axisまたはを使用できますdup_axis。

library(ggplot2)

LakeLevels <- data.frame(Day = c(1:365), 
                         Elevation = sin(seq(0, 2*pi, 2 * pi/364)) * 10 + 100)

ggplot(data = LakeLevels) + 
  geom_path(aes(x = Elevation, y = Day)) + 
  scale_x_continuous(name = "Elevation (m)", limits = c(75, 125),
                     sec.axis = sec_axis(trans = ~ . * 3.28084, name = "Elevation (ft)"))

ここに画像の説明を入力

ggplot2バージョン 3.1.1

于 2019-05-09T14:34:48.780 に答える