In paithiov909/gibasa: An Alternative 'Rcpp' Wrapper of 'MeCab'

knitr::opts_chunk$set(
  tidy = "styler",
  collapse = TRUE,
  comment = "#>"
)
set.seed(39710)

require(tidymodels, quietly = TRUE)
tidymodels::tidymodels_prefer()

データの準備

livedoorニュースコーパスを使います。このコーパスのカテゴリ分類はかなり易しいタスクであることが知られている（というか、一部のカテゴリではそのカテゴリを同定できる単語が本文に含まれてしまっている）ので、機械学習を手軽に試すのに便利です。テキストの特徴量をもとに以下の9カテゴリの分類をします。

• トピックニュース
• Sports Watch
• ITライフハック
• 家電チャンネル
• MOVIE ENTER
• 独女通信
• エスマックス
• livedoor HOMME
• Peachy

ldccrでデータフレームにします。

tbl <- ldccr::read_ldnws() |>
  dplyr::mutate(doc_id = as.character(dplyr::row_number()))

ここでは、KH Coderの品詞体系における名詞・地名・人名・組織名・固有名詞・動詞・未知語を抽出し、IPA辞書に収録されている語については原形にしながら分かち書きにします。

corp <- tbl |>
  dplyr::mutate(
    text = stringi::stri_trans_nfkc(body) |>
      stringi::stri_replace_all_regex("(https?\\://[[:alnum:]\\.\\-_/]+)", "\nURL\tタグ\n") |>
      stringi::stri_replace_all_regex("[\\s]{2,}", "\n") |>
      stringi::stri_trim_both(),
    chunk = dplyr::ntile(dplyr::row_number(), 10)
  ) |>
  dplyr::group_by(chunk) |>
  dplyr::group_modify(\(df, idx) {
    data.frame(
      doc_id = df$doc_id,
      text = df$text
    ) |>
      gibasa::tokenize(text, partial = TRUE) |>
      gibasa::prettify(
        col_select = c("POS1", "POS2", "POS3", "Original")
      ) |>
      dplyr::mutate(
        pos = dplyr::case_when(
          (POS1 == "タグ") ~ "タグ",
          (is.na(Original) & stringr::str_detect(token, "^[[:alpha:]]+$")) ~ "未知語",
          (POS1 == "感動詞") ~ "感動詞",
          (POS1 == "名詞" & POS2 == "一般" & stringr::str_detect(token, "^[\\p{Han}]{1}$")) ~ "名詞C",
          (POS1 == "名詞" & POS2 == "一般" & stringr::str_detect(token, "^[\\p{Hiragana}]+$")) ~ "名詞B",
          (POS1 == "名詞" & POS2 == "一般") ~ "名詞",
          (POS1 == "名詞" & POS2 == "固有名詞" & POS3 == "地域") ~ "地名",
          (POS1 == "名詞" & POS2 == "固有名詞" & POS3 == "人名") ~ "人名",
          (POS1 == "名詞" & POS2 == "固有名詞" & POS3 == "組織") ~ "組織名",
          (POS1 == "名詞" & POS2 == "形容動詞語幹") ~ "形容動詞",
          (POS1 == "名詞" & POS2 == "ナイ形容詞語幹") ~ "ナイ形容詞",
          (POS1 == "名詞" & POS2 == "固有名詞") ~ "固有名詞",
          (POS1 == "名詞" & POS2 == "サ変接続") ~ "サ変名詞",
          (POS1 == "名詞" & POS2 == "副詞可能") ~ "副詞可能",
          (POS1 == "動詞" & POS2 == "自立" & stringr::str_detect(token, "^[\\p{Hiragana}]+$")) ~ "動詞B",
          (POS1 == "動詞" & POS2 == "自立") ~ "動詞",
          (POS1 == "形容詞" & stringr::str_detect(token, "^[\\p{Hiragana}]+$")) ~ "形容詞B",
          (POS1 == "形容詞" & POS2 == "非自立") ~ "形容詞（非自立）",
          (POS1 == "形容詞") ~ "形容詞",
          (POS1 == "副詞" & stringr::str_detect(token, "^[\\p{Hiragana}]+$")) ~ "副詞B",
          (POS1 == "副詞") ~ "副詞",
          (POS1 == "助動詞" & Original %in% c("ない", "まい", "ぬ", "ん")) ~ "否定助動詞",
          .default = "その他"
        )
      ) |>
        dplyr::filter(
          pos %in% c(
            "名詞",
            "地名", "人名", "組織名", "固有名詞",
            "動詞", "未知語"
          )
        ) |>
        dplyr::mutate(
          doc_id = droplevels(doc_id),
          token = dplyr::if_else(is.na(Original), token, Original),
          token = paste(token, pos, sep = "/")
        ) |>
        gibasa::pack()
  }) |>
  dplyr::ungroup() |>
  dplyr::left_join(dplyr::select(tbl, doc_id, category), by = "doc_id")

モデルの学習

データを分割します。

corp_split <- rsample::initial_split(corp, prop = .8, strata = "category")
corp_train <- rsample::training(corp_split)
corp_test <- rsample::testing(corp_split)

以下のレシピとモデルで学習します。ここでは、ハッシュトリックを使っています。

なお、tidymodelsの枠組みの外であらかじめ分かち書きを済ませましたが、textrecipes::step_tokenizeのcustom_token引数に独自にトークナイザを指定することで、一つのstepとして分かち書きすることもできます。

NUM_TERMS <- 100L

corp_spec <-
  parsnip::boost_tree(
    trees = !!NUM_TERMS, # model_specに外にある変数を与える場合には、このようにinjectionします
    tree_depth = tune::tune(),
    mtry = tune::tune(),
    min_n = 5,
    learn_rate = .3,
    stop_iter = 5 # 例なので小さな値にしています
  ) |>
  parsnip::set_engine(
    "xgboost",
    nthread = !!max(1, parallel::detectCores() - 1, na.rm = TRUE)
  ) |>
  parsnip::set_mode("classification")

corp_rec <-
  recipes::recipe(
    category ~ text,
    data = corp_train
  ) |>
  textrecipes::step_tokenize(
    text,
    custom_token = \(x) strsplit(x, " +")
  ) |>
  textrecipes::step_tokenfilter(
    text,
    max_times = nrow(corp_train),
    max_tokens = NUM_TERMS * 5
  ) |>
  textrecipes::step_texthash(text, num_terms = NUM_TERMS)

corp_wflow <-
  workflows::workflow() |>
  workflows::add_model(corp_spec) |>
  workflows::add_recipe(corp_rec)

F値をメトリクスにして学習します。5分割CVで、簡単にですが、ハイパーパラメータ探索をします。

corp_tune_res <-
  corp_wflow |>
  tune::tune_grid(
    resamples = rsample::vfold_cv(corp_train, strata = category, v = 5L),
    grid = dials::grid_space_filling(
      dials::tree_depth(),
      dials::mtry(range = c(30L, NUM_TERMS)),
      size = 10L
    ),
    metrics = yardstick::metric_set(yardstick::f_meas),
    control = tune::control_grid(save_pred = TRUE)
  )

ハイパラ探索の要約を確認します。

ggplot2::autoplot(corp_tune_res)

fitします。

corp_wflow <-
  tune::finalize_workflow(corp_wflow, tune::select_best(corp_tune_res, metric = "f_meas"))

corp_fit <- tune::last_fit(corp_wflow, corp_split)

学習したモデルの精度を見てみます。

corp_fit |>
  tune::collect_predictions() |>
  yardstick::f_meas(truth = category, estimate = .pred_class)

セッション情報

sessioninfo::session_info()

paithiov909/gibasa documentation built on June 14, 2025, 4:31 p.m.