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

各種「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))

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

Prices and shipping availability may change. Please refer to the product page at time of purchase.
Content displayed on this site is provided by Amazon and may be updated or removed.
Amazon Associate, karada-good earns income through qualifying sales.
タイトルとURLをコピーしました