備忘ログ

チラシの裏的備忘録&メモ

Rで文字列中の漢数字を計算してアラビア数字に変換する

追記:途中で総集編とか書いているが、まだ続く。

indenkun.hatenablog.com

追記終わり

Rには{zipangu}という日本語まわりの便利パッケージがあり、漢数字をアラビア数字に変換するkansuji2arabicと文字列中の漢数字をアラビア数字に置き換えるkansuji2arabic_allがある。

インストールは

install.packages("zipangu")

しかしkansuji2arabic_allの処理は漢数字をアラビア数字に置換する処理なので、時として期待する出力結果にならない。具体的には、「昭和六十四年は一月七日までです。」という文章をkansuji2arabic_allで処理すると、

zipangu::kansuji2arabic_all("昭和六十四年は一月七日までです。")
## [1] "昭和6104年は1月7日までです。"

となり、通常期待する「昭和64年は1月7日までです。」とはならない。

この処理の原因は、前述したとおり漢数字をアラビア数字に逐字的に置換しているためであり、たとえば「六十四」は六と十と四でそれぞれ6、10、4と置換されたものが結合されているから。

そこで、Rで文字列中の漢数字を計算してアラビア数字に変換する(「昭和六十四年は一月七日までです。」が「昭和64年は1月7日までです。」となる)処理について考えてみた。

ちなみに、この記事の中で{zipangu}arabic2kansuji_allの気になるところについて書いているが、パッケージ及び関数製作者には感謝しかなく、決してディスっているわけでない。

今までやってきた漢数字をアラビア数字に変換するアイディアの個人的総集編。

あと、この記事はなぜかリンクが評価されないのでURLがリンクにならずベタ打ちになっている……

kansuji2arabicを応用した自作関数

依存関係は{zipangu}パッケージがインストールされていれば解決する。

# パイプ処理が途中であるので読んでおく
library("magrittr")

kansuji2arabic_kai <- function(str, ...) {
  n <- stringr::str_split(str,
                          pattern = stringr::boundary("character")) %>%
    purrr::map(zipangu::kansuji2arabic, ...) %>%
    purrr::reduce(c) %>% as.numeric()
  
  if(!any(n >= 10000)){
    if(length(n) == 1){
      res <- n
      return(res)
    }else{
      res <- NULL
      for(i in 1:length(n)){
        if(i == length(n) && n[i - 1] >= 10)
          res[i] <- n[i]
        else if(length(n[i - 1]) == 0 && n[i] >= 10)
          res[i] <- n[i]
        else if(n[i] <= 9 && n[i + 1] >= 10 )
          res[i] <- n[i] * n[i + 1]
        else if(n[i] >=10 && n[i - 1] >=10)
          res[i] <- n[i]
      }
    }
    res <- sum(na.omit(res))
    return(res)
  }else{
    if(length(n) == 1){
      res <- n
      return(res)
    }else{
      ans <- NULL
      l <- 1
      k <- 1
      basyo <- which(n >= 10000)
      keta <- sum(n >= 10000)
      ketasuu <- n[n >= 10000]
      if(max(which(n >= 10000)) <= max(which(!n >= 10000))){
        keta <- keta + 1 
        ketasuu <- c(ketasuu, 1)
        basyo <- c(basyo, (max(which(n >= 0)) + 1))
      }
      for (j in 1:keta) {
      m <- basyo[k] - 1
      nn <- n[l:m]
      res <- NULL
      for (i in 1:length(nn)) {
        if(length(nn) <= 1)
          res[i] <- nn[i]
        else if(i == length(nn) && nn[i - 1] >= 10)
          res[i] <- nn[i]
        else if(length(nn[i - 1]) == 0 && nn[i] >= 10)
          res[i] <- nn[i]
        else if(nn[i] <= 9 && nn[i + 1] >= 10 )
          res[i] <- nn[i] * nn[i + 1]
        else if(nn[i] >=10 && nn[i - 1] >=10)
          res[i] <- nn[i]
      }
      ans[k] <- sum(na.omit(res)) * ketasuu[k]
      l <- basyo[k] + 1
      k <- k + 1
    }
    ans <- sum(na.omit(ans))
    return(ans)
  }
  }
}

kansuji2arabic_num <- function(str){
  purrr::map(str, kansuji2arabic_kai) %>% unlist()
}

kansuji2arabic_kai2 <- function(str){
  doc_num <- stringr::str_split(str, pattern = "[^零〇一二三四五六七八九十百千万億兆京]")[[1]]
  doc_num[doc_num == ""] <- NA
  str <- stringr::str_replace_all(str, pattern = "[零〇一二三四五六七八九十百千万億兆京]",  replacement = "〇〇")
  doc_str <- stringr::str_split(str, pattern = "[零〇一二三四五六七八九十百千万億兆京]")[[1]]
  doc_num <- kansuji2arabic_num(na.omit(doc_num))
  
  j <- 1
  for(i in 1:length(doc_str)){
    if(!stringr::str_detect(doc_str[i], pattern = "") && i == 1){
      doc_str[i] <- doc_num[j]
      j <- j + 1
    }
    else if(stringr::str_detect(doc_str[i - 1], pattern = "[^0123456789]")
            && !stringr::str_detect(doc_str[i], pattern = "")){
      doc_str[i] <- doc_num[j]
      j <- j + 1
    }
    if((length(doc_num) + 1)  ==  j) break
  }
  ans <- stringr::str_c(doc_str, collapse = "")
  return(ans)
}

kansuji2arabic_str <- function(str){
  purrr::map(str, kansuji2arabic_kai2) %>% unlist()
}

kansuji2arabic_kaiは前の記事のときと一切変わりない。

indenkun.hatenablog.com

kansuji2arabic_numは今回の処理ではいらないといればいらない。ただ、個人的に後述する理由によりほしい。

単一の文字列を処理するだけならkansuji2arabic_kai2だけでいいが、2つ以上の文字列を与えるときにはkansuji2arabic_strをつかうといい。関数的には、kansuji2arabic_kaikansuji2arabic_kai2もそれぞれ、kansuji2arabic_numkansuji2arabic_strに無名関数として内包することはできるが、今回は関数の役割と処理がわかりやすいように(and自分の思考過程の問題で)バラバラの関数として作った。

使ってみる

kansuji2arabic_str("昭和六十四年は一月七日までです。")
## [1] "昭和64年は1月7日までです。"

でいける。複数文字列もいける。

x <- c("昭和六十四年は一月七日までです。", "平成三十一年は四月三十一日までです。")
kansuji2arabic_str(x)
## [1] "昭和64年は1月7日までです。"  "平成31年は4月31日までです。"

このkansuji2arabic_strの実体は、kansuji2arabic_kai2で、複数文字列を受け付けたときにも対応するためにpurrr::mapでループさせている。

少し説明してみる。

この処理の自分的グッジョブ(自画自賛)な発想としては、2つあって文字列を分割して処理するところと、漢数字を数字に変換したあとに戻す場所を確保してやる処理のところ。このおかげで、よもや形態素解析が必要!?かと思っていた問題が解決した。

分割

stringr::str_splitを使って文字列を漢数字のみのものと、漢数字を含まないもので漢数字をパターンとして分割してやる。

x <- "昭和六十四年一月"
doc_num <- stringr::str_split(x, pattern = "[^零〇一二三四五六七八九十百千万億兆京]")[[1]]
doc_num
## [1] ""       ""       "六十四" "一"     ""
doc_str <- stringr::str_split(x, pattern = "[零〇一二三四五六七八九十百千万億兆京]")[[1]]
doc_str
## [1] "昭和" ""     ""     "年"   "月"

doc_numで漢数字だけ(+"")が切れてでてくる。doc_strで漢数字を含まないものだけと""がでてくる。doc_numの方の""はいらないので後で消すが、doc_strはこの""を目印にして変換後の数字を投入していく。

通常の日本語であれば、数を表す漢数字の場合は(日本語文字列+)漢数字列+日本語文字列+漢数字列+日本語文字列~となるはずなので、漢数字をアラビア数字に変換後に文字列に戻すときに「漢数字が抜けて空白のところに入れる」+「戻すところ前に日本語があるところ」という2つ条件を満たす場所に漢数字を抜いた順番に戻すとOK。

だが、上記のコードのみではうまく場所を確保できていない。具体的には一月の一が入る隙間がない。これは実際の細かいコード上の挙動はよくわからないが、stringr::str_splitの挙動がパターンにマッチした文字列を区切りに置換している挙動による。つまり、「昭和六十四年一月」なら「昭和(区切り)(区切り)(区切り)年(区切り)月」になり、区切りの間は""となるが区切りが一個しかない年と月の間には”"がつくられない。

戻す場所を作る

戻す場所がなければ作ればいいのよ、ということで戻す場所を作る。

いろいろ考えたが一番手っ取り早いのは漢数字が一文字だとだめなので、必ず2文字以上になるようにすればいい。3文字以上なら隙間がたくさんできてしまうが、上の条件的にはただいらない空欄ができるだけなので(メモリは圧迫するが)処理上は困らない。

そこで、漢数字を「〇〇」(漢数字の0)にすべて置換し必ず2文字以上になるようにする。

x <- stringr::str_replace_all(x, pattern = "[零〇一二三四五六七八九十百千万億兆京]",  replacement = "〇〇")
doc_str <- stringr::str_split(x, pattern = "[零〇一二三四五六七八九十百千万億兆京]")[[1]]
doc_str
## [1] "昭和" ""     ""     ""     ""     ""     "年"   ""     "月"

これで、「昭和六十四年一月」は「昭和〇〇〇〇〇〇年〇〇月」になり、年と月の間にも""ができて数字を戻すべき場所ができる。

あとは、前に作った漢数字を計算してアラビア数字に変換するkansuji2arabic_kaiで漢数字をアラビア数字に変換して、条件を満たす場所のdoc_strに戻してやるだけ。

これにより形態素解析をしなくても、漢数字を取り出しアラビア数字にした上で元の場所に戻せるようになった。

相変わらずの問題

相変わらず八戸市とかなら8戸市と変換する。これを確実行いたいなら形態素解析して名詞は除くなどの処理をする必要があると思う(そうすればできるんじゃないかとおいうイメージだけで形態素解析が全然わからない自分にはできない)。

普通なら「これは百百百円」などという日本語はないが、そういう日本語は変換できない。有り得そうな文章としては「加藤一二三九段」とか……。

大字は対応してない。

ただ、和暦+漢数字+年+(閏)+漢数字+月+漢数字+日の漢数字部分を数字に変換できるようになったので和暦(明治5年以前)から西暦への正確な変換に一歩進んだ気がする。

雑記・雑感

kansuji2arabic_numについて

{zipangu}kansuji2arabic_allは、一見すると不思議な挙動をする。

x <- c("昭和六十四年は一月七日までです。", "平成三十一年は四月三十一日までです。")
zipangu::kansuji2arabic_all(x)
## [1] "昭和6104年は1月7日までです。平成3101年は4月3101日までです。"

2つの文字列を与えたはずなのに、一つの文字列に結合して出力する。これはソースコードを読むとわかるが、あたえられたベクトルを一文字一文字切り取って漢数字を見つけたら置換して最後に全部くっつけている処理によるものなので、2つめの文字列も文字ごとに切って処理の過程で最初の文字列とつなげてしまう。

この挙動を知っていれば解決策は、apply系かpurrrを使って解決するといい。

x <- c("昭和六十四年は一月七日までです。", "平成三十一年は四月三十一日までです。")
purrr::map(x, zipangu::kansuji2arabic_all) %>% unlist()
## [1] "昭和6104年は1月7日までです。"    "平成3101年は4月3101日までです。"

つかう人のひと工夫で簡単に解決できるのでその点のみをみると、そういう仕様ですでもいいと思うが、一方でファミリー的関数であるkansuji2arabic

x <- c("百", "二", "千")
zipangu::kansuji2arabic(x)
## [1] "100"  "2"    "1000"

で複数文字をそれぞれ受け取ったらそれぞれアラビア数字に変換して返している。

そうなるとファミリー的関数なのに特に注意されることなく、結果の返され方が異なるのはちょっと気になる。

前に作った、kansuji2arabic_kaiは実はkansuji2arabic_allの挙動と同じ挙動(もともとその関数をいじった関数なので)になっているので、返す結果も同じような挙動をしていた。

一つだけの漢数字を変換しているだけのときにはあまり気にならなかったが、いろいろいじっているうちに挙動が統一されていないのが気になり始めた。

そこでkansuji2arabic_numを作って、ただ単に関数に対してpurrr::mapしているだけなのだが、結果の返し方がkansuji2arabicと同じようになるようにした。

x <- c("百十", "二千", "千五百")
kansuji2arabic_num(x)
## [1]  110 2000 1500

一個のときも、複数のときも同じような結果の返し方をし、かつ、統一感のある返しができるのは使い勝手が地味にいい。

この発想でkansuji2arabic_strも複数文字列を受け取り通常期待する形結果を返すためにkansuji2arbic_kai2purrr::mapしている。この一手間でいろいろ落ちるところもあるが、気持ちよく行くこともあると現在のところ個人的には思っている。

この自作関数では常用するとして、arabic2kansuji_kaiarabic2kansuji_kai2ではなくarabic2kansuji_numarabic2kansuji_strを期待する、という形になっている。

もし自分が自作パッケージ化するなら、上の前2つは@exprtしないで中でだけつかうか、一つ以上の文字列を入れられたらstopかけてエラーだす処理にするかなと思う。これはパッケージ製作者の思想(考え)にもよると思う。

前にも書いたが{zipangu}パッケージはありがたい機能を提供してくれるすばらしいパッケージで、この出力結果もわかればなんてことのないこと思うので、関数製作者には感謝しかないのである。

そもそも、漢数字をアラビア数字に変換する種をつくってくれなかったらこんなことは考えなかったと思うのでその点も感謝である。

漢数字をアラビア数字に計算して変換する関数ネット上に他にもあった件について

ちょっとググっていたら、漢数字をアラビア数字に計算する関数がGitHubにあった(漢数字以外を入れるとNAを返すので文字列中の漢数字は変換できない)。

[https://gist.github.com/kos59125/bec05eab7c33072dc008:title]

apply系をつかって、Rっぽい書き方でスッキリしている。soureceで読み込みたかったが、日本語の箇所が文字化けしてうまくコードが動かないのでコピペして読み込む。

んで、おんなじ結果を出力する別の関数を見つけるとちょっと気になるので、system.timeで計算速度を比べてみた。

比較対象はkansuji2arabic_num

処理は、1~100000000000000の整数から乱数100個取り出して、自作関数のarabic2kansuji_calで漢数字に変換し、purrr:mapで漢数字をそれぞれの関数でアラビア数字に計算し変換するのを10回やる。

Rでアラビア数字から漢数字への変換するための自作関数についてはこちら

[https://indenkun.hatenablog.com/entry/2020/10/23/203809:embed:cite]

system.time(
  for(i in 1:10){
    x <- sample(1:100000000000000, 100) %>% 
      arabic2kansuji::arabic2kansuji_cal()
    x <- kansuji2arabic_num(x)
  }
)
##    user  system elapsed 
##   17.91    8.34   26.80
system.time(
  for(i in 1:10){
    x <- sample(1:100000000000000, 100) %>% 
      arabic2kansuji::arabic2kansuji_cal()
    x <- kansuuji(x)
  }
)
##    user  system elapsed 
##   17.45    8.34   26.12

自作関数の方は単純にforループが多くて遅い。apply系を使っている方は、多分apply系の中に更にapply系で回している処理があるので遅くなっているんだと思う。

漢数字を計算してアラビア数字にするには結構処理が時間がかかるということで。

速度だけを求めるならIMEみたいに辞書をつくって、漢数字を辞書検索してアラビア数字を返すのが最速な気がするが、対応したい桁数までのデータを持たなければならないので無駄にパッケージがでかくなりそうだし、メモリ食いそう。

ちなみに、arabic2kansujiボトルネックにもなってはいる。

system.time(
  for(i in 1:10){
    x <- sample(1:100000000000000, 100) %>% 
      arabic2kansuji::arabic2kansuji_cal()
  }
)
##    user  system elapsed 
##   15.81    8.44   24.47

1セットじゃよくわからないのでせっかくなので10セットで結果をグラフにしてみた(おまけでarabic2kansujiも入れた)。

library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.3.0 --

## √ ggplot2 3.3.2     √ purrr   0.3.4
## √ tibble  3.0.4     √ dplyr   1.0.2
## √ tidyr   1.1.2     √ stringr 1.4.0
## √ readr   1.4.0     √ forcats 0.5.0

## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x tidyr::extract()   masks magrittr::extract()
## x dplyr::filter()    masks stats::filter()
## x dplyr::lag()       masks stats::lag()
## x purrr::set_names() masks magrittr::set_names()
func_kansuji2arabic <- NULL
func_kansuuji <- NULL
func_arabic2kansuji <- NULL

for(j in 1:10){
  func_kansuji2arabic[j] <- system.time(
  for(i in 1:10){
    x <- sample(1:100000000000000, 100) %>% 
      arabic2kansuji::arabic2kansuji_cal()
    x <- kansuji2arabic_num(x)
  }
)[["user.self"]]
  
  func_kansuuji[j] <- system.time(
  for(i in 1:10){
    x <- sample(1:100000000000000, 100) %>% 
      arabic2kansuji::arabic2kansuji_cal()
    x <- kansuuji(x)
  }
)[["user.self"]]
  
   func_arabic2kansuji[j] <- system.time(
  for(i in 1:10){
    x <- sample(1:100000000000000, 100) %>% 
      arabic2kansuji::arabic2kansuji_cal()
  }
)[["user.self"]]
}

d <- data.frame(func_kansuji2arabic,
                func_kansuuji,
                func_arabic2kansuji) %>%
  gather(key = "func", value = "time",
         func_kansuji2arabic, func_kansuuji, func_arabic2kansuji)

ggplot(d, aes(x = func, y = time)) + 
  geom_boxplot() +
  coord_flip()

f:id:indenkun:20201023192712p:plain

やっぱりあんまり変わらない印象。

ここではやらないが、apply系は桁数が多くなると極端に遅くなる。自作関数のforループの方は、桁数が少なくても遅いが、多くなると遅くはなるがapply系ほどには桁数が増えることで極端には速度が落ちない印象。

sessioninfo

sessionInfo()
## R version 4.0.3 (2020-10-10)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 19041)
## 
## Matrix products: default
## 
## locale:
## [1] LC_COLLATE=Japanese_Japan.932  LC_CTYPE=Japanese_Japan.932   
## [3] LC_MONETARY=Japanese_Japan.932 LC_NUMERIC=C                  
## [5] LC_TIME=Japanese_Japan.932    
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] forcats_0.5.0   stringr_1.4.0   dplyr_1.0.2     purrr_0.3.4    
##  [5] readr_1.4.0     tidyr_1.1.2     tibble_3.0.4    ggplot2_3.3.2  
##  [9] tidyverse_1.3.0 magrittr_1.5   
## 
## loaded via a namespace (and not attached):
##  [1] tidyselect_1.1.0          xfun_0.18                
##  [3] haven_2.3.1               colorspace_1.4-1         
##  [5] vctrs_0.3.4               generics_0.0.2           
##  [7] htmltools_0.5.0           yaml_2.2.1               
##  [9] blob_1.2.1                rlang_0.4.8              
## [11] pillar_1.4.6              glue_1.4.2               
## [13] withr_2.3.0               DBI_1.1.0                
## [15] dbplyr_1.4.4              zipangu_0.2.1            
## [17] modelr_0.1.8              readxl_1.3.1             
## [19] lifecycle_0.2.0           munsell_0.5.0            
## [21] gtable_0.3.0              cellranger_1.1.0         
## [23] rvest_0.3.6               evaluate_0.14            
## [25] labeling_0.4.2            knitr_1.30               
## [27] fansi_0.4.1               broom_0.7.2              
## [29] Rcpp_1.0.5                scales_1.1.1             
## [31] backports_1.1.10          arabic2kansuji_0.0.0.9900
## [33] jsonlite_1.7.1            farver_2.0.3             
## [35] fs_1.5.0                  hms_0.5.3                
## [37] digest_0.6.26             stringi_1.5.3            
## [39] grid_4.0.3                cli_2.1.0                
## [41] tools_4.0.3               crayon_1.3.4             
## [43] pkgconfig_2.0.3           ellipsis_0.3.1           
## [45] xml2_1.3.2                reprex_0.3.0             
## [47] lubridate_1.7.9           assertthat_0.2.1         
## [49] rmarkdown_2.5             httr_1.4.2               
## [51] rstudioapi_0.11           R6_2.4.1                 
## [53] compiler_4.0.3