aoc_day7_speed.R

library(dplyr)
library(tidyr)
library(purrr)
library(readr)
library(stringr)
library(microbenchmark)

# matrix/iterative ----

parse_keyval <- function( s, pat, keyname, valname ) {
  nms <- sub( pat, "\\1", s )
  vals <- sub( pat, "\\2", s )
  result <- data.frame( key = nms
                      , vals = vals
                      , stringsAsFactors = FALSE
                      )
  names( result ) <- c( keyname, valname )
  result
}

parse_bag_rules <- function( s ) {
  ruleno <- seq_along( s )
  some_bags_ix <- grepl( "\\D+ bags contain .*$", s )
  DF <- (   s[ some_bags_ix ]
        %>% parse_keyval( pat = "^(.*?) bags contain (.*)$"
                        , "containing_bag_color"
                        , "all_vals" )
        %>% rowwise()
        %>% mutate( data = (   all_vals
                           %>% strsplit( ", " )
                           %>% map( function( x )
                                 sub( " bags?.?$", "", x ) )
                           %>% map( parse_keyval
                                  , pat = "^(.*?) (.*)$"
                                  , keyname = "cbnum"
                                  , valname = "cbcolor"
                                  )
                           )
        )
        %>% ungroup()
        %>% select( -all_vals )
        %>% unnest( cols = "data" )
        )
  DF
}

make_bag_rules_matrix <- function( bag_rules_df ) {
  bag_rules_df <- subset( bag_rules_df, "no" != cbnum )
  bag_rules_df$cbnum <- as.integer( bag_rules_df$cbnum )
  colrs <- union( bag_rules_df$containing_bag_color
                , bag_rules_df$cbcolor
                )
  result <- matrix( 0
                  , ncol = length( colrs )
                  , nrow = length( colrs )
                  )
  rownames( result ) <- colnames( result ) <- colrs
  result[ matrix( with( bag_rules_df
                      , match( c( containing_bag_color
                                , cbcolor
                                )
                             , colrs
                             )
                      )
                , ncol = 2L
                )
        ] <- bag_rules_df$cbnum
  result
}

count_colors_containing <- function( bag_rules_mat, contained_color ) {
  brl <- 0 != bag_rules_mat
  v <- brl[ , match( contained_color, colnames( brl ) ) ]
  svlast <- 0
  while ( svlast < ( sv <- sum( v ) ) ) {
    svlast <- sv
    v <- as.logical( brl %*% v ) | v
  }
  sum( v )
}

count_required_bags <- function( bag_rules_mat, containing_color ) {
  v <- bag_rules_mat[ containing_color, ]
  accum <- 0
  while ( 0 < ( sv <- sum( v ) ) ) {
    accum <- accum + sv 
    v <- v %*% bag_rules_mat
  }
  accum
}

p7a_mat <- function( bag_rules_df, start_color ) {
  bag_rules_mat <- make_bag_rules_matrix( bag_rules_df )
  count_colors_containing( bag_rules_mat, start_color )
}

p7b_mat <- function( bag_rules_df, start_color ) {
  bag_rules_mat <- make_bag_rules_matrix( bag_rules_df )
  count_required_bags( bag_rules_mat, start_color )
}


# join ----

join_read_7a <- function( fname ) {
  input <- read_delim(fname, delim = "\n", col_names = "obs")
  
  b <- input %>%
    mutate(
      outer = str_extract(obs, "^(?:(?!\\sbag).)*"),
      inner = str_extract_all(obs, "\\d+\\s(?:(?!\\sbag).)*")
    ) %>%
    unnest(inner, keep_empty = TRUE) %>%
    mutate(
      num = as.numeric(str_extract(inner, "^\\d+\\s")),
      num = ifelse(is.na(num), 0, num), 
      inner = str_remove(inner, "^(\\d+?)(.*?)(?<=\\s)"),
      inner = ifelse(is.na(inner), "none", inner)
    )
}

x <- "shiny gold"
p7a_join <- function( b, x ) {
  s <- NULL
  while (length(x) != 0) {
    x <- b %>% filter(inner %in% x) %>% pull(outer)
    s <- unique(c(s, x))
  }

  length(s) #Part 1
}

p7b_join <- function(b, x) {
  j <- tibble(inner = x)
  t = 0
  while (nrow(j) != 0) {
    j <- j %>% left_join(b, by = c("inner" = "outer")) %>% uncount(num) %>% transmute(inner = inner.y)
    t <- t + nrow(j)
  }
  
  t #Part 2
}

dtadir <- "data"
start_colour <- "shiny gold"
s <- readLines( file.path( dtadir, "aoc2020_data_7a.txt" ), warn = FALSE )
bag_rules_df <- parse_bag_rules( s )
b <- join_read_7a( file.path( dtadir, "aoc2020_data_7a.txt" ) )

microbenchmark( ans_p7a_mat <- p7a_mat( bag_rules_df, start_colour )
              , ans_p7a_join <- p7a_join( b, start_colour )
              , times = 500L
              )

microbenchmark( ans_p7b_mat <- p7b_mat( bag_rules_df, start_colour )
              , ans_p7b_join <- p7b_join( b, start_colour )
              , times = 500L
              )

stopifnot( ans_p7a_mat == ans_p7a_join )
stopifnot( ans_p7b_mat == ans_p7b_join )