R/day12.R

In tjmahr/adventofcode21:

#' Day 12: Passage Pathing
#'
#' [Passage Pathing](https://adventofcode.com/2021/day/12)
#'
#' @name day12
#' @rdname day12
#' @details
#'
#' **Part One**
#'
#' With your [submarine\'s subterranean subsystems subsisting
#' suboptimally]{title="Sublime."}, the only way you\'re getting out of
#' this cave anytime soon is by finding a path yourself. Not just *a* path
#' - the only way to know if you\'ve found the *best* path is to find *all*
#' of them.
#'
#' Fortunately, the sensors are still mostly working, and so you build a
#' rough map of the remaining caves (your puzzle input). For example:
#'
#'     start-A
#'     start-b
#'     A-c
#'     A-b
#'     b-d
#'     A-end
#'     b-end
#'
#' This is a list of how all of the caves are connected. You start in the
#' cave named `start`, and your destination is the cave named `end`. An
#' entry like `b-d` means that cave `b` is connected to cave `d` - that is,
#' you can move between them.
#'
#' So, the above cave system looks roughly like this:
#'
#'         start
#'         /   \
#'     c--A-----b--d
#'         \   /
#'          end
#'
#' Your goal is to find the number of distinct *paths* that start at
#' `start`, end at `end`, and don\'t visit small caves more than once.
#' There are two types of caves: *big* caves (written in uppercase, like
#' `A`) and *small* caves (written in lowercase, like `b`). It would be a
#' waste of time to visit any small cave more than once, but big caves are
#' large enough that it might be worth visiting them multiple times. So,
#' all paths you find should *visit small caves at most once*, and can
#' *visit big caves any number of times*.
#'
#' Given these rules, there are `10` paths through this example cave
#' system:
#'
#'     start,A,b,A,c,A,end
#'     start,A,b,A,end
#'     start,A,b,end
#'     start,A,c,A,b,A,end
#'     start,A,c,A,b,end
#'     start,A,c,A,end
#'     start,A,end
#'     start,b,A,c,A,end
#'     start,b,A,end
#'     start,b,end
#'
#' (Each line in the above list corresponds to a single path; the caves
#' visited by that path are listed in the order they are visited and
#' separated by commas.)
#'
#' Note that in this cave system, cave `d` is never visited by any path: to
#' do so, cave `b` would need to be visited twice (once on the way to cave
#' `d` and a second time when returning from cave `d`), and since cave `b`
#' is small, this is not allowed.
#'
#' Here is a slightly larger example:
#'
#'     dc-end
#'     HN-start
#'     start-kj
#'     dc-start
#'     dc-HN
#'     LN-dc
#'     HN-end
#'     kj-sa
#'     kj-HN
#'     kj-dc
#'
#' The `19` paths through it are as follows:
#'
#'     start,HN,dc,HN,end
#'     start,HN,dc,HN,kj,HN,end
#'     start,HN,dc,end
#'     start,HN,dc,kj,HN,end
#'     start,HN,end
#'     start,HN,kj,HN,dc,HN,end
#'     start,HN,kj,HN,dc,end
#'     start,HN,kj,HN,end
#'     start,HN,kj,dc,HN,end
#'     start,HN,kj,dc,end
#'     start,dc,HN,end
#'     start,dc,HN,kj,HN,end
#'     start,dc,end
#'     start,dc,kj,HN,end
#'     start,kj,HN,dc,HN,end
#'     start,kj,HN,dc,end
#'     start,kj,HN,end
#'     start,kj,dc,HN,end
#'     start,kj,dc,end
#'
#' Finally, this even larger example has `226` paths through it:
#'
#'     fs-end
#'     he-DX
#'     fs-he
#'     start-DX
#'     pj-DX
#'     end-zg
#'     zg-sl
#'     zg-pj
#'     pj-he
#'     RW-he
#'     fs-DX
#'     pj-RW
#'     zg-RW
#'     start-pj
#'     he-WI
#'     zg-he
#'     pj-fs
#'     start-RW
#'
#' *How many paths through this cave system are there that visit small
#' caves at most once?*
#'
#' **Part Two**
#'
#' After reviewing the available paths, you realize you might have time to
#' visit a single small cave *twice*. Specifically, big caves can be
#' visited any number of times, a single small cave can be visited at most
#' twice, and the remaining small caves can be visited at most once.
#' However, the caves named `start` and `end` can only be visited *exactly
#' once each*: once you leave the `start` cave, you may not return to it,
#' and once you reach the `end` cave, the path must end immediately.
#'
#' Now, the `36` possible paths through the first example above are:
#'
#'     start,A,b,A,b,A,c,A,end
#'     start,A,b,A,b,A,end
#'     start,A,b,A,b,end
#'     start,A,b,A,c,A,b,A,end
#'     start,A,b,A,c,A,b,end
#'     start,A,b,A,c,A,c,A,end
#'     start,A,b,A,c,A,end
#'     start,A,b,A,end
#'     start,A,b,d,b,A,c,A,end
#'     start,A,b,d,b,A,end
#'     start,A,b,d,b,end
#'     start,A,b,end
#'     start,A,c,A,b,A,b,A,end
#'     start,A,c,A,b,A,b,end
#'     start,A,c,A,b,A,c,A,end
#'     start,A,c,A,b,A,end
#'     start,A,c,A,b,d,b,A,end
#'     start,A,c,A,b,d,b,end
#'     start,A,c,A,b,end
#'     start,A,c,A,c,A,b,A,end
#'     start,A,c,A,c,A,b,end
#'     start,A,c,A,c,A,end
#'     start,A,c,A,end
#'     start,A,end
#'     start,b,A,b,A,c,A,end
#'     start,b,A,b,A,end
#'     start,b,A,b,end
#'     start,b,A,c,A,b,A,end
#'     start,b,A,c,A,b,end
#'     start,b,A,c,A,c,A,end
#'     start,b,A,c,A,end
#'     start,b,A,end
#'     start,b,d,b,A,c,A,end
#'     start,b,d,b,A,end
#'     start,b,d,b,end
#'     start,b,end
#'
#' The slightly larger example above now has `103` paths through it, and
#' the even larger example now has `3509` paths through it.
#'
#' Given these new rules, *how many paths through this cave system are
#' there?*
#'
#' @param x some data
#' @return For Part One, `f12a_traverse_caves_once(x)` returns the list of
#'   paths. For Part Two, `f12b_traverse_caves_maybe_twice(x)` returns the list
#'   of paths.
#' @export
#' @examples
#' f12a_traverse_caves_once(example_data_12())
#' f12b_traverse_caves_maybe_twice(example_data_12())
f12a_traverse_caves_once <- function(x) {
  # strategy: recursion + lookup vectors
  filter_candidates <- function(candidates, history) {
    is_lower <- function(xs) xs == tolower(xs)
    visited <- is.element(candidates, history)
    candidates[!(is_lower(candidates) & visited)]
  }
  f12a_traverse_caves(x, filter_candidates)
}


#' @rdname day12
#' @export
f12b_traverse_caves_maybe_twice <- function(x) {
  filter_candidates <- function(candidates, history) {
    is_lower <- function(xs) xs == tolower(xs)
    lc_candidates <- candidates[is_lower(candidates)]
    uc_candidates <- candidates[!is_lower(candidates)]

    # count appearance of items, including candidates, so that counts of
    # unvisited candidates can be 0
    u_history <- unique(c(history, candidates))
    all_counts <- u_history |>
      lapply(function(xs) sum(history %in% xs)) |>
      stats::setNames(u_history) |>
      unlist()

    # counts of lc items
    lc_names <- which(all_counts |> names() |> is_lower())
    lc_counts <- all_counts[lc_names]

    if (any(lc_counts == 2)) {
      lc_candidates <- names(lc_counts)[which(lc_counts < 1)]
    }

    c(uc_candidates, lc_candidates)
  }

  f12a_traverse_caves(x, filter_candidates)
}


f12a_traverse_caves <- function(x, user_f_rule) {
  is_lower <- function(xs) xs == tolower(xs)

  walk_next_step <- function(history, paths = from_to, f_rule = user_f_rule) {
    # find valid next steps
    candidates <- paths[[utils::tail(history, 1)]]
    candidates <- f_rule(candidates, history)

    # dead-end or recursively walk down the candidates
    if (length(candidates) == 0) {
      history
    } else {
      candidates |>
        lapply(function(xs) c(history, xs)) |>
        lapply(walk_next_step, paths, f_rule)
    }
  }

  # walk_next_step() returns a deeply nested list so flatten it
  flatten_path_list <- function(l) {
    all_steps <- unlist(l, use.names = FALSE)
    starts <- which(all_steps == "start")
    starts |>
      f_map2(c(starts[-1] - 1, length(all_steps)), seq) |>
      lapply(function(xs) all_steps[xs])
  }

  # Make a dataframe of all valid paths
  edges <- x |> strsplit("-")
  edge_df <- c(edges, lapply(edges, rev)) |>
    lapply(function(x) data.frame(from = x[1], to = x[2])) |>
    f_reduce(rbind)

  edge_df <- edge_df[edge_df[["to"]] != "start", ]
  edge_df <- edge_df[edge_df[["from"]] != "end", ]

  # Convert the dataframe into a look-up vector
  from_to <- edge_df |>
    split(~from) |>
    lapply(function(xs) {
      stats::setNames(xs[["to"]], xs[["from"]])
    })

  walk_next_step("start", from_to, user_f_rule) |>
    flatten_path_list() |>
    f_filter(function(xs) utils::tail(xs, 1) == "end")
 }


#' @param example Which example data to use (by position or name). Defaults to
#'   1.
#' @rdname day12
#' @export
example_data_12 <- function(example = 1) {
  l <- list(
    a = c(
      "start-A",
      "start-b",
      "A-c",
      "A-b",
      "b-d",
      "A-end",
      "b-end"
    ),
    b = c(
      "dc-end",
      "HN-start",
      "start-kj",
      "dc-start",
      "dc-HN",
      "LN-dc",
      "HN-end",
      "kj-sa",
      "kj-HN",
      "kj-dc"
    ),
    c = c(
      "fs-end",
      "he-DX",
      "fs-he",
      "start-DX",
      "pj-DX",
      "end-zg",
      "zg-sl",
      "zg-pj",
      "pj-he",
      "RW-he",
      "fs-DX",
      "pj-RW",
      "zg-RW",
      "start-pj",
      "he-WI",
      "zg-he",
      "pj-fs",
      "start-RW"
    ),
    d = c(
      "start,A,b,A,b,A,c,A,end",
      "start,A,b,A,b,A,end",
      "start,A,b,A,b,end",
      "start,A,b,A,c,A,b,A,end",
      "start,A,b,A,c,A,b,end",
      "start,A,b,A,c,A,c,A,end",
      "start,A,b,A,c,A,end",
      "start,A,b,A,end",
      "start,A,b,d,b,A,c,A,end",
      "start,A,b,d,b,A,end",
      "start,A,b,d,b,end",
      "start,A,b,end",
      "start,A,c,A,b,A,b,A,end",
      "start,A,c,A,b,A,b,end",
      "start,A,c,A,b,A,c,A,end",
      "start,A,c,A,b,A,end",
      "start,A,c,A,b,d,b,A,end",
      "start,A,c,A,b,d,b,end",
      "start,A,c,A,b,end",
      "start,A,c,A,c,A,b,A,end",
      "start,A,c,A,c,A,b,end",
      "start,A,c,A,c,A,end",
      "start,A,c,A,end",
      "start,A,end",
      "start,b,A,b,A,c,A,end",
      "start,b,A,b,A,end",
      "start,b,A,b,end",
      "start,b,A,c,A,b,A,end",
      "start,b,A,c,A,b,end",
      "start,b,A,c,A,c,A,end",
      "start,b,A,c,A,end",
      "start,b,A,end",
      "start,b,d,b,A,c,A,end",
      "start,b,d,b,A,end",
      "start,b,d,b,end",
      "start,b,end"
    )
  )
  l[[example]]
}