第22章: テキスト分析とtidytext

# tidytextエコシステムの読み込み library(tidymodels) library(tidytext) library(textrecipes) library(textdata) library(tidyverse) # サンプルデータの準備 library(janeaustenr) # Jane Austenの作品からテキストデータを作成 book_words <- austen_books() %>% group_by(book) %>% mutate(linenumber = row_number(), chapter = cumsum(str_detect(text, regex("^chapter [\\\\divxlc]", ignore_case = TRUE)))) %>% ungroup() glimpse(book_words)

# 単語レベルのトークン化 tidy_books <- book_words %>% unnest_tokens(word, text) # ストップワードの除去 data("stop_words") tidy_books <- tidy_books %>% anti_join(stop_words) # 最頻出語の確認 word_counts <- tidy_books %>% count(word, sort = TRUE) print(head(word_counts, 15)) # 美しい頻度可視化 word_counts %>% slice_head(n = 15) %>% mutate(word = reorder(word, n)) %>% ggplot(aes(x = word, y = n, fill = word)) + geom_col(show.legend = FALSE) + coord_flip() + labs(title = "Jane Austen作品の最頻出語", x = "単語", y = "頻度") + theme_minimal()

# n-gramトークン化（バイグラム） austen_bigrams <- book_words %>% unnest_tokens(bigram, text, token = "ngrams", n = 2) %>% filter(!is.na(bigram)) # バイグラムの分離と清浄化 bigrams_separated <- austen_bigrams %>% separate(bigram, c("word1", "word2"), sep = " ") bigrams_filtered <- bigrams_separated %>% filter(!word1 %in% stop_words$word) %>% filter(!word2 %in% stop_words$word) # 最頻出バイグラム bigram_counts <- bigrams_filtered %>% count(word1, word2, sort = TRUE) print(head(bigram_counts, 10)) # 文レベルのトークン化 austen_sentences <- book_words %>% unnest_tokens(sentence, text, token = "sentences") # 段落レベルのトークン化 austen_paragraphs <- book_words %>% unnest_tokens(paragraph, text, token = "paragraphs")

# 3つの感情辞書の取得 afinn <- get_sentiments("afinn") bing <- get_sentiments("bing") nrc <- get_sentiments("nrc") # Jane Austenの感情分析（AFINN辞書） austen_sentiment <- tidy_books %>% inner_join(afinn, by = "word") %>% group_by(book) %>% summarise(sentiment_score = sum(value), sentiment_words = n(), avg_sentiment = sentiment_score / sentiment_words, .groups = "drop") print(austen_sentiment) # 作品別感情スコアの可視化 austen_sentiment %>% mutate(book = fct_reorder(book, avg_sentiment)) %>% ggplot(aes(x = book, y = avg_sentiment, fill = book)) + geom_col(show.legend = FALSE) + coord_flip() + labs(title = "Jane Austen作品の平均感情スコア", x = "作品", y = "平均感情スコア") + theme_minimal()

# NRC辞書による多次元感情分析 austen_emotions <- tidy_books %>% inner_join(nrc, by = "word") %>% count(book, sentiment) %>% pivot_wider(names_from = sentiment, values_from = n, values_fill = 0) # レーダーチャート用データの準備 emotion_radar <- tidy_books %>% inner_join(nrc, by = "word") %>% filter(!sentiment %in% c("positive", "negative")) %>% count(sentiment) %>% mutate(percentage = n / sum(n) * 100) # 感情プロファイルの可視化 emotion_radar %>% ggplot(aes(x = reorder(sentiment, percentage), y = percentage, fill = sentiment)) + geom_col(show.legend = FALSE) + coord_flip() + labs(title = "Jane Austen作品の感情プロファイル", x = "感情", y = "割合(%)") + theme_minimal()

# テキスト分類のためのサンプルデータ作成 book_classification <- book_words %>% filter(str_length(text) > 50) %>% select(book, text) %>% slice_sample(n = 2000) %>% mutate(book = factor(book)) # データ分割 set.seed(123) book_split <- initial_split(book_classification, prop = 0.8, strata = book) book_train <- training(book_split) book_test <- testing(book_split) # テキスト前処理レシピ text_recipe <- recipe(book ~ text, data = book_train) %>% step_tokenize(text) %>% step_stopwords(text) %>% step_tokenfilter(text, max_tokens = 1000) %>% step_tfidf(text) %>% step_normalize(all_numeric_predictors()) # 前処理の確認 text_recipe %>% prep() %>% bake(new_data = NULL) %>% glimpse()

# 複数の分類モデルを定義 rf_spec <- rand_forest(trees = 500) %>% set_engine("ranger") %>% set_mode("classification") svm_spec <- svm_linear() %>% set_engine("LiblineaR") %>% set_mode("classification") nb_spec <- naive_Bayes() %>% set_engine("naivebayes") %>% set_mode("classification") # ワークフローセットによる効率的な比較 text_workflows <- workflow_set( preproc = list(text = text_recipe), models = list(rf = rf_spec, svm = svm_spec, nb = nb_spec) ) # クロスバリデーション book_folds <- vfold_cv(book_train, v = 5, strata = book) # 並列処理で全モデルを評価 text_results <- text_workflows %>% workflow_map( resamples = book_folds, metrics = metric_set(accuracy, roc_auc, f_meas), verbose = TRUE ) # 結果の比較 text_results %>% rank_results() %>% filter(.metric == "accuracy") %>% select(model, .config, mean, rank)