Rでggplot2:装飾が簡単「annotate」コマンド

ggplot2
スポンサーリンク

各種「geom_XXXX」コマンドでプロットを装飾するのも良いですが、場合によっては「annotate」コマンドで装飾する方が便利な場合があります。紹介では四角で塗りつぶしの”rect”、範囲で塗りつぶしの”segment”、テキストを追加の”text”を紹介します。

なお、”rect”や”segment”を上手に利用すると図の塗色をベタではなくグラデーションで設定することが可能です。全体またはエリア分けのグラデーションが可能です。

スポンサーリンク

「ggplot2」のインストールと読み込み

「tidyverse」をインストールして「ggplot2」パッケージを利用するのが便利です。

# パッケージのインストール
install.packages("tidyverse")

# パッケージの読み込み
library("tidyverse")

データ例を作成

以下のコマンドを実行してください。

#日付データの作成に便利:lubridateパッケージがなければインストール
if(!require("lubridate", quietly = TRUE)){
  install.packages("lubridate");require("lubridate")
}
set.seed(1234)
#lubridate::ymd;locale="C", tz="Asia/Tokyo"を設定するのがポイント
TestData <- tibble(Date = seq(lubridate::ymd("2021-01-01", locale = "C",
                                             tz = "Asia/Tokyo"),
                              lubridate::ymd("2022-03-24", locale = "C",
                                             tz = "Asia/Tokyo"),
                              by = "10 day")) %>%
  mutate(Data = sample(c(1:30), length(Date), replace = TRUE),
         #Date&#12434;&#22522;&#28310;&#12395;&#26332;&#26085;&#12434;&#20837;&#25163;:wday&#12467;&#12510;&#12531;&#12489;
         Day_Type = lubridate::wday(Date, label = TRUE,
                                    abbr = FALSE))

基本的なプロット

以下の図を「annotate」コマンドで装飾していきます。左から折れ線グラフ、空のプロットです。

# &#25240;&#12428;&#32218;&#12464;&#12521;&#12501;
ggplot(TestData, aes(x = Date, y = Data)) +
  geom_line() -> BasePlot

# &#31354;&#12398;&#12503;&#12525;&#12483;&#12488;
ggplot(TestData, aes(x = Date, y = Data)) +
  geom_blank() -> BlankPlot

体裁の設定例

annotateコマンドに”rect”、”segment”、”text”の設定例です。

## &#22235;&#35282;&#12391;&#22615;&#12426;&#12388;&#12406;&#12375;
# annotate&#12467;&#12510;&#12531;&#12489;&#12391;"rect"&#12434;&#35373;&#23450;
BasePlot +
  annotate(geom = "rect",
           xmin = as.POSIXct(c("2021-03-01", "2021-06-01", "2022-03-20")),
           xmax = as.POSIXct(c("2021-04-01", "2021-07-01", "2022-10-01")),
           ymin = c(-Inf, -Inf, -Inf) , ymax = c(Inf, Inf, Inf),
           alpha = 0.2, color = "black", fill = c("yellow", "blue", "red"))

## &#31684;&#22258;&#12391;&#22615;&#12426;&#12388;&#12406;&#12375;
## &#22615;&#12426;&#12388;&#12406;&#12375;&#31684;&#22258;&#12434;&#35336;&#31639;
# X&#36600;&#31684;&#22258;&#12434;POSIXct objects&#12391;&#20316;&#25104;
day_period <- seq(lubridate::ymd("2021-07-01", locale = "C",
                                 tz = "Asia/Tokyo"),
                  lubridate::ymd("2022-03-20", locale = "C",
                                 tz = "Asia/Tokyo"),
                  by = "1 day")
# Y&#36600;&#31684;&#22258;&#12434;&#20316;&#25104;
# &#12300;layer_scales&#12301;&#12467;&#12510;&#12531;&#12489;&#12391;Range&#12363;&#12425;&#26368;&#23567;&#20516;,&#26368;&#22823;&#20516;&#12434;&#21462;&#24471;
yaxis_range <- layer_scales(BasePlot)$y$range$range
# &#32066;&#30528;&#20516;&#12434;&#24179;&#22343;&#20516;&#12391;&#21462;&#24471;
yaxis_mean <- mean(yaxis_range)
# y&#19979;&#38480;&#20516;&#12434;&#26368;&#23567;&#20516;&#12363;&#12425;&#32066;&#30528;&#20516;&#12414;&#12391;X&#36600;&#31684;&#22258;&#12398;&#38263;&#12373;&#12391;&#21462;&#24471;
day_ymin <- seq(min(yaxis_range), mean(yaxis_range), length = length(day_period))
# y&#19978;&#38480;&#20516;&#12434;&#26368;&#22823;&#20516;&#12363;&#12425;&#32066;&#30528;&#20516;&#12414;&#12391;X&#36600;&#31684;&#22258;&#12398;&#38263;&#12373;&#12391;&#21462;&#24471;
day_ymax <- seq(max(yaxis_range), mean(yaxis_range), length = length(day_period))

# annotate&#12467;&#12510;&#12531;&#12489;&#12391;"segment"&#12434;&#35373;&#23450;
BasePlot +
  annotate(geom = "rect",
           xmin = as.POSIXct(c("2021-03-01", "2021-06-01", "2022-03-20")),
           xmax = as.POSIXct(c("2021-04-01", "2021-07-01", "2022-10-01")),
           ymin = c(-Inf, -Inf, -Inf) , ymax = c(Inf, Inf, Inf),
           alpha = 0.2, color = "black", fill = c("yellow", "blue", "red")) +
  annotate(geom = "segment",
           x = day_period,
           xend = day_period,
           y = day_ymax, 
           yend = day_ymin,
           alpha = 0.7, color = "green")

## &#12486;&#12461;&#12473;&#12488;&#12434;&#36861;&#21152;
# annotate&#12467;&#12510;&#12531;&#12489;&#12391;"text"&#12434;&#35373;&#23450;
BasePlot +
  annotate(geom = "text",
           x = as.POSIXct("2021-05-01"),
           y = 28, size = 4, color = "red",
           label = "KARADA-GOOD")

例えばこんな使い方

塗りをグラデーションにする方法とヒストグラムをグラデーションにする方法です。何かの参考になりますように。ヒストグラムをグラデーションにする方法は理解しやすいように手順をなるべく省略せずに記述しています。

# &#22615;&#12426;&#12434;&#12464;&#12521;&#12487;&#12540;&#12471;&#12519;&#12531;
# &#22615;&#12426;&#31684;&#22258;&#12434;&#35336;&#31639;
colfunc <- colorRampPalette(c("green", "yellow", "blue", "red"))

BlankPlot +
  annotate("rect",
           xmin = as.POSIXct(c("2021-03-01", "2021-06-01", "2022-03-20")),
           xmax = as.POSIXct(c("2021-04-01", "2021-07-01", "2022-10-01")),
           ymin = c(2, 2, 2) , ymax = c(30, 30, 30),
           #ymin = c(-Inf, -Inf, -Inf) , ymax = c(Inf, Inf, Inf),
           alpha = 0.2, color = "black", fill = c("yellow", "blue", "red")) +
  annotate("segment",
           x = day_period,
           xend = day_period,
           y = day_ymax, 
           yend = day_ymin,
           alpha = 0.7,
           color = colfunc(length(day_period)))

## &#12498;&#12473;&#12488;&#12464;&#12521;&#12512;&#12391;&#12464;&#12521;&#12487;&#12540;&#12471;&#12519;&#12531;
# &#12487;&#12540;&#12479;&#20316;&#25104;
set.seed(1234)
Chr_data <- data.frame(Chr = sample(LETTERS[c(1, 5, 8)],
                                    size = 100,
                                    replace = TRUE),
                       Group = sample(LETTERS[1:2],
                                      size = 100,
                                      replace = TRUE)) 
# &#19968;&#24230;&#12503;&#12525;&#12483;&#12488;
ggplot(Chr_data, aes(x = Chr)) +
  geom_bar()
# &#12418;&#12375;&#12367;&#12399;&#12458;&#12502;&#12472;&#12455;&#12463;&#12488;&#12395;&#20445;&#23384;&#12377;&#12427;
#ggplot(Chr_data, aes(x = Chr)) +
#geom_bar() -> object_gg

# &#12487;&#12540;&#12479;&#21462;&#24471;:layer_data&#12467;&#12510;&#12531;&#12489;
# i&#12399;&#12524;&#12452;&#12516;&#12540;&#30058;&#21495;
get_data <- layer_data(plot = last_plot(), i = 1L)
# &#12418;&#12375;&#12367;&#12399;&#12458;&#12502;&#12472;&#12455;&#12463;&#12488;&#12363;&#12425;&#35501;&#12415;&#36796;&#12416;
#get_data <- layer_data(plot = object_gg, i = 1L)

# &#30906;&#35469;
get_data
#y count prop x flipped_aes PANEL group ymin ymax xmin xmax colour   fill
#1 29    29    1 1       FALSE     1     1    0   29 0.55 1.45     NA grey35
#2 40    40    1 2       FALSE     1     2    0   40 1.55 2.45     NA grey35
#3 31    31    1 3       FALSE     1     3    0   31 2.55 3.45     NA grey35
#linewidth linetype alpha
#1       0.5        1    NA
#2       0.5        1    NA
#3       0.5        1    NA

# get_data&#12458;&#12502;&#12472;&#12455;&#12463;&#12488;&#12363;&#12425;&#12487;&#12540;&#12479;&#12434;&#21462;&#24471;&#12377;&#12427;
x_range <- c(seq(get_data$xmin[1], get_data$xmax[1], by = 0.001),
             seq(get_data$xmin[2], get_data$xmax[2], by = 0.001),
             seq(get_data$xmin[3], get_data$xmax[3], by = 0.001))
y_max <- rep(get_data$ymax, each = length(x_range)/3)
y_min <- rep(0, length(x_range))

# &#25551;&#20889;&#12456;&#12522;&#12450;&#12434;&#31354;&#12391;&#12503;&#12525;&#12483;&#12488;
ggplot(Chr_data, aes(x = Chr)) +
  geom_blank() -> blank_bar

# &#20840;&#20307;&#12391;&#12464;&#12521;&#12487;&#12540;&#12471;&#12519;&#12531;&#12398;&#12503;&#12525;&#12483;&#12488;
blank_bar +
  annotate("segment",
           x = x_range,
           xend = x_range,
           y = y_max, 
           yend = y_min,
           alpha = 0.7,
           color = colfunc(length(x_range)))

# &#12456;&#12522;&#12450;&#20998;&#12369;&#12391;&#12464;&#12521;&#12487;&#12540;&#12471;&#12519;&#12531;&#12398;&#12503;&#12525;&#12483;&#12488;
blank_bar +
  annotate("segment",
           x = x_range,
           xend = x_range,
           y = y_max, 
           yend = y_min,
           alpha = 0.7,
           color = rep(colfunc(length(x_range)/3), 3))

少しでも、あなたの解析に役に立ちますように!

タイトルとURLをコピーしました