potisanのプログラミングメモ

趣味のプログラマーがプログラミング関係で気になったことや調べたことをいつでも忘れられるようにメモするブログです。はてなブログ無料版なので記事の上の方はたぶん広告です。記事中にも広告挿入されるみたいです。

R&tidyverse ベクトルから開始位置をずらした2つの等長ベクトルを作成して関数を呼び出す

ベクトルから開始位置をずらした等長のベクトルを作成して関数を呼び出すコードです。dplyr (tidyverse)を使用しています。

require(dplyr)

# ベクトルのstart個めとそこからdiff個ずらした2個の配列のデータフレームを返します。
vec_shifted_tibble <- function(x, start, diff, col_names=c("x","y"), invert=FALSE) {
  a <- x[start:(length(x)-diff)]
  b <- x[(start+diff):length(x)]
  if (!invert) ret <- tibble(a, b)
  else ret <- tibble(b, a)
  colnames(ret) <- col_names
  ret
}
# ベクトルのstart個めとそこからdiff個ずらした2要素を第1、2引数として
# 与えられた関数を繰り返し呼び出します。
vec_invoke_shifted2 <- function(x, fun, args=NULL, start=1, diff=1, invert=FALSE) {
  vec_shifted_tibble(x, start=start, diff=diff, invert=invert) %>%
    transmute(z=invoke(fun, c(list(x, y), args))) %>%
    pull(z)
}

x <- c("a","b","c","d","e","f")

vec_invoke_shifted2(x, paste)
# [1] "a b" "b c" "c d" "d e" "e f"
vec_invoke_shifted2(x, paste, args=list(sep="-"))
# [1] "a-b" "b-c" "c-d" "d-e" "e-f"
vec_invoke_shifted2(x, start=3, diff=2, paste)
# [1] "c e" "d f"
vec_invoke_shifted2(x, start=3, diff=2, paste, args=list(sep="-"))
# [1] "c-e" "d-f"

よく使う関数は名前をつけておくと便利かもしれません。

# paste
vec_paste_shifted2 <- function(x, sep=" ", collapse=NULL, recycle0=FALSE, start=1, diff=1, invert=FALSE) {
  vec_invoke_shifted2(x, paste,
    args=list(sep=sep, collapse=collapse, recycle0=recycle0),
    start=start, diff=diff, invert=invert)
}
# "-"
vec_diff_shifted2 <- function(x, start=1, diff=1, invert=FALSE) {
  vec_invoke_shifted2(x, "-", start=start, diff=diff, invert=invert)
}