トップ > R > Rで転置インデックスを作ろうとしたらひどく苦労したという話

Rで転置インデックスを作ろうとしたらひどく苦労したという話

R 自然言語処理

WEB+DB PRESS Vol.49のP77付近を読みながら。Perlとかだったら配列のハッシュ(逆だっけ)とかで簡単に実現できそうな感じのものなんだけど、Rの仕様にひどく悩まされて一時間くらいかかってしまった。。。

こういうデータから

txt1 <- "PerlによるWebアプリケーション開発の手引き"
txt2 <- "PerlとRubyによるプログラム開発"

こういうデータ構造を作る、というやつです。

> l
$Perl
[1] "txt1" "txt2"

$による
[1] "txt1" "txt2"

$Web
[1] "txt1"

$アプリケーション
[1] "txt1"

$開発
[1] "txt1" "txt2"

$の
[1] "txt1"

$手引き
[1] "txt1"

$と
[1] "txt2"

$Ruby
[1] "txt2"

$プログラム
[1] "txt2"

そのためのプログラムがこれ。

txt1 <- "PerlによるWebアプリケーション開発の手引き"
txt2 <- "PerlとRubyによるプログラム開発"
l <- list()

for(txt in c("txt1","txt2")){
  for(text_i in unlist(RMeCabC(eval(parse(text=txt))),use.names=FALSE)){
    if(is.null(unlist(l[text_i]))){
      l[text_i] <- txt
    }else{
      # 凶悪な感じ。。。
      l[text_i] <- list(c(unlist(l[text_i],use.names=FALSE),txt))
    }
  }
}

list$hogeとlist["hoge"]が同じように見えて代入すべきものが違う、ということではまっていた。

この転置インデックスを使うと「Perl」と「Ruby」の両方を含む文章を探してこれる。

> intersect(unlist(l["Perl"]),unlist(l["Ruby"]))
[1] "txt2"

で、こんな短かいテキストで遊んでも面白くはないので、もうちょっと量を増やす。バイト先で「蛋白質核酸酵素」という本(雑誌?)のテキストが触れるので、それに対してやってみることにする。量としてはこんな感じ。

/Users/yasuhisa/dbcls/txt% wc *.txt
     107    1332   36942 2297_51_2006.txt
      91     952   29227 2306_51_2006.txt
     121    1144   36108 2312_51_2006.txt
     108    1041   26614 2321_51_2006.txt
      78     821   22921 2328_51_2006.txt
      99    1128   26197 2334_51_2006.txt
      79     739   18829 2341_51_2006.txt
      94     906   22151 2346_51_2006.txt
      55     782   15468 2352_51_2006.txt
      54     676   16927 2356_51_2006.txt
      83     956   26313 2360_51_2006.txt
     134    1222   29065 2366_51_2006.txt
      18     111    3596 2375_51_2006.txt
      40     363    6582 2376_51_2006.txt
      48     361    8104 2378_51_2006.txt
      24     198    7248 2380_51_2006.txt
      24     179    5299 2382_51_2006.txt
      22     154    4391 2383_51_2006.txt
      23     155    4556 2384_51_2006.txt
      23     162    4372 2385_51_2006.txt
      20     179    4963 2387_51_2006.txt
      20     130    4233 2388_51_2006.txt
      19     130    4127 2389_51_2006.txt
      19     118    3614 2390_51_2006.txt
      20     161    4659 2391_51_2006.txt
      19     173    5211 2392_51_2006.txt
    1442   14273  377717 total

で、これに対して転置インデックスの作成をする。上のやつを使い回してます。

setwd("~/dbcls/txt")
l <- list()

for(file in list.files(".")){
  for(text_i in unlist(lapply(RMeCabText(file),function(x)x[1]),use.names=FALSE)){
    if(is.null(unlist(l[text_i]))){
      l[text_i] <- file
    }else{
      l[text_i] <- list(c(unlist(l[text_i],use.names=FALSE),file))
    }
  }
}

で、とにかく量が多くなってしまったので、headとかを使いながら結果を見てみる。ふむふむ、どうやらうまく転置インデックスが作られているようですね!!記号っぽいのも名詞として含まれているけど、その辺のチューニングとかは後で考えよう。

> head(lapply(l,function(x){head(x)}))
$`<`
[1] "2297_51_2006.txt" "2297_51_2006.txt" "2297_51_2006.txt" "2297_51_2006.txt"
[5] "2297_51_2006.txt" "2297_51_2006.txt"

$総説
[1] "2297_51_2006.txt" "2297_51_2006.txt" "2306_51_2006.txt" "2306_51_2006.txt"
[5] "2312_51_2006.txt" "2312_51_2006.txt"

$誌
[1] "2297_51_2006.txt" "2297_51_2006.txt" "2306_51_2006.txt" "2306_51_2006.txt"
[5] "2312_51_2006.txt" "2312_51_2006.txt"

$名
[1] "2297_51_2006.txt" "2297_51_2006.txt" "2297_51_2006.txt" "2297_51_2006.txt"
[5] "2297_51_2006.txt" "2297_51_2006.txt"

$`>`
[1] "2297_51_2006.txt" "2297_51_2006.txt" "2297_51_2006.txt" "2297_51_2006.txt"
[5] "2297_51_2006.txt" "2297_51_2006.txt"

$蛋白
[1] "2297_51_2006.txt" "2297_51_2006.txt" "2297_51_2006.txt" "2297_51_2006.txt"
[5] "2297_51_2006.txt" "2297_51_2006.txt"

ただ、思ったよりは作成に時間がかかった。Rのlist操作が重いからな気がしているんだけど、どうなのか。Pythonあたりとちょっと比較してみたい。listの長さは

> length(l)
[1] 6373

という感じ。

適当にplotしてみるとめっちゃlong tail。

> table(unlist(lapply(l,length)))

   1    2    3    4    5    6    7    8    9   10   11   12   13   14   15   16 
3195  938  467  289  187  121  112   81   70   58   51   49   45   42   43   32 
  17   18   19   20   21   22   23   24   25   26   27   28   29   30   31   32 
  26   24   28   20   12   18   16   14   16   11   13   15   17   12   16   10 
  33   34   35   36   37   38   39   40   41   42   43   44   46   47   48   49 
   7    7   11    5    4   13    5    5    2    8    5    6    5    6    3    7 
  50   51   52   53   54   55   56   57   58   59   60   61   62   63   64   65 
   5    4    5    3    1    5    4    2    5    3    5    3    3    1    3    3 
  66   67   68   69   70   71   72   73   74   75   76   77   78   79   80   81 
   4    3    3    2    3    2    2    1    4    2    4    1    2    1    3    3 
  82   83   84   85   86   87   90   91   92   94   96   99  100  101  102  103 
   3    2    1    1    3    1    2    1    2    1    1    1    3    2    1    2 
 105  107  108  109  110  112  113  114  115  117  118  125  126  129  132  133 
   2    1    2    2    1    2    1    1    1    2    2    3    1    2    1    2 
 134  135  136  139  141  142  145  146  150  155  156  160  162  165  168  169 
   1    1    1    1    1    1    2    2    2    1    1    1    1    1    1    1 
 170  181  185  186  187  190  192  194  208  218  224  234  249  255  257  258 
   1    1    1    1    1    1    1    2    1    1    1    3    2    1    1    1 
 262  285  286  291  294  297  323  324  367  381  454  465  487  505  513  544 
   1    1    1    1    1    1    2    1    2    1    1    1    1    1    1    1 
 582  595  610  750  781  949  970  972 1035 1072 1096 1116 1214 1355 1729 1742 
   1    1    1    1    1    1    1    1    1    1    1    1    1    1    1    1 
1881 1940 2452 3687 4728 
   1    1    1    1    1
> hist(unlist(lapply(l,length)),nclass=300)

Quartz 2 [*]

追記

転置インデックスを作るんだったら、重複いらないからuniqしておかないとだめじゃんか。。。

for(file in list.files(".")){
  for(text_i in unique(unlist(lapply(RMeCabText(file),function(x)x[1]),use.names=FALSE))){
    if(is.null(unlist(l[text_i]))){
      l[text_i] <- file
    }else{
      l[text_i] <- list(c(unlist(l[text_i],use.names=FALSE),file))
    }
  }
}

上のヒストグラムとかtableは転置インデックスとしてじゃなくて、単語の登場回数としては意味があるからまあいいか。