2 抽出語メニュー1

Code

suppressPackageStartupMessages({
  library(ggplot2)
  library(duckdb)
})
drv <- duckdb::duckdb()
con <- duckdb::dbConnect(drv, dbdir = "tutorial_jp/kokoro.duckdb", read_only = TRUE)

tbl <-
  readxl::read_xls("tutorial_jp/kokoro.xls",
    col_names = c("text", "section", "chapter", "label"),
    skip = 1
  ) |>
  dplyr::mutate(
    doc_id = factor(dplyr::row_number()),
    dplyr::across(where(is.character), ~ audubon::strj_normalize(.))
  ) |>
  dplyr::filter(!gibasa::is_blank(text)) |>
  dplyr::relocate(doc_id, text, section, label, chapter)

2.1 抽出語リスト（A.5.1）

活用語をクリックするとそれぞれの活用の出現頻度も見れるUIについては、Rだとどうすれば実現できるかわからない。

Code

dat <- dplyr::tbl(con, "tokens") |>
  dplyr::filter(
    !pos %in% c("その他", "名詞B", "動詞B", "形容詞B", "副詞B", "否定助動詞", "形容詞（非自立）")
  ) |>
  dplyr::count(token, pos) |>
  dplyr::filter(n >= 100) |>
  dplyr::collect()

reactable::reactable(
  dat,
  filterable = TRUE,
  defaultColDef = reactable::colDef(
    cell = reactablefmtr::data_bars(dat, text_position = "outside-base")
  )
)

2.2 出現回数の分布（A.5.2）

2.2.1 度数分布表

Code

dat <-
  dplyr::tbl(con, "tokens") |>
  dplyr::filter(
    !pos %in% c("その他", "名詞B", "動詞B", "形容詞B", "副詞B", "否定助動詞", "形容詞（非自立）")
  ) |>
  dplyr::count(token, pos) |>
  dplyr::summarise(
    degree = sum(n, na.rm = TRUE),
    .by = n
  ) |>
  dplyr::mutate(
    prop = degree / sum(degree, na.rm = TRUE)
  ) |>
  dplyr::arrange(n) |>
  dplyr::compute() |>
  dplyr::mutate(
    cum_degree = cumsum(degree),
    cum_prop = cumsum(prop)
  ) |>
  dplyr::collect()

dat
#> # A tibble: 98 × 5
#>        n degree   prop cum_degree cum_prop
#>    <dbl>  <dbl>  <dbl>      <dbl>    <dbl>
#>  1     1   2938 0.111        2938    0.111
#>  2     2   1934 0.0729       4872    0.184
#>  3     3   1506 0.0568       6378    0.240
#>  4     4   1248 0.0470       7626    0.287
#>  5     5    955 0.0360       8581    0.323
#>  6     6    768 0.0289       9349    0.352
#>  7     7    868 0.0327      10217    0.385
#>  8     8    592 0.0223      10809    0.407
#>  9     9    531 0.0200      11340    0.427
#> 10    10    570 0.0215      11910    0.449
#> # ℹ 88 more rows

2.2.2 折れ線グラフ

Code

dat |>
  dplyr::filter(cum_prop < .8) |>
  ggplot(aes(x = n, y = degree)) +
  geom_line() +
  theme_bw() +
  labs(x = "出現回数", y = "度数")

2.3 文書数の分布（A.5.3）

2.3.1 ヒストグラム🍳

段落（doc_id）ではなく、章ラベル（label）でグルーピングして集計している。docfreqについて上でやったのと同様に処理すれば度数分布表にできる。

Code

dat <-
  dplyr::tbl(con, "tokens") |>
  dplyr::mutate(token = paste(token, pos, sep = "/")) |>
  dplyr::count(label, token) |>
  dplyr::collect() |>
  tidytext::cast_dfm(label, token, n) |>
  quanteda.textstats::textstat_frequency() |>
  dplyr::as_tibble()

dat
#> # A tibble: 7,140 × 5
#>    feature   frequency  rank docfreq group
#>    <chr>         <dbl> <dbl>   <dbl> <chr>
#>  1 の/その他      5801     1     110 all  
#>  2 た/その他      5396     2     110 all  
#>  3 。/その他      4648     3     110 all  
#>  4 は/その他      4148     4     110 all  
#>  5 に/その他      4104     5     110 all  
#>  6 、/その他      3646     6     110 all  
#>  7 て/その他      3403     7     110 all  
#>  8 を/その他      3216     8     110 all  
#>  9 私/その他      2694     9     110 all  
#> 10 が/その他      2194    10     110 all  
#> # ℹ 7,130 more rows

度数分布をグラフで確認したいだけなら、このかたちからヒストグラムを描いたほうが楽。

Code

dat |>
  ggplot(aes(x = docfreq)) +
  geom_histogram(binwidth = 3) +
  scale_y_sqrt() +
  theme_bw() +
  labs(x = "文書数", y = "度数")

2.3.2 Zipf’s law🍳

よく見かけるグラフ。言語処理100本ノック 2020の39はこれにあたる。

Code

dat |>
  ggplot(aes(x = rank, y = frequency)) +
  geom_line() +
  geom_smooth(method = lm, formula = y ~ x, se = FALSE) +
  scale_x_log10() +
  scale_y_log10() +
  theme_bw()

2.4 出現回数・文書数のプロット（A.5.4）

図 A.25のようなグラフの例。ggplot2でgraphics::identify()のようなことをするやり方がわからないので、適当に条件を指定してgghighlightでハイライトしている。

Code

dat |>
  ggplot(aes(x = frequency, y = docfreq)) +
  geom_jitter() +
  gghighlight::gghighlight(
    frequency > 100 & docfreq < 60
  ) +
  ggrepel::geom_text_repel(aes(label = feature)) +
  scale_x_log10() +
  theme_bw() +
  labs(x = "出現回数", y = "文書数")

2.5 KWIC（A.5.5）

2.5.1 コンコーダンス

コンコーダンスはquanteda::kwic()で確認できる。もっとも、KH Coderの提供するコンコーダンス検索やコロケーション統計のほうが明らかにリッチなのと、Rのコンソールは日本語の長めの文字列を表示するのにあまり向いていないというのがあるので、このあたりの機能が必要ならKH Coderを利用したほうがよい。

Code

dat <-
  dplyr::tbl(con, "tokens") |>
  dplyr::filter(section == "[1]上_先生と私") |>
  dplyr::select(label, token) |>
  dplyr::collect() |>
  dplyr::reframe(token = list(token), .by = label) |>
  tibble::deframe() |>
  quanteda::as.tokens() |>
  quanteda::tokens_select("[[:punct:]]", selection = "remove", valuetype = "regex", padding = FALSE) |>
  quanteda::tokens_select("^[\\p{Hiragana}]{1,2}$", selection = "remove", valuetype = "regex", padding = TRUE)

quanteda::kwic(dat, pattern = "^向[いくけこ]$", window = 5, valuetype = "regex")
#> Keyword-in-context with 18 matches.                                                                    
#>      [上・二, 183]            海 方 | 向い |  立っ                  
#>      [上・二, 527]            沖 方 | 向い |  行っ それから 引き返し
#>      [上・七, 740]            外 方 | 向い |  今 手                 
#>      [上・八, 622]            私 方 | 向い |  私                    
#>      [上・八, 697]            私 方 | 向い |  子供                  
#>    [上・十二, 568]        花 そちら | 向い |  眼 峙                 
#>    [上・十二, 628]          方角 足 | 向け |  それから 私           
#>    [上・十四, 247]            庭 方 | 向い |  庭 この間             
#>    [上・十五, 661]      奥さん 差し | 向い |  話 なけれ             
#>    [上・十六, 265]            眼 私 | 向け |  そうして 客 来        
#>    [上・十七, 447]    世の中 どっち | 向い |  面白                  
#>  [上・二十五, 557]        世間 背中 | 向け |  人 苦味               
#>  [上・二十六, 480]                  | 向い |  歩い やがて 若葉      
#>  [上・三十三, 686]            庭 方 | 向い |  澄まし 烟草           
#>  [上・三十三, 771] 先生 ちょっと 顔 | 向け | 直し 奥さん 言葉       
#>  [上・三十四, 415]               下 | 向い |  私 父                 
#>  [上・三十四, 436]   突然 奥さん 方 | 向い |  静 お前               
#>  [上・三十五, 425]            庭 方 | 向い |  笑っ しかし

なお、上の例ではひらがな1～2文字の語をpaddingしつつ除外したので、一部の助詞などは表示されていない（それぞれの窓のなかでトークンとして数えられてはいる）。

2.5.2 コロケーション

たとえば、前後5個のwindow内のコロケーション（nodeを含めて11語の窓ということ）の合計については次のように確認できる。

Code

dat |>
  quanteda::fcm(context = "window", window = 5) |>
  tidytext::tidy() |>
  dplyr::rename(node = document, term = term) |>
  dplyr::filter(node == "向い") |>
  dplyr::slice_max(count, n = 10)
#> # A tibble: 30 × 3
#>    node  term     count
#>    <chr> <chr>    <dbl>
#>  1 向い  庭           4
#>  2 向い  奥さん       2
#>  3 向い  立っ         1
#>  4 向い  眼           1
#>  5 向い  やがて       1
#>  6 向い  沖           1
#>  7 向い  それから     1
#>  8 向い  引き返し     1
#>  9 向い  烟草         1
#> 10 向い  しかし       1
#> # ℹ 20 more rows

「左合計」や「右合計」については、たとえば次のようにして確認できる。paddingしなければtidyr::separate_wider_delim()で展開して位置ごとに集計することもできそう。

Code

dat |>
  quanteda::kwic(pattern = "^向[いくけこ]$", window = 5, valuetype = "regex") |>
  dplyr::as_tibble() |>
  dplyr::select(docname, keyword, pre, post) |>
  tidyr::pivot_longer(
    c(pre, post),
    names_to = "window",
    values_to = "term",
    values_transform = ~ strsplit(., " ", fixed = TRUE)
  ) |>
  tidyr::unnest(term) |>
  dplyr::count(window, term, sort = TRUE)
#> # A tibble: 57 × 3
#>    window term           n
#>    <chr>  <chr>      <int>
#>  1 post   ""            17
#>  2 pre    ""            14
#>  3 pre    "方"           9
#>  4 post   "私"           3
#>  5 pre    "庭"           3
#>  6 pre    "私"           3
#>  7 post   "それから"     2
#>  8 pre    "奥さん"       2
#>  9 post   "お前"         1
#> 10 post   "この間"       1
#> # ℹ 47 more rows

Code

duckdb::dbDisconnect(con)
duckdb::duckdb_shutdown(drv)

sessioninfo::session_info(info = "packages")
#> ═ Session info ═══════════════════════════════════════════════════════════════
#> ─ Packages ───────────────────────────────────────────────────────────────────
#>  package            * version    date (UTC) lib source
#>  audubon              0.5.2      2024-04-27 [1] https://paithiov909.r-universe.dev (R 4.4.0)
#>  blob                 1.2.4      2023-03-17 [1] RSPM (R 4.4.0)
#>  cachem               1.1.0      2024-05-16 [1] CRAN (R 4.4.0)
#>  cellranger           1.1.0      2016-07-27 [1] RSPM (R 4.4.0)
#>  cli                  3.6.3      2024-06-21 [1] CRAN (R 4.4.1)
#>  colorspace           2.1-0      2023-01-23 [1] RSPM (R 4.4.0)
#>  crosstalk            1.2.1      2023-11-23 [1] RSPM (R 4.4.0)
#>  curl                 5.2.1      2024-03-01 [1] RSPM (R 4.4.0)
#>  DBI                * 1.2.3      2024-06-02 [1] RSPM (R 4.4.0)
#>  dbplyr               2.5.0      2024-03-19 [1] RSPM (R 4.4.0)
#>  digest               0.6.36     2024-06-23 [1] RSPM (R 4.4.0)
#>  dplyr                1.1.4      2023-11-17 [1] RSPM (R 4.4.0)
#>  duckdb             * 1.0.0      2024-06-13 [1] CRAN (R 4.4.0)
#>  evaluate             0.24.0     2024-06-10 [1] RSPM (R 4.4.0)
#>  fansi                1.0.6      2023-12-08 [1] RSPM (R 4.4.0)
#>  farver               2.1.2      2024-05-13 [1] CRAN (R 4.4.0)
#>  fastmap              1.2.0      2024-05-15 [1] RSPM (R 4.4.0)
#>  fastmatch            1.1-4      2023-08-18 [1] RSPM (R 4.4.0)
#>  generics             0.1.3      2022-07-05 [1] RSPM (R 4.4.0)
#>  ggplot2            * 3.5.1      2024-04-23 [1] RSPM (R 4.4.0)
#>  gibasa               1.1.0.9004 2024-04-25 [1] https://paithiov909.r-universe.dev (R 4.3.3)
#>  glue                 1.7.0      2024-01-09 [1] RSPM (R 4.4.0)
#>  gtable               0.3.5      2024-04-22 [1] RSPM (R 4.4.0)
#>  htmltools            0.5.8.1    2024-04-04 [1] RSPM (R 4.4.0)
#>  htmlwidgets          1.6.4      2023-12-06 [1] RSPM (R 4.4.0)
#>  janeaustenr          1.0.0      2022-08-26 [1] RSPM (R 4.4.0)
#>  jsonlite             1.8.8      2023-12-04 [1] RSPM (R 4.4.0)
#>  knitr                1.47       2024-05-29 [1] CRAN (R 4.4.0)
#>  labeling             0.4.3      2023-08-29 [1] RSPM (R 4.4.0)
#>  lattice              0.22-5     2023-10-24 [4] CRAN (R 4.3.1)
#>  lifecycle            1.0.4      2023-11-07 [1] RSPM (R 4.4.0)
#>  magrittr             2.0.3      2022-03-30 [1] RSPM (R 4.4.0)
#>  Matrix               1.6-5      2024-01-11 [4] CRAN (R 4.3.3)
#>  memoise              2.0.1      2021-11-26 [1] RSPM (R 4.4.0)
#>  mgcv                 1.9-1      2023-12-21 [4] CRAN (R 4.3.2)
#>  munsell              0.5.1      2024-04-01 [1] RSPM (R 4.4.0)
#>  nlme                 3.1-165    2024-06-06 [4] CRAN (R 4.4.0)
#>  nsyllable            1.0.1      2022-02-28 [1] CRAN (R 4.4.0)
#>  pillar               1.9.0      2023-03-22 [1] RSPM (R 4.4.0)
#>  pkgconfig            2.0.3      2019-09-22 [1] RSPM (R 4.4.0)
#>  purrr                1.0.2      2023-08-10 [1] RSPM (R 4.4.0)
#>  quanteda             4.0.2      2024-04-24 [1] CRAN (R 4.4.0)
#>  quanteda.textstats   0.97       2024-04-08 [1] CRAN (R 4.4.0)
#>  R.cache              0.16.0     2022-07-21 [1] RSPM (R 4.4.0)
#>  R.methodsS3          1.8.2      2022-06-13 [1] RSPM (R 4.4.0)
#>  R.oo                 1.26.0     2024-01-24 [1] RSPM (R 4.4.0)
#>  R.utils              2.12.3     2023-11-18 [1] RSPM (R 4.4.0)
#>  R6                   2.5.1      2021-08-19 [1] RSPM (R 4.4.0)
#>  Rcpp                 1.0.12     2024-01-09 [1] RSPM (R 4.4.0)
#>  RcppParallel         5.1.7      2023-02-27 [1] RSPM (R 4.4.0)
#>  reactable            0.4.4      2023-03-12 [1] RSPM (R 4.4.0)
#>  reactablefmtr        2.0.0      2022-03-16 [1] RSPM (R 4.4.0)
#>  reactR               0.6.0      2024-06-26 [1] RSPM (R 4.4.0)
#>  readxl               1.4.3      2023-07-06 [1] RSPM (R 4.4.0)
#>  rlang                1.1.4      2024-06-04 [1] RSPM (R 4.4.0)
#>  rmarkdown            2.27       2024-05-17 [1] CRAN (R 4.4.0)
#>  sass                 0.4.9      2024-03-15 [1] RSPM (R 4.4.0)
#>  scales               1.3.0      2023-11-28 [1] RSPM (R 4.4.0)
#>  sessioninfo          1.2.2      2021-12-06 [1] RSPM (R 4.4.0)
#>  SnowballC            0.7.1      2023-04-25 [1] RSPM (R 4.4.0)
#>  stopwords            2.3        2021-10-28 [1] RSPM (R 4.4.0)
#>  stringi              1.8.4      2024-05-06 [1] CRAN (R 4.4.0)
#>  stringr              1.5.1      2023-11-14 [1] RSPM (R 4.4.0)
#>  styler               1.10.3     2024-04-07 [1] RSPM (R 4.4.0)
#>  tibble               3.2.1      2023-03-20 [1] RSPM (R 4.4.0)
#>  tidyr                1.3.1      2024-01-24 [1] RSPM (R 4.4.0)
#>  tidyselect           1.2.1      2024-03-11 [1] RSPM (R 4.4.0)
#>  tidytext             0.4.2      2024-04-10 [1] RSPM (R 4.4.0)
#>  tokenizers           0.3.0      2022-12-22 [1] RSPM (R 4.4.0)
#>  utf8                 1.2.4      2023-10-22 [1] RSPM (R 4.4.0)
#>  V8                   4.4.2      2024-02-15 [1] RSPM (R 4.4.0)
#>  vctrs                0.6.5      2023-12-01 [1] RSPM (R 4.4.0)
#>  withr                3.0.0      2024-01-16 [1] RSPM (R 4.4.0)
#>  xfun                 0.45       2024-06-16 [1] RSPM (R 4.4.0)
#>  yaml                 2.3.8      2023-12-11 [1] RSPM (R 4.4.0)
#> 
#>  [1] /home/paithiov909/R/x86_64-pc-linux-gnu-library/4.4
#>  [2] /usr/local/lib/R/site-library
#>  [3] /usr/lib/R/site-library
#>  [4] /usr/lib/R/library
#> 
#> ──────────────────────────────────────────────────────────────────────────────