KH Coderから「文書×抽出語」表を出力し、Rで潜在意味スケーリング（LSS）

[ko-ichi-h]

潜在意味スケーリング（LSS）

潜在意味スケーリング（LSS）とは、たとえば

• ポジティブ vs. ネガティブ
• 保守 vs. 革新
• 敵対的 vs. 友好的

のような任意の尺度／軸にそって、抽出語や文書に得点を与えられる手法です。分析者が種語（たねご / seed words）を指定することで、任意の軸を設定できるところに、すごく面白みがあると思います。しかも数少ない種語を指定するだけでよく効率的です。

KH Coderは現在のところ潜在意味スケーリング（LSS）の機能を備えていませんが、「文書×抽出語」表を出力して、それをRに読み込めば潜在意味スケーリング（LSS）を実行できます。

CSVファイルを、C:\KHCoderOfficialPackageフォルダに「senkyo.csv」という名前で保存したとします。

なお、ここでは渡辺耕平先生のquanteda・LSXパッケージを使わせていただきます。渡辺先生はLSSについての資料も公開されています。

• 武蔵大学データサイエンス研究所でのご講演
• 「単語埋め込みによる柔軟な日本語文書の感情分析」
• "Introduction to LSX: The package for Latent Semantic Scaling"
• "Selection of seed words: Evaluating seed words using utility functions"

Rコマンド（分析ごとに異なる部分）

まず種語を指定します。今回は2025年参院選の党首第一声を対象として、「減税 vs. 経済・成長」という軸で分析してみます。種語の数は5から10程度以下のことが多いようですが、沢山指定することもできるようです。

# 種語（seed words）の指定
seed <- list(
    tax    = c("減税"),
    growth = c("経済", "成長")
)

次に、KH Coderから出力した「文書×抽出語」表を読み込みます。

# KH Coderから出力した「文書×抽出語」表のファイル名を指定して読み込み
d <- read.csv("C:/KHCoderOfficialPackage/senkyo.csv")

ここまでのコマンドは、分析ごとに変更する必要があるでしょう。逆に、ここから先はだいたい同じコマンドが使えると思います。

Rコマンド（おおむね共通）

# 必要なパッケージのインストールと読み込み
if (!require("LSX"))      install.packages("LSX")
if (!require("quanteda")) install.packages("quanteda")

library(LSX)
library(quanteda)

# KH Coderの「文書×抽出語」表から不要な列を削除
if ( "name" %in% names(d) ) {
    row.names(d) <- paste(d[["id"]], d[["name"]])
}
idx <- match("length_w", names(d))
d <- d[, -(1:idx)]

# 「文書×抽出語」表をLSXパッケージで使えるdfm形式に変換
dfm_d <- as.dfm(d)

# 潜在意味スケーリング（LSS） kは大きなデータでは300に!!!
lss <- textmodel_lss(dfm_d, seeds = as.seedwords(seed), k = 12, include_data = TRUE)

# 結果をデータフレームに格納
df <- data.frame(
  word  = format( names( coef(lss) ), justify = "left" ),
  value = coef(lss)
)

# 上位20語を表示
print("head words")
print(head(df, 20), row.names = FALSE)

# 下位20語を表示
print("tail words")
print(tail(df, 20)[20:1,], row.names = FALSE)

「減税 vs 経済, 成長」という軸で、抽出語に得点を与えたところ、次のような結果になりました。

「減税」側の語

目に付くところでは、「中小（企業」「物価高」「給付」「暮らし」などが、「減税」側の語と認識されています。

「経済・成長」側の語

「増える」「投資」などが目に付くでしょうか。両側の語をプロットすると次のようになります。

# 抽出語をプロット（ハイライトされる語はランダム）
textplot_terms(lss,family="Meiryo UI",size=5)

文書の得点

それでは文書の得点を見てみましょう。この場合の文書は、各党の党首演説です。

# 各文書の得点
dat <- data.frame(
    name = format( names( predict(lss) ), justify = "left" ),
    lss  = predict(lss)
)
dat <- dat[order(dat$lss, decreasing = TRUE),]

# 上位5文書を表示
print("head documents")
print(head(dat,5), row.names = FALSE)

# 下位5文書を表示
print("tail documents")
print(tail(dat,5)[5:1,], row.names = FALSE)

「減税」側の得点が高かったのは公明党と共産党で、「経済・成長」側の得点が高かったのは日本維新の会と国民民主党でした。

※文書番号を使ってKH Coder上で検索し、文書を見ることもできます。

潜在意味スケーリング（LSS）を使えば、種語を指定することで、自由に軸を設定して得点を付けられるのが興味深いですね。（もちろんポジティブ・ネガティブのような一般的な得点付けも可能ですが）

そして、入力する必要があるコマンドもわずかで、意外と簡単でした！　渡辺耕平先生のquanteda・LSXパッケージのおかげです。ありがとうございます。