R の named vector から subset を得る際の最悪計算量は O(n^2)

()

昨日、久しぶりに Tokyo.R に参加して意識が高まったので、久しぶりに誰得な R ネタを投下してみようと思います。
使用した R のバージョンは 3.1.0 です。

R では、ベクトルなどの各要素に名前を割り当て、それらの名前でアクセスすることができます。

> x <- 1:5
> names(x) <- letters[1:5]
> x
a b c d e 
1 2 3 4 5 
> x[c("e", "a", "c", "z")]
   e    a    c <NA> 
   5    1    3   NA

これはなかなか便利で、merge の代わりに使うことで劇的にパフォーマンスを改善することができます。
例えば、学生の各科目に “優”, “良”, “可”, “不可” という成績が割り当てられていて、各成績のスコアとしてそれぞれ 30, 20, 10, 0 を割り当てたいとします。

merge を使うと次のような処理になります。生徒数が 100 万というのはあり得ないでしょうが、アクセスログなどの解析だとレコード数が 100 万超はザラでしょう。

> N <- 1000000
> grades <- c("優", "良", "可", "不可")
> classes <- c("科目1", "科目2", "科目3")
> students <- data.frame(
+   id = 1:N,
+   class = rep(classes, each = N),
+   grade = sample(grades, N * length(classes), replace = TRUE)
+ )
> scores <- data.frame(grade = grades, score = 3:0 * 10)
> system.time(m <- merge(students, scores, sort = FALSE))
   user  system elapsed 
 37.499   0.415  38.760

これを、names を使って書き換えると次のようになります。400 倍以上速くなってますね！！

> scores <- 3:0 * 10
> names(scores) <- grades
> system.time(students$score <- scores[students$grade])
   user  system elapsed 
  0.088   0.001   0.089

上記のように、何らかの情報を付与する上で、named vector はめちゃくちゃ便利です。

named vector の罠

規模にもよりますが、named vector は基本的にハッシュテーブルを使った高速なアクセスを行います。

> set.seed(0)
> CHARS <- c(letters, LETTERS)
> HASH.LENGHT <- 10
> N <- 100000
> hashes <- sapply(1:N, function(i) {
>   paste(CHARS[sample(seq_along(CHARS), HASH.LENGHT, replace = TRUE)], collapse = "")
> })
> x <- seq_along(hashes)
> names(x) <- hashes
> keys <- sample(hashes)
> system.time(x[head(keys, 1000)])
   user  system elapsed 
  0.011   0.000   0.010 
> system.time(x[head(keys, 10000)])
   user  system elapsed 
  0.012   0.000   0.012 
> system.time(x[keys])
   user  system elapsed 
  0.031   0.000   0.032

ところが、存在しない名前でのアクセスが含まれると劇的に遅くなります。

> set.seed(1234)
> another.hashes <- sapply(1:N, function(i) {
>   paste(CHARS[sample(seq_along(CHARS), HASH.LENGHT, replace = TRUE)], collapse = "")
> })
> keys <- sample(c(hashes, another.hashes), N)
> system.time(x[head(keys, 1000)])
   user  system elapsed 
  0.017   0.000   0.017 
> system.time(x[head(keys, 10000)])
   user  system elapsed 
  0.383   0.000   0.383 
> system.time(x[keys])
   user  system elapsed 
132.291   0.444 136.171

これは、src/main/subscript.c の stringSubscript 関数の実装の問題です。
stringSubscript 関数は、指定された名前に対応するインデックスを返す関数ですが、次のような処理があります。

    for (i = 0; i < ns; i++) {
	sub = INTEGER(indx)[i];
	if (sub == 0) {
	    for (j = 0 ; j < i ; j++)
		if (NonNullStringMatch(STRING_ELT(s, i), STRING_ELT(s, j))) {
		    sub = INTEGER(indx)[j];
		    SET_VECTOR_ELT(indexnames, i, STRING_ELT(s, j));
		    break;
		}
	}
	if (sub == 0) {
	    if (!canstretch) {
		ECALL(call, _("subscript out of bounds"));
	    }
	    extra += 1;
	    sub = extra;
	    SET_VECTOR_ELT(indexnames, i, STRING_ELT(s, i));
	}
	INTEGER(indx)[i] = (int) sub;
    }

indx はハッシュテーブルを使って求めた、各名前に対応するインデックスです。名前に対応するインデックスがない場合は 0 が入り、sub == 0 が true になります。ns は指定された名前の長さです。
つまり、indx の全ての値が 0 だと、NonNullStringMatch が (ns + 1) * ns / 2 回実行されることになります。1
最悪計算量は O(ns^2) ということです。

では、高速に同じ結果を得るにはどうすればいいか？
次のように、named vector の名前に存在するものと存在しないものに分ければいいですね。

> system.time({
+   existing.indices <- which(keys %in% names(x))
+   ret <- rep(NA_integer_, length(x))
+   ret[existing.indices] <- x[keys[existing.indices]]
+   names(ret)[existing.indices] <- keys[existing.indices]
+ })
   user  system elapsed 
  0.083   0.001   0.084

1000 倍以上の高速化に成功しました！！

以上、R でちょっとした工夫で桁違いに高速化できる例でした！

  1. NonNullStringMatch は異なる文字エンコードであっても等しい文字列と判定するための関数みたいです ↩