From 0727b48730c569e147dfa354f4c0c24b647d6dc7 Mon Sep 17 00:00:00 2001 From: "Trevor L. Davis" Date: Thu, 16 Apr 2026 23:13:07 -0700 Subject: [PATCH 1/2] feat: `solve_dominosa()` and `solve_fujisan()` `pawns` argument * `solve_dominosa()` solves Dominosa (Domino Solitaire) * `solve_fujisan()` gains a `pawns` argument to support solving from an intermediate pawns position using a FEN-like string (e.g. `"S12M/A12C"`) (#1). Co-Authored-By: Claude Sonnet 4.6 --- .gitignore | 1 + DESCRIPTION | 2 +- NAMESPACE | 1 + NEWS.md | 5 +- R/dominosa.R | 316 ++++++++++++++++++++++ R/fujisan.R | 80 +++++- README.Rmd | 32 ++- README.md | 35 ++- _pkgdown.yml | 1 + man/figures/README-dominosa-1.png | Bin 0 -> 18813 bytes man/solve_dominosa.Rd | 42 +++ man/{game_solvers.Rd => solve_fujisan.Rd} | 14 +- tests/testthat/_snaps/dominosa.md | 63 +++++ tests/testthat/_snaps/fujisan.md | 32 +++ tests/testthat/test-dominosa.R | 100 +++++++ tests/testthat/test-fujisan.R | 45 ++- 16 files changed, 716 insertions(+), 53 deletions(-) create mode 100644 R/dominosa.R create mode 100644 man/figures/README-dominosa-1.png create mode 100644 man/solve_dominosa.Rd rename man/{game_solvers.Rd => solve_fujisan.Rd} (63%) create mode 100644 tests/testthat/_snaps/dominosa.md create mode 100644 tests/testthat/test-dominosa.R diff --git a/.gitignore b/.gitignore index 7daae70..f8e2038 100644 --- a/.gitignore +++ b/.gitignore @@ -5,6 +5,7 @@ *.png *.swp +.claude/ codecov.yml README.html diff --git a/DESCRIPTION b/DESCRIPTION index 45ae112..0136a52 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Encoding: UTF-8 Package: ppgamer Type: Package Title: Players for Piecepack Games like Fuji-san -Version: 0.1.2-1 +Version: 0.2.0-1 Authors@R: c(person("Trevor L.", "Davis", role=c("aut", "cre"), email="trevor.l.davis@gmail.com", comment = c(ORCID = "0000-0001-6341-4639"))) diff --git a/NAMESPACE b/NAMESPACE index bf5ecd8..eb9bfa3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(solve_dominosa) export(solve_fujisan) importFrom(dplyr,near) importFrom(rlang,.data) diff --git a/NEWS.md b/NEWS.md index d436242..1058c70 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,8 @@ -ppgames 0.1.2 (development) +ppgames 0.2.0 (development) =========================== -* No user-facing changes. +* `solve_dominosa()` solves Dominosa (Domino Solitaire) +* `solve_fujisan()` gains a `pawns` argument to support solving from an intermediate pawns position using a FEN-like string (e.g. `"S12M/A12C"`) (#1). ppgamer 0.1.1 ============= diff --git a/R/dominosa.R b/R/dominosa.R new file mode 100644 index 0000000..8f9b70b --- /dev/null +++ b/R/dominosa.R @@ -0,0 +1,316 @@ +parse_dominosa_pips <- function(pips) { + if (is.matrix(pips)) { + storage.mode(pips) <- "integer" + pips + } else if (is.character(pips)) { + rows <- strsplit(pips, "/")[[1]] + rows <- lapply(rows, function(r) as.integer(process_ranks(r)) - 1L) + lens <- lengths(rows) + if (length(unique(lens)) != 1L) { + abort("All rows in `pips` must have the same length.") + } + do.call(rbind, rows) + } else { + abort(str_glue("`pips` must be a matrix or character string, not {class(pips)[1L]}.")) + } +} + +validate_dominosa_pips <- function(pips) { + n <- max(pips) + n_cells <- length(pips) + expected_cells <- (n + 1L) * (n + 2L) + if (n_cells != expected_cells) { + abort(str_glue( + "For a double-{n} domino set the grid must have {expected_cells} cells, but `pips` has {n_cells} cells." + )) + } + expected_count <- n + 2L + bad <- integer(0) + for (k in 0:n) { + if (sum(pips == k) != expected_count) bad <- c(bad, k) + } + if (length(bad) > 0L) { + abort(str_glue( + "For a double-{n} domino set each pip value must appear exactly {expected_count} time(s). The following pip values have incorrect counts: {paste(bad, collapse = ', ')}." + )) + } +} + +# Compute 1-based domino type ID for sorted pip pair (p_lo <= p_hi). +# Ordering: (0,0)=1, (0,1)=2, ..., (0,n)=n+1, (1,1)=n+2, ... +domino_id <- function(p_lo, p_hi, n) { + as.integer(p_lo * (n + 1L) - (p_lo * (p_lo - 1L)) %/% 2L + (p_hi - p_lo) + 1L) +} + +build_dominosa_placements <- function(pips, n_rows, n_cols, n) { + # Horizontal pairs: (r,c)-(r,c+1) + h_r <- rep(seq_len(n_rows), each = n_cols - 1L) + h_c <- rep(seq_len(n_cols - 1L), times = n_rows) + h_p1 <- pips[cbind(h_r, h_c)] + h_p2 <- pips[cbind(h_r, h_c + 1L)] + + # Vertical pairs: (r,c)-(r+1,c) + v_r <- rep(seq_len(n_rows - 1L), each = n_cols) + v_c <- rep(seq_len(n_cols), times = n_rows - 1L) + v_p1 <- pips[cbind(v_r, v_c)] + v_p2 <- pips[cbind(v_r + 1L, v_c)] + + all_p1 <- c(h_p1, v_p1) + all_p2 <- c(h_p2, v_p2) + p_lo <- pmin(all_p1, all_p2) + p_hi <- pmax(all_p1, all_p2) + + list( + cell1 = c( + (h_r - 1L) * n_cols + h_c, + (v_r - 1L) * n_cols + v_c + ), + cell2 = c( + (h_r - 1L) * n_cols + h_c + 1L, + v_r * n_cols + v_c + ), + did = domino_id(p_lo, p_hi, n) + ) +} + +# Commits a single placement `pid` as solution for its domino +# Then eliminates everything that conflicts with this placement +assign_placement <- function(pid, eliminated, cell_pids, domino_pids, pl_cell1, pl_cell2, pl_did) { + to_elim <- c( + cell_pids[[pl_cell1[pid]]], # all other placements that touch cell 1 + cell_pids[[pl_cell2[pid]]], # all other placements that touch cell 2 + domino_pids[[pl_did[pid]]] # all other placements for this domino type + ) + eliminated[to_elim[to_elim != pid]] <- TRUE + eliminated +} + +# Constraint propagation +# Repeatedly scans for forced assignments until no more can be deduced +propagate_dominosa <- function( + eliminated, + cell_pids, + domino_pids, + pl_cell1, + pl_cell2, + pl_did, + n_cells, + n_dom +) { + repeat { + prev <- eliminated + + for (d in seq_len(n_dom)) { + pids <- domino_pids[[d]] + active <- pids[!eliminated[pids]] + if (length(active) == 0L) { + # domino can't be placed => unsolvable + return(NULL) + } + if (length(active) == 1L) { + # Forced assignment + eliminated <- assign_placement( + active, + eliminated, + cell_pids, + domino_pids, + pl_cell1, + pl_cell2, + pl_did + ) + } + } + + for (ci in seq_len(n_cells)) { + pids <- cell_pids[[ci]] + active <- pids[!eliminated[pids]] + if (length(active) == 0L) { + # cell has no placements => unsolvable + return(NULL) + } + if (length(active) == 1L) { + # Forced assignment + eliminated <- assign_placement( + active, + eliminated, + cell_pids, + domino_pids, + pl_cell1, + pl_cell2, + pl_did + ) + } + } + + if (identical(eliminated, prev)) break + } + eliminated +} + +search_dominosa <- function( + eliminated, + cell_pids, + domino_pids, + pl_cell1, + pl_cell2, + pl_did, + n_cells, + n_dom +) { + # Check for all forced placements first + eliminated <- propagate_dominosa( + eliminated, + cell_pids, + domino_pids, + pl_cell1, + pl_cell2, + pl_did, + n_cells, + n_dom + ) + if (is.null(eliminated)) { + return(NULL) + } + + active_counts <- vapply(domino_pids, function(pids) sum(!eliminated[pids]), integer(1L)) + if (all(active_counts == 1L)) { + # If all dominoes have exactly one placement left we have our solution + return(eliminated) + } + + # Minimum Remaining Values (MRV) + # Branch on domino with fewest remaining candidates (>= 2) + unresolved <- which(active_counts >= 2L) + d <- unresolved[which.min(active_counts[unresolved])] + pids <- domino_pids[[d]] + candidates <- pids[!eliminated[pids]] + + for (pid in candidates) { + result <- search_dominosa( + assign_placement(pid, eliminated, cell_pids, domino_pids, pl_cell1, pl_cell2, pl_did), + cell_pids, + domino_pids, + pl_cell1, + pl_cell2, + pl_did, + n_cells, + n_dom + ) + if (!is.null(result)) return(result) + } + NULL +} + +#' Solve Dominosa puzzle +#' +#' Solves a Dominosa (Domino Solitaire) puzzle given a grid of pip values. +#' +#' @param pips A matrix of non-negative integer pip values, +#' or a string with rows of integers separated by `"/"`. +#' For a double-`n` domino set the grid must have `(n + 1)(n + 2)` cells +#' and each pip value `0`:`n` must appear exactly `n + 2` times. +#' @return A list with components: +#' \describe{ +#' \item{`domino_ids`}{An integer matrix of the same dimensions as `pips` +#' where cells belonging to the same domino share the same integer value.} +#' \item{`pips`}{The input `pips` matrix.} +#' \item{`ppn`}{A string of Portable Piecepack Notation for the solution.} +#' } +#' @seealso and +#' for more information about Dominosa. +#' @examples +#' pips <- matrix(c(0, 1, 0, 1, 3, +#' 3, 1, 0, 2, 2, +#' 3, 2, 1, 0, 3, +#' 2, 3, 1, 0, 2), nrow = 4L, byrow = TRUE) +#' s <- solve_dominosa(pips) +#' if (rlang::is_installed(c("piecepackr", "ppn"))) { +#' g <- ppn::read_ppn(textConnection(s$ppn))[[1]] +#' envir <- piecepackr::game_systems(round = TRUE) +#' ppn::plot_move(g, open_device = FALSE, annotate = FALSE, envir = envir, scale = 0.95) +#' } +#' @export +solve_dominosa <- function(pips) { + pips <- parse_dominosa_pips(pips) + validate_dominosa_pips(pips) + + n <- max(pips) + n_rows <- nrow(pips) + n_cols <- ncol(pips) + n_cells <- n_rows * n_cols + n_dom <- ((n + 1L) * (n + 2L)) %/% 2L + + pl <- build_dominosa_placements(pips, n_rows, n_cols, n) + pl_cell1 <- pl$cell1 + pl_cell2 <- pl$cell2 + pl_did <- pl$did + n_pl <- length(pl_did) + + cell_pids <- lapply(seq_len(n_cells), function(ci) which(pl_cell1 == ci | pl_cell2 == ci)) + domino_pids <- lapply(seq_len(n_dom), function(d) which(pl_did == d)) + + result <- search_dominosa( + rep(FALSE, n_pl), + cell_pids, + domino_pids, + pl_cell1, + pl_cell2, + pl_did, + n_cells, + n_dom + ) + + if (is.null(result)) { + abort("No solution exists for this Dominosa puzzle.") + } + + dom_ids <- matrix(0L, nrow = n_rows, ncol = n_cols) + for (d in seq_len(n_dom)) { + pids <- domino_pids[[d]] + pid <- pids[!result[pids]] + for (cell in c(pl_cell1[pid], pl_cell2[pid])) { + r <- (cell - 1L) %/% n_cols + 1L + cc <- (cell - 1L) %% n_cols + 1L + dom_ids[r, cc] <- as.integer(d) + } + } + + sol <- list(domino_ids = dom_ids, pips = pips) + sol$ppn <- dominosa2ppn(sol) + sol +} + +dominosa2ppn <- function(sol) { + pips <- sol$pips + dom_ids <- sol$domino_ids + y_max <- nrow(pips) + n_dom <- max(dom_ids) + + pieces <- character(n_dom) + for (i in seq_len(n_dom)) { + cells <- which(dom_ids == i, arr.ind = TRUE) + r1 <- cells[1L, 1L] + c1 <- cells[1L, 2L] + r2 <- cells[2L, 1L] + c2 <- cells[2L, 2L] + p1 <- pips[r1, c1] + p2 <- pips[r2, c2] + if (r1 == r2) { + # Horizontal with `<` (90° CCW): 1st number appears on LEFT, 2nd on RIGHT. + x <- c1 + 0.5 + y <- y_max + 1L - r1 + rotation <- "<" + } else { + # Vertical (0°): 1st number appears on TOP, 2nd on BOTTOM. + x <- c1 + y <- y_max + 0.5 - r1 + rotation <- "" + } + pieces[i] <- str_glue("`{p1}-{p2}'{rotation}@({x},{y})") + } + + paste0( + "---\nGameType: Dominosa\nSetUp: None\n...\n", + str_glue("Solution. {paste(pieces, collapse = ' ')}\n") + ) +} diff --git a/R/fujisan.R b/R/fujisan.R index 511a130..1d3b650 100644 --- a/R/fujisan.R +++ b/R/fujisan.R @@ -128,8 +128,8 @@ path2movetext <- function(p) { } p <- stringr::str_split(p, "_") p <- lapply(p, n2alg) - movetext <- character(length(p) - 1) - for (ii in seq(length(p) - 1)) { + movetext <- character(length(p) - 1L) + for (ii in seq_len(length(p) - 1L)) { b <- p[[ii]] a <- p[[ii + 1]] i <- intersect(b, a) @@ -149,7 +149,7 @@ path2counter_intuitive <- function(p) { p <- stringr::str_split(p, "_") p <- lapply(p, n2alg) n_counter_intuitive <- 0 - for (ii in seq(length(p) - 1)) { + for (ii in seq_len(length(p) - 1L)) { b <- p[[ii]] a <- p[[ii + 1]] i <- intersect(b, a) @@ -180,6 +180,45 @@ alg2level <- function(alg) { ) } +parse_fujisan_pawns <- function(pawns) { + rows <- strsplit(pawns, "/")[[1]] + if (length(rows) != 2L) { + abort(str_glue( + "The `pawns` string must have exactly one '/' separator but got: {sQuote(pawns)}" + )) + } + pos1 <- parse_fujisan_pawn_row(rows[1L], 1L, pawns) + pos2 <- parse_fujisan_pawn_row(rows[2L], 2L, pawns) + all_pos <- c(pos1, pos2) + if (length(all_pos) != 4L) { + abort(str_glue( + "The `pawns` string must contain exactly 4 pawns but got {length(all_pos)}: {sQuote(pawns)}" + )) + } + all_pos +} + +parse_fujisan_pawn_row <- function(row_str, row_num, pawns) { + tokens <- regmatches(row_str, gregexpr("[A-Z]|[0-9]+", row_str))[[1]] + positions <- integer(0) + col <- 1L + for (tok in tokens) { + if (grepl("^[0-9]+$", tok)) { + col <- col + as.integer(tok) + } else { + offset <- if (row_num == 1L) 0L else 14L + positions <- c(positions, offset + col) + col <- col + 1L + } + } + if (col != 15L) { + abort(str_glue( + "Row {row_num} of pawns string {sQuote(pawns)} covers {col - 1L} columns but must cover exactly 14" + )) + } + positions +} + coins2string <- function(coins, sep = "/") { coins <- c(coins[1, ], coins[2, ]) coins <- as.character(coins) @@ -205,12 +244,22 @@ dice2ppn <- function(coins, dice) { } } +pawns2ppn <- function(pawns) { + if (is.null(pawns) || pawns == "S12M/A12C") { + "" + } else { + str_glue('\n Pawns: "{pawns}"', pawns = pawns) + } +} + sol2ppn <- function(sol) { movetext <- paste(path2movetext(sol$shortest_path), collapse = "\n") + is_default_pawns <- is.null(sol$pawns) || sol$pawns == "S12M/A12C" metadata <- str_glue( - '---\nGameType:\n Name: Fujisan\n Coins: "{coins}"{dice}\n...', + '---\nGameType:\n Name: Fujisan\n Coins: "{coins}"{dice}{pawns}\n...', coins = coins2string(sol$coins, "/"), - dice = dice2ppn(sol$coins, sol$dice) + dice = if (is_default_pawns) dice2ppn(sol$coins, sol$dice) else "", + pawns = pawns2ppn(sol$pawns) ) paste0(metadata, "\n", movetext, "\n") } @@ -235,31 +284,38 @@ first_move_needs_dice <- function(coins) { #' Solves a game of Fujisan (if possible). #' @param coins A vector or matrix of Fujisan coin layout. Default is a random layout. #' @param dice A vector of Fujisan dice layout. Default is random dice. Usually not needed. +#' @param pawns A FEN-like string of the pawns position. The four pawns `S`, `M`, `C`, and +#' `A` are represented by their letter and empty spaces by a number. The two rows are +#' separated by `/`. Default is `"S12M/A12C"` (all pawns at starting corners). #' @return A list with solution of Fujisan solution, its length, coin layout, dice (if needed), -#' and portable piecepack notation. -#' @rdname game_solvers +#' pawns position, and portable piecepack notation. #' @examples #' puzzle2 <- matrix(c(4, 4, 4, 5, 2, 0, 2, 4, 0, 3, 1, 1, #' 1, 2, 5, 3, 3, 5, 3, 2, 5, 1, 0, 0), nrow = 2, byrow = TRUE) #' s2 <- solve_fujisan(coins = puzzle2) #' if (rlang::is_installed(c("piecepackr", "ppn"))) { #' g2 <- ppn::read_ppn(textConnection(s2$ppn))[[1]] -#' ppn::plot_move(g2) +#' ppn::plot_move(g2, open_device = FALSE) #' } #' @export -solve_fujisan <- function(coins = random_fujisan_coins(), dice = random_dice() - 1) { +solve_fujisan <- function( + coins = random_fujisan_coins(), + dice = random_dice() - 1, + pawns = "S12M/A12C" +) { rlang::check_installed("igraph") if (is.vector(coins)) { coins <- process_ranks(coins) - 1 coins <- matrix(coins, nrow = 2, byrow = TRUE) } dice <- process_ranks(dice) - 1 + initial_state <- state2string(parse_fujisan_pawns(pawns)) edges <- do.call(rbind, apply(get_states(), 2, states2edges, coins, dice)) g <- igraph::graph_from_edgelist(edges, directed = TRUE) te <- try( { - initial <- igraph::V(g)["1_14_15_28"] + initial <- igraph::V(g)[initial_state] final <- igraph::V(g)["7_8_21_22"] d <- igraph::distances(g, v = initial, to = final, mode = "out") d <- as.integer(d) @@ -272,7 +328,8 @@ solve_fujisan <- function(coins = random_fujisan_coins(), dice = random_dice() - } else { p <- names(igraph::shortest_paths(g, from = initial, to = final)$vpath[[1]]) } - if (!first_move_needs_dice(coins)) { + is_default_pawns <- initial_state == "1_14_15_28" + if (!is_default_pawns || !first_move_needs_dice(coins)) { dice <- NA_integer_ } sol <- list( @@ -282,6 +339,7 @@ solve_fujisan <- function(coins = random_fujisan_coins(), dice = random_dice() - dice = dice, coin_string = coins2string(coins), dice_string = dice2string(dice), + pawns = pawns, n_counter_intuitive = path2counter_intuitive(p) ) sol$ppn <- sol2ppn(sol) diff --git a/README.Rmd b/README.Rmd index 67ee9f9..a66bebf 100644 --- a/README.Rmd +++ b/README.Rmd @@ -13,9 +13,10 @@ ## Overview -* Currently this package only provides a [Fuji-san](https://www.ludism.org/ppwiki/Fuji-san) solver `solve_fujisan()` which can compute the shortest solution (if it exists) to a given Fuji-san puzzle and output the PPN text to record/visualize the solution. -* In the future it may provide computer players for other board games and/or puzzles. -* This is an extraction and refinement of functionality originally contained in the experimental [{ppgames}](https://www.github.com/piecepackr/ppgames) package. +* Currently this package only provides the following solvers: + + * `solve_dominosa()` which computes a solution (if it exists) to a given [Dominosa](https://www.solitairelaboratory.com/puzzlelaboratory/DominoGG.html). + * `solve_fujisan()` which can compute the shortest solution (if it exists) to a given [Fuji-san](https://www.ludism.org/ppwiki/Fuji-san) puzzle and output the PPN text to record/visualize the solution. ## Installation @@ -25,6 +26,27 @@ remotes::install_github("piecepackr/ppgamer") ## Examples +```{r hidden, echo = FALSE} +knitr::opts_chunk$set(fig.path = "man/figures/README-", fig.cap = '') +``` + +```{r dominosa, fig.width = 9, fig.height = 8, fig.alt = "Solution to a Dominosa puzzle"} +library("ppgamer") +library("ppn") # `remotes::install_github("piecepackr/ppn")` +pips <- matrix(c(2, 5, 1, 6, 6, 4, 3, 5, + 0, 1, 3, 3, 0, 2, 6, 6, + 0, 3, 4, 5, 0, 4, 3, 0, + 0, 2, 6, 1, 3, 5, 4, 0, + 3, 6, 5, 5, 4, 5, 4, 1, + 1, 2, 4, 6, 0, 6, 2, 2, + 4, 3, 2, 2, 1, 1, 1, 5 + ), nrow = 7, byrow = TRUE) +s <- solve_dominosa(pips = pips) +game <- read_ppn(textConnection(s$ppn))[[1]] +envir <- piecepackr::game_systems(round = TRUE) +plot_move(game, open_device = FALSE, annotate = FALSE, envir = envir, scale = 0.95) +``` + ```r library("igraph") library("piecepackr") @@ -41,7 +63,7 @@ piecepack_suits <- list(suit_text="\U0001f31e,\U0001f31c,\U0001f451,\u269c,\uaa5 suit_fontfamily="Noto Emoji,Noto Sans Symbols2,Noto Emoji,Noto Sans Symbols,Noto Sans Cham", suit_cex="0.6,0.7,0.75,0.9,0.9") traditional_ranks <- list(use_suit_as_ace=TRUE, rank_text=",a,2,3,4,5") -cfg3d <- list(width.pawn=0.75, height.pawn=0.75, depth.pawn=0.375, +cfg3d <- list(width.pawn=0.75, height.pawn=0.75, depth.pawn=0.375, dm_text.pawn="", shape.pawn="convex6", invert_colors.pawn=TRUE, edge_color.coin="tan", edge_color.tile="tan") cfg <- pp_cfg(c(piecepack_suits, dark_colorscheme, traditional_ranks, cfg3d)) @@ -49,7 +71,7 @@ cfg <- pp_cfg(c(piecepack_suits, dark_colorscheme, traditional_ranks, cfg3d)) animate_game(game, op_scale=1, op_angle=90, trans=op_transform, cfg=cfg, file="fujisan.gif") ``` -![Animation of a Fuji-san game](https://www.trevorldavis.com/piecepackr/images/knitr/fujisan.gif) +Animation of a Fuji-san game ## Related links diff --git a/README.md b/README.md index 719136f..24d0a0e 100644 --- a/README.md +++ b/README.md @@ -13,19 +13,42 @@ ## Overview -* Currently this package only provides a [Fuji-san](https://www.ludism.org/ppwiki/Fuji-san) solver `solve_fujisan()` which can compute the shortest solution (if it exists) to a given Fuji-san puzzle and output the PPN text to record/visualize the solution. -* In the future it may provide computer players for other board games and/or puzzles. -* This is an extraction and refinement of functionality originally contained in the experimental [{ppgames}](https://www.github.com/piecepackr/ppgames) package. +* Currently this package only provides the following solvers: + + * `solve_dominosa()` which computes a solution (if it exists) to a given [Dominosa](https://www.solitairelaboratory.com/puzzlelaboratory/DominoGG.html). + * `solve_fujisan()` which can compute the shortest solution (if it exists) to a given [Fuji-san](https://www.ludism.org/ppwiki/Fuji-san) puzzle and output the PPN text to record/visualize the solution. ## Installation -```r +``` r remotes::install_github("piecepackr/ppgamer") ``` ## Examples + + + +``` r +library("ppgamer") +library("ppn") # `remotes::install_github("piecepackr/ppn")` +pips <- matrix(c(2, 5, 1, 6, 6, 4, 3, 5, + 0, 1, 3, 3, 0, 2, 6, 6, + 0, 3, 4, 5, 0, 4, 3, 0, + 0, 2, 6, 1, 3, 5, 4, 0, + 3, 6, 5, 5, 4, 5, 4, 1, + 1, 2, 4, 6, 0, 6, 2, 2, + 4, 3, 2, 2, 1, 1, 1, 5 + ), nrow = 7, byrow = TRUE) +s <- solve_dominosa(pips = pips) +game <- read_ppn(textConnection(s$ppn))[[1]] +envir <- piecepackr::game_systems(round = TRUE) +plot_move(game, open_device = FALSE, annotate = FALSE, envir = envir, scale = 0.95) +``` + +Solution to a Dominosa puzzle + ```r library("igraph") library("piecepackr") @@ -42,7 +65,7 @@ piecepack_suits <- list(suit_text="\U0001f31e,\U0001f31c,\U0001f451,\u269c,\uaa5 suit_fontfamily="Noto Emoji,Noto Sans Symbols2,Noto Emoji,Noto Sans Symbols,Noto Sans Cham", suit_cex="0.6,0.7,0.75,0.9,0.9") traditional_ranks <- list(use_suit_as_ace=TRUE, rank_text=",a,2,3,4,5") -cfg3d <- list(width.pawn=0.75, height.pawn=0.75, depth.pawn=0.375, +cfg3d <- list(width.pawn=0.75, height.pawn=0.75, depth.pawn=0.375, dm_text.pawn="", shape.pawn="convex6", invert_colors.pawn=TRUE, edge_color.coin="tan", edge_color.tile="tan") cfg <- pp_cfg(c(piecepack_suits, dark_colorscheme, traditional_ranks, cfg3d)) @@ -50,7 +73,7 @@ cfg <- pp_cfg(c(piecepack_suits, dark_colorscheme, traditional_ranks, cfg3d)) animate_game(game, op_scale=1, op_angle=90, trans=op_transform, cfg=cfg, file="fujisan.gif") ``` -![Animation of a Fuji-san game](https://www.trevorldavis.com/piecepackr/images/knitr/fujisan.gif) +Animation of a Fuji-san game ## Related links diff --git a/_pkgdown.yml b/_pkgdown.yml index 2ead74d..66ac3eb 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -8,4 +8,5 @@ reference: - title: "Piecepack puzzle solvers" desc: "Functions to solve puzzles" contents: + - solve_dominosa - solve_fujisan diff --git a/man/figures/README-dominosa-1.png b/man/figures/README-dominosa-1.png new file mode 100644 index 0000000000000000000000000000000000000000..5f850d69ce9212685e3bcf9789c76e18b4f4d93b GIT binary patch literal 18813 zcmce;Wn5HU`}a+E3@9QXGIWC?jlj^QGzds2jg-{TjWV=^bV!4OG)M~!QqtWrfYg9A z0}}ThJ+JfnKlkTz-_P^vdBKa>d&RNV-uqbJ^*fG5gr>R@DG@CZ1_lPHin6>m1_l-k z_=6B&16Ra&Y_xzMj+#$&6@Z_Zn3z~tSh%>jczAe(goH#yL}X-S)2+uO&-$Jf`_&(F`_ z-#;KAATTg6C@3f-BqTI6G%PIa&6_uG-@XkG4~M~E5fKrQk&#hRQPI)SF)=Z*v9WP+ zaqr%}i;s^_NJvObOiW5jdjI}?a&mG?N=j;KYFb)adU|?BMn-04W>!{Kc6N47PR@r9 zA98bZ^YZfY^YaS|3JMDgi;9Yhi;GK2N=i#hKYsl9>C>mOva<5>^3R_?S5#C~RaI42 zSJ%|k)YjJ4)z#J4*EcjYeEIUFsi~>Cxw)mKrM0!St*x!Sz5VOguN@s7ot>RsU0rZE zyt}*m+qZ8$Jw3g>y?uRs{r&v|0|Vc`e;*ti92y!L9v&VU85tcN9UB`PA0MBXn3$TH znx3AXnVFfLot>MTo1dRwSXfwGTwGdOT3%lM@#DwJ$_fI3SY2IRTU%RSU;p{@=f=jy z=H}+s*4Fm+_Rh`@5{ca1-QC;U`}OPB{{H^K!NK9-;nC62@$vD=$;s*I>Dk#C3WYj9 zKfk!R`2G9$<>lqo)z$U&_07$Vfuq+Z@WK(kRyK6Qz#yhX|6z_T23%rbfH73$WpuqV zceAc6ZYyNpa8o|)4`vE;CP>40`7|#>9;BJwAxVyJ;QN>(DjxY6cKG4bYprKw zgdt@%5KGBl>cRW&hwnfO7=)mau z)`9i&)yuNds$Dkszz>`$h+7!&Yz1a5eIZvZa!cS!1A>_x(V;cFt1p{R)_Kyi?eLlQ zk&#TCzHmK z0zu4fQXOrKcn_1V`_i?vVBjfr>1v|pXh19UL$?x#A&8rT>%OMDat2-`#mCwk;_o@9 zsD}2E+*O8lE`!E^T1NG!D;wgwkf=C=1Tgf@hw!HN^wl2Cbth2eTZ`nmA?iWb$B!u) z&Oq1h-AWF+aZ*6X%#13aX{Lz}dvWD11Tn<+`IxzN7*~eTBdfUqfp`d;D%J}m&|nyg zOqpzn++tP%A1mKWzBhtn!J1T$1D&Gf-!NA63`Il8Pj{-Zd8Gsra9l`arzaOxwx8r# z*vQguDQrIUx~^r^y*2huFLcDz1U(eR1n~7OSx=yps#*^o=z`trT9ENrU0H5QfP0fAD*%IHxK;D z$Rh1FFd`H76R7Xp0*@qtf2Q;`x2Fw2q>fc(=|^QPQg?GJOdz;7%6X@LH-2FgLs6Nz!|PCft4 zQQQ8l&TR^q)O9AS0=L5T2u7WRkm~0HvZY5Ir9ZEs1)+Dpk+mF9a&v(`!E}g`luZ^# zy~P^Uj()PQ7;T`uOd$VDLybsPg=tC{c2lwb8m_ol>VSwe1^qlJLwqB=*0lm5~G)yi6IP&rp@( zwVAig6+cZh`D0@Xgx+|K92cbb=E&AUtW>CvQx*GR61~?dtG+IHh*3&tmesw-lr3k- zVqR1c=t?UR-PIDa0!k@pD^41sQ4?pPq~{hn1IBCkJ00@<*zmHd%4!(0!em0k8MtX{!W>(^Y8-4?r?MT5$840+aAQnV`_y;%2PRvv%u3W}zehw*NmBRd{ z#sdL=t}nJ`H(Q^G$Eo`Cy?*lEHwKz@4ww<*mSqb(1Us)ey*%mWi5eCh^K9!k!^Bm5 z0y(TT=7v1?kUpg0>D&4q5SQUr+naYFKK{JDK36I>^T*y#1s2YgF}=act?J2J z8B~!Eh7=GB$dD3dsSaR<9)OK9T-sHCRdM$PdwDX|pA0=v_p~*)l>8Vb_2J1mL>qBoEl03D-!#V-sPE&AUnJ6qaf%!aplucqD^B2O z*AJqM%D8jVEKeM>dvILq(a@w19wf=qr5IVum8dsaS9!_)5~c<%!9Fy7K^&~M^r7n- zL%crk;xXgdvGbz;FK1|`!XB8K+Djrr7Ur6k6C<##ptm^|+K%W= z0N-$P0YNdJ^@SX!`>@GO^%$a8@&`*xiViI-7x|TrzX~f96*w`vlwj`=6@M=?vGDro zwkD0*&)BO2m7hb$;aIlBrLNij$eIHEsQrPNSz|V|M*=ZGN$u# z^7@9?{qA3NX7D@{JEWV#J9qQa+YSzFaQSHC&UP$;p$ont!P{s(iYb`VE#~--jYPNR z%tY~@58D6GQ|-Axs^|+wGz?|7u=?Glmd6ENi_jsXodap2t6Ypcr}~P@IRCVXxs}_6 z!FT)74@~X8{9*Hw9)t80${^ZQ_|kxNo6Ze(^(9i z4v8YtM#wDijr=TG2oZO~eE!mf4+SmhFxs)=QzvWKQ}U6Ej*FK2tuP)ooEg^q^`k7X zgGAl0Hb3v1sJbJym6_>>qP|vM1~+VC>i=m=e9x)el{S3jOQkSv=DCT%^;c|)zjsQp zj$fyIp?%iy{JC?Kz02gu11?eAVFoX7XJlM7i%jiDiuA8fCDRB=pFm3HuK76ve*_b7 z1B`@wAWI=@A)zNZmOoTQKxKllNe%(Y09;fJHu_COL911>+uJZZx`I9bN)fF4g*;Ch zLk5S6fkq|Nwk}TAaJmHg?)pU#U$)+u0?9i*G(J+xfAa0?MMCY@5}Z=6XD}9Ni(lC; z@Y2Hf(Y*BtmOR;B>=H0F@ueqG120lq7*f71H>DbScL`W~Z1DlY6_%KS-ufu5DHBG? zFbF>7=|9!D%DbO>{q?a>S45mCh+OsyN|IoV;hhL~5F(!n4tIyV9ITf!OeaH~j?|}j z9&gccTtl+jf+-nj`a-HXz!i?5U}4AV>iObN&hz;zP5NOH7lrr5ILrB8&vi zi35j-wX}e<-AP+xc8;4A_R8zPQj;j11XoKMJ}#(dyCpD1UAS<1%NOJyFWfR_Ua-B? zPS&Pmdz+Pndi<1UWsN+hV6#OB9yg46xW!kD`97VZn9}MSx{~}WhIQPJ*M7329ja=@ zJi@RVta*yU!VKj|VR3~^)OY3_M6LUd3WfT7Pjp=LTVmLfZeqt(yvjsrnILGOFPFuP zqzFks=`l7NO)Wl%Iv`Bz)m7{Q!HM(&jY=Rj+SJ_Kr1D&(`{!Sw@}*Iwd4VpGsDoT> z>J$l5KW&LetA7T3k20T4FEG|S5Qho-z?4&J>{G`sETK_Hy1}alC%_MYN<`MsGMXe4 zXc%ZnsX?XSEWMNPxi(C*9HoX84bL?H0-x(U5^Ydzgxubfgk!Qou}|miw1gW zsrH_nsbtTVy(Ue#+4#jio`y=JJmW@JV~WxoulIi7o{ts+qZlFIs zfnm@3zPcqi{DH3`zZyz7np?#P^6F^fe77W_tYV;FP5gUpX%zn$re7nu_Xn>$mULDN z$Hq3}Fyjj|aYn@r89tRP4zxY0#CnYQT~g0fpV_QesraWB8;nvQ>b@m<4;xJaqy2xG zyc~xR(TOUnadyw%Wjy(K5|}Y(h}VLt&z3c-Fqnvn5f+{@$+tj1(JmOs=bS3!wkswS zSdEW(hB}DLC|x9%&p};I4~%crE-7=0H(#U~((yM3My|TGdJG+Z`=t|!2jwk!9uRgZ zSq4F-CEtrg1U=_1yjZnFI1;7e@C|^;-r*xe&vL1Ob{1TqI5TRIZ%wPC7A6ilQGT}6 zgM|qX#FnG_?Z3Pb4W5z4jO$*WyfO@Rh$v<82O`)!0X$rh z!}pEl$HwS;6j&QF6IO5#YI_Dx)}&%q&&O5pj_LVKPRjnfeD|SOk3u}!L{bP|E17$~x0t^2kHvyRHY6Fg@ZwS9dO4yr zIE(QtlR3F(2+z0c&jVNLUR*pHUL4agF=G-`N}+f0yD*Jn)NRe-yC^KYms={aX!h8} z?^LflYU+4gp$9>YWyMWUt`+2E@|jJiNd{+4LuX_Fi=j1CGZ9S&%*-mF9`MAcJ#}p( z@u{d0TR@D7=jOJW1lK-G`LiJa@P}a~$e!qNQ_|*4;X6ff(8rLC;h6Z6N*&|0;z!IQ zp;t|RJ|7kt<8aN;CW-oQjDmb+F?cq=&0k#eC~h8LzO;(P`^Ho&pM!4j9Sf|OXr#*o z@ydA7$+4C9bGP1fSILjtkU*dNG9_Om!m`Z66i+s50JVrR0q5bvBPqrSPrYzFHn{T% z@&@auxD}L}_m=FrBw`hHkJwuV=}v>P^0V|*`i ze`7ywyqyC9FF6cY_sls(O6uOK#SHza!FC(13(j7bn!(lO@5zp+zZ|*ji(Zp?Ot6AT zG0k*sYCO~`{B-fr+Q$@oPC-&I(7oG`8Wyn?)S2!WUM)z!znkkQ^yb+8>zjW332YNh z@7TR*Sh^!VnN6vg(q(bsS5!XtP!r@axmCz<%hiov7V6EK(>a~3f+)xfKaV=MhsVAmoAtyoS%`Kh;o@OL;LG!T z{vq@AnVkY`BQyPw@rs?V0xPD|_iU=ra z-39cJmo^7C zm+=ub)rXkyJ6sUX($}RJT6&^!EVp$oFJL){XNLWpX&xx%TQ*kf*sz`wj6xRtGyDU) zde-iO4XJdwS3;$y14{iW+y9oCfD&?NG2Mq{+N4Lp!A3Doq)Wmy6CchUuyc8GGTwhb z|EH}f!h1QCEt&9J;O(VD?E2irf;(;&na}rL`}G{zael5dZ8bAJ4@#8@WI>dbwP1{1 z%*AS)41f803w#*$Aba(P2^Q1Pv#qR=HftM2hQOqqv3H3vL?O#5xaBn+n1ih{|hSOJ6xbTVuRxJOFP|}~^y@q_jIW|7}KI{Ch_$7rCG)*iJ z?xL@k9hAzKgVCCWQa&o4X#3d0`S0zZO(QDl(m9jh(_V!%X{h> zbKV%5;K=|Cb#@(W!Z{83uA146g>5e4dLllrY%Q~(>}S3)*!vJvbIYdcYmjpJP$s-A z=_QDrBBx$}d;KnKHlhX)$&6*O!e)kd1c(s+{e>H8b*?0EB;1e(I}bB{Yq%2UfY@ZWo58rt~eGbQ>C0${aiOgE=*V%;96=&>EqoRrJ02=YZp^ei15~gR|KOQS|Ct zu&K@%EchsS^aKbhkQ+X;aC)-koIGZLRGgQ!;fr2Tr;$Df|t2a6pLS3-(J?-YH zS}AljXW8fBzuSC;}`yYDQk7tL3Ql(Z7wm|oOdyVh&hYmBheZKH| zL(_A``vqW_$JfoOMc?v$;eh8eanVl>09Ay$^h6?G`sKKt8V=iA8}1;D>QJ7cL872B z)AjVROdGHf?Yb|Z$1QHHN}pk!rLnW z&B2^X_R{8;xrr*yCR)%T(Ay#bl?BKg0WIx(X&&jfyC=KaIcKXp^n8bS#7OkYC<8^E z42Ud`^@8s2Q9fJUhT88qy6}E(y03^^?2cDbgCRM=`}zC(w*el&s+sT{+J!bMg65L& zC4au0{R=GF$>b>vJtp1Es{kryUAr6VBx#ULi)Pr!%n*poPIJQ`ERxT_2;2R>YWvXq z4gNa0JgD6N4M9xFEOc!ixw#+gD8vlnT1eSfunD5P;wqbka;RNhpp_Nb1z>Rv!U2%w zP4#E3U6p6A{|G*K69U;NJJM&fdS5%th&<6npy1Wdos(ldCpSl_Eq`3D)1QaM`{JC++VsNF31XyI^*U{Hi0^TWW zVE)gWUfj}ezhIDOmi=75$0N_|yjhJ6fIlk#KcSp^soW# z_~+D2iS+bIWgVN47&sKFY~z^2YLX&Z#`rCRxjZ6Uz0R%t8kpP9Zr#vZbN+>BJo#tz z9t7_v69=4r?G!j=GY;JePp-q9MzpGbWQ(~<|Cd=bQs}Xnrnt$Z_U1kBgBlV`D=PVC zxVh2;SOx#3lTj1pV{Rr1)qY}7-zxO+`gb+4&c3v|;0g1hds=#e!1N?~L=eR^po%UM zI6=jUoZjS+CM3rn{Mb)hxvh{IrlL1`JTRD}>l$P85r0Dj8u)x1bIeLf?;Hccep_m& z>@GRn&_RvTZYzoEY5V6dLR{WO0jv65_@ zpOwcG!ZBW9RnSjSU)WVJrEco$_@7(=S3nB}n?REQoT=Bu210{tG?gMM?~feRHk8ZD z)wS-(ByCXx5yDNIe=o3;aF41rv+$P@>oAN0z!hCe~d6< zfBjl@|L{(ZU2JaFWYwWJVEa^6<9Zdlr^}zM!>0ZUGzwQ)3}Dq`dn&e7j^Ux{FUc9p zqV&K7=)PwM7jc_Go}_5B|BoP^8xX|91X@s_0pVhi=Xq>YWEjP|)vwfe++-v_&Cxm^ zY(-By8+IOKUq&}kJ?PI$sUQH3#CiSou+D4***h_S4H~|l&!b-2v1q88Y`DsyE|=E0 z76w}n#Xf1x#6NhpQ58VfzH+}=zYEOw;NQ!JkFigGwLlpVMtj$@uKz_8Dwp7t~b)!t@M>Tppww3a6|Fr zWZIh|NQb1_fDR;WA-wp)Y;)r8oP&uSbk zRA&fx6LH`=fBJQ$khkCb15!g@299?u{mb&8{AcXXKbkqEV=SF@261Sshj8SQoZ8py zi+2QZBxA-i_XU{v?|8P)_b(Uq2XQ0-S86spf>Oh;LaddFvN0c$|Hd5z-j2r@2d6z5 z_4jVI@rnIWuIwt*I`>l2(NiV#;?$@sf*nN~H?LN*1SJOWwuV`U-yUrGH^7&9(RN67 zcPMIT`O5~ku{{-E1d+VSmG*n!u}xq;cXk_PiQmgkw)rZ)P)yq0QaH7i3l~w>k_T^Z zr&I&&7n01-e($b+q4*eEu`tyyXVHPWRH4`edx3x8KM}kVs~$J2s*hQvTc=D_`5ZG~ zDCL7N3e|XX*?~8@Ld6`Epp%n|Bla8ZVd)c@qw>NuLJLZRp5o&dHGm@ zNH_nFfJHaz>$0^vH}cek1Tid${t(iaOgg*}=PXGzu@20DyB~zgnX2g`MSHzq2S_voUS9N9mn+ePQ`il!+NN z#p*AIEn8g+*&kbd4RdI?YEjPQ32C--~i21(dq|4i>M(@G< zLcJuTC6cGQF`p8&0!cY1WU^03E);TzerMKP`UG@&K+BCpwCpZ8g`(;GUGAt+!XFZx zymjdr6MO-%SAAJ4!DN`A=VWXe^G zz-+!frmWwTz=0A z0@Q}BWtQ2UfODXW>GOpZa^RY6*QPkiH3qP-3 zG>VllPcLR9Ommr(o;Ec|(*qDjsF`#pUhA$au1*KK3j(szO!g(QZu{5Z68<4sAY{ep z9B)=Epx)|&VivZm_3u)e@l$1QKlj>@Z@NOBok(iDO@tw< z2^_s92o25s6`S^6#~6?Co(g>VaXf&xIVGwmx9T(se%o+Mq1KQHBhTvOmtAI#kkH;1 zwQmU<$5l1vE2_j!ZEjL?FA1&gd5vI5%WU!>rhPN#>4OFt)|d z4HfYjjVH#VWW+N*eJe4Rmo}R9OW#Y~?nZ6aMjh;5uT2lC`uGV3r>6eo_`{v!_m=O^ z>FX$KEN6b=(Zs(9?kAp!{k%m;f1SETS2ZM;hLUu?F`Jg>=8yowk|Mb#5t=Ti3~vDL zO}jMnJsj2Pkq*$SbiJ}Y939_?xRHpf{QMX7)FeB{R)O%IN4F9nFi8-P$h~Ag5ac1- z3?QIl2}t(69}&neiyEh5_tA}O>%NtKiHXnDqCjrH!job|cVqKVHZJ^m_HF3_{?Ufa zCyCNOAQMy!gzIaaGjz;aFMD?;|7w+Y0=5tFX<-=D-(oQjos{@x;|%pPvRRS79=va+ z*EP5x_&gsForJS^> ziz{{cHWNxTUFMo$dmM?m)F;%Ik$$;zd^J>YT>13w~=IzJ0+{p9ZnplAYDkua`M4D!a{6TQF`cQEdMT+uP6SG)Q^3$Ukg%@NZt) z9a~#yzY3{($Y5Q8zIQD&36}s))EpL%p!U4PjTA2~dBb(l$2XSIbhk1~L?!0PK?04U zqjTuCGv%6oK4BgOw>^>SK0Eyt&veP`9ZjpZp``6B;Q1B0_Z~59W|g5bR5EAI<~D7q zWH^f#AF^2n48-fLpU;Bbh*ISK)xZ^H1Hp1Thm&&^2LS|(G+4Ac?K!!0Ec>tFPX z)|%DQ10n{=2*|3RE$6t%f1-w?iB7%hKk_JB9D1-3cjXl#)t-1_` zd2FWhb^2kKeLfnm$4uzyR5AqZ_D)3oH$81*EL+IzZ+ejC{qKo&Tx<| zQr_tgprjz(+s`kLcrRPSz^7_xWC=%#eu7+MbTb%A2%HE8iyo(>msVM^d+U+FUhbBC zON`6(5Cs2b)zKh_nG9hMTC3Azn=4C5C-gil2BVmrfmZK;@E0ZtGiww9Wo_mGMef+s zh2__2kezB~=Blhh9Jmj({7DE09Yflx9i|I2A%#S{{7(oH+D2X2GT;+|F2`C$pEC(J zJW-O866hJnLaI!FJ*J8B4u!{#JCP3E9he21$yG`+ndaEC8NZ!T6&?^N$a3+GkySIj81F=e2YT!1qn{n_qisJ{X6zw7i`9URUb- z%+xvSQR~6)q`Y7g;_YM|8vbx{m}s12V18l6>vBD}T~c=xqLs&bl)mG4$;a6l6&b4?ZeGaOw!wF4Xy>wa|6Lk_I+gz84p^I$n_B>M z6L)xC4!-{|q0wU74@iZG=uPWeXn4o9G22rl>|*BRW$LMFT4?{p@lo zaLARu%WGahv{82?RB%Vi)aXO*Y$?0Y^|yMrun8jy^n~Cc=p$o?L%iexk#XiL-L+=( z>lM;KsY0^ux&82u0*U@e2;FK><@kDlX}7S2p~jcV{g1maV0CHAc)!K+*7J+wn0)9A zkY@&!DyqNm>gLQ#wQ&kojNyQlce>A3k%=*+Tz;>NpAhns_Pm=S4=53%!OBB}9jAv+ z)7rd==D``VpT8=s9t0FknAs)rSEk&R zJh5CJGOZqLs(uA}HEsoHSb8Cobd*g=7zb#bvd@md1T)0C_zx#PtE&OUwB!zuK|s?k z>_689$#Pv@ItsFEMC4)?IDSnA3qm2rDdoXEiNi@kvzP>k|B;P`>qa2!AsJ1izWxv< znGfP3quAIp54*ornEdOff{G5e!+O}hA^8o z&x6FJaNqAOHjznyWoqY?Nz8*xpa+8AYNyx}V7^NYffkC+hw2&rzp5?ZE z0gLo5aHm+|w&a`jW!87!Q}HmgP7t28MNylhbNqR^vno(Na%ZBtkkq(wq7fv^wMS7O z*}b8$$FuPSMSYgreIcnSx5`J52HqDxAVt|Mup#Dr`__f%)9dXMDIX#`d|C)CJ`X=b zVgE!T_CpPZZ*nz>6;WzH#o#Y2(kbjRz|VnQ%Wak5)CywZ+}XZq++Kl`0!UbE*wxod zgYE&@HVLy#+UFzc*QZzofDc7t(vfbwkAAoX?(b$dF_H?rf+%7=3)tM{&e#Ro$h~X+v!KDn@DeU z4uoLrE+HDlmPRe-6;=d#MFl>M4XkfRk~|khQr<(5C2}QY*$Zro2QBs7)C?81A$LdX zCcgGXQSt{I?K-gQL_eE}f%AU@wvjvl7xE8qX>SE)<%xwlX{99cSkex~Qt2dvDJ^k36j){Bs;B6@xJzw zn|tqLD%z+ZECaOry5jtGY9H>s-j{(dpC#D0=*vp5NI??VOZx$+TGJHmQ)K28|8;v8 ztf1~1{sX+kCM?U=Y<{X%<`C@Fz5C3HLqa#mx{3~0m7N;sXH4c;?M5X2wxfIGN99qh zW)@Lcj%Ij*@=Z?!d5xL56|wxQ=`H33D3-)JoQ(b9Pb2M5kBubyRq;pJ8M(5Ad~(OX zXB-NO!UPDl))8IE6oXl;_-)@xB|<1*_e{GsOR~0`DN~)D{Xllg&V|eEwKI! zYlnaRuimZVc82%+>5qid=4>y~^tlDTU>z(DNZubJc2kb8 zIg))1iqi@=XB$k3BL8G&j)@Upvl}uKJ85G5ymZ5vy=vmK-k$ZBsQ%cGk43oGhTw~e zYm$_LEtxrJhNZkG|B8;Hg(^g3C*9c3;EIy_IavEFj3KP*mW_ptN10#tgXgRNkxI8m zt(3IxgPa?^{5F~lVxpv=^Ss>(qU70~$Ag3p`8fRZ2eSq$0#et1nn`dzM79lvl^G6itV`otT#$mr2C|*kXQfpNO8ne^{>FRs;%F3wz9$UvL0&d}f26QcED0^g^R)Vi z8PAVx4v`o}cn=0{)Lj7i55KeMK)3>6yc#*jKHt#AP4Ut?ek>r+i4}2=_8<5JVc}OL zfKS<>%v^flrR$lX-e+twNa+3H6w`HGEHWlWl0gfRbTz%GuMB|x>lgmk+{=N@Ejw|I z4EAUyricy{$`uL@P{y+%UuOIYPL5Y^>2#`1nBe+P`B#0LukSp^#y=1mi@32CxyYU{ zx)lsWs)JEv-pk7`#c=Mzr5ebOyvrA&;0In2wf_u4TGYfVAw&3AY>lGNWtgdJTv9gt11a!g0ET@a1@;5~hsUD( zzY$}j+;!|wZ2BRtd^@VQcEBIBD-?1|V?TqwA?0JEVNiZee#v9ZQ4uKtQb3i>49{%W z8hZ9+>SM`nNk94D5VAV%QM+ljRI!i;>G|yB@b@{d*{esS@BupOL1W(`A`U&!)hhG2 zz_bkVbl2e4FV@YCyMWcEJamn%|Xv=gvbce-0x$azI-wvj?Dh%aNHfibN^ohMKG{-6k z!?8ZR{*-iE#uBbn#OVMUP6((&&FA_IsSveiPNd%k`Y8-8VNLt3d&p^1S`znf!D%n- zH0$E*2^8J@5Fm;w0Nd;LWO>QEylYcDzm@-vx)V>Ur9(aCw>Q;*vMd@1xhp7uox3=Y zop+s-z|^v$A;ft&yKf_Pe%uFHDp6lX^(YmwI)H45WorM+gPAl}4+a>3g=)RgFxS+i zo180Mc@($UmYwsWlP?!gQ*-vn)?&C|*9Y--gmmy2mUrKu-qm1Na#(i^BsOSBXjXVE z$L7Oalg~j8TU$WxxjYrfZh=MNEuOvb7kT4H6i7=f9A9#2*^PchUWRfs@a_Tx$kO@P z{XkGsZ+9m5ERM{AJ%n(VKQp_6?fpKTsav0LcjQWZq)m?1 z)VweKWQs0za>__rsoUN7mM@~Ho(RL55X?H{qOd9Pj4mUQVCzoxTOLi?lfcj4?354SsY_b!TAX-JabjZ)#(~)fi*k zS&FOBVw1Ugh%GOWr>9w58C*rcTU7=qtfV#@2WvHUCf6)W0PosY#{HAj7dB;dfnd&E zz^U4x2#aj)es8$VrD&@gXLS-CIlo0YZBr`Yv=JXh|Mc1bok|9RCNwS1aixY*e*Dd- z`wkT`jh5utVEVp{vI?a1MAJHFJ{9zi9I_?*M{u(o_T77}pMUgL+-xe(*=bzn4&=!H zoI_MLaOVnvHi`w#rA-bfxRqpTPtn?|YZ2tbtQbSXBjL3ZYXgsO6}KXR*!lD%f37Q) z{Eo3zu#eaM5_nv18S#7al6lS&cj}d$LmRV8k^kpW+i`k^c&uQrgR%rZ^B`cq(uzKx zTb`%HouM(_DzRvMUJ{x05I9~VZIXT|CaUWH!^3W(g8-3F3V*(;`&(%54q9eCTpUn1 z;h`<11xwO4D(_v(e!>cx;o8GeD;I>V?8?(8IqdxBlyK3E+*Q9FD3>(#0La^51LbC= z=Vo(>JXOAXquLXL^3l_SDT~erF!m*DmsQ8Jg_n>W} zLiIsLSZlaiL+VWqK;maXwO~YYGV4hzfn+jj8r5~CRQ46n8(oR_h0m%MEE(IMdT*(8 z#40UK^HCMDj$rqtL`O?A1;UAl5Faw8H%LvRNWbX!+kfcT^(rJmwDLX-D{2|=+SS(n z8xa>8@C+vPv%Ds8$_df*j@qo#)%Qc!g$g(Zyjg@?nzv-qGn9tRth02bzRd~xNb>j( zAc`6TXZJ&0$5N%S6MZsc^}Ukg_~?Bb+l1K$TrE_XY1 zM8p{|LNdFZ!0PPmHa$v_VEy>j^8)9@arUI~A)Tm~Scu1CF6urK>S&{x-b;GYH+KN| zw*VZq(i(~dT;>{kZPGZKId+ckTSAyCp|sc^Yn>A;vTQ^|m0me|M2n>on5msm{iu^KZMLvArtg@kww4;o!?RlLd2PIw=bxRY<@@#ggL)UUP4U z*Hw+72bs+{DlznDkR1#Mq`PIY?}t}W7CSQwhck)IX>=#b^C~IZj}hAU@=w%*JHO_9 z6;|D^PI`%zcjCKnId&1RUq%cmRvLDb@+zMg?;mv-Xx77wWbZe*IYN3-O+I^ zmkz)`3&6`p|6c%uE<8AjUiWV*o`x!R;MrBT2dSA>AUQRtoV#K;yKxVzxXs^B(GO0m z2reQ-ececrHm3o}5pI8#J5u7oHs_F`_p-f)SwToxOR&iY8LCKNxi}s_a?hFX@PL|^ z{jSgNTrUaY!HtiVcr?M{8iP0BYHa?IZwzhH<}z3=LfNSs$kF!V=9Og`V~;j%8++_)=MY}m)jK{JeUO{w5(pOnzfCx1u8Vuc zZ9X7I9&LFk_VN`=j;UJu~IZ{Ui1P=%$Z5I!x9A zp$kM^!>I1bO8}|&w=UUwc3GXBn{gw-7jwbXwrJM|oSlRnc^ru(ofAzPy-}Nh95*E1 z-~4;plonMBG5Z^g#&is#_qw|7?Y4O_9n!R})B?168&38FkLxEdCe%LHIg^PML<7~v zUIeg>{fE9hsi z2iwu$J(h5>JG~viS7Yo4NPti6fF7{qhXh`2dp^1iwC(;Oyo77{0qHr6OfZ;ckaX?G z157PGDW%d}*kg}}9%XpY(Di~lrb4ASOkHI3n>YE7eYjzciq)<|I|5R`N8H~Xt~$ct zFL37LTGn1gcaO17UsORAEPxydmU?<3HF96SqrrK9^Z_QtkJCFQd$}LIc(Y%BTA6(H zYFy+Rx(Qj%^|>(wjk|x?xJ8#q>gXr<1U<6i2~GL7l{k-HG3~zLmOIn?9y>3M^YHT8 zvyvbh?5*uxl?ZO}5#X%E9^{(z7HAzIcf}^(j%##joOAyMZIf4e>>F%E%J&OQ zWC7jZpo|=zB z_GS{q_vLupc3lB2 zUcZp4zVmO<0aHHU_D_~y;O(C#(?At;M391-(A*wbj)(oGA1XfG+@fcF&FWpVtYxor zMofe>uU}O(IC(#Dcq7>wP&j>uocGK)0(x!(d`IlR8KqU>@18v9=kEz91iDsPs41{`ebwg2?* z!_>pb%LE_$8`M_-8#KM2+y}vNEZC2R`Dg!K>xl~c5&LJrV{I5bUHx3vIVCg!0P_L` AzyJUM literal 0 HcmV?d00001 diff --git a/man/solve_dominosa.Rd b/man/solve_dominosa.Rd new file mode 100644 index 0000000..2d0f6d3 --- /dev/null +++ b/man/solve_dominosa.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dominosa.R +\name{solve_dominosa} +\alias{solve_dominosa} +\title{Solve Dominosa puzzle} +\usage{ +solve_dominosa(pips) +} +\arguments{ +\item{pips}{A matrix of non-negative integer pip values, +or a string with rows of integers separated by \code{"/"}. +For a double-\code{n} domino set the grid must have \code{(n + 1)(n + 2)} cells +and each pip value \code{0}:\code{n} must appear exactly \code{n + 2} times.} +} +\value{ +A list with components: +\describe{ +\item{\code{domino_ids}}{An integer matrix of the same dimensions as \code{pips} +where cells belonging to the same domino share the same integer value.} +\item{\code{pips}}{The input \code{pips} matrix.} +\item{\code{ppn}}{A string of Portable Piecepack Notation for the solution.} +} +} +\description{ +Solves a Dominosa (Domino Solitaire) puzzle given a grid of pip values. +} +\examples{ +pips <- matrix(c(0, 1, 0, 1, 3, + 3, 1, 0, 2, 2, + 3, 2, 1, 0, 3, + 2, 3, 1, 0, 2), nrow = 4L, byrow = TRUE) +s <- solve_dominosa(pips) +if (rlang::is_installed(c("piecepackr", "ppn"))) { + g <- ppn::read_ppn(textConnection(s$ppn))[[1]] + envir <- piecepackr::game_systems(round = TRUE) + ppn::plot_move(g, open_device = FALSE, annotate = FALSE, envir = envir, scale = 0.95) +} +} +\seealso{ +\url{https://www.solitairelaboratory.com/puzzlelaboratory/DominoGG.html} and +\url{https://puzzlebreaks.com/dominosa/} for more information about Dominosa. +} diff --git a/man/game_solvers.Rd b/man/solve_fujisan.Rd similarity index 63% rename from man/game_solvers.Rd rename to man/solve_fujisan.Rd index 19f1ca4..d7a7858 100644 --- a/man/game_solvers.Rd +++ b/man/solve_fujisan.Rd @@ -4,16 +4,24 @@ \alias{solve_fujisan} \title{Solve Fujisan game} \usage{ -solve_fujisan(coins = random_fujisan_coins(), dice = random_dice() - 1) +solve_fujisan( + coins = random_fujisan_coins(), + dice = random_dice() - 1, + pawns = "S12M/A12C" +) } \arguments{ \item{coins}{A vector or matrix of Fujisan coin layout. Default is a random layout.} \item{dice}{A vector of Fujisan dice layout. Default is random dice. Usually not needed.} + +\item{pawns}{A FEN-like string of the pawns position. The four pawns \code{S}, \code{M}, \code{C}, and +\code{A} are represented by their letter and empty spaces by a number. The two rows are +separated by \code{/}. Default is \code{"S12M/A12C"} (all pawns at starting corners).} } \value{ A list with solution of Fujisan solution, its length, coin layout, dice (if needed), -and portable piecepack notation. +pawns position, and portable piecepack notation. } \description{ Solves a game of Fujisan (if possible). @@ -24,6 +32,6 @@ Solves a game of Fujisan (if possible). s2 <- solve_fujisan(coins = puzzle2) if (rlang::is_installed(c("piecepackr", "ppn"))) { g2 <- ppn::read_ppn(textConnection(s2$ppn))[[1]] - ppn::plot_move(g2) + ppn::plot_move(g2, open_device = FALSE) } } diff --git a/tests/testthat/_snaps/dominosa.md b/tests/testthat/_snaps/dominosa.md new file mode 100644 index 0000000..045a5c3 --- /dev/null +++ b/tests/testthat/_snaps/dominosa.md @@ -0,0 +1,63 @@ +# solve_dominosa() works as expected + + Code + cat(s1$ppn) + Output + --- + GameType: Dominosa + SetUp: None + ... + Solution. `0-0'<@(1.5,2) `1-0'<@(1.5,1) `1-1'@(3,1.5) + +--- + + Code + ppn::cat_move(g1, move = "Solution.", color = FALSE) + Output + ┌───┬─┐ + │ ┃ │·│ + ├───┤━│ + │·┃ │·│ + └───┴─┘ + + +# solve_dominosa() errors on invalid input + + Code + solve_dominosa(matrix(c(0L, 0L, 1L, 1L), nrow = 1L)) + Condition + Error in `validate_dominosa_pips()`: + ! For a double-1 domino set the grid must have 6 cells, but `pips` has 4 cells. + +--- + + Code + solve_dominosa(matrix(c(1L, 1L, 1L, 1L, 0L, 0L), nrow = 2L, byrow = TRUE)) + Condition + Error in `validate_dominosa_pips()`: + ! For a double-1 domino set each pip value must appear exactly 3 time(s). The following pip values have incorrect counts: 0, 1. + +--- + + Code + solve_dominosa("010/101") + Condition + Error in `solve_dominosa()`: + ! No solution exists for this Dominosa puzzle. + +--- + + Code + solve_dominosa("0101/10") + Condition + Error in `parse_dominosa_pips()`: + ! All rows in `pips` must have the same length. + +--- + + Code + solve_dominosa(as.data.frame(pips1)) + Condition + Error in `parse_dominosa_pips()`: + ! `pips` must be a matrix or character string, not data.frame. + diff --git a/tests/testthat/_snaps/fujisan.md b/tests/testthat/_snaps/fujisan.md index 2615811..78dbd93 100644 --- a/tests/testthat/_snaps/fujisan.md +++ b/tests/testthat/_snaps/fujisan.md @@ -1,3 +1,35 @@ +# parse_fujisan_pawns() works as expected + + Code + parse_fujisan_pawns("S12M") + Condition + Error in `parse_fujisan_pawns()`: + ! The `pawns` string must have exactly one '/' separator but got: 'S12M' + +--- + + Code + parse_fujisan_pawns("S12M/A11C") + Condition + Error in `parse_fujisan_pawn_row()`: + ! Row 2 of pawns string 'S12M/A11C' covers 13 columns but must cover exactly 14 + +--- + + Code + parse_fujisan_pawns("S13M/A12C") + Condition + Error in `parse_fujisan_pawn_row()`: + ! Row 1 of pawns string 'S13M/A12C' covers 15 columns but must cover exactly 14 + +--- + + Code + parse_fujisan_pawns("S13/A12C") + Condition + Error in `parse_fujisan_pawns()`: + ! The `pawns` string must contain exactly 4 pawns but got 3: 'S13/A12C' + # fujisan solver works as expected Code diff --git a/tests/testthat/test-dominosa.R b/tests/testthat/test-dominosa.R new file mode 100644 index 0000000..5fcde52 --- /dev/null +++ b/tests/testthat/test-dominosa.R @@ -0,0 +1,100 @@ +test_that("solve_dominosa() works as expected", { + # double-0: trivial single domino + pips0 <- matrix(c(0L, 0L), nrow = 1L) + s0 <- solve_dominosa(pips0) + expect_equal(s0$domino_ids, matrix(c(1L, 1L), nrow = 1L)) + + # double-1: 2x3 grid + # fmt: skip + pips1 <- matrix(c( + 0L, 0L, 1L, + 1L, 0L, 1L + ), nrow = 2L, byrow = TRUE) + s1 <- solve_dominosa(pips1) + expect_equal( + s1$domino_ids, + # fmt: skip + matrix(c( + 1L, 1L, 3L, + 2L, 2L, 3L + ), nrow = 2L, byrow = TRUE) + ) + + # string input equivalent to pips1 + expect_equal(solve_dominosa("001/101")$domino_ids, s1$domino_ids) + + # ppn output + expect_snapshot(cat(s1$ppn)) + + skip_if_not_installed("ppn") + skip_if_not_installed("ppcli") + skip_on_os("windows") + g1 <- ppn::read_ppn(textConnection(s1$ppn))[[1]] + expect_snapshot(ppn::cat_move(g1, move = "Solution.", color = FALSE)) + + # double-2: 3x4 grid + # fmt: skip + pips2 <- matrix(c( + 0L, 0L, 2L, 2L, + 0L, 1L, 2L, 0L, + 1L, 1L, 1L, 2L + ), nrow = 3L, byrow = TRUE) + s2 <- solve_dominosa(pips2) + # Verify all 6 domino types present and each pip pair is valid + expect_setequal(as.vector(s2$domino_ids), 1:6) + for (d in 1:6) { + cells <- which(s2$domino_ids == d, arr.ind = TRUE) + expect_equal(nrow(cells), 2L) + p <- sort(c(pips2[cells[1, 1], cells[1, 2]], pips2[cells[2, 1], cells[2, 2]])) + expected_pip <- switch( + d, + `1` = c(0L, 0L), + `2` = c(0L, 1L), + `3` = c(0L, 2L), + `4` = c(1L, 1L), + `5` = c(1L, 2L), + `6` = c(2L, 2L) + ) + expect_equal(p, expected_pip) + } +}) + +test_that("solve_dominosa() errors on invalid input", { + # Wrong grid size + expect_snapshot( + error = TRUE, + solve_dominosa(matrix(c(0L, 0L, 1L, 1L), nrow = 1L)) + ) + # Wrong pip distribution: pip 0 appears 2 times, pip 1 appears 4 times + expect_snapshot( + error = TRUE, + solve_dominosa(matrix(c(1L, 1L, 1L, 1L, 0L, 0L), nrow = 2L, byrow = TRUE)) + ) + # Valid distribution but no solution exists + expect_snapshot( + error = TRUE, + solve_dominosa("010/101") + ) + # Unbalanced strings + expect_snapshot( + error = TRUE, + solve_dominosa("0101/10") + ) + # Wrong type + pips1 <- matrix( + c( + 0L, + 0L, + 1L, + 1L, + 0L, + 1L + ), + nrow = 2L, + byrow = TRUE + ) + expect_snapshot( + error = TRUE, + solve_dominosa(as.data.frame(pips1)) + ) +}) diff --git a/tests/testthat/test-fujisan.R b/tests/testthat/test-fujisan.R index f88b596..b672e81 100644 --- a/tests/testthat/test-fujisan.R +++ b/tests/testthat/test-fujisan.R @@ -1,3 +1,14 @@ +test_that("parse_fujisan_pawns() works as expected", { + expect_equal(parse_fujisan_pawns("S12M/A12C"), c(1L, 14L, 15L, 28L)) + expect_equal(parse_fujisan_pawns("6SM6/6AC6"), c(7L, 8L, 21L, 22L)) + expect_equal(parse_fujisan_pawns("S12S/A12A"), c(1L, 14L, 15L, 28L)) + expect_equal(parse_fujisan_pawns("6PP6/6PP6"), c(7L, 8L, 21L, 22L)) + expect_snapshot(error = TRUE, parse_fujisan_pawns("S12M")) + expect_snapshot(error = TRUE, parse_fujisan_pawns("S12M/A11C")) + expect_snapshot(error = TRUE, parse_fujisan_pawns("S13M/A12C")) + expect_snapshot(error = TRUE, parse_fujisan_pawns("S13/A12C")) +}) + test_that("fujisan solver works as expected", { coins <- "235334140030554141221205" dice <- "0000" @@ -20,43 +31,27 @@ test_that("fujisan solver works as expected", { withr::local_seed(42) random_fujisan_coins() }, + # fmt: skip matrix( c( - 1L, - 2L, - 3L, - 1L, - 1L, - 3L, - 0L, - 3L, - 5L, - 4L, - 0L, - 2L, - 2L, - 4L, - 4L, - 1L, - 0L, - 3L, - 4L, - 5L, - 0L, - 5L, - 5L, - 2L + 1L, 2L, 3L, 1L, 1L, 3L, 0L, 3L, 5L, 4L, 0L, 2L, + 2L, 4L, 4L, 1L, 0L, 3L, 4L, 5L, 0L, 5L, 5L, 2L ), nrow = 2L ) ) puzzle2 <- matrix( - c(4, 4, 4, 5, 2, 0, 2, 4, 0, 3, 1, 1, 1, 2, 5, 3, 3, 5, 3, 2, 5, 1, 0, 0), + # fmt: skip + c( + 4, 4, 4, 5, 2, 0, 2, 4, 0, 3, 1, 1, + 1, 2, 5, 3, 3, 5, 3, 2, 5, 1, 0, 0 + ), nrow = 2, byrow = TRUE ) s2 <- solve_fujisan(coins = puzzle2) + expect_equal(solve_fujisan(coins = puzzle2, pawns = "6SM6/6AC6")$shortest_distance, 0L) g2 <- ppn::read_ppn(textConnection(s2$ppn))[[1]] expect_snapshot(ppn::cat_move(g2, move = "SetupFn.", color = FALSE)) From 518ea4c06e9e9d1a477614e30276612b60ecf6e2 Mon Sep 17 00:00:00 2001 From: "Trevor L. Davis" Date: Thu, 16 Apr 2026 23:38:52 -0700 Subject: [PATCH 2/2] refactor: `solve_fujisan()` should return `pawn_string` to match `coin_string` and `dice_string` --- DESCRIPTION | 21 +++++++++++---------- R/fujisan.R | 15 ++++++--------- man/solve_fujisan.Rd | 9 +++------ 3 files changed, 20 insertions(+), 25 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0136a52..6c9b761 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,17 +13,18 @@ BugReports: https://github.com/piecepackr/ppgamer/issues LazyLoad: yes Depends: R (>= 3.4.0) Imports: - dplyr, - rlang, - stringr, - tibble, + dplyr, + rlang, + stringr, + tibble, Suggests: - igraph, - ppcli, - ppn (>= 0.1.0-2), - testthat, - withr, - vdiffr, + igraph, + piecepackr, + ppcli, + ppn (>= 0.1.0-2), + testthat, + withr, + vdiffr, Remotes: piecepackr/ppcli, piecepackr/ppn Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.3 diff --git a/R/fujisan.R b/R/fujisan.R index 1d3b650..9ab8fe3 100644 --- a/R/fujisan.R +++ b/R/fujisan.R @@ -254,12 +254,12 @@ pawns2ppn <- function(pawns) { sol2ppn <- function(sol) { movetext <- paste(path2movetext(sol$shortest_path), collapse = "\n") - is_default_pawns <- is.null(sol$pawns) || sol$pawns == "S12M/A12C" + is_default_pawns <- is.null(sol$pawn_string) || sol$pawn_string == "S12M/A12C" metadata <- str_glue( '---\nGameType:\n Name: Fujisan\n Coins: "{coins}"{dice}{pawns}\n...', coins = coins2string(sol$coins, "/"), dice = if (is_default_pawns) dice2ppn(sol$coins, sol$dice) else "", - pawns = pawns2ppn(sol$pawns) + pawns = pawns2ppn(sol$pawn_string) ) paste0(metadata, "\n", movetext, "\n") } @@ -288,15 +288,12 @@ first_move_needs_dice <- function(coins) { #' `A` are represented by their letter and empty spaces by a number. The two rows are #' separated by `/`. Default is `"S12M/A12C"` (all pawns at starting corners). #' @return A list with solution of Fujisan solution, its length, coin layout, dice (if needed), -#' pawns position, and portable piecepack notation. +#' pawn position string, and portable piecepack notation. #' @examples #' puzzle2 <- matrix(c(4, 4, 4, 5, 2, 0, 2, 4, 0, 3, 1, 1, #' 1, 2, 5, 3, 3, 5, 3, 2, 5, 1, 0, 0), nrow = 2, byrow = TRUE) -#' s2 <- solve_fujisan(coins = puzzle2) -#' if (rlang::is_installed(c("piecepackr", "ppn"))) { -#' g2 <- ppn::read_ppn(textConnection(s2$ppn))[[1]] -#' ppn::plot_move(g2, open_device = FALSE) -#' } +#' s <- solve_fujisan(coins = puzzle2) +#' print(s$shortest_distance) # minimum number of moves to solve game #' @export solve_fujisan <- function( coins = random_fujisan_coins(), @@ -339,7 +336,7 @@ solve_fujisan <- function( dice = dice, coin_string = coins2string(coins), dice_string = dice2string(dice), - pawns = pawns, + pawn_string = pawns, n_counter_intuitive = path2counter_intuitive(p) ) sol$ppn <- sol2ppn(sol) diff --git a/man/solve_fujisan.Rd b/man/solve_fujisan.Rd index d7a7858..875ba78 100644 --- a/man/solve_fujisan.Rd +++ b/man/solve_fujisan.Rd @@ -21,7 +21,7 @@ separated by \code{/}. Default is \code{"S12M/A12C"} (all pawns at starting cor } \value{ A list with solution of Fujisan solution, its length, coin layout, dice (if needed), -pawns position, and portable piecepack notation. +pawn position string, and portable piecepack notation. } \description{ Solves a game of Fujisan (if possible). @@ -29,9 +29,6 @@ Solves a game of Fujisan (if possible). \examples{ puzzle2 <- matrix(c(4, 4, 4, 5, 2, 0, 2, 4, 0, 3, 1, 1, 1, 2, 5, 3, 3, 5, 3, 2, 5, 1, 0, 0), nrow = 2, byrow = TRUE) - s2 <- solve_fujisan(coins = puzzle2) - if (rlang::is_installed(c("piecepackr", "ppn"))) { - g2 <- ppn::read_ppn(textConnection(s2$ppn))[[1]] - ppn::plot_move(g2, open_device = FALSE) - } + s <- solve_fujisan(coins = puzzle2) + print(s$shortest_distance) # minimum number of moves to solve game }