Rの{gghighlight}で折れ線グラフをいろいろな条件でハイライトするグループを決定したいメモ

Rの{ggplot2}で描画する折れ線グラフや点グラフの任意の値をハイライトしてくれる便利パッケージの{gghighlight}パッケージがある。

この{gghighlight}で、折れ線グラフの場合にexampleやIntroduction to gghighlightに記載されている以外のいろいろな条件でハイライトするグループを決定したいと思った。

yutannihilation.github.io

基本的には{dplyr}のgroup_by()やfilter()で任意の条件にマッチするグループを取り出せるような条件式を書くように工夫していく作業となる。なので、ほとんどのものはgroup_by()とfilter()の組み合わせでデータを取り出したいときにも有効となる。

サンプルデータは、Introduction to gghighlightにあるデータを使う。

set.seed(2)
d <- purrr::map_dfr(
  letters,
  ~ data.frame(
      idx = 1:400,
      value = cumsum(runif(400, -1, 1)),
      type = .,
      flag = sample(c(TRUE, FALSE), size = 400, replace = TRUE),
      stringsAsFactors = FALSE
    )
)

Introduction to gghighlightにある通りに一度描画してみる。

library(ggplot2)
ggplot(d) +
  geom_line(aes(idx, value, colour = type))

ところで、複雑な条件もさまざまな工夫で抽出可能になることを示していくが、そもそもハイライトしたいグループがわかっていればグループ名をしていするとそのグループがハイライトされるという仕組みをつかうと、{gghighlihgt}の中に複雑な条件を書かなくてもよいので、こちらのほうが楽な場合もありえると思う。

たとえば途中で書く、時系列の任意の期間で任意の値の範囲を一度でも取っているグループをハイライトしたい場合は{dplyr}などをつかって次のようにして簡単に書くことができる。例：idxが51～100の期間でvalueが-20～-10の値を一度でも取ったグループをハイライトする。

library(dplyr)

## 
##  次のパッケージを付け加えます: 'dplyr'

##  以下のオブジェクトは 'package:stats' からマスクされています:
## 
##     filter, lag

##  以下のオブジェクトは 'package:base' からマスクされています:
## 
##     intersect, setdiff, setequal, union

library(gghighlight)
# 条件に合う値たちを取り出す。
high_group <- d |> 
  filter(idx %in% 51:100 & between(value, -20, -10))
# ほしいのは取り出した値のtypeのuniqueな値なので、uniqueをつかって色付けしたいグループを取り出す。
high_group <- unique(high_group$type)
ggplot(d) +
  geom_line(aes(idx, value, colour = type)) +
  gghighlight(type %in% high_group)

## Warning: Tried to calculate with group_by(), but the calculation failed.
## Falling back to ungrouped filter operation...

## label_key: type

最後の値を条件にしてハイライトするグループを決めたい（または任意の1点での値を条件にしてハイライトするグループを決めたい）

まずは、時系列データの場合で最後に観測された値を条件としてハイライトするかどうかを決定したい場合。結局、最後に観測された値が重要ということは結構あると思う。

次のようにすると各グループ（今回はtype）の最後の観測値を任意の条件としてハイライトすることができるようになる。 たとえば最後の観測値が15を超えているグループのみをハイライトしたかったら次のようにかける。

library(gghighlight)
ggplot(d) +
  geom_line(aes(idx, value, colour = type)) +
  gghighlight(tail(value, n = 1) > 15)

## label_key: type

これはtail()で最後の値をn = 1で指定してその値が15を超えるかどうかを条件としているというものである。

ただしこの手法は、時系列データがきれいに順番にデータフレーム上で並んでいる場合にのみ有効なので、今回の場合idxになるがここが順番に並んでいないとうまくいかない。

たとえば、次のようにdの行をランダムに入れ替える（d_rand）と結果が変わってしまう。

set.seed(123)
d_rand <- d[sample(1:nrow(d), nrow(d)),]
head(d_rand)

##      idx      value type  flag
## 2463  63   9.674239    g  TRUE
## 2511 111   4.427907    g  TRUE
## 8718 318  -3.764171    v FALSE
## 2986 186  -3.842254    h  TRUE
## 1842 242  -9.555816    e FALSE
## 9334 134 -12.147484    x FALSE

ggplot(d_rand) +
  geom_line(aes(idx, value, colour = type)) +
  gghighlight(tail(value, n = 1) > 15)

## label_key: type

上記のようになるのはtail()で取り出す最後の値が、実際に観測される最後の値とは限らないからなので、時系列通りに並ぶように調整するといい。今回の場合はidxが昇順になればよいので次のようにするとちゃんと意図した通り最後の値が15より大きい値がハイライトされる。

d_rand |> 
  # dplyrのarrange()でidxを昇順に並べ直す
  arrange(idx) |> 
  ggplot() +
  geom_line(aes(idx, value, colour = type)) +
  gghighlight(tail(value, n = 1) > 15)

## label_key: type

最後の値を指定せずに取り出す場合には次の通りrev()で最後の値を取り出す方法も有効となる。

# 図は省略
ggplot(d) +
  geom_line(aes(idx, value, colour = type)) +
  gghighlight(rev(value)[1] > 15)

ちなみに冒頭の値であればhead()で抽出できる。

また、今回の値は最終の値がidxの400であることが明らかなので、次のようにするとidxが400のときの値を判定に用いてくれる。この場合、idxを指定しているのでデータが時系列通り昇順に並んでいる必要はなくなる。

# 図は省略
ggplot(d) +
  geom_line(aes(idx, value, colour = type)) +
  gghighlight(value[idx == 400] > 15)

今回は欠損値なく400個の値があって400番目の値はidxの400なので次のようにもかける。この場合はデータが時系列で昇順に並んでいる必要がある。

ggplot(d) +
  geom_line(aes(idx, value, colour = type)) +
  gghighlight(value[400] > 15)

上記2つの方法は、そのまま任意の一点（例えばidxが100番目の値など）を条件とした場合でも有効となる。

任意の範囲期間に観測された値が任意の範囲にすべて収まっている場合にハイライトしたい場合

任意の範囲の期間にされた値が任意の範囲にすべて収まってる場合にハイライトしたい場合を考える。任意の範囲ということでbetween()を使うが、すべての値が任意の値より大きいだけや小さいだけなどの一方向の条件でも同じようにかけるが、少し複雑な範囲条件で考えてみる。

この場合は、要するに任意の期間の観測値の最大値と最小値が任意の範囲内にあればよいので次のように書くことができる。例：idxが51～100の期間でvalueが-20～-10の範囲にすべて収まっているものをハイライトする。

ggplot(d) +
  geom_line(aes(idx, value, colour = type)) +
  gghighlight(between(max(value[idx == 51:100]), -20, -10) & between(min(value[idx == 51:100]), -20, -10))

## label_key: type

これは次のようにall()でもいける

# 図は省略
d |> 
  ggplot(aes(x = idx, y = value, color = type)) +
  geom_line() +
  gghighlight(all(between(c(max(value[51:200]), min(value[51:200])), -20, -10)))

また次のように、冒頭のようにハイライトしたいグループのtypeを抽出する方法もあり得る。

# 図は省略
ggplot(d) +
  geom_line(aes(idx, value, colour = type)) +
  gghighlight(type %in% unique(d |> 
                                 filter(idx %in% 51:100 & between(value, -20, -10)) |> 
                                 group_by(type) |> 
                                 filter(n() == 50))$type)

ここで50個値が揃っていることを条件と最後にしているが、ここの値を観測期間の範囲内で調整することで値が任意の個数が条件を満たしている場合にハイライトするなど応用が効く。 次にあげる、任意の範囲で1つでも条件をみたす場合はここを1以上とするとうまくいく。

任意の範囲期間に観測された値が任意の範囲に一つでも（あるいは任意の個数）収まっている場合にハイライトしたい場合

上記の例では任意の範囲期間に観測された値が任意の範囲にすべて入っている例だったが、1つでも値を取っている場合について考える。

次のように冒頭に上げた例を{gghighlight}内に書き込む方法がありえる。例：idxが51～100の期間でvalueが-20～-10の範囲にひとつでも収まっているものをハイライトする。

ggplot(d) +
  geom_line(aes(idx, value, colour = type)) +
  gghighlight(type %in% unique(filter(.data = d, idx %in% 51:100 & between(value, -20, -10))$type))

## Warning: Tried to calculate with group_by(), but the calculation failed.
## Falling back to ungrouped filter operation...

## label_key: type

他には任意の範囲の値を調べ、1つでも範囲に値が入っているとTRUEを返す条件を考えると、例えば{purrr}のmap_lgl()を使い一つでも当てはまった場合にTRUEとなるようにany()を使って次のようにするといける。

# 図は省略
ggplot(d) +
  geom_line(aes(idx, value, colour = type)) +
  gghighlight(any(purrr::map_lgl(51:100, function(x) between(value[x], -20, -10))))

ちなみにここのany()をall()にすると指定した観測期間のすべての値が条件を満たす場合ということになる。

ここで任意の個数条件を満たした場合について考える。条件式の結果の論理値をsum()するとTRUEの数が分かるのでそれを使う。

たとえば、上記の例で40個以上満たす場合について考えると次のようにできる。

ggplot(d) +
  geom_line(aes(idx, value, colour = type)) +
  gghighlight(sum(purrr::map_lgl(51:100, function(x) between(value[x], -20, -10))) >= 40)

## label_key: type

{gghighlight}便利で楽しい。