備忘ログ

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

Rのzipangu::kansuji2arabicで期待した結果を返さない場合の個人的暫定解決策その2

前にzipangu::kansuji2arabic_allで漢数字をアラビア数字に変換したときに期待する答えを返さないことがあることを書いた。

indenkun.hatenablog.com

この記事でもとの関数をいじって10万未満で期待する答えを得られるようになった(zipangu::kansuji2arabic_allをちょっとアレンジした自作関数kansuji2arabic_kaiを使って)と思っていたら、”千百十一”が“1001”になってしまうことに気づいた。

数カ月ぶりに漢数字の西暦いじっていて躓いたので前の自作関数を触ったらバグがあったので修正してみたというもの。

ついてでに10万以上でも対応できるように力技でやってみた(少し進捗中間報告)。

期待した回答を返さない件については先の記事にまとめている。要約するとzipangu::kansuji2arabic_allでは一文字一文字漢数字をアラビア数字に置換してくっつけてるだけなので百十なら100と10と変換してくっつけて10010になってしまっている。

本家の{zipangu}はこちら。

github.com

改良版kansuji2arabic_kai

依存関係は{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)
    }
  }
}

1万を超える場合と超えない場合で場合分けして、1万を超得ない場合は前の記事に書いた処理で回し、1万を超える場合は京兆億万の桁で区切って計算して最後に足してやるという力技。

ループ処理なので大量に漢数字データを流し込むをめっちゃ遅い。もっとスマートに書きたい。

なんだか冗長な箇所や不要な箇所もあるし変数名が統一されていなくて読みにくい気がするけど、ちょっと混乱してきたので、とりあえず動くしまぁ……

これで日本の人口一億二千四百二十七万千三百十八人も

kansuji2arabic_kai("一億二千四百二十七万千三百十八")
## [1] 124271318

とアラビア数字に変換できるし、日本の国家予算の百二兆六千五百八十億円も

kansuji2arabic_kai("百二兆六千五百八十億")
## [1] 1.02658e+14

と変換できる。

ただしRでそもそもちゃんと処理できない桁数まで行くとちゃんと計算できない八~九千兆こえたあたりからちゃんと計算できない。

相変わらず漢数字以外を含んでいるとエラーがでるので本家のように、文中の漢数字を変換するまでは至っていない。根本的にこの手法では文中の漢数字変換にいたるのは難しそうか?切り出した文字列を数字に変換するタイミングを調整すればいけるのか?

難しそうといえば、零や〇の処理、125を意図した一二五の処理もこの延長線上には見えてこない。いろんな条件を包含して変換するためには漢数字からアラビア数字への変換は根本的にこんな力技のフープ処理ではなくアプローチを根本的に変えたほうがいいのかもと思っているが、思うだけ。