R で自然順ソート - 捨てられたブログ

『F# で自然順ソート』をやったからには R でも自然順ソートがしたいというのが当然の心理です。しかし R は F# などの汎用言語とは異なりやや癖があります。そしてそれは自然順ソートの実装においても影響します。驚くべきことに R には比較関数を引数にとるソート関数がありません。したがってユーザーカスタムなソートを実装するのは意外と骨折り仕事なのです。

そんな話を「第31回R勉強会＠東京（#TokyoR）」で LT してきました。スライドは以下です。

この記事ではもう少し具体的にコードを加えて解説します。ということで順を追って少しずつ実装していきましょう。

最終目的は以下のような形の関数です。

naturalOrder <- function(text) {
   # 実装
}

まず R は静的型付き言語ではないので，引数に文字列ベクトルが与えられる保証がありません。 text を文字列として扱うために，強制的に文字列変換を行います。

if (is.character(text)) {
   text <- as.character(text)
}

方針としては， F# のときと同様に，数字パーツと非数字パーツに分解して，数字同士ならば整数変換して比較，それ以外なら文字列として比較します。以下，非数字のことを単純に文字と呼びます。

まず文字列を数字パーツと文字パーツに分解するのに正規表現を使います。

tokenList <- strsplit(text, "(?<=\\d)(?=\\D)|(?<=\\D)(?=\\d)", perl=TRUE)

ゼロ幅の先読み・後読みは R のデフォルトの正規表現では扱うことができないので， perl 互換の正規表現を使うために perl=TRUE とします。ゼロ幅を使っているので，数字と文字の境界で文字列が分割され，各パーツのベクトルのリストを結果として得ることができます。

次に数字と文字に分解したパーツをデータフレームに変換します。

maxLength <- max(sapply(tokenList, length))
tokenList <- sapply(tokenList, function(tokens) c(tokens, rep("", maxLength - length(tokens))))
tokenList <- as.data.frame(t(tokenList), stringsAsFactors=FALSE)

パーツ数は文字列ごとに異なるので，データフレームとして扱うためにパーツ数が少ないものに関しては末尾に空文字列を連結しています。 NA でなく空文字列である理由は後で述べます。転置してデータフレームにすることで， 1 列目に各文字列の最初のパーツ， 2 列目に各文字列の 2 番目のパーツ，…という具合になります。

先頭のパーツからソートしていきます。記号など，数字より先に文字がくる文字もあるので，優先度は文字列としての比較の方が整数としての比較より高くなります。

ranks <- lapply(tokenList, function(tokens) {
   isInteger <- grepl("^\\d+$", tokens)
   ## 文字列の後で数値としての比較があるので整数同士に順序がついては困るので同じ値にしておく
   strings <- ifelse(isInteger, "0", tokens)
   ## 数字でない文字列から整数への変換で NA 警告が出るが，期待通りの動作なので警告はいらない
   integers <- suppressWarnings(ifelse(isInteger, as.integer(tokens), -1))
   list(rank(strings), rank(integers))
})
ranks <- unlist(ranks, recursive=FALSE)

rank は与えられたベクトルの順位を返す関数で，デフォルトでは同じ値に対しては同じ順位を返します。先ほどの末尾に空文字列を加えずに NA が入っていると， NA に対しては同じ順位を返さないので，問題になります。 lapply の結果はリストのリストになっているので， unlist で単純なリストにします。

ranks は先頭パーツの文字列の順位，先頭パーツの数値の順位， 2 番目のパーツの文字列の順位，…という具合になっています。この順位にしたがい最終的な順位を決定します。複数の条件でソートするには，基数ソートの考え方を利用して後ろからソートしていけば良いのですが，ここでは order 関数を利用します。ただし条件を与えるのに単純にリストを与えられないので eval をつかってごにょごにょします。

orderFunction <- sprintf("order(%s)", paste(names(ranks), collapse=","))
orderIndex <- with(ranks, eval(parse(text=orderFunction)))

これで最終的な順位が得られたので，その順位にしたがい与えられたベクトルを並べ替えれば完成です。

text[orderedIndex]

実際に使うと以下のような感じになります。

> x <- c("a10.png", "a2.png", "a1.png", "1a.jpg", "1", "a")
> naturalSort(x)
[1] "1"       "1a.jpg"  "a"       "a1.png"  "a2.png"  "a10.png"

さらに考慮すべき事柄として，先頭に 0 が付いた等価な数値に対する安定性， NA の扱い，降順ソートが挙げられます。これらの処理については詳しく述べませんが，完成版コードを参照してください。