fix: fix parse_meld for chi mianzi

paithiov909 · Nov 10, 2024 · 5a31da3 · 5a31da3
1 parent 0a8cff7
commit 5a31da3
Show file tree

Hide file tree

Showing 10 changed files with 69 additions and 44 deletions.
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -54,7 +54,7 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: any::rcmdcheck
+          extra-packages: any::rcmdcheck, any::covr
           needs: check
 
       - uses: r-lib/actions/check-r-package@v2
@@ -63,3 +63,10 @@ jobs:
           args: 'c("--no-vignettes", "--no-manual", "--ignore-vignettes", "--as-cran")'
           build_args: 'c("--no-build-vignettes", "--no-manual")'
           # build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'
+
+      - name: Codecov
+        if: ${{ matrix.config.os == 'ubuntu-latest' && matrix.config.r == 'release' }}
+        env:
+          CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }}
+        run: covr::codecov()
+        shell: Rscript {0}
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: shikakusphere
 Title: Miscellaneous Functions for Japanese Mahjong
-Version: 0.0.8.9000
+Version: 0.0.8.9001
 Authors@R: c(
     person("Akiru", "Kato", , "paithiov909@gmail.com", role = c("aut", "cre")),
     person("tomo", "hxx", role = "ctb",
@@ -20,11 +20,11 @@ Depends:
     R (>= 4.0)
 Imports:
     generics,
-    jsonlite,
     magick,
     methods,
     purrr,
     Rcpp,
+    RcppSimdJson,
     rlang,
     stringi,
     tibble,

diff --git a/R/read-json.R b/R/read-json.R
@@ -155,8 +155,8 @@ parse_tile <- function(x) {
         purrr::map2_chr(tile, pos, \(str, i) {
           rank <- tile2rank(str)
           switch(as.character(i),
-            "1" = stri_flatten(c(tile2suit(str[1]), rank[2], rank[3], rank[1], "-")),
-            "3" = stri_flatten(c(tile2suit(str[2]), rank[1], rank[3], rank[2], "-")),
+            "1" = stri_flatten(c(tile2suit(str[1]), rank[1], "-", rank[2], rank[3])),
+            "3" = stri_flatten(c(tile2suit(str[2]), rank[1], rank[2], "-", rank[3])),
             "5" = stri_flatten(c(tile2suit(str[3]), rank[1], rank[2], rank[3], "-"))
           )
         })
@@ -173,20 +173,12 @@ parse_tile <- function(x) {
   x
 }
 
-#' Read 'tenhou.net/6' format mahjong log
-#'
-#' @param file JSON file.
-#' @returns
-#' A list that contains the following elements:
-#' * `meta`: a list that contains `title`, `name` and `rule` string of the game.
-#' * `paifu`: a tibble that contains the log of the game.
-#' * `info`: a tibble that contains the other information of the game.
-#' @export
-read_tenhou6 <- function(file) {
-  js <-
-    jsonlite::read_json(file, simplifyVector = TRUE)
-
-  log <- purrr::list_transpose(js$log)
+#' 牌譜をファイルごとにパースする
+#' @param js JSONからパースしたリスト
+#' @param path 元のファイルのパス
+#' @noRd
+parse_tenhou6 <- function(js, path) {
+  log <- purrr::list_transpose(js[["log"]])
 
   # 局
   ju <- as_version(log[[1]])
@@ -207,7 +199,7 @@ read_tenhou6 <- function(file) {
     purrr::imap(function(x, i) {
       vctrs::vec_cbind(
         purrr::list_rbind(x),
-        data.frame(player = paste0("l", i))
+        data.frame(player = paste0("l", i), path = path)
       )
     }) |>
     purrr::list_rbind() |>
@@ -235,10 +227,11 @@ read_tenhou6 <- function(file) {
     tibble::as_tibble()
 
   list(
-    meta = list(
-      title = js[["title"]],
-      name = js[["name"]],
-      rule = js[["rule"]]
+    meta = tibble::tibble(
+      path = path,
+      title = paste0(js[["title"]], collapse = " "),
+      name = list(js[["name"]]),
+      rule = list(js[["rule"]])
     ),
     paifu = paifu,
     info = tibble::tibble(
@@ -248,7 +241,31 @@ read_tenhou6 <- function(file) {
       score = score,
       result = footer1,
       payment = footer2,
-      footer3
+      footer3,
+      path = path
     )
   )
 }
+
+#' Read 'tenhou.net/6' format mahjong log
+#'
+#' @param json paths to the JSON files.
+#' @returns
+#' A list that contains the following elements:
+#' * `meta`: a list that contains `title`, `name` and `rule` string of the games.
+#' * `paifu`: a tibble that contains the log of the games.
+#' * `info`: a tibble that contains the other information of the games.
+#' @export
+read_tenhou6 <- function(json) {
+  list_js <-
+    RcppSimdJson::fload(json, always_list = TRUE, compressed_download = TRUE) |>
+    purrr::map2(json, function(js, path) {
+      parse_tenhou6(js, path)
+    }) |>
+    purrr::list_transpose(simplify = FALSE)
+  list(
+    meta = purrr::list_rbind(list_js[["meta"]]),
+    paifu = purrr::list_rbind(list_js[["paifu"]]),
+    info = purrr::list_rbind(list_js[["info"]])
+  )
+}
diff --git a/R/utils.R b/R/utils.R
@@ -35,7 +35,7 @@ int2tile <- function(x = seq_len(38) - 1, origin = c("zero", "one")) {
   )
 }
 
-#' Detect the suit or rank of tiles
+#' Detect specific tiles
 #'
 #' @rdname detect
 #' @name detect-tiles
@@ -63,7 +63,7 @@ tile2rank <- function(x) {
 #' @rdname detect
 #' @export
 is_fulou <- function(x) {
-  stringi::stri_detect_regex(x, "[\\-\\=\\+]")
+  stringi::stri_detect_regex(x, "(\\d(?=[\\-\\=\\+]))|\\d{4}")
 }
 
 #' @rdname detect
@@ -106,13 +106,12 @@ is_zhongzhang <- function(x) {
 is_suzhi <- function(x, suzhi = c("23", "34", "45", "56", "67", "78")) {
   suzhi <- rlang::arg_match(suzhi)
   ret <- tile2suit(x) != "z" # 字牌はFALSE
-  ret <- ret & switch(suzhi,
+  ret & switch(suzhi,
     "23" = tile2rank(x) %in% c("1", "4"),
     "34" = tile2rank(x) %in% c("2", "5", "0"),
     "45" = tile2rank(x) %in% c("3", "6"),
     "56" = tile2rank(x) %in% c("4", "7"),
     "67" = tile2rank(x) %in% c("5", "8", "0"),
     "78" = tile2rank(x) %in% c("6", "9")
   )
-  ret
 }
diff --git a/README.Rmd b/README.Rmd
@@ -19,6 +19,7 @@ pkgload::load_all(export_all = FALSE)
 <!-- badges: start -->
 [![shikakusphere status badge](https://paithiov909.r-universe.dev/badges/shikakusphere)](https://paithiov909.r-universe.dev/shikakusphere)
 [![R-CMD-check](https://github.com/paithiov909/shikakusphere/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/paithiov909/shikakusphere/actions/workflows/R-CMD-check.yaml)
+[![codecov](https://codecov.io/gh/paithiov909/shikakusphere/branch/main/graph/badge.svg)](https://app.codecov.io/gh/paithiov909/shikakusphere)
 <!-- badges: end -->
 
 shikakusphere is a collection of miscellaneous funcitons for Japanese mahjong that wraps C++ sources derived from [tomohxx/shanten-number](https://github.com/tomohxx/shanten-number) and [TadaoYamaoka/cmajiang](https://github.com/TadaoYamaoka/cmajiang).

diff --git a/README.md b/README.md
@@ -8,6 +8,7 @@
 [![shikakusphere status
 badge](https://paithiov909.r-universe.dev/badges/shikakusphere)](https://paithiov909.r-universe.dev/shikakusphere)
 [![R-CMD-check](https://github.com/paithiov909/shikakusphere/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/paithiov909/shikakusphere/actions/workflows/R-CMD-check.yaml)
+[![codecov](https://codecov.io/gh/paithiov909/shikakusphere/branch/main/graph/badge.svg)](https://app.codecov.io/gh/paithiov909/shikakusphere)
 <!-- badges: end -->
 
 shikakusphere is a collection of miscellaneous funcitons for Japanese
@@ -76,7 +77,7 @@ plot(hands[4])
 
 ``` r
 tidy(hands)
-#> # A tibble: 41 × 3
+#> # A tibble: 43 × 3
 #>       id tile      n
 #>    <int> <fct> <int>
 #>  1     1 m1        2
@@ -89,7 +90,7 @@ tidy(hands)
 #>  8     2 p1        2
 #>  9     2 p2        2
 #> 10     2 p3        2
-#> # ℹ 31 more rows
+#> # ℹ 33 more rows
 ```
 
 このかたちの表現は`lineup()`でlist of factorsにすることができます。
@@ -110,11 +111,11 @@ tidy(hands) |>
 #> 37 Levels: m0 m1 m2 m3 m4 m5 m6 m7 m8 m9 p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 ... z7
 #> 
 #> [[4]]
-#>  [1] m0 m5 m5 m7 m8 z5 z5 z5 z5 z6 z6 z6 z7 z7
+#>  [1] m0 m5 m5 m7 m8 m9 z5 z5 z5 z5 z6 z6 z6 z7 z7
 #> 37 Levels: m0 m1 m2 m3 m4 m5 m6 m7 m8 m9 p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 ... z7
 #> 
 #> [[5]]
-#>  [1] m0 m5 m5 m7 m8 z5 z5 z5 z5 z6 z6 z6 z7 z7
+#>  [1] m0 m5 m5 m7 m8 m9 z5 z5 z5 z5 z6 z6 z6 z7 z7
 #> 37 Levels: m0 m1 m2 m3 m4 m5 m6 m7 m8 m9 p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 ... z7
 ```
 
@@ -150,8 +151,8 @@ n_xiangting
 
 # 有効牌
 collect_tingpai(hands[n_xiangting$num >= 0])
-#> Warning in skksph_get_tingpai(pai, index_s, index_h): zimo must be empty at:
-#> m055z77,m78-9,z5555,z666=,
+#> Warning in .Call(`_shikakusphere_skksph_get_tingpai`, pai, index_s, index_h):
+#> zimo must be empty at: m055z77,m78-9,z5555,z666=,
 #> [[1]]
 #> [1] "m1" "z2"
 #> 

diff --git a/man/detect.Rd b/man/detect.Rd
diff --git a/man/read_tenhou6.Rd b/man/read_tenhou6.Rd
diff --git a/tests/testthat/_snaps/read-json.md b/tests/testthat/_snaps/read-json.md
@@ -9,7 +9,7 @@
           "value": ["zimo", "zimo", "zimo", "zimo", "zimo", "zimo", "zimo", "zimo", "zimo", "zimo", "zimo", "zimo", "zimo", "zimo", "dapai", "dapai", "dapai", "dapai", "dapai", "dapai", "dapai", "dapai", "dapai", "dapai", "dapai", "dapai", "dapai"]
         }
       },
-      "value": ["p5", "s7", "p7", "s0", "s1", "s7", "p3", "m9", "p5", "s243-", "z6", "s777-", "s2", "s4", "z4", "z3", "z5", "p9", "p1", "m5", "p3_", "m9_", "s8", "s1", "z6_", "p5", "s2_"]
+      "value": ["p5", "s7", "p7", "s0", "s1", "s7", "p3", "m9", "p5", "s3-24", "z6", "s777-", "s2", "s4", "z4", "z3", "z5", "p9", "p1", "m5", "p3_", "m9_", "s8", "s1", "z6_", "p5", "s2_"]
     }
 
 # read_tenhou6 works for chankan.json

diff --git a/tests/testthat/test-read-json.R b/tests/testthat/test-read-json.R
@@ -22,7 +22,7 @@ test_that("parse_meld works", {
   # チー
   expect_equal(
     parse_tile(c("c141516", "14c1516", "1415c16")),
-    c("m564-", "m465-", "m456-")
+    c("m4-56", "m45-6", "m456-")
   )
 })