〇はじめに
この記事ではRを使って教師あり学習の線形判別分析を行います。2グループの文書を使い、訓練データから判別式を求めて、評価データを分類して分類精度を見ます。基本的な内容は本に沿ってやっているので、詳しい説明は参考書籍をご参照ください。
こぶしとつばきの歌詞を文字・単語に切り分け、曲ごとの出現頻度を特徴量として各グループに分類することに挑戦します。
・分析データ
ハロプロのグループ「こぶしファクトリー」と「つばきファクトリー」の歌詞。詳しくは下の記事をご参照ください。
・主な参考書籍
『Rによるやさしいテキストマイニング』小林雄一郎,オーム社
〇線形判別分析による文書分類
・処理コード
使用パッケージ
library(RMeCab) #docDF() library(dplyr) library(stringr) #str_remove() library(MASS) #lda()
ファイルを指定
# 1人目 folder_name1 <- "1人目のフォルダ名" file_name1 <- list.files(folder_name1) file_path1 <- paste(folder_name1, file_name1, sep = "/") # 2人目 folder_name2 <- "2人目のフォルダ名" file_name2 <- list.files(folder_name2) file_path2 <- paste(folder_name2, file_name2, sep = "/") #両方 file_name12 <- c(list.files(folder_name1), list.files(folder_name2)) file_path12 <- c(paste(folder_name1, list.files(folder_name1), sep = "/"), paste(folder_name2, list.files(folder_name2), sep = "/"))
特徴語の頻度表を作成
#特徴語の頻度表を作成 freq_table <- term_5050[, 1] for(i in 1:length(file_path12)) { #形態素解析 tmp1 <- docDF(file_path12[i]) colnames(tmp1) <- c("TERM", "FREQ") #処理しやすくするため列名を統一 tmp2 <- tmp1 %>% filter(!grepl("\\s", TERM)) #docDF()で紛れ込む空白の行を取り除く #頻度表に統合 tmp2$FREQ <- tmp2$FREQ / sum(tmp2$FREQ) * 1000 #相対頻度に書き換え freq_table <- left_join(freq_table, tmp2, by = "TERM") #頻度表に解析結果を加える } freq_table2 <- freq_table colnames(freq_table2) <- c("TERM", str_remove(file_name12, ".txt")) #列名をテキスト名に戻す freq_table2[is.na(freq_table2)] <- 0
特徴語(term_5050)についてはこの記事を読んでね。
まずRMeCab::docDF()で形態素解析を行う。
相対頻度を使うのでtmp2$FREQ <- tmp2$FREQ / sum(tmp2$FREQ) * 1000として書き換える。観測頻度で処理するならこの行をコメントアウトしておく。
left_join()で特徴語(cluster1$TERM)と一致するものだけをデータフレーム(cluster1)に残す。
これらの処理を全ての文書に行う。
文書に含まれていない特徴語がNAとなるので、0に書き換える。
これは文字レベルの処理になっているので単語レベルであれば次のようにする。
for(i in 1:length(file_path12)) { #形態素解析 tmp1 <- docDF(file_path12[i], type = 1) colnames(tmp1) <- c("TERM", "POS1", "POS2", "FREQ") #処理しやすくするため列名を統一 tmp2 <- tmp1 %>% filter(!grepl("\\s", TERM)) %>% #docDF()で紛れ込む空白の行を取り除く dplyr::select(TERM, FREQ) %>% #品詞は使わない。select()がMASSパッケージと競合するようなのでパッケージを指定 group_by(TERM) %>% #別の品詞として集計された同単語を統合 summarise(FREQ = sum(FREQ)) #統合時に頻度を加算 #頻度表に統合 tmp2$FREQ <- tmp2$FREQ / sum(tmp2$FREQ) * 1000 #相対頻度に書き換え freq_table <- left_join(freq_table, tmp2, by = "TERM") #頻度表に解析結果を加える }
docDF()に引数type = 1とすると結果が単語レベルで返ってくる。単語レベルにすると品詞情報も付随して返ってくるので、colnames(tmp_freqency_table)のところをc("TERM", "POS1", "POS2", "FREQ")とする。品詞情報が加わることで同じ単語が品詞的には別の語としてカウントされることがあるので、それを統合する(今回は品詞に注目していないため)。
MASSパッケージを使うと競合するので、dplyr::select()として、直接パッケージを指定しておく。
分析を行うための頻度表の整形
#頻度表の整形 term <- freq_table2$TERM freq_table3 <- freq_table2[, -1] freq_table4 <- t(freq_table3) %>% as.data.frame() colnames(freq_table4) <- term freq_table4$TYPE <- str_replace(file_name12, "_[a-z]\\d[a-z].txt", "") #教師データ freq_table4$ALBUM <- str_replace_all(file_name12, "[a-z]+_|\\d[a-z].txt", "") #作品タイプ
t()で転置する。クラスが変わるのでdata.frameに戻す｡特徴量となる値だけでいいので、TERM列を削り、替わりに列名を特徴語にしておく。
教師データとしてテキスト名からそれぞれkbs,tbkを抜き出して列に加える。同様にシングル曲を訓練データ、アルバム曲を評価データにしたいので、テキスト名から作品タイプの文字(s,a)を抜き出し列に加える。ランダムで選び出すならこの操作は不要。
判別式を求めるための訓練データと、判別式の精度を測るための評価データに分ける。
#訓練データと評価データに振り分け train_data <- freq_table4 %>% filter(grepl("s", ALBUM)) train_data2 <- train_data[, 1:ncol(freq_table4)-1] #作品タイプ列を落とす test_data <- freq_table4 %>% filter(grepl("a", ALBUM)) test_data2 <- test_data[, 1:(freq_table4)-1] #作品タイプ列を落とす #ランダムに振り分け all_data <- freq_table4[, 1:ncol(freq_table4)-1] #作品タイプ列を落とす n <- c(sample(1:length(file_name1), length(file_name1)/2), #1人目から半数 sample(length(file_name1)+1:length(file_name1)+length(file_name2), length(file_name2)/2)) #2人目から半数 train_data2 <- all_data[n, ] #指定した列を抜き出す test_data2 <- all_data[-n, ] #それ以外を抜き出す
今回はシングル曲を訓練用、アルバム曲を評価用とするため、上で用意したs,aを検索して振り分ける。その後作品タイプ列を消す。
ランダムに半数ずつ振り分けるなら下の方の処理をする。
線形判別分析による分類
result1 <- lda(TYPE ~ ., data = train_data2) result2 <- predict(result1, test_data2) result3 <- table(test_data2$TYPE, result2$class) #分類精度 sum(diag(result3))/sum(result3)
lda()の引数に教師データとなる列(TYPE)を指定する、それ以外の列が全て特徴量の列なら教師データ列名 ~ .とすればよい。
こういうようなメッセージがほぼ毎回出た。
> result1 <- lda(TYPE ~ ., data = train_data2) ## Warning in lda.default(x, grouping, ...): variables are collinear
> result1 <- lda(TYPE ~ ., data = train_data2) ## Error in lda.default(x, grouping, ...) : ## variables 66 81 115 appear to be constant within groups
多重共線性があるとのこと、回避するための処理は分からないのでとりあえず今回は無視して進めました。下の場合は、表示された列を削って進めた。(どれくらいマズいのかは分かってない…)
・分析結果
文字の出現頻度を特徴量とした場合
相対頻度
両グループから50語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 5 2 ## tbk 2 4 > sum(diag(result3))/sum(result3) ## [1] 0.6923077
両グループから10曲ずつをランダムで選んで訓練データとして、100回分析を繰り返した正答率の平均が0.5828571、標準偏差が0.1033399となった。
処理コード(クリックで展開)
result <- NULL for(i in 1:100) { n <- c(sample(1:20, 10), sample(21:41, 10)) train_data2 <- all_data[n, ] test_data2 <- all_data[-n, ] result1 <- lda(TYPE ~ ., data = train_data2) result2 <- predict(result1, test_data2) result3 <- table(test_data2$TYPE, result2$class) result <- c(result, sum(diag(result3))/sum(result3)) } mean(result) sd(result)
ちなみに訓練データでテストしたところ下の結果でした。
> result3 ## kbs tbk ## kbs 13 0 ## tbk 2 13 > sum(diag(result3))/sum(result3) ## [1] 0.9285714
両グループから100語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 4 3 ## tbk 0 6 > sum(diag(result3))/sum(result3) ## [1] 0.5384615
両グループから200語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 3 4 ## tbk 1 5 > sum(diag(result3))/sum(result3) ## [1] 0.6153846
観測頻度
両グループから50語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 4 3 ## tbk 1 5 > sum(diag(result3))/sum(result3) ## [1] 0.6923077
両グループから10曲ずつをランダムで選んで訓練データとし、100回分析を繰り返した正答率の平均が0.5838095、標準偏差が0.1163711となった。
両グループから100語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 3 4 ## tbk 2 4 > sum(diag(result3))/sum(result3) ## [1] 0.5384615
両グループから200語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 3 4 ## tbk 3 3 > sum(diag(result3))/sum(result3) ## [1] 0.4615385
単語の出現頻度を特徴量とした場合
相対頻度
両グループから50語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 4 3 ## tbk 2 4 > sum(diag(result3))/sum(result3) ## [1] 0.6153846
両グループから10曲ずつをランダムで選んで訓練データとし、100回分析を繰り返した正答率の平均が0.5838095、標準偏差が0.1163711となった。
両グループから100語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 4 3 ## tbk 2 4 > sum(diag(result3))/sum(result3) ## [1] 0.6153846
両グループから200語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 5 2 ## tbk 2 4 > sum(diag(result3))/sum(result3) ## [1] 0.6923077
相対頻度,品詞限定(名詞,動詞,形容詞,形容動詞)
相対頻度
歌詞の内容によって特徴が出ているのでは、との考えのもと意味的役割を持つ名詞・動詞・形容詞・形容動詞に限定した分析を行う。
両グループから50語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 4 3 ## tbk 2 4 > sum(diag(result3))/sum(result3) ## [1] 0.6153846
両グループから100語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 4 3 ## tbk 0 6 <br> > sum(diag(result3))/sum(result3) ## [1] 0.7692308
両グループから200語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 6 1 ## tbk 0 6 > sum(diag(result3))/sum(result3) ## [1] 0.9230769
なんかすごい結果が出た。
何故ですかね。よく分かりませんが、訓練データをランダムで半数選んでテストをしても6割を優に超える正答率でした。
TF-IDF
その単語がどれだけ文書を特徴づけているのかに注目した値であるので、TF-IDFも基準として使い分析を行う。
両グループから50語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 5 2 ## tbk 2 4 > sum(diag(result3))/sum(result3) ## [1] 0.6923077
両グループか100語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 6 1 ## tbk 2 4 > sum(diag(result3))/sum(result3) ## [1] 0.7692308
両グループか200語ずつを特徴語とした結果
> result3 ## kbs tbk ## kbs 5 2 ## tbk 3 3 > sum(diag(result3))/sum(result3) ## [1] 0.6153846
以上です。
〇おわりに
以前に挑戦したときよりかなり良くなったので満足してるのですが、結局特徴語をどう選ぶのがいいのでしょうか。それを確認するのが目的の1つで、その為に5パターン×3つで試してはいるのですがね。1つの文書だけで数を稼いだ語を含めてしまったのはマズったなぁと思う今日この頃。でも今から抜くわけにもいかず、このまま進めます。他に思い付くのは、テキストで登場した数が多い単語や、今の方法と間をとって出現文書数が1割未満は含めないとか、文字と単語の間をとって文字2-gramとか、色々試してみたいです！
今回の分析結果は正答率が概ね6割以上なので、当てずっぽうよりはいい結果が出たと言えるでしょう。ただ、前記事の階層型クラスター分析では特徴語数が増えるほど結果が悪くなっていくような印象だったのですが、今回はバラバラです。上から、谷型、右下がり、変わらず、右上がり、山型。更に文字レベルよりも単語レベルの方が高精度なのも逆の傾向。うーむ傾向が見えぬ。とにかく一旦最後まで通すぞ。
1つ前の記事とこの記事の内容は以前に試したことがあったのですが、次以降は初挑戦の内容なのでどうなるのか楽しみです。最後まで読んでいただきありがとうございました。ではまた次の記事で！
