dplyrは(今のところ)S4の列をうまく扱えないらしい

というのを最近知ったのでいちおうブログに。

例えば、こういうデータがあるとします。intervals列はIntervalというS4クラスになっています。

library(lubridate, warn.conflicts = FALSE)

dat <- data.frame(
  year      = c(1900L, 2000L),
  intervals = c(interval(ymd(19000101), ymd(19001231)),
                interval(ymd(20000101), ymd(20001231)))
)

これをfilter()しようとしてもうまくいきません。year2000の列を取り出しているのに1900年のintervalsが表示されています。

library(dplyr, warn.conflicts = FALSE)

dat_2000 <- filter(dat, year == 2000L)

dat_2000
#> Warning in format.data.frame(x, digits = digits, na.encode = FALSE):
#> corrupt data frame: columns will be truncated or padded with NAs
#>   year                      intervals
#> 1 2000 1900-01-01 UTC--1901-01-01 UTC

これがなぜかというと、startというスロットがうまくサブセットできていないからです。

str(dat_2000$intervals)
#> Formal class 'Interval' [package "lubridate"] with 3 slots
#>   ..@ .Data: num 31536000
#>   ..@ start: POSIXct[1:2], format: "1900-01-01" ...
#>   ..@ tzone: chr "UTC"

これは、dplyrではS4のメソッド(↓)をうまくディスパッチできないかららしいです。

selectMethod(`[`, "Interval")
#> Method Definition:
#> 
#> function (x, i, j, ..., drop = TRUE) 
#> {
#>     new("Interval", x@.Data[i], start = x@start[i], tzone = x@tzone)
#> }
#> <environment: namespace:lubridate>
#> 
#> Signatures:
#>         x         
#> target  "Interval"
#> defined "Interval"

この対応はvctrsパッケージに入るらしいんですけど、まあそんなすぐには出てこないでしょう。

それまではS4に出会わないように祈るか、こんな感じのワークアラウンドを使うしかなさそうです。

myfilter <- function(d, ...) {
  preds <- rlang::quos(...)
  
  result <- d %>%
    # どの行が絞り込まれたのか分かるようにrow IDを追加しておく
    tibble::rowid_to_column(var = "rowid") %>%
    dplyr::filter(!!! preds)
  
  # S4の列は、row IDを使って元データから要素を抽出し、上書きする。
  cols_S4 <- colnames(result)[purrr::map_lgl(result, ~ isS4(x = .))]
  result[, cols_S4] <- d[result$rowid, cols_S4]
  
  # row IDを取り除く
  dplyr::select(result, -rowid)
}

が、filter()とかだったらまだこういうのができるんですけど、arrange()とかだとたぶんうまくいかないのであまり期待しすぎない方がいいでしょう。問題は[だけでなくてあらゆる総称関数に及ぶ話なので。

なかなかつらい話ですね。みんな困ってないのかな…