Advent of R

Advent of R

2021-12-28 · Esta página é feita de pedra

O Advent of Code é um Calendário do Advento desenvolvido por Eric Wastl composto por 25 pequenos exercícios de programação que vão sendo disponibilizados, um a um, entre 1º de dezembro e o Natal de cada ano.

Meu objetivo com o Advent of R foi resolver todos os problemas do Advent of Code 2021 em R e documentar o processo. Todo dia entre 01/12/2021 e 25/12/2021 eu vou resolvi o novo problema, documentei a minha solução e subi os meus scripts completos para um repositório público no GitHub.

Abaixo, cada seção representa um item de um dia do advent. Cada exercício foi individualmente resolvido no blog da Curso-R no dia correto, então todos começam com a minha opinião daquele exercício. Boas festas e bom código!

Varredura de Sonar (A) #

A parte 1 do primeiro exercício do AoC envolve ler uma lista de números e ver quantas vezes os valores aumentam em relação ao anterior. Em linguagem matemática, precisamos avaliar quantas vezes xi>xi1x_i > x_{i - 1}.

Por exemplo, suponha a seguinte lista:

 1# 199
 2# 200
 3# 208
 4# 210
 5# 200
 6# 207
 7# 240
 8# 269
 9# 260
10# 263

Nesse caso, precisamos comparar cada número com o da linha anterior e verificar se ele representa que a série aumentou, diminuiu ou manteve-se constante.

 1# 199 (NA)
 2# 200 (aumentou)
 3# 208 (aumentou)
 4# 210 (aumentou)
 5# 200 (diminuiu)
 6# 207 (aumentou)
 7# 240 (aumentou)
 8# 269 (aumentou)
 9# 260 (diminuiu)
10# 263 (aumentou)

Tendo isso, podemos concluir que houve 7 aumentos na série exemplo e essa seria a resposta do problema.

O meu código para resolver o exercício ficou bem enxuto. Bastou ler a lista de número do arquivo disponibilizado como uma tabela e comparar seus valores com o seu dplyr::lag(); depois disso um dplyr::summarise() contou o número de TRUEs ignorando NAs.

1"data-raw/01a_sonar_sweep.txt" |>
2  readr::read_table(col_names = "depth") |>
3  dplyr::mutate(
4    prev_depth = dplyr::lag(depth),
5    is_deeper = depth > prev_depth
6  ) |>
7  dplyr::summarise(n_deeper = sum(is_deeper, na.rm = TRUE)) |>
8  dplyr::pull(n_deeper)
9#> [1] 1228

Varredura de Sonar (B) #

A segunda parte, entretanto, aumenta (com o perdão do trocadilho) a dificuldade. Dessa vez precisamos somar uma janela de 3 valores e comparar com a próxima janela, ou seja, verificar quantas vezes k=ii+2xk>k=i1i+1xk\sum_{k = i}^{i+2} x_k > \sum_{k = i-1}^{i+1} x_k.

Observe como as janelas funcionam:

 1# 199  A
 2# 200  A B
 3# 208  A B C
 4# 210    B C D
 5# 200  E   C D
 6# 207  E F   D
 7# 240  E F G
 8# 269    F G H
 9# 260      G H
10# 263        H

Nesse exemplo precisaríamos somar os números da janela A (199, 200, 208) e testar se isso é maior que a soma dos números da janela B (200, 208, 210). Então compararíamos B com C, C com D e assim por diante.

1# A: 607 (NA)
2# B: 618 (aumentou)
3# C: 618 (não mudou)
4# D: 617 (diminuiu)
5# E: 647 (aumentou)
6# F: 716 (aumentou)
7# G: 769 (aumentou)
8# H: 792 (aumentou)

Alterando o código da primeira parte, eu criei as janelas usando dplyr::lead() e depois comparei as somas utilizando o mesmo dplyr::lag(). Mais uma vez o dplyr::summarise() contou o número de TRUEs ignorando NAs.

 1"data-raw/01b_sonar_sweep.txt" |>
 2  readr::read_table(col_names = "depth") |>
 3  dplyr::mutate(
 4    depth1 = dplyr::lead(depth, n = 1),
 5    depth2 = dplyr::lead(depth, n = 2),
 6    sum_depth = depth + depth1 + depth2,
 7    prev_sum_depth = dplyr::lag(sum_depth),
 8    is_deeper = sum_depth > prev_sum_depth
 9  ) |>
10  dplyr::summarise(n_deeper = sum(is_deeper, na.rm = TRUE)) |>
11  dplyr::pull(n_deeper)
12#> [1] 1257

Mergulhe (A) #

A parte 1 do segundo dia do AoC pede para lermos uma lista de comandos para um submarino e calcular a sua posição final. Os comandos possíveis são forward X (soma X à posição horizontal), up X (subtrai X da profundidade) e down X (soma X à profundidade), então precisamos fazer um dplyr::group_by(command == "forward") para que um grupo represente a posição horizontal e um represente a profundidade.

Para concluir o código, como a resposta final é a posição horizontal multiplicada pela profundidade, temos que fazer um prod() ao final:

1"data-raw/02a_dive.txt" |>
2  readr::read_delim(" ", col_names = c("command", "x")) |>
3  dplyr::mutate(x = ifelse(command == "up", -x, x)) |>
4  dplyr::group_by(command == "forward") |>
5  dplyr::summarise(x = sum(x)) |>
6  dplyr::summarise(x = prod(x)) |>
7  dplyr::pull(x)
8#> [1] 1727835

Mergulhe (B) #

A parte 2 complica um pouco a nossa vida. Os mesmos comandos agora possuem outro significado:

  • down X aumenta a mira em X unidades
  • up X diminui a mira em X unidades.
  • forward X faz duas coisas:
    • Aumenta a posição horizontal em X unidades.
    • Aumenta a profundidade em X vezes a mira atual.

O meu código da primeira parte não permitiria resolver isso de forma eficiente. Minha solução foi fazer uma cumsum() da posição horizontal e uma da mira, que são as partes mais simples. Depois eu calculei a profundidade com cumsum(aim * x) (dado que a mira tinha sido calculada no passo anterior).

A saída, mais uma vez é o produto entre a posição horizontal e a profundidade. Dessa vez a resposta vai estar na última linha da tabela, então o código precisa de um tail(1).

 1"data-raw/02a_dive.txt" |>
 2  readr::read_delim(" ", col_names = c("command", "x")) |>
 3  dplyr::mutate(
 4    horizontal = ifelse(command == "forward", x, 0),
 5    horizontal = cumsum(horizontal),
 6    aim = ifelse(command == "down", x, 0),
 7    aim = ifelse(command == "up", -x, aim),
 8    aim = cumsum(aim),
 9    depth = ifelse(command == "forward", aim * x, 0),
10    depth = cumsum(depth),
11    output = horizontal * depth
12  ) |>
13  utils::tail(1) |>
14  dplyr::pull(output)
15#> [1] 1544000595

Diagnóstico Binário (A) #

Na primeira parte do terceiro dia do AoC somos apresentados aos diagnósticos do submarino. Cada linha é composta por um número binário e precisamos carclular, a partir deles, os índices gama e épsilon.

 1# 00100
 2# 11110
 3# 10110
 4# 10111
 5# 10101
 6# 01111
 7# 00111
 8# 11100
 9# 10000
10# 11001
11# 00010
12# 01010

Cada bit do fator gama é igual ao valor mais comum do bit correspondente na entrada, enquanto o épsilon funciona ao contrário. No exemplo acima, o primeiro bit mais comum é 1 e o segundo é 0, então o índice gama começará com 10… e o índice épsilon começará com 01…

O meu código quebra os bits da entrada com tidyr::separate() e calcula o valor mais frequente com names(sort(-table(.x)))[1] (a moda estatística). É importante lembrar que épsilon é o oposto, então eu troquei todos os bits de gama com stringr::str_replace_all(). A resposta final é a multiplicação de gama por épsilon na base decimal.

 1"data-raw/03a_binary_diagnostic.txt" |>
 2  readr::read_table(col_names = "reading") |>
 3  tidyr::separate(reading, paste0("B", 0:12), "") |>
 4  dplyr::select(-B0) |>
 5  dplyr::summarise_all(~names(sort(-table(.x)))[1]) |>
 6  tidyr::unite("gamma", dplyr::everything(), sep = "") |>
 7  dplyr::mutate(
 8    epsilon = gamma |>
 9      stringr::str_replace_all("0", "!") |>
10      stringr::str_replace_all("1", "0") |>
11      stringr::str_replace_all("!", "1") |>
12      strtoi(base = 2),
13    gamma = strtoi(gamma, base = 2),
14    output = gamma * epsilon
15  ) |>
16  dplyr::pull(output)

Diagnóstico Binário (B) #

O segundo item desse dia foi o mais difícil de todos, ainda mais considerando que eu tento resolver tudo em apenas uma pipeline. Usando os mesmos dados, precisamos obter a taxa de O₂ e de CO₂ do submarino, sendo que as regras são as seguintes:

  1. Jogue fora os número que não atendem ao critério daquele gás.

  2. Se restar apenas 1 número, essa é a taxa daquele gás.

  3. Caso contrário, repita o processo com o próximo bit.

E quais são os critérios?

  • Para o oxigênio, determinamos o valor mais comum para o bit atual e jogamos fora todos os números que diferem, nessa posição, desse valor. Se 0 e 1 forem igualmente comuns, manter apenas os números com 1 no bit considerado.

  • Para gás carbônico, determinamos o valor menos comum para o bit atual e jogamos fora todos os números que diferem, nessa posição, desse valor. Se 0 e 1 forem igualmente comuns, manter apenas os números com 0 no bit considerado.

O primeiro passo da minha solução foi criar uma função que calcula a anti-moda de um vetor. Ela difere da função usada no item anterior somente pelo sinal de subtração, mas isso garante a ela uma propriedade importante: se 0 e 1 empatarem na contagem, ela retorna o valor que vem antes na ordem alfabética, ou seja, 0. Dessa forma a função antimode() realiza exatamente a operação que precisamos para determinar a taxa de gás carbônico.

1antimode <- function(x) names(sort(table(x)))[1]

A função abaixo é uma versão recursiva do cálculo das taxas dos gases. A coluna current é só um atalho para deixar o filtro mais enxuto, pois ela não passa da do bit atual. O op(), porém, é a chave que nos permite usar a mesma função para calcular O₂ e CO₂; por padrão a função filtra os valores iguais à anti-moda, mas, com co2 = FALSE, ela filtra os valores diferentes da anti-moda, atendendo ao critério do oxigênio (incluindo o desempate)!

A última linha chama a função de novo para o próximo bit, resolvendo o cálculo.

 1gas <- function(df, co2 = TRUE, bit = 1) {
 2
 3  # Condição de parada
 4  if (bit > 12 || nrow(df) == 1) return(df)
 5
 6  # Escolher o operador apropriado
 7  if (co2) op <- `==` else op <- `!=`
 8
 9  # Filtrar usando antimode() e fazer a recursão
10  df |>
11    dplyr::mutate(current = .data[[names(df)[bit]]]) |>
12    dplyr::filter(op(current, antimode(current))) |>
13    dplyr::select(-current) |>
14    find_rating(co2 = co2, bit = bit + 1)
15}

Só nos resta aplicar essa função na lista de números. Para tentar manter o fim do código em uma pipeline só (já que não foi possível com o resto), eu usei rep_len(list(df), 2) para duplicar a base e poder aplicar gas() e gas(co2 = FALSE) em uma linha só com purrr::map2_dfr(). O final do código deixa cada taxa em uma linha, junta os seu bits, as converte para decimal e multiplica seus valores. Essa é a saída.

 1"data-raw/03b_binary_diagnostic.txt" |>
 2  readr::read_table(col_names = "reading") |>
 3  tidyr::separate(reading, paste0("B", 0:12), "") |>
 4  dplyr::select(-B0) |>
 5  list() |>
 6  rep_len(2) |>
 7  purrr::map2_dfr(list(gas, \(df) gas(df, FALSE)), ~.y(.x)) |>
 8  tidyr::unite("reading", dplyr::everything(), sep = "") |>
 9  dplyr::mutate(reading = strtoi(reading, base = 2)) |>
10  dplyr::summarise(output = prod(reading)) |>
11  dplyr::pull(output)

Lula Gigante (A) #

O quarto dia do AoC foi talvez o mais interessante até agora. Na primeira parte, precisávamos calcular a pontuação da cartela vencedora de um bingo americano: cada cartela é composta por 5 linhas e 5 colunas de números que devem ser riscados conforme eles são anunciados pelo sistema do submarino. A primeira cartela a riscar todos os números de uma linha ou coluna é a vencedora e sua pontuação é a soma de todos os números não riscados multiplicada pelo último número anunciado.

A entrada era composta por uma linha com os números anunciados em sequência e, posteriormente, todas as cartelas da platéia:

 1# 7,4,9,5,11,17,23,2,0,14,21,24,10,16,13,6,15,25,12,22,18,20,8,19,3,26,1
 2#
 3# 22 13 17 11  0
 4#  8  2 23  4 24
 5# 21  9 14 16  7
 6#  6 10  3 18  5
 7#  1 12 20 15 19
 8#
 9#  3 15  0  2 22
10#  9 18 13 17  5
11# 19  8  7 25 23
12# 20 11 10 24  4
13# 14 21 16 12  6
14#
15# 14 21 17 24  4
16# 10 16 15  9 19
17# 18  8 23 26 20
18# 22 11 13  6  5
19#  2  0 12  3  7

Eu escolhi um caminho simples para resolver o problema, apesar de o código não ter ficado tão bom assim. Primeiro eu li a sequência de números e criei uma função que transpunha uma matrix numérica e a empilhava com a original.

 1# Processar os números sorteados
 2draws <- "data-raw/04a_giant_squid.txt" |>
 3  readr::read_lines(n_max = 1) |>
 4  stringr::str_split(",") |>
 5  purrr::pluck(1) |>
 6  as.numeric()
 7
 8# Converter as colunas de uma matrix para linhas e empilhar
 9cols_to_rows <- function(df) {
10  df |>
11    dplyr::select(-board, -id) |>
12    as.matrix() |>
13    t() |>
14    tibble::as_tibble(rownames = "id") |>
15    purrr::set_names("id", paste0("C", 1:5)) |>
16    dplyr::mutate(board = df$board) |>
17    dplyr::bind_rows(df) |>
18    dplyr::relocate(board, id) |>
19    purrr::set_names("id", "board", paste0("N", 1:5))
20}

O objetivo de cols_to_rows() era criar uma tabela final com todas as linhas das cartelas e também todas as suas colunas; isso permitiu que eu riscasse os números sorteados aplicando dplyr::na_if() indiscriminadamente. Quando alguma linha da tabela fosse formada somente por NAs (indicando que uma linha ou coluna de alguma cartela estava completa), bastava extrair a cartela original, somar os seus valores não-NA e multiplicar o resultado pelo número sorteado mais recente. A função utilizada para isso se chamava winning_score() e operava recursivamente para poupar tempo.

 1# Calcular a pontuação da cartela vencedora
 2winning_score <- function(df, draws) {
 3
 4  # Marcar o número sorteado com NA (nas linhas e colunas)
 5  df <- dplyr::mutate(df, dplyr::across(c(N1:N5), dplyr::na_if, draws[1]))
 6
 7  # Filtrar possíveis linhas/colunas completas
 8  win <- dplyr::filter(df, dplyr::if_all(c(N1:N5), is.na))
 9
10  # Se houver pelo menos uma linha/coluna completa...
11  if (nrow(win) > 0) {
12
13    # Extrair a cartela vencedora, somar os não-NA e multiplicar por draws[1]
14    output <- df |>
15      dplyr::filter(id == win$id, stringr::str_starts(board, "R")) |>
16      dplyr::select(-id, -board) |>
17      purrr::flatten_dbl() |>
18      sum(na.rm = TRUE) |>
19      magrittr::multiply_by(draws[1])
20
21    # Retornar a pontuação
22    return(output)
23  }
24
25  # Recursão para o próximo sorteio
26  winning_score(df, draws[-1])
27}
28
29# Ler cartelas, empilhas linhas com colunas e riscar usando NAs
30"data-raw/04a_giant_squid.txt" |>
31  readr::read_table(skip = 1, col_names = paste0("C", 1:5)) |>
32  dplyr::mutate(board = (dplyr::row_number() - 1) %/% 5) |>
33  dplyr::group_by(board) |>
34  dplyr::mutate(id = paste0("R", 1:5)) |>
35  dplyr::group_split() |>
36  purrr::map_dfr(cols_to_rows) |>
37  winning_score(draws)
38#> [1] 33348

Lula Gigante (B) #

O segundo item do problema pedia o contrário: calcular a pontuação da última cartela a ter uma linha ou coluna completa, ou seja, da cartela perdedora. Na minha solução todo o código permaneceu igual, salvo pela função winning_score(), que virou loosing_score(). A grande novidade é que, quando o programa encontrava uma cartela vencedora, ele verificava se aquela era a última. Se não fosse, ele removia aquela cartela da tabela e, se fosse, ele retornava a pontuação.

 1# Calcular a pontuação da cartela perdedora
 2loosing_score <- function(df, draws) {
 3
 4  # Marcar o número sorteado com NA (nas linhas e colunas)
 5  df <- dplyr::mutate(df, dplyr::across(c(N1:N5), dplyr::na_if, draws[1]))
 6
 7  # Filter possible complete rows or cols
 8  win <- dplyr::filter(df, dplyr::if_all(c(N1:N5), is.na))
 9
10  # Se houver pelo menos uma linha/coluna completa...
11  if (nrow(win) > 0) {
12
13    # Se restasse apenas uma cartela, calcular a sua pontuação
14    if (length(unique(df$id)) == 1) {
15
16      # Extrair a cartela perdedora, somar os não-NA e multiplicar por draws[1]
17      output <- df |>
18        dplyr::filter(stringr::str_starts(board, "R")) |>
19        dplyr::select(-id, -board) |>
20        purrr::flatten_dbl() |>
21        sum(na.rm = TRUE) |>
22        magrittr::multiply_by(draws[1])
23
24      # Retornar a pontuação
25      return(output)
26    }
27
28    # Jogar fora cartelas que já venceram
29    df <- dplyr::filter(df, !id %in% win$id)
30  }
31
32  # Recursão para o próximo sorteio
33  loosing_score(df, draws[-1])
34}

Aventura Hidrotermal (A) #

O quinto dia do AoC foi um pouco mais tranquilo do que o anterior porque eu tive ajuda da incrível Renata Hirota. Hoje tínhamos as coordenadas cartesianas do início e do fim de tubulações submarinas e o objetivo era descobrir quantos pontos do plano tinham mais de uma tubulação passando por eles. No primeiro item deveríamos considerar apenas as tubulações verticais e horizontais.

  • Uma entrada do tipo 1,1 -> 1,3 cobria os pontos 1,1, 1,2 e 1,3.

  • Uma entrada do tipo 9,7 -> 7,7 cobria os pontos 9,7, 8,7 e 7,7.

A minha ideia começava filtrando os pontos em que x1 == x2 ou y1 == y2 e expandindo as coordenadas para criar uma lista que contivesse todos os pontos pelos quais as tubulações passavam. Eu resolvi isso com o paste(x1:x2, y1:y2), pois a paste() repetiria a coordenada que não muda ao longo da coordenada que muda: paste(9:7, 7:7) := "9 7" "8 7" "7 7".

Depois disso bastava contar o números de ocorrências de cada ponto do plano, filtrar aqueles que ocorriam mais de 1 vez e contar quantos pontos restavam. Esta era a saída do problema.

 1"data-raw/05a_hydrothermal_venture.txt" |>
 2  readr::read_csv(col_names = c("x1", "y1x2", "y2")) |>
 3  tidyr::separate(sep = " -> ", col = "y1x2", into = c("y1", "x2")) |>
 4  dplyr::filter(x1 == x2 | y1 == y2) |>
 5  dplyr::mutate(
 6    dif_x = purrr::map2(x1, x2, seq),
 7    dif_y = purrr::map2(y1, y2, seq),
 8    coord = purrr::map2(dif_x, dif_y, paste)
 9  ) |>
10  tidyr::unnest(coord) |>
11  dplyr::count(coord) |>
12  dplyr::filter(n > 1) |>
13  nrow()
14#> [1] 7142

Aventura Hidrotermal (B) #

O segundo item parecia bastante mais complexo, pois agora deveríamos considerar todas as tubulações da entrada, removendo o dplyr::filter() do item anterior. Mas uma especificação do enunciado facilitou tudo: todas as linhas diagonais tinham inclinação de 45 graus.

  • Uma entrada do tipo 1,1 -> 3,3 cobria os pontos 1,1, 2,2 e 3,3.

  • Uma entrada do tipo 9,7 -> 7,9 cobria os pontos 9,7, 8,8 e 7,9.

Isso significa que a estratégia do paste() continuava funcionando! Note que paste(1:3, 1:3) := "1 1" "2 2" "3 3", então bastou tirar o dplyr::filter() que a solução estava pronta.

 1"data-raw/05b_hydrothermal_venture.txt" |>
 2  readr::read_csv(col_names = c("x1", "y1x2", "y2")) |>
 3  tidyr::separate(sep = " -> ", col = "y1x2", into = c("y1", "x2")) |>
 4  dplyr::mutate(
 5    dif_x = purrr::map2(x1, x2, seq),
 6    dif_y = purrr::map2(y1, y2, seq),
 7    coord = purrr::map2(dif_x, dif_y, paste)
 8  ) |>
 9  tidyr::unnest(coord) |>
10  dplyr::count(coord) |>
11  dplyr::filter(n > 1) |>
12  nrow()
13#> [1] 20012

Peixes-lanterna (A) #

O dia 6 do AoC me pegou um pouco de surpresa. O primeiro item foi tranquilo de fazer: a entrada era uma lista de números que representavam os “contadores biológicos” de um cardume de peixes-lanterna e precisávamos retornar o número de peixes depois de 80 dias.

Os peixes adultos demoram 7 dias (contador vai de 6 até 0) para gerar um novo peixe bebê e um peixe bebê demora 9 dias (contador vai de 8 até 0) para gerar seu primeiro filhote.

 1Estado inicial   : 3,4,3,1,2
 2Depois de  1 dia : 2,3,2,0,1
 3Depois de  2 dias: 1,2,1,6,0,8
 4Depois de  3 dias: 0,1,0,5,6,7,8
 5Depois de  4 dias: 6,0,6,4,5,6,7,8,8
 6Depois de  5 dias: 5,6,5,3,4,5,6,7,7,8
 7Depois de  6 dias: 4,5,4,2,3,4,5,6,6,7
 8Depois de  7 dias: 3,4,3,1,2,3,4,5,5,6
 9Depois de  8 dias: 2,3,2,0,1,2,3,4,4,5
10Depois de  9 dias: 1,2,1,6,0,1,2,3,3,4,8
11Depois de 10 dias: 0,1,0,5,6,0,1,2,2,3,7,8
12Depois de 11 dias: 6,0,6,4,5,6,0,1,1,2,6,7,8,8,8
13Depois de 12 dias: 5,6,5,3,4,5,6,0,0,1,5,6,7,7,7,8,8
14Depois de 13 dias: 4,5,4,2,3,4,5,6,6,0,4,5,6,6,6,7,7,8,8
15Depois de 14 dias: 3,4,3,1,2,3,4,5,5,6,3,4,5,5,5,6,6,7,7,8
16Depois de 15 dias: 2,3,2,0,1,2,3,4,4,5,2,3,4,4,4,5,5,6,6,7
17Depois de 16 dias: 1,2,1,6,0,1,2,3,3,4,1,2,3,3,3,4,4,5,5,6,8
18Depois de 17 dias: 0,1,0,5,6,0,1,2,2,3,0,1,2,2,2,3,3,4,4,5,7,8
19Depois de 18 dias: 6,0,6,4,5,6,0,1,1,2,6,0,1,1,1,2,2,3,3,4,6,7,8,8,8,8

O meu código até que ficou bem simples. Precisei apenas de uma função que, todo dia, subtraia 1 de todos os contadores, criava 1 peixe com contador 8 para cada peixe com contador -1 e, por fim, subia todos os peixes com contador -1 para 6.

 1# Rodar n cíclos de reprodução do peixe-lanterna
 2reproduce <- function(fish, n = 80) {
 3
 4  # Condição de parada
 5  if (n == 0) return(length(fish))
 6
 7  # Reduzir contadores biológicos
 8  fish <- fish - 1L
 9
10  # Criar novos peixes e reiniciar contadores
11  fish <- append(fish, rep_len(8L, length(fish[fish == -1L])))
12  fish[fish == -1L] <- 6L
13
14  # Recursão
15  reproduce(fish, n = n - 1)
16}
17
18# Ler uma lista de peixes e reproduzir por 80 dias
19"data-raw/06a_lanternfish.txt" |>
20  readr::read_lines() |>
21  stringr::str_split(",") |>
22  purrr::pluck(1) |>
23  as.integer() |>
24  reproduce()
25#> [1] 362666

Peixes-lanterna (B) #

O segundo item do exercício não mudava essencialmente nada em relação ao primeiro. Assumindo espaço e recursos infinitos, quantos peixes teríamos depois de 256 dias?

Para resolver esse item, em teoria, seria necessário trocar apenas o valor do n por 256. Mas não foi o que aconteceu… Por causa da ineficiência do algoritmo, obter uma resposta demoraria horas e acabaria com a memória do meu computador. Foi necessário pensar em um novo método de resolver o problema.

A solução abaixo foi inspirada pela função table(). Para reduzir a exigência de espaço e não precisar iterar ao longo de um vetor com todos os peixes, eu agrupei os peixes com o mesmo contador biológico em apenas uma linha de uma tabela! Assim o programa nunca precisava lidar com mais de 9 linhas por dia, resolvendo as complicações com espaço e tempo.

 1# Rodar n cíclos de reprodução do peixe-lanterna
 2reproduce <- function(fish, n = 80) {
 3
 4  # Condição de parada
 5  if (n == 0) return(sum(fish$n))
 6
 7  # Reduzir contadores biológicos
 8  fish <- dplyr::mutate(fish, timer = timer - 1L)
 9
10  # Criar novos peixes
11  babies <- fish |>
12    dplyr::filter(timer == -1L) |>
13    dplyr::mutate(timer = 8L)
14
15  # Reiniciar contadores e recursão
16  fish |>
17    dplyr::bind_rows(babies) |>
18    dplyr::mutate(timer = ifelse(timer == -1L, 6L, timer)) |>
19    dplyr::group_by(timer) |>
20    dplyr::summarise(n = sum(n)) |>
21    reproduce(n = n - 1)
22}
23
24# Ler uma lista de peixes e reproduzir por 256 dias
25"data-raw/06b_lanternfish.txt" |>
26  readr::read_lines() |>
27  stringr::str_split(",") |>
28  purrr::pluck(1) |>
29  as.integer() |>
30  tibble::as_tibble() |>
31  purrr::set_names("timer") |>
32  dplyr::count(timer) |>
33  reproduce(n = 256) |>
34  format(scientific = FALSE)
35#> [1] 1640526601595

A Traição das Baleias (A) #

O dia 7 do AoC foi o mais rápido até agora. A nossa tarefa era determinar a posição horizontal na qual um exército de caranguejos deveria se alinhar, com a restrição de que deveríamos encontrar a posição que exigisse menos combustível.

Cada caranguejo estava equipado de um mini-submarino que gastava 1 unidade de combustível por unidade de deslocamento, logo o total de combustível gasto pela tropa para ir até a posição x seria simplesmente sum(abs(positions - x)). A saída era o combustível gasto para levar todos os caranguejos até a posição mais econômica.

 1# Ler vetor de posições iniciais
 2positions <- "data-raw/07a_the_treachery_of_whales.txt" |>
 3  readr::read_lines() |>
 4  stringr::str_split(",") |>
 5  purrr::pluck(1) |>
 6  as.integer()
 7
 8# Iterar nas posições para encontrar a mais barata
 9cheapest <- Inf
10for (pos in max(positions):min(positions)) {
11
12  # Calcular o combustível gasto para a posição
13  fuel <- sum(abs(positions - pos))
14
15  # Trocar a resposta se essa posição for mais econômica
16  if (fuel < cheapest) cheapest <- fuel
17}
18
19# Imprimir
20cheapest
21#> [1] 328318

Note que não era necessário testar nenhuma posição fora do intervalo max(positions):min(positions)! Qualquer posição fora disso seria menos econômica do que a ponta mais próxima a ela dentro do intervalo.

A Traição das Baleias (B) #

O segundo item mantinha o mesmo problema, mas mudava o cálculo do gasto de combustível dos mini-submarinos: o primeiro movimento consumiria 1 unidade de combustível, o segundo consumiria 2 unidades, o terceiro consumiria 3 e assim por diante.

A única linha que muda dessa solução para a anterior é a que calcula o gasto de combustível para cada posição. Se um caranguejo estiver na posição a e quiser ir até a x, o seu consumo total será k=0axk\sum_{k = 0}^{|a - x|} k. Abaixo a operação sum(purrr::map_int(positions, ~sum(0:abs(.x - pos)))) faz isso para todos os caranguejos.

 1# Iterar nas posições para encontrar a mais barata
 2cheapest <- Inf
 3for (pos in max(positions):min(positions)) {
 4
 5  # Calcular o combustível gasto para a posição
 6  fuel <- sum(purrr::map_int(positions, ~sum(0:abs(.x - pos))))
 7
 8  # Trocar a resposta se essa posição for mais econômica
 9  if (fuel < cheapest) cheapest <- fuel
10}
11
12# Imprimir
13cheapest
14#> [1] 328318

Busca em Sete Segmentos (A) #

O oitavo dia do AoC foi bastante difícil para mim. O problema começou pelo enunciado, que é longo e complexo, então realmente recomendo ler a versão original além do resumo que trago abaixo.

Dito isso, vamos lá. O problema dizia respeito a displays de sete segmentos, onde cada número é representado por um conjunto de segmentos acessos; de acordo com o diagrama abaixo, vemos que 0 é representado por abcefg, 1 é cf e assim por diante.

 1#   0:      1:      2:      3:      4:
 2#  aaaa    ....    aaaa    aaaa    ....
 3# b    c  .    c  .    c  .    c  b    c
 4# b    c  .    c  .    c  .    c  b    c
 5#  ....    ....    dddd    dddd    dddd
 6# e    f  .    f  e    .  .    f  .    f
 7# e    f  .    f  e    .  .    f  .    f
 8#  gggg    ....    gggg    gggg    ....
 9
10#   5:      6:      7:      8:      9:
11#  aaaa    aaaa    aaaa    aaaa    aaaa
12# b    .  b    .  .    c  b    c  b    c
13# b    .  b    .  .    c  b    c  b    c
14#  dddd    dddd    ....    dddd    dddd
15# .    f  e    f  .    f  e    f  .    f
16# .    f  e    f  .    f  e    f  .    f
17#  gggg    gggg    ....    gggg    gggg

O desafio é que, no nosso submarino, todo os displays estão com os fios trocados e, para piorar, cada display tem um arranjo diferente. A entrada do problema é uma série de linhas como a abaixo: como os 10 dígitos são representados em um display específico (em qualquer ordem) e, depois da barra, 4 dígitos que precisamos decodificar.

1# acedgfb cdfbe gcdfa fbcad dab cefabd cdfgeb eafb cagedb ab |
2# cdfeb fcadb cdfeb cdbaf

Alguns dígitos são fáceis de identificar. Os números 1, 4, 7 e 8 usam números únicos de segmentos, então é possível perceber que, quando ab acenderam, o display estava tentando mostrar um 1. Seguindo a mesma lógica, dab é 7, eafb é 4 e acedgfb é 8.

O objetivo do primeiro item do dia 08 era contar quantas vezes os dígitos 1, 4, 7 e 8 aparecem nas saídas que devemos decodificar (lado direito da barra). A solução foi bem simples, pois bastou pivotar a tabela e filtrar as linhas que tinham stringr::str_length() igual a 2, 3, 4, ou 7.

 1"data-raw/08a_seven_segment_search.txt" |>
 2  readr::read_delim(" ", col_names = NULL) |>
 3  purrr::set_names(
 4    paste0("P", stringr::str_pad(1:10, 2, "left", "0")), "remove",
 5    paste0("V", stringr::str_pad(1:4, 2, "left", "0"))
 6  ) |>
 7  dplyr::select(-remove) |>
 8  dplyr::select(V01:V04) |>
 9  tidyr::pivot_longer(V01:V04, names_to = "col", values_to = "value") |>
10  dplyr::filter(stringr::str_length(value) %in% c(2, 4, 3, 7)) |>
11  nrow()
12#> [1] 365

Busca em Sete Segmentos (B) #

O verdadeiro problema veio no item 2. Aqui o exercício abandona qualquer pretexto de bondade e pede de uma vez para decodificarmos os dígitos depois da barra baseados nos 10 padrões antes da barra. A saída deveria ser a soma de todos os números de 4 dígitos decodificados.

Minha primeira tentativa de resolver o problema testava cada segmento em cada posição (essencialmente verificando todos os possíveis jeitos de embaralhar os fios) para ver em qual das configurações os padrões faziam sentido; depois seria só bater os padrões com os 4 dígitos da direita para ver quem é quem. Não preciso nem dizer que isso seria demorado demais para funcionar.

Depois de um tempo olhando para o arquivo de entrada, entretanto, me veio uma luz: talvez eu pudesse analisar a frequência com a qual cada segmento aparece nos padrões. Perceba, por exemplo, que no diagrama acima o segmento e está ligado em 4 dígitos (0, 2, 6 e 8). O fato importante é que ele é o único segmento com essa propriedade!

Partindo deste princípio, criei as seguinte regras para o código:

  1. O único segmento que aparecer 4 vezes nos padrões corresponderá ao e;

  2. O único segmento que aparecer 6 vezes nos padrões corresponderá ao b;

  3. O único segmento que aparecer 9 vezes nos padrões corresponderá ao f;

  4. No padrão com 2 segmentos acessos, aquele que não representar o e corresponderá ao c (número 1).

  5. No padrão com 3 segmentos acessos, aquele que não representar c ou f corresponderá ao a (número 7).

  6. No padrão com 4 segmentos acessos, aquele que não representar b, c ou f corresponderá ao d (número 4).

  7. O segmento que ainda não tiver correspondente corresponderá ao g.

O resto do código cuidava de organizar as letras de cada dígito de modo que fosse fácil transpor as correspondências dos 10 padrões para os 4 valores das saídas.

  1# Decodificar uma linha da entrada
  2decode <- function(entry) {
  3
  4  # Encontra e quebra o padrão que tenha certa str_length()
  5  find_by_len <- function(patterns, len) {
  6    patterns |>
  7      magrittr::extract(stringr::str_length(patterns) == len) |>
  8      stringr::str_split("") |>
  9      purrr::pluck(1)
 10  }
 11
 12  # Frequências de referência
 13  ref_freq <- list(
 14    "a" = 8,
 15    "b" = 6,
 16    "c" = 8,
 17    "d" = 7,
 18    "e" = 4,
 19    "f" = 9,
 20    "g" = 7
 21  )
 22
 23  # Valores de referência
 24  ref_val <- list(
 25    "abdefg" = 6,
 26    "abcefg" = 0,
 27    "cf" = 1,
 28    "acdfg" = 3,
 29    "abcdfg" = 9,
 30    "abcdefg" = 8,
 31    "bcdf" = 4,
 32    "acf" = 7,
 33    "abdfg" = 5,
 34    "acdeg" = 2
 35  )
 36
 37  # Calcular frequências desta entrada
 38  cur_freq <- entry |>
 39    dplyr::select(P01:P10) |>
 40    purrr::flatten_chr() |>
 41    stringr::str_split("") |>
 42    purrr::flatten_chr() |>
 43    table()
 44
 45  # Criar um dicionário para traduzir os segmentos
 46  dict <- list()
 47
 48  # Traduzir segmentos com frequências únicas
 49  dict[["e"]] <- names(cur_freq[cur_freq == 4])
 50  dict[["b"]] <- names(cur_freq[cur_freq == 6])
 51  dict[["f"]] <- names(cur_freq[cur_freq == 9])
 52
 53  # Extrair padrões da entrada
 54  patterns <- entry |>
 55    dplyr::select(P01:P10) |>
 56    purrr::flatten_chr()
 57
 58  # Determinar segmento que falta do 1
 59  one <- find_by_len(patterns, 2)
 60  dict[["c"]] <- one[!one %in% purrr::flatten_chr(dict)]
 61
 62  # Determinar segmento que falta do 7
 63  seven <- find_by_len(patterns, 3)
 64  dict[["a"]] <- seven[!seven %in% purrr::flatten_chr(dict)]
 65
 66  # Determinar segmento que falta do 4
 67  four <- find_by_len(patterns, 4)
 68  dict[["d"]] <- four[!four %in% purrr::flatten_chr(dict)]
 69
 70  # Determinar último segmento que falta
 71  dict[["g"]] <- names(cur_freq)[!names(cur_freq) %in% purrr::flatten_chr(dict)]
 72
 73  # Traduzir segmentos dos valores de saída
 74  entry |>
 75    dplyr::select(V01:V04) |>
 76    purrr::flatten_chr() |>
 77    stringr::str_split("") |>
 78    purrr::map(~names(dict)[match(.x, dict)]) |>
 79    purrr::map(sort) |>
 80    purrr::map(stringr::str_c, collapse = "") |>
 81    purrr::map(~purrr::flatten_chr(ref_val)[match(.x, names(ref_val))]) |>
 82    purrr::flatten_chr() |>
 83    as.integer() |>
 84    stringr::str_c(collapse = "") |>
 85    as.numeric()
 86}
 87
 88# Ler entrada, mapear decode() e somar todas os valores de saída
 89"data-raw/08b_seven_segment_search.txt" |>
 90  readr::read_delim(" ", col_names = NULL) |>
 91  purrr::set_names(
 92    paste0("P", stringr::str_pad(1:10, 2, "left", "0")), "remove",
 93    paste0("V", stringr::str_pad(1:4, 2, "left", "0"))
 94  ) |>
 95  dplyr::select(-remove) |>
 96  tibble::rowid_to_column("id") |>
 97  tidyr::nest(entry = c(P01:V04)) |>
 98  dplyr::mutate(output = purrr::map_dbl(entry, decode)) |>
 99  dplyr::summarise(output = sum(output)) |>
100  dplyr::pull(output)
101#> [1] 975706

Bacia de Fumaça (A) #

O dia 9 do AoC foi desafiador, apesar de não tanto quanto o anterior. Como sempre o problema envolvia uma historinha que não contribui muito para o entendimento do enunciado, então vamos direto ao ponto: recebemos uma matriz 100x100 que representa um mapa de alturas e precisávamos encontrar todos os pontos que eram cercados (em cima, embaixo, na esquerda e na direita) por pontos mais altos. Ademais sabíamos que as alturas iam de 0 a 9 e que as fronteiras fora do mapa podiam ser todas consideradas mais altas que o resto do mapa. A resposta do problema seria o risco total de todos os pontos baixos, onde o risco de um ponto é igual à sua altura + 1.

O problema não é tão complicado, pois bastaria iterar em todos os pontos da matriz e comparar cada um com seus vizinhos. O maior dezafio era lidar com as fronteiras do mapa. Para isso, resolvi cercar toda a matriz por noves e iterar no quadrado 2:101x2:101.

 1# Ler o mapa de alturas e estofar as fronteiras com 9
 2height <- "data-raw/09a_smoke_basin.txt" |>
 3  readr::read_lines() |>
 4  stringr::str_split("") |>
 5  purrr::flatten_chr() |>
 6  as.integer() |>
 7  matrix(nrow = 100, ncol = 100, byrow = TRUE) |>
 8  rbind(rep(9, 100)) |>
 9  {\(m) rbind(rep(9, 100), m)}() |>
10  cbind(rep(9, 102)) |>
11  {\(m) cbind(rep(9, 102), m)}()
12
13# Iterar por todos os pontos
14risk <- 0
15for (i in 2:101) {
16  for (j in 2:101) {
17
18    # Verificar se é um ponto baixo e somar o risco ao total
19    if (
20      height[i, j] < height[i - 1, j] &&
21      height[i, j] < height[i + 1, j] &&
22      height[i, j] < height[i, j - 1] &&
23      height[i, j] < height[i, j + 1]
24    ) {
25      risk <- risk + height[i, j] + 1
26    }
27  }
28}
29
30# Imprimir
31risk
32#> [1] 494

Bacia de Fumaça (B) #

O segundo item já era mais complicado. Considerando que os pontos com altura 9 não pertencem a nenhuma bacia, precisávamos encontrar as 3 maiores bacias no nosso mapa. Uma bacia é definida por toda uma região cercada por noves e seu tamanho é igual ao número de pontos contíguos contidos nessa área.

O diagrama abaixo não estava no enunciado, mas ele me ajudou muito a entender o que era uma bacia. Para criá-lo, eu peguei um retângulo na ponta do meu mapa e substituí todos os números menores que 9 por um ., representando assim as bacias. Cada região cercada por noves é uma bacia diferente.

 1# ....999.........9.9....99......9....9..........9
 2# ...9.9.9.......9...9..9.......9.9...99.99.9.....
 3# ..9.....9.9.....9...99...........999.999.9.9....
 4# ..9......9.9...9....999.........9..9..9.....999.
 5# 99..........999......9999......9..9..9.....9...9
 6# ...........9..9........99...9.9.......9.........
 7# 9..............9...9..9..9.99.9......9..........
 8# ...........99.9...9.99....9..99.....9...........
 9# ............99....9..9.......9.......9..........
10# 9........99999...9....9.9....9.......999........

Minha solução começou igual à do item anterior, mas desta vez criei também uma tabela com todos os pontos do mapa. Meu objetivo era fazer uma busca em largura e remover desta tabela os pontos já explorados.

1# Criar uma tabela de pontos a explorar
2points <- purrr::cross2(2:101, 2:101) |>
3  purrr::map(purrr::flatten_int) |>
4  purrr::transpose() |>
5  purrr::set_names("i", "j") |>
6  tibble::as_tibble() |>
7  tidyr::unnest(c(i, j))

A seguir eu criei uma função que explorava uma bacia a partir de um ponto “semente”. O primeiro passo era verificar se o ponto já tinha sido explorado e retornar 0 se sim (indicando que aquele ponto não contribuiria mais para o tamanho da bacia). Se o ponto não tivesse sido explorado, então o código o removia da tabela de pontos e verificava se ele tinha altura 9, mais uma vez retornando 0 se sim. O final da função aplicava uma recursão nos 4 vizinhos do ponto, somando os tamanhos das 4 sub-bacias encontradas mais 1 (indicando que o ponto “semente” contribuia em 1 para o tamanho total da bacia).

 1# Explorar uma bacia
 2explore <- function(a, b) {
 3
 4  # Pular se o ponto já tiver sido explorado
 5  if (nrow(dplyr::filter(points, i == a, j == b)) == 0) return(0)
 6
 7  # Marcar o ponto como explorado
 8  points <<- dplyr::filter(points, i != a | j != b)
 9
10  # Se a altura for 9, então ele não faz parte da bacia
11  if (height[a, b] == 9) return(0)
12
13  # Adicionar os pontos vizinhos à bacia
14  return(
15    explore(a - 1, b) +
16    explore(a + 1, b) +
17    explore(a, b - 1) +
18    explore(a, b + 1) + 1
19  )
20}

A resposta para o item era o produto dos tamanhos das 3 maiores bacias do mapa, então o programa terminava iterando na matriz, calculando o tamanho de todas as bacias e seguindo para obter o resultado final.

 1# Iterar por todos os pontos
 2basins <- matrix(rep(0, 10404), 102, 102)
 3for (i in 2:101) {
 4  for (j in 2:101) {
 5    basins[i, j] <- explore(i, j)
 6  }
 7}
 8
 9# Multiplicar as 3 maiores bacias
10basins |>
11  sort(decreasing = TRUE) |>
12  magrittr::extract(1:3) |>
13  prod()
14#> [1] 1048128

Pontuação de Sintaxe (A) #

O dia 10 do AoC pedia para que resolvessemos um clássico problema de parentização com alguns facilitadores. Em resumo, recebíamos uma string composta por parênteses e seus amigos ("(", “[”, “{”, “<”, “>”, “}”, “]”, “)") e precisávamos identificar se o fechamento de algum deles estava errado, por exemplo, “[}”, “{()()()>”, etc. Para cada string que tivesse um fechamento ilegal recebia uma quantidade de pontos de acordo com a tabela abaixo e, finalmente, a saída do exercício era a soma de todas as pontuações.

1# ): 3 pontos.
2# ]: 57 pontos.
3# }: 1197 pontos.
4# >: 25137 pontos.

Para quem nunca viu um problema desse tipo, a solução pode ser alcançada facilmente usando uma pilha. Cada caractere que abre um bloco é colocado na pilha e, para cada caractere que fecha um bloco, removemos o elemento do topo da pilha. Se os caracteres se complementam corretamente o algoritmo segue em frente, caso contrário ele busca a pontuação na tabela e retorna.

 1# Correspondência de valores
 2scores <- list(
 3  ")" = 3,
 4  "]" = 57,
 5  "}" = 1197,
 6  ">" = 25137
 7)
 8
 9# Calcular a pontuação por caractere ilegal em uma linha
10score_ilegal <- function(line) {
11  stack <- flifo::lifo()
12
13  # Iterar na linha até um elemento não corresponder
14  symbols <- stringr::str_split(line, "")[[1]]
15  for (symbol in symbols) {
16
17    # Empilhar ou desempilhar (e calcular pontuação se necessário)
18    if (symbol %in% c("(", "[", "{", "<")) {
19      flifo::push(stack, symbol)
20    } else {
21      check <- flifo::pop(stack)
22      if (
23        (check == "{" && symbol != "}") ||
24        (check == "(" && symbol != ")") ||
25        (check == "[" && symbol != "]") ||
26        (check == "<" && symbol != ">")
27      ) {
28        return(scores[names(scores) == symbol][[1]])
29      }
30    }
31  }
32
33  return(0)
34}
35
36# Iterar nas linhas e calcular pontuações
37"data-raw/10a_syntax_scoring.txt" |>
38  readr::read_lines() |>
39  purrr::map_dbl(score_ilegal) |>
40  sum()
41#> [1] 216297

Pontuação de Sintaxe (B) #

O segundo item do problema pedia para que começássemos removendo as linhas que tinham pontuação maior que 0 (então só foi necessário filtrar isso no código, que vou omitir). Depois disso o objetivo era completar as linhas que restavam.

O fato é que as linhas restantes estavam todas com um pedaço faltando, por exemplo, “[({(<(())[]>[[{[]{<()<»” precisa ainda de “}}]])})]” para ficar correta. Usando a lógica do item anterior, só precisávamos seguir o mesmo roteiro e, ao final da linha, contar os pontos dos caracteres que ainda haviam sobrado na pilha.

Desta vez a regra de pontuação era diferente: para cada caractere faltante, precisávamos multiplicar a pontuação corrente por 5 e então somar o valor do caractere de acordo com uma nova tabelha. A resposta final era a mediana da pontuação de todoas as linhas. Enfim, o código vai a seguir:

 1# Ler linhas e remover corrompidas
 2lines <- readr::read_lines("data-raw/10b_syntax_scoring.txt")
 3lines <- lines[purrr::map_dbl(lines, score_ilegal) == 0]
 4
 5# Correspondência de valores
 6scores <- list(
 7  "(" = 1,
 8  "[" = 2,
 9  "{" = 3,
10  "<" = 4
11)
12
13# Calcular a pontuação por caractere faltante em uma linha
14score_complete <- function(line) {
15  stack <- flifo::lifo()
16
17  # Iterar na linha e remover parte completa
18  symbols <- stringr::str_split(line, "")[[1]]
19  for (symbol in symbols) {
20
21    # Empilhar ou desempilhar
22    if (symbol %in% c("(", "[", "{", "<")) {
23      flifo::push(stack, symbol)
24    } else {
25      flifo::pop(stack)
26    }
27  }
28
29  # Iterar no resto da pilha e calcular pontos
30  score <- 0
31  while (flifo::size(stack) > 0) {
32    check <- flifo::pop(stack)
33    score <- (score * 5) + scores[names(scores) == check][[1]]
34  }
35
36  return(score)
37}
38
39# Pegar mediana das pontuações
40lines |>
41  purrr::map_dbl(score_complete) |>
42  median()
43#> [1] 2165057169

Polvo-dumbo (A) #

O dia 11 do AoC foi bastante complicado e o meu código talvez tenha ficado pior ainda. As instruções eram até simples: recebemos uma matriz 10x10 com os níveis de energia de 100 polvos-dumbo e precisávamos acompanhar seus níveis de energia ao longo de 100 iterações. As regras eram as seguintes:

  • Primeiro, o nível de energia de cada polvo sobe em 1.

  • Depois, qualquer polvo com nível de energia maior que 9 emite luz (pisca). Isso aumenta o nível de energia de todos os polvos adjacentes em 1, incluindo os adjacentes diagonalmente. Se isso causar um polvo a atingir um nível de energia maior que 9, ele também pisca. Esse processo continua conforme mais polvos passam do nível de energia 9. Um polvo só pode piscar uma vez por passo e não pode subir mais nenhum nível de energia a partir daí.

  • Finalmente, todos os polvos que piscaram durante este passo têm seus níveis de energia ajustados para 0 (já que ele usou toda a sua energia para piscar).

Meu código seguia esse procedimento à risca e precisou de 3 loops aninhados para funcionar. O truque mais importante foi criar um clone dos polvos que marcava todos os polvos que já tinham piscado para garantir que nenhum deles ganharia mais energia durante aquele passo; este mecanismo envolvia marcar um polvo que piscava com 0 e um polvo que tinha piscado em qualquer ponto anterior do loop com -1 (para que ele não fosse contado duas vezes). O resultado final deveria ser o número de piscadas totais depois dos 100 passos.

 1# Ler matriz
 2dumbo <- "data-raw/11a_dumbo_octopus.txt" |>
 3  readr::read_table(col_names = FALSE) |>
 4  tidyr::separate(X1, paste0("C", 0:10), "") |>
 5  dplyr::select(-C0) |>
 6  dplyr::mutate_all(as.numeric) |>
 7  as.matrix()
 8
 9# Iterar nos 100 passos
10flashes <- 0
11for (k in 1:100) {
12
13  # Aumentar níveis de energia
14  dumbo <- (dumbo + 1) %% 10
15
16  # Adicionar energia aos polvos cujos vizinhos piscaram
17  flag <- FALSE
18  while(!flag) {
19
20    # Contar piscadas
21    flashes <- flashes + sum(dumbo == 0)
22
23    # Adicionar energia aos polvos adjacentes a piscadas
24    dumbo_ <- dumbo
25    for (i in 1:10) {
26      for (j in 1:10) {
27
28        # Índices dos vizinhos
29        i1 <- i - 1
30        i2 <- min(i + 1, 10)
31        j1 <- j - 1
32        j2 <- min(j + 1, 10)
33
34        # Adicionar energia nos índices (exceto no centro)
35        if (dumbo[i, j] == 0) {
36          dumbo_[i1:i2, j1:j2] <- dumbo_[i1:i2, j1:j2] + 1
37          dumbo_[i, j] <- dumbo_[i, j] - 1
38        }
39      }
40    }
41
42    # Separar piscadas anteriores dos que piscaram na última iteração
43    dumbo <- ifelse(dumbo == -1, 0, dumbo)
44
45    # Sobrescrever as piscadas com 0 (eles não podem receber mais energia)
46    dumbo <- ifelse(dumbo == 0, 0, dumbo_)
47
48    # Verificar se o passo atual acabou
49    if (!any(dumbo > 9)) {
50      flag <- TRUE
51    } else {
52
53      # Prevenir piscadas antigas de serem contadas de novo
54      dumbo <- ifelse(dumbo == 0, -1, dumbo)
55      dumbo <- ifelse(dumbo > 9, 0, dumbo)
56    }
57  }
58}
59
60# Imprimir
61flashes
62#> [1] 1681

Polvo-dumbo (B) #

Felizmente o segundo item o exercício de hoje foi bem mais simples. Eventualmente todos os polvos entram em sincronia, ou seja, passam a piscar todos juntos; o nosso objetivo era descobrir em que passo isso acontecia. A única coisa que precisei fazer com o código do item anterior foi ignorar o limite de passos e criar uma verificação para quando todos os polvos atingiam 0 de energia juntos.

 1# Ler matriz
 2dumbo <- "data-raw/11b_dumbo_octopus.txt" |>
 3  readr::read_table(col_names = FALSE) |>
 4  tidyr::separate(X1, paste0("C", 0:10), "") |>
 5  dplyr::select(-C0) |>
 6  dplyr::mutate_all(as.numeric) |>
 7  as.matrix()
 8
 9# Iterar em 1000 passos
10for (k in 1:1000) {
11  print(k)
12
13  # Aumentar níveis de energia
14  dumbo <- (dumbo + 1) %% 10
15
16  # Adicionar energia aos polvos cujos vizinhos piscaram
17  flag <- FALSE
18  while(!flag) {
19
20    # Adicionar energia aos polvos adjacentes a piscadas
21    dumbo_ <- dumbo
22    for (i in 1:10) {
23      for (j in 1:10) {
24
25        # Índices dos vizinhos
26        i1 <- i - 1
27        i2 <- min(i + 1, 10)
28        j1 <- j - 1
29        j2 <- min(j + 1, 10)
30
31        # Adicionar energia nos índices (exceto no centro)
32        if (dumbo[i, j] == 0) {
33          dumbo_[i1:i2, j1:j2] <- dumbo_[i1:i2, j1:j2] + 1
34          dumbo_[i, j] <- dumbo_[i, j] - 1
35        }
36      }
37    }
38
39    # Separar piscadas anteriores dos que piscaram na última iteração
40    dumbo <- ifelse(dumbo == -1, 0, dumbo)
41
42    # Sobrescrever as piscadas com 0 (eles não podem receber mais energia)
43    dumbo <- ifelse(dumbo == 0, 0, dumbo_)
44
45    # Verificar se o passo atual acabou
46    if (!any(dumbo > 9)) {
47      flag <- TRUE
48    } else {
49
50      # Prevenir piscadas antigas de serem contadas de novo
51      dumbo <- ifelse(dumbo == 0, -1, dumbo)
52      dumbo <- ifelse(dumbo > 9, 0, dumbo)
53    }
54  }
55
56  # Parar se todos os polvos tiverem piscado
57  if (all(dumbo %in% c(0, -1))) {
58    break()
59  }
60}
61
62# Imprimir
63k
64#> [1] 276

Busca de Caminho (A) #

O dia 12, juntamente com os anteriores, começou a me deixar preocupado com os próximos exercícios do Advent of Code. Aparentemente a dificuldade vai aumentando conforme o passar dos dias, mas já estou chegando no limite do meu conhecimento.

Mais uma vez temos um enunciado complicado, então leia a versão original se ficar difícil de entender aqui. Nosso objetivo esta vez era contar o número de caminhos que o nosso submarino podia tomar em um sistema de cavernas.

A entrada era uma lista de arestas nomeadas em um grafo. Os nossos caminhos deveriam sempre começar na caverna chamada “start” e terminar na chamada “end”, sendo que todas as outras eram divididas em dois grupos: grandes e pequenas. Uma caverna grande era demarcada por uma letra maiúscula e podia ser utilizada pelo nosso caminho qualquer número de vezes. Já uma caverna pequena (demarcada por uma letra minúscula), só podia ser utilizada uma vez no caminho.

Veja o exemplo abaixo. A primeira parte seria a entrada do problema, a segunda, o diagrama das cavernas e a terceira, os 10 possíveis caminhos para o nosso submarino.

 1# start-A
 2# start-b
 3# A-c
 4# A-b
 5# b-d
 6# A-end
 7# b-end
 8
 9#     start
10#     /   \
11# c--A-----b--d
12#     \   /
13#      end
14
15# start,A,b,A,c,A,end
16# start,A,b,A,end
17# start,A,b,end
18# start,A,c,A,b,A,end
19# start,A,c,A,b,end
20# start,A,c,A,end
21# start,A,end
22# start,b,A,c,A,end
23# start,b,A,end
24# start,b,end

Minha solução envolvia uma tabela que representava todas as arestas do grafo do sistema de cavernas. A cada nova recursão, a última caverna poderia ser mantida na tabela ou removida (no caso das cavernas pequenas); toda vez que um caminho chegasse ao “end”, um contador global era incrementado.

 1# Contar caminhos distintos em um grafo
 2count <- 0
 3count_paths <- function(graph, path = "start") {
 4
 5  # Verificar se o nó atual é "pequeno"
 6  cave <- tail(path, 1)
 7  is_small <- stringr::str_to_lower(cave) == cave
 8
 9  # Condições de parada
10  if (cave == "end") {count <<- count + 1; return(1)}
11  if (!any(graph$orig == cave)) return(0)
12
13  # Encontrar próximo nó do caminho
14  searches <- graph |>
15    dplyr::filter(orig == cave) |>
16    dplyr::pull(dest) |>
17    purrr::map(purrr::prepend, path)
18
19  # Atualizar nós disponíveis
20  graph <- if (is_small) dplyr::filter(graph, orig != cave) else graph
21
22  # Iterar nos possíveis caminhos
23  for (search in searches) {
24    count_paths(graph, search)
25  }
26
27  # Retornar contador global
28  return(count)
29}
30
31# Ler arestas do grafo e retornar conta dos caminhos
32"data-raw/12a_passage_pathing.txt" |>
33  readr::read_table(col_names = "path") |>
34  tidyr::separate(path, c("orig", "dest"), "-") |>
35  {\(d) dplyr::bind_rows(d, purrr::set_names(d, rev(names(d))))}() |>
36  dplyr::filter(dest != "start", orig != "end") |>
37  count_paths()
38#> [1] 4792

Busca de Caminho (B) #

O segundo item do problema mudava muito pouco o enunciado. Agora, ao invés de cada caverna pequena poder ser visitada apenas 1 vez, tínhamos um pequeno acréscimo de tempo. Isso queria dizer que, em cada caminho até o final do sistema de cavernas, podíamos visitar apenas 1 das cavernas pequenas até 2 vezes.

Minha solução foi criar um argumento chamado boost que indicava se já tínhamos usado o nosso excedente de tempo naquele caminho expecífico. Se não tivéssemos, poderíamos não retirar uma das cavernas pequenas da lista imediatamente. Esta estratégia funcionou, mas gerou caminhos repetidos (usando e não usando o boost), então, ao invés de contar os caminhos, passei a salvar os caminhos e contar o número de caminhos distintos no final.

 1# Pegar todos os caminhos distintos em um grafo
 2all_paths <- list()
 3get_paths <- function(graph, path = "start", boost = FALSE) {
 4
 5  # Verificar se o nó atual é "pequeno"
 6  cave <- tail(path, 1)
 7  is_small <- stringr::str_to_lower(cave) == cave
 8
 9  # Condições de parada
10  if (cave == "end") {all_paths <<- append(all_paths, list(path)); return(1)}
11  if (!any(graph$orig == cave)) return(0)
12
13  # Encontrar próximo nó do caminho
14  searches <- graph |>
15    dplyr::filter(orig == cave) |>
16    dplyr::pull(dest) |>
17    purrr::map(purrr::prepend, path)
18
19  # Atualizar nós disponíveis
20  graph_ <- if (is_small) dplyr::filter(graph, orig != cave) else graph
21
22  # Iterar nos possíveis caminhos
23  for (search in searches) {
24    get_paths(graph_, search, boost = boost)
25
26    # Uma opção é não remover o nó do grafo e usar o boost
27    if (!boost && is_small && cave != "start") {
28      get_paths(graph, search, boost = TRUE)
29    }
30  }
31
32  # Retornar lista global
33  return(all_paths)
34}
35
36# Ler arestas do grafo e retornar conta dos caminhos distintos
37"data-raw/12b_passage_pathing.txt" |>
38  readr::read_table(col_names = "path") |>
39  tidyr::separate(path, c("orig", "dest"), "-") |>
40  {\(d) dplyr::bind_rows(d, purrr::set_names(d, rev(names(d))))}() |>
41  dplyr::filter(dest != "start", orig != "end") |>
42  get_paths() |>
43  purrr::map_chr(stringr::str_c, collapse = "|") |>
44  unique() |>
45  length()
46#> [1] 133360

Origami Transparente (A) #

O dia 13 foi um belo alívio comparado com o dia anterior. Nossa missão hoje era descobrir o código de um sensor a partir de um código escrito em papel transparente. A entrada era uma série de coordenadas de pontos no papel e uma sequência de instruções de como dobrar o papel para obter o código final.

Partindo do princípio de que a matriz começava no ponto (0, 0) na esqueda superior, o primeiro item pedia para que lêssemos a nossa lista de coordenadas e contasse o número de pontos (#) visíveis depois de realizar a primeira instrução que nos era dada. Para ilustrar como as dobras ocorriam, veja os resultados de uma dobra em y = 7 e, depois, de uma dobra em x = 5:

 1# Papel inicial
 2# ...#..#..#.
 3# ....#......
 4# ...........
 5# #..........
 6# ...#....#.#
 7# ...........
 8# ...........
 9# ...........
10# ...........
11# ...........
12# .#....#.##.
13# ....#......
14# ......#...#
15# #..........
16# #.#........
17
18# Linha em y = 7
19# ...#..#..#.
20# ....#......
21# ...........
22# #..........
23# ...#....#.#
24# ...........
25# ...........
26# -----------
27# ...........
28# ...........
29# .#....#.##.
30# ....#......
31# ......#...#
32# #..........
33# #.#........
34
35# Resultado da primeira dobra
36# #.##..#..#.
37# #...#......
38# ......#...#
39# #...#......
40# .#.#..#.###
41# ...........
42# ...........
43
44# Linha em x = 5
45# #.##.|#..#.
46# #...#|.....
47# .....|#...#
48# #...#|.....
49# .#.#.|#.###
50# .....|.....
51# .....|.....
52
53# Resultado final
54# #####
55# #...#
56# #...#
57# #...#
58# #####
59# .....
60# .....

O maior desafio no código em R foi arrumar todas as coordenadas e sub-matrizes para um sistema que começa em 1 e não em 0. Eu também resolvi fazer uma aposta: o primeiro item pedia para fazer apenas a primeira dobra, então eu imaginei que o segundo item pediria para fazer todas. Minha decisão, portanto, foi tentar já generalizar meu algortimo para que ele funcionasse com o mínimo de alterações possíveis para realizar várias dobras.

 1# Ler tabela de onde os pontos estão
 2dots <- "data-raw/13a_transparent_origami.txt" |>
 3  readr::read_lines() |>
 4  stringr::str_subset("^[0-9]") |>
 5  tibble::tibble() |>
 6  purrr::set_names("dot") |>
 7  tidyr::separate(dot, c("x", "y"), ",") |>
 8  dplyr::mutate_all(as.integer) |>
 9  dplyr::mutate_all(`+`, 1L)
10
11# Ler instruções das dobras
12instructions <- "data-raw/13a_transparent_origami.txt" |>
13  readr::read_lines() |>
14  stringr::str_subset("^[^0-9]") |>
15  tibble::tibble() |>
16  purrr::set_names("fold") |>
17  tidyr::separate(fold, c("axis", "line"), "=") |>
18  dplyr::mutate(
19    axis = stringr::str_sub(axis, -1),
20    line = as.integer(line) + 1L
21  )
22
23# Colocar os pontos no papel
24paper <- matrix(FALSE, nrow = max(dots$y), ncol = max(dots$x))
25for (i in seq_len(nrow(dots))) {
26  paper[dots$y[i], dots$x[i]] <- TRUE
27}
28
29# Rodar apenas a primeira instrução
30for (i in 1) {
31
32  # Achar o eixo e o ponto da dobra
33  axis <- instructions$axis[i]
34  line <- instructions$line[i]
35
36  # Dobras de acordo com o eixo
37  if (axis == "x") {
38
39    # Número de colunas à direita da dobra
40    size <- length((line + 1):dim(paper)[2])
41
42    # Pegar colunas à direita, invertê-las e fazer um OR com o lado esquerdo
43    paper[, (line - size):(line - 1)] <-
44      paper[, (line + 1):(line + size)][, size:1] |
45      paper[, (line - size):(line - 1)]
46
47    # Descartar colunas representando o papel dobrado
48    paper <- paper[, 1:(line - 1)]
49
50  } else {
51
52    # Número de linhas abaixo da dobra
53    size <- length((line + 1):dim(paper)[1])
54
55    # Pegar linhas abaixo da dobra, invertê-las e fazer um AND com as acima
56    paper[(line - size):(line - 1), ] <-
57      paper[(line + 1):(line + size), ][size:1, ] |
58      paper[(line - size):(line - 1), ]
59
60    # Descartar linhas representando o papel dobrado
61    paper <- paper[1:(line - 1), ]
62  }
63}
64
65# Contar pontos no papel
66sum(paper)
67#> [1] 765

Origami Transparente (B) #

E minha aposta valeu à pena! De fato o enunciado da parte 2 pedia para que realizássemos todas as dobras do nosso conjunto de instruções. No final, se tudo estivesse correto, os # e . do papel deveriam formar 8 letras maiúsculas.

A única alteração no código foi trocar a condição do for:

1# Iterar por todas as instruções
2for (i in seq_len(nrow(instructions)))

E, no final, também foi necessário fazer um print melhor da matriz:

 1# Imprimir os pontos de um jeito mais amigável
 2paper <- ifelse(paper, "#", ".")
 3for (i in seq_len(nrow(paper))) {
 4  cat(paper[i, ])
 5  cat("\n")
 6}
 7# # # # . . # # # # . # . . # . # # # # . # . . . . # # # . . . # # . . # . . # .
 8# # . . # . . . . # . # . # . . . . . # . # . . . . # . . # . # . . # . # . . # .
 9# # . . # . . . # . . # # . . . . . # . . # . . . . # . . # . # . . . . # # # # .
10# # # # . . . # . . . # . # . . . # . . . # . . . . # # # . . # . # # . # . . # .
11# # . # . . # . . . . # . # . . # . . . . # . . . . # . . . . # . . # . # . . # .
12# # . . # . # # # # . # . . # . # # # # . # # # # . # . . . . . # # # . # . . # .

Polimerização Estendida (A) #

O 14º dia do AoC foi muito demorado de resolver para mim. Apesar de ambas as soluções abaixo serem “simples”, levei horas para encontrar um jeito razoável de resolver o segundo item e, infelizmente, só consegui depois de olhar uma dica na internet que deixou tudo mais simples.

Desta vez nossa missão era estender um molde de polímero através de um conjunto de regras de reação. A primeira linha da entrada era o molde e, a partir daí, tínhamos as regras de inserção:

 1# NNCB
 2#
 3# CH -> B
 4# HH -> N
 5# CB -> H
 6# NH -> C
 7# HB -> C
 8# HC -> B
 9# HN -> C
10# NN -> C
11# BH -> H
12# NC -> B
13# NB -> B
14# BN -> B
15# BB -> N
16# BC -> B
17# CC -> N
18# CN -> C

As regras eram fáceis de entender. Cada uma delas indicava que, quando os dois elementos da esquerda se encontravam, entre eles apareceria o elemento da direita. Uma rodada de reação envolvia estender todos os pares da cadeia polimérica; no caso do exemplo, isso transformaria NNCB em NCNBCHB.

Após 10 iterações, deveríamos contar o número de ocorrências do elemento mais comum da cadeia e subtrair dele o número de ocorrências do elemento menos comum da cadeia. Esta seria a resposta do problema.

Meu código para o primeiro item acabou seguindo o que chamamos de estratégia de força bruta. A cada iteração, eu quebrava o polímero nos seus pares de elementos e fazia um join com a tabela de regras; depois era só colar tudo em uma string só e seguir em frente. No final eu só precisava encontrar as letras mais e menos comuns da string e subtraí-las.

 1# Ler modelo como string
 2poly <- readr::read_lines("data-raw/14a_extended_polymerization.txt", n_max = 1)
 3
 4# Ler regras como tabela
 5rules <- "data-raw/14a_extended_polymerization.txt" |>
 6  readr::read_table(skip = 1, col_names = FALSE) |>
 7  purrr::set_names("pair", "rm", "insertion") |>
 8  dplyr::select(-rm) |>
 9  dplyr::mutate(insertion = stringr::str_replace(
10    pair, "(.)(.)", paste0("\\1", insertion, "\\2")
11  ))
12
13# Executar uma rodada de inserções
14do_insertions <- function(poly) {
15  poly |>
16    stringr::str_split("") |>
17    purrr::pluck(1) |>
18    purrr::accumulate(~paste0(stringr::str_sub(.x, -1), .y)) |>
19    utils::tail(-1) |>
20    purrr::map_chr(~rules[rules$pair == .x, ]$insertion) |>
21    purrr::reduce(~paste0(.x, stringr::str_sub(.y, -2))) |>
22    stringr::str_c(collapse = "")
23}
24
25# Rodar do_insertions() 10 vezes e fazer el. mais comum - el. menos comum
2610 |>
27  seq_len() |>
28  purrr::reduce(~do_insertions(.x), .init = poly) |>
29  stringr::str_split("") |>
30  table() |>
31  {\(t) list(t[which.max(t)], t[which.min(t)])}() |>
32  purrr::reduce(`-`) |>
33  abs() |>
34  unname()
35#> [1] 2584

Polimerização Estendida (B) #

O segundo item parecia suspeitamente simples, mas eu estava redondamente enganado. A única instrução era repetir o problema do primeiro item para 40 iterações ao invés de 10. Pode parecer que eu não precisaria nem mudar meu código, mas note que no primeiro item a minha cadeia polimérica só chegou a ter 19457 letras. No segundo item a cadeia chegaria a… mais de 20 trilhões.

Seria necessário mudar de estratégia e foi aí que eu empaquei. Tentei diversas formas de manter apenas o número de letras na cadeia, sem armazenar a cadeia em si, mas nada funcionava. Eu até notei que a primeira e a última letras da cadeia nunca mudavam, mas isso não me ajudou.

Depois de procurar por dicas no subreddit do AoC, finalmente achei uma boa alma que havia feito uma observação incrível:

Sempre podemos manter apenas a contagem de pares distintos na cadeia. Se tivermos, por exemplo, um par AC aparecendo n = 10 vezes na cadeia e uma regra AC -> B, então na próxima iteração podemos adicionar à nossa contagem AB e BC, cada uma aparecendo n = 10 vezes.

Até aí eu já sabia, era essencialmente o que eu fazia manualmente no item 1. O problema é que, mantendo apenas as contagens dos pares, isso repetiria a letra B duas vezes, totalizando A 10 vezes, C 10 vezes e B 20 vezes. A ideia que veio a seguir, entretanto, foi o que realmente resolveu o problema:

Se pensarmos na cadeia como um todo, todos as letras serão contadas 2 vezes, exceto pela primeira e pela última, pois elas nunca ficam no meio de uma reação. O número de ocorrências de cada letra é, portanto, n / 2, exceto pelas letras que aparecem no início e no fim, paras quais a fórmula é (n + 1) / 2.

Depois disso o item 2 podia ser solucionado facilmente.

 1# Registrar a primeira e a última letras da cadeia original
 2orig <- "data-raw/14b_extended_polymerization.txt" |>
 3  readr::read_lines(n_max = 1) |>
 4  stringr::str_replace("^(.).*?(.)$", "\\1\\2") |>
 5  stringr::str_split("") |>
 6  purrr::pluck(1)
 7
 8# Ler modelo já no formato de contagem de pares
 9poly <- "data-raw/14b_extended_polymerization.txt" |>
10  readr::read_lines(n_max = 1) |>
11  stringr::str_split("") |>
12  purrr::pluck(1) |>
13  purrr::accumulate(~paste0(stringr::str_sub(.x, -1), .y)) |>
14  utils::tail(-1) |>
15  tibble::tibble() |>
16  purrr::set_names("pair") |>
17  dplyr::count(pair)
18
19# Ler regras como tabela
20rules <- "data-raw/14b_extended_polymerization.txt" |>
21  readr::read_table(skip = 1, col_names = FALSE) |>
22  purrr::set_names("pair", "rm", "insertion") |>
23  dplyr::select(-rm) |>
24  dplyr::mutate(insertion = stringr::str_replace(
25    pair, "(.)(.)", paste0("\\1", insertion, "\\2")
26  ))
27
28# Executar uma rodada de inserções
29do_insertions <- function(poly) {
30  poly |>
31    dplyr::left_join(rules, "pair") |>
32    dplyr::mutate(
33      insertion = purrr::map(insertion, stringr::str_extract, c("^..", "..$"))
34    ) |>
35    tidyr::unnest(insertion) |>
36    dplyr::group_by(pair = insertion) |>
37    dplyr::summarise(n = sum(n))
38}
39
40# Rodar do_insertions() 40 vezes e fazer el. mais comum - el. menos comum
4140 |>
42  seq_len() |>
43  purrr::reduce(~do_insertions(.x), .init = poly) |>
44  dplyr::mutate(elem = stringr::str_split(pair, "")) |>
45  tidyr::unnest(elem) |>
46  dplyr::group_by(elem) |>
47  dplyr::summarise(n = sum(n)) |>
48  dplyr::mutate(
49    n = ifelse(elem %in% orig, n + 1, n),
50    n = n / 2
51  ) |>
52  dplyr::filter(n == max(n) | n == min(n)) |>
53  dplyr::pull(n) |>
54  purrr::reduce(`-`) |>
55  abs() |>
56  format(scientific = FALSE)
57#> [1] 3816397135460

Quítons (A) #

No 15º dia do AoC eu demorei muito mais do que deveria. Apesar de ter entendido bem o enunciado e ter identificado rapidamente o caminho para a solução, eu empaquei na implementação do algoritmo. No final achei melhor pegar uma versão pronta do algoritmo para não perder mais horas com isso.

Novamente o enunciado envolvia um submarino, uma caverna, etc. Passar por cada ponto da caverna vinha com um certo risco que variava entre 1 e 9 e nosso objetivo era levar o submarino do ponto esquerdo superior até o ponto esquerdo inferior passando pelo caminho com menor risco total. A saída do programa deveria ser a soma do risco de todos os pontos do caminho (sem incluir o ponto de entrada, pois já começávamos nele).

A esse ponto, qualquer um que tenha aprendido sobre grafos já deve estar com o sentido aranha ativado. Esse é um problema clássico da Computação que pode ser facilmente solucionado pelo algoritmo de Dijkstra. Algumas alterações são necessárias, mas todas podem ser feitas antes de executar o algoritmo.

O passo-a-passo do código é mais ou menos o seguinte:

  1. Marcar todos os pontos como não visitados. Criar um conjunto com todos os pontos não visitador chamado conjunto não visitado.

  2. Atribuir a todos os pontos um risco temporário: ele deve ser 0 para o nó inicial e infinito para o resto. O risco temporário de um ponto v é o risco total do caminho de menor risco já descoberto entre v e o ponto inicial. Como no começo não conhecemos nenhum outro ponto além do inicial, todos os riscos temporários começam como infinito. Fixar o ponto inicial como o atual.

  3. Para o ponto atual, considerar todos os seus vizinhos não vizitados e calcular os seus riscos temporários através do ponto atual. Comparar o novo risco temporário ao risco atual e atribuir o menor dos dois. Por exemplo, se o risco do ponto atual A é 6 e o seu vizinho B tem risco 2, então o risco de chegar em B por A é 6 + 2 = 8. Se o risco temporário de B até agora era maior que 8, então ele deve virar 8. Caso contrário, nada muda.

  4. Quando já tivermos considerado todos os vizinhos não visitados do ponto atual, marcar o ponto atual como visitado e removê-lo do conjunto não visitado. Um ponto visitado nunca será checado de novo.

  5. Se o ponto final houver sido marcado como visitado, então parar. O algoritmo terminou e o risco total do melhor caminho até o distino é igual ao risco temporário que foi atribuido ao destino.

  6. Caso contrário, selecionar o ponto não visitado que tem o menor risco temporário e torná-lo o ponto atual. Voltar ao passo 3.

Normalmente o algoritmo de Dijkstra é aplicado em grafos nos quais os custos de cada passo do caminho são atribuídos à arestas do grafo e não aos nós, como é o nosso caso. Para resolver esse problema, temos que fazer uma certa ginástica para que os custos sejam transferidos para as arestas. Cada par de nós vizinhos ganham duas arestas direcionadas, cada uma com o risco do nó para o qual ela aponta:

 1# Ponto atual com seus 4 vizinhos
 2#   7
 3# 9 3 1
 4#   6
 5#
 6# Arestas indo para o ponto atual (todas têm risco 3)
 7#       o
 8#       3
 9#       ↓
10# o 3 → x ← 3 o
11#       ↑
12#       3
13#       o
14#
15# Arestas saindo do ponto atual (todas têm o risco do vizinho)
16#       o
17#       ↑
18#       7
19# o ← 9 x 1 → o
20#       6
21#       ↓
22#       o

Eu queria ter de fato implementado o algoritmo de Dijkstra no R por conta própria, mas eu cometi vários erros pelo caminho (eram 7:30, não me julgue) e, para não passar a manhã toda nisso, resolvi usar o pacote cppRouting para aplicar o algoritmo.

 1# Ler os riscos da caverna como uma matriz
 2cave <- "data-raw/15a_chiton.txt" |>
 3  readr::read_lines() |>
 4  stringr::str_split("") |>
 5  purrr::flatten_chr() |>
 6  as.integer() |>
 7  matrix(100, 100, byrow = TRUE)
 8
 9# Criar uma tabela com os custos entre vizinhos
10graph <- tibble::tibble()
11for (i in 1:prod(dim(cave))) {
12
13  vals <- c()
14  if (i %% 100 != 0)  vals <- append(vals, i + 1L)
15  if (i %% 100 != 1)  vals <- append(vals, i - 1L)
16  if (i > 100)        vals <- append(vals, i - 100L)
17  if (i < 9901)       vals <- append(vals, i + 100L)
18
19  node <- tibble::tibble(from_vertex = i, to_vertex = vals, cost = cave[vals])
20  graph <- dplyr::bind_rows(graph, node)
21}
22
23# Criar grafo e executar o algoritmo de Dijkstra
24path <- graph |>
25  cppRouting::makegraph(directed = TRUE) |>
26  cppRouting::get_path_pair(from = 1L, to = 10000L) |>
27  purrr::pluck(1) |>
28  as.integer()
29
30# Calcular o risco total do caminho (subtraíndo o custo da entrada)
31graph |>
32  dplyr::filter(to_vertex %in% path) |>
33  dplyr::group_by(to_vertex) |>
34  dplyr::summarise(cost = cost[1]) |>
35  dplyr::summarise(risk = sum(cost)) |>
36  dplyr::pull(risk) |>
37  magrittr::subtract(cave[1])
38#> [1] 811

Quítons (B) #

O segundo item seguia a mesma lógica de outros problemas desse ano: igual ao primeiro item, mas maior. Como eu estava usando um algoritmo bastante eficiente, não tive problema nenhum nessa parte.

Aqui descobríamos que, na verdade, a caverna era 5 vezes maior em cada dimensão (ou seja, 25 vezes mais pontos). A caverna completa era, entretanto, composta por cópias da sessão original com riscos mais elevados; para obter a versão final da caverna era necessário juntar 25 cópias da original somando um certo fator a cada cópia.

1# +0 +1 +2 +3 +4
2# +1 +2 +3 +4 +5
3# +2 +3 +4 +5 +6
4# +3 +4 +5 +6 +7
5# +4 +5 +6 +7 +8

Seguindo o guia acima, vemos que o canto superior esquerdo da caverna maior era igual à sessão original e, sucessivamente, chegávamos ao canto direito inferior, que era igual à sessão original, mas o risco de cada ponto era acrescido de 8. O único detalhe é que, quando o risco de um ponto passava de 9, ele voltava para 1 (igual aos polvos-dumbo que vimos anteriormente). O resto da solução era igual.

 1# Criar clones da caverna, somar fator de risco e juntar
 2cave <- cbind(
 3  rbind(cave + 0L, cave + 1L, cave + 2L, cave + 3L, cave + 4L),
 4  rbind(cave + 1L, cave + 2L, cave + 3L, cave + 4L, cave + 5L),
 5  rbind(cave + 2L, cave + 3L, cave + 4L, cave + 5L, cave + 6L),
 6  rbind(cave + 3L, cave + 4L, cave + 5L, cave + 6L, cave + 7L),
 7  rbind(cave + 4L, cave + 5L, cave + 6L, cave + 7L, cave + 8L)
 8)
 9
10# Reduzir pontos que passaram de 9
11cave[cave > 9] <- cave[cave > 9] - 9

Decodificador de Pacotes (A) #

O 16º problema do AoC foi bastante diverido. O enunciado era extremamente longo e cheio de detalhes, mas consegui fazer uma implementação direta e eficiente que só não funcionou de primeira por causa de um detalhe obscuro da função strtoi().

Hoje nosso objetivos era decodificar pacotes binários. Eles chegavam ao nosso submarino em hexadecimal e, depois de convertidos para binário eles tinham as seguintes características:

  • Os 3 primeiros bits representavam a versão do pacote;

  • Os 3 bits seguintes representavam o tipo do pacote, que podia cair em dois casos:

    • Se o tipo (na forma decimal) fosse igual a 4, então o pacote representaria um valor. Isso queria dizer que o resto do pacote poderia ser quebrado em pedaços de 5 bits com a seguinte configuração:

      • Se o pedaço começasse com 1, então os 4 bits a seguir eram parte do valor e deveríamos continuar lendo o pacote;

      • Se o pedaço começassem em 0, então os 4 bits a seguir eram o final do valor e poderíamos parar de ler o pacote.

    • Se o tipo do pacote fosse diferente de 4, então o pacote representaria um operador. Isso queria dizer que o bit de número 7 indicava o modo do pacote:

      • Se o indicador fosse 1, então os próximos 15 bits seriam iguais à soma dos comprimentos de todos os sub-pacotes contidos naquele pacote operador;

      • Se o indicador fosse 0, então os próximos 11 bits seriam iguais ao número de sub-pacotes contidos naquele pacote operador.

Simples? Longe disso. Vejamos alguns exemplos:

 1# Pacote literal (valor)
 2# D2FE28
 3# 110100101111111000101000
 4# VVVTTTAaaaaBbbbbCcccc
 5#
 6# - VVV são a versão do pacote, 6.
 7# - TTT são o tipo, 4. Então este pacote carrega um valor.
 8# - A é 1 (continuar lendo), então aaaa são o primeiro pedaço do valor.
 9# - B é 1 (continuar lendo), então bbbb são o segundo pedaço do valor.
10# - C é 0 (parar de ler), então cccc são o último pedaço do valor.
11# - O resto são bits extras.
12# - Portanto, o valor carregado por este pacote é 011111100101 = 2021.
13#
14# Pacote operador com indicador 0
15# 38006F45291200
16# 00111000000000000110111101000101001010010001001000000000
17# VVVTTTILLLLLLLLLLLLLLLAAAAAAAAAAABBBBBBBBBBBBBBBB
18#
19# - VVV são a versão do pacote, 1.
20# - TTT são o tipo, 6. Então este pacote carrega um operador.
21# - I é o indicador, 0. Então este pacote tem 15 bits com os comprimentos
22#   dos sub-pacotes.
23# - LLLLLLLLLLLLLLL contêm a soma dos comprimentos dos sub-pacotes, 27.
24# - AAAAAAAAAAA são um sub-pacote carregando um valor, 10.
25# - BBBBBBBBBBBBBBBB são um sub-pacote carregando um valor, 20.
26#
27# Pacote operador com indicador 1
28# EE00D40C823060
29# 11101110000000001101010000001100100000100011000001100000
30# VVVTTTILLLLLLLLLLLAAAAAAAAAAABBBBBBBBBBBCCCCCCCCCCC
31# - VVV são a versão do pacote, 7.
32# - TTT são o tipo, 3. Então este pacote carrega um operador.
33# - I é o indicador, 1. Então este pacote tem 11 bits com os número de
34#   sub-pacotes.
35# - LLLLLLLLLLL contêm o número de sub-pacotes, 3.
36# - AAAAAAAAAAA são um sub-pacote carregando um valor, 1.
37# - BBBBBBBBBBB são um sub-pacote carregando um valor, 2.
38# - CCCCCCCCCCC são um sub-pacote carregando um valor, 3.

O ponto positivo desse enunciado enorme é que conseguimos implementar os recursos necessários quase em sequência.

 1# Converter string hexadecimal para string binária
 2hex_to_bits <- function(hex) {
 3  hex |>
 4    stringr::str_split("") |>
 5    purrr::pluck(1) |>
 6    purrr::map(~paste(rev(as.integer(intToBits(strtoi(.x, 16)))))) |>
 7    purrr::map(magrittr::extract, 29:32) |>
 8    purrr::flatten_chr() |>
 9    stringr::str_c(collapse = "")
10}
11
12# Pegar a versão de um pacote
13get_version <- function(pkt) {
14  strtoi(stringr::str_sub(pkt, 1, 3), 2)
15}
16
17# Pegar o tipo de um pacote
18get_type <- function(pkt) {
19  strtoi(stringr::str_sub(pkt, 4, 6), 2)
20}

O objetivo final deste item era parsear a hierarquia de pacotes da nossa entrada e somar as versões de todos. Minha solução envolveu, desta forma, cirar uma “classe” que podia conter a versão e o comprimento de um pacote. O comprimento era importante para descartar o número certo de bits do pacote quando tivéssemos terminado de processar um sub-pacote.

Se um pacote fosse do tipo operador, então sua “classe” também conteria todos os seus sub-pacotes como elementos sem nome. O código abaixo implementa o processamento dos dois tipos de pacotes; note como foram implementadas as “classes”:

 1# Pegar o valor de um pacote literal
 2get_literal <- function(pkt) {
 3  interval <- c(7, 11)
 4
 5  # Iterar até o último pedaço ser encontrado
 6  literal <- ""
 7  flag <- FALSE
 8  while (!flag) {
 9
10    # Pegar o grupo especificado pelo intervalo
11    group <- stringr::str_sub(pkt, interval[1], interval[2])
12    literal <- stringr::str_c(literal, stringr::str_sub(group, 2))
13
14    # Parar se este é o último pedaço, caso contrário somar 5 ao intervalo
15    if (!as.integer(stringr::str_sub(group, 1, 1))) {
16      flag <- TRUE
17    } else {
18      interval <- interval + 5
19    }
20  }
21
22  # Retornar a "classe" que descreve o pacote
23  return(list(
24    version = get_version(pkt),
25    len = interval[2],
26    value = strtoi(literal, 2)
27  ))
28}
29
30# Processar um pacote operador
31get_operator <- function(pkt) {
32  indicator <- stringr::str_sub(pkt, 7, 7)
33
34  # Inicializar "classe"
35  out <- list(
36    version = get_version(pkt)
37  )
38
39  # Lidar com os 2 indicadores
40  if (as.integer(indicator)) {
41
42    # Pegar o número de sub-pacotes e separar a cauda do pacote
43    num <- strtoi(stringr::str_sub(pkt, 8, 18), 2)
44    rest <- stringr::str_sub(pkt, 19)
45    out$len <- 18
46
47    # Iterar no número de pacotes
48    for (i in seq_len(num)) {
49
50      # Processar sub-pacote
51      sub <- if (get_type(rest) == 4) get_literal(rest) else get_operator(rest)
52      out$len <- out$len + sub$len
53      out <- c(out, list(sub))
54
55      # Atualizar a cauda dado o compimento do último sub-pacote
56      rest <- stringr::str_sub(rest, sub$len + 1)
57    }
58  } else {
59
60    # Pegar o limite de comprimento dos sub-pacotes e separar a cauda
61    lim <- strtoi(stringr::str_sub(pkt, 8, 22), 2)
62    rest <- stringr::str_sub(pkt, 23)
63    out$len <- 22
64
65    # Iterar enquanto os sub-pacotes não tiverem passado do limite
66    while (lim > 0) {
67
68      # Processar sub-pacote
69      sub <- if (get_type(rest) == 4) get_literal(rest) else get_operator(rest)
70      out$len <- out$len + sub$len
71      out <- c(out, list(sub))
72
73      # Atualizar a cauda dado o compimento do último sub-pacote
74      rest <- stringr::str_sub(rest, sub$len + 1)
75      lim <- lim - sub$len
76    }
77  }
78
79  return(out)
80}

O último passo do meu código era achatar toda a estrutura de árvore que seria devolvida pelas funções acima e somar todos os comprimentos.

 1# Somar todas as versões do pacote representado por um hex
 2sum_versions <- function(hex) {
 3
 4  # Pegar a árvore de pacotes representada pelo hex
 5  pkt <- hex_to_bits(hex)
 6  pkts <- if (get_type(pkt) == 4) get_literal(pkt) else get_operator(pkt)
 7
 8  # Achatar árvore
 9  while (purrr::vec_depth(pkts) > 2) {
10    pkts <- purrr::flatten(pkts)
11  }
12
13  # Somar versões
14  pkts |>
15    magrittr::extract(names(pkts) == "version") |>
16    purrr::reduce(sum)
17}
18
19# Ler pacotes de um hex e somar versões
20"data-raw/16a_packet_decoder.txt" |>
21  readr::read_lines() |>
22  sum_versions()
23#> [1] 991

Decodificador de Pacotes (B) #

O segundo item era mais ou menos o que eu já esperava. Os tipos dos pacotes tinham um significado maior, ou seja, cada sub-tipo de pacote operador indicava uma operação matemática que deveria ser aplicada no valor dos seus sub-pacotes.

  • A operação 0 é soma (sum()).

  • A operação 1 é produto (prod()).

  • A operação 2 é mínimo (min()).

  • A operação 3 é máximo (max()).

  • A operação 5 é maior que (>).

  • A operação 6 é menor que (<).

  • A operação 7 é igual (==).

Ou seja, se um pacote tiver a estrutura (operador + (operador * (valor 1) (valor 2)) (valor 3)), então a expressão aritmética resultante seria (1 * 2) + 3). Nosso objetivo final era calcular o valor da expressão que o nosso pacote representava. Felizmente, o meu script anterior funcionava muito bem com essa alteração!

Eu troquei o elemento version da “classe” por type (o tipo do operador) e adicionei o seguinte no final do código:

 1# Avaliar a árvore de pacotes
 2get_value <- function(tree) {
 3
 4  # Funções correspondentes aos tipos
 5  fun <- switch(as.character(tree$type),
 6    "0" = sum,
 7    "1" = prod,
 8    "2" = min,
 9    "3" = max,
10    "5" = `>`,
11    "6" = `<`,
12    "7" = `==`,
13  )
14
15  # Aplicar função aos sub-pacotes
16  apply_fun <- function(tree) {
17    tree |>
18      purrr::keep(names(tree) == "") |>
19      purrr::map(get_value) |>
20      purrr::reduce(fun)
21  }
22
23  # Aplicar recursivamente
24  if (tree$type == 4) tree$value else as.numeric(apply_fun(tree))
25}
26
27# Decodificar a expressão de um pacote hex
28decode <- function(hex) {
29  pkt <- hex_to_bits(hex)
30  tree <- if (get_type(pkt) == 4) get_literal(pkt) else get_operator(pkt)
31
32  get_value(tree)
33}
34
35# Ler pacotes de um hex e calcular o valor da expressão
36"data-raw/16b_packet_decoder.txt" |>
37  readr::read_lines() |>
38  decode() |>
39  format(scientific = FALSE)
40#> [1] 1264485568252

P.S.: Mas isso não funcionou de primeira! Eu recebi um belo NA ao final da execução e demorei para entender a causa… No final eu descobri que a função strtoi() retorna NA quando o resultado é grande demais. A solução foi trocá-la por uma função própria:

1strton <- function(x) {
2  y <- as.numeric(strsplit(x, "")[[1]])
3  sum(y * 2^rev((seq_along(y) - 1)))
4}

Cesta de Três (A) #

O 17º dia do AoC foi uma ótima quebra em relação aos últimos. O enunciado era simples de entender e a solução foi fácil de criar, tudo que eu precisava depois de uma semana cansativa.

Hoje precisávamos tentar encontrar a chave do nosso submarino em uma fossa marinha. A sonda que tínhamos a bordo podia ser arremessada a partir do ponto (0, 0) com qualquer velocidade inteira tanto no eixo x quanto no y. A entrada do problema era a posição do alvo e a saída do primeiro item deveria ser a altura máxima que podíamos arremessar a sonda de modo que ela ainda atingisse o alvo.

As regras para a aceleração da sonda a cada passo eram as seguintes:

  • A posição x da sonda aumenta um valor igual à sua velocidade x.

  • A posição y da sonda aumenta um valor igual à sua velocidade y.

  • Por causa do atrito, a velocidade x da sonda muda em 1 um direção a 0 (ou seja, ela diminui em 1 se a velocidade for maior que 0 e aumenta em 1 caso contrário).

  • Por causa da gravidade, a velocidade y da sonda diminui em 1.

O grande truque do exercício era identificar todas as velocidades possíveis da sonda e depois verificar qual o levava à maior altura. Como o alvo estava sempre abaixo e à direita do (0, 0), podíamos estabelecer os limites inferiores e superiores para as velocidades x e y:

  • A velocidade x necessariamente tem que ser maior que 0, já que precisamos que a sonda se mova para frente. Adicionalmente, velocidade x máxima não pode ser maior que a fronteira direita do alvo; se o alvo terminar, por exemplo, em x = 10, nunca vamos acertá-lo jogando o módulo para frente com velocidade maior que 10.

  • Os limites da velocidade y são mais difícil de entender. Em primeiro lugar, ela nunca pode ser menor do que a fronteira inferior do alvo (pensando na mesma lógica que usamos antes, se o alvo terminar, por exemplo, em y = -10, nunca vamos acertá-lo jogando a sonda para baixo com velocidade menor que -10). O limite superior vem do fato de que se jogarmos a sonda para cima, não importando a velocidade, ela eventualmente vai voltar a y = 0 com velocidade igual à velocidade inicial menos 1, mas com sinal negativo; sendo assim, a velocidade y máxima é igual ao valor absoluto do limite inferior do alvo.

 1# Velocidade inicial: (6,3)
 2# ..................................
 3# .........(3,0).#..#.(2,-1)........
 4# .....(4,1).#........#.(1,-2)......
 5# ..................................
 6# (5,2).#..............#.(0,-3).....
 7# ..................................
 8# ..................................
 9# S.(6,3)..............#.(0,-4).....
10# ..................................
11# ..................................
12# ..................................
13# .....................#.(0,-5).....
14# ....................TTTTTTTTTTT...
15# ....................TTTTTTTTTTT...
16# ....................TTTTTTTTTTT...
17# ....................TTTTTTTTTTT...
18# ....................T#T(0,-6)TT...
19# ..................................
20# ..................................

Note no diagrama acima a simetria da trajetória no eixo y. Assim fica mais fácil entender porque, por exemplo, se o limite inferior do alvo for y = -10, então nunca podemos jogar a sonda para cima com velocidade maior que 9; ela voltará para y = 0 com velocidade -10 e acertará exatamente a fronteira de baixo do alvo.

 1# Ler alvo como uma tabela de coordenadas
 2target <- "data-raw/17a_trick_shot.txt" |>
 3  readr::read_lines() |>
 4  stringr::str_split("[=,]") |>
 5  purrr::pluck(1) |>
 6  stringr::str_subset("^[0-9-]") |>
 7  stringr::str_replace("\\.\\.", ":") |>
 8  purrr::map(~eval(parse(text = .x))) |>
 9  purrr::cross() |>
10  purrr::transpose() |>
11  purrr::set_names("x", "y") |>
12  tibble::as_tibble() |>
13  tidyr::unnest(c(x, y))
14
15# Todas as possíveis combinações de velocidades x e y válidas
16vels <- purrr::cross(list(
17  1:max(target$x),
18  min(target$y):abs(min(target$y))
19))

Para calcular a altura máxima que poderíamos arremessar a sonda, eu simulei a trajetória a partir de cada um dos pares de velocidades válidas e guardei a altura máxima à qual a sonda chegava. No final da iteração, se a sonda de fato atingisse o alvo, então eu comparava a altura máxima dessa combinação com a altura máxima global e mantinha a maior.

 1# Verificar quais pares de velocidades funcionam e pegar a altura máxima
 2max_height <- 0
 3for (vel in vels) {
 4
 5  # Posição inicial
 6  x_pos <- 0
 7  y_pos <- 0
 8
 9  # Velocidades iniciais
10  x_vel <- vel[[1]]
11  y_vel <- vel[[2]]
12
13  # Encontrar a altura máxima deste par de velocidades
14  max_height_ <- 0
15  while (y_pos >= min(target$y) && x_pos <= max(target$x)) {
16
17    # Atualizar posições
18    x_pos <- x_pos + x_vel
19    y_pos <- y_pos + y_vel
20
21    # Atualizar altura máxima local
22    if (y_pos > max_height_) max_height_ <- y_pos
23
24    # Se o par de fato leva ao alvo, atualizar altura máxima global
25    if (x_pos %in% target$x && y_pos %in% target$y) {
26      if (max_height_ > max_height) max_height <- max_height_
27    }
28
29    # Atualizar velocidades
30    x_vel <- if (x_vel > 0) x_vel - 1 else 0
31    y_vel <- y_vel - 1
32  }
33}
34
35# Retornar a altura máxima global
36max_height
37#> [1] 4753

Cesta de Três (B) #

Chegando no item 2, eu percebi que tinha dado muita sorte. O enunciado aqui pedia para encontrarmos o número de velocidades iniciais da sonda que a faziam chegar ao alvo. Meu código anterior já encontrava todos os pares válidos, mas utilizava isso para atualizar a altura máxima; só era necessário trocar a variável sendo atualizada dentro do while.

 1# Verificar pares de velocidades que funcionam e contá-los
 2n_works <- 0
 3for (vel in vels) {
 4
 5  # Posição inicial
 6  x_pos <- 0
 7  y_pos <- 0
 8
 9  # Velocidades iniciais
10  x_vel <- vel[[1]]
11  y_vel <- vel[[2]]
12
13  # Encontrar a altura máxima deste par de velocidades
14  max_height_ <- 0
15  while (y_pos >= min(target$y) && x_pos <= max(target$x)) {
16
17    # Atualizar posições
18    x_pos <- x_pos + x_vel
19    y_pos <- y_pos + y_vel
20
21    # Se o par de fato leva ao alvo, atualizar contador
22    if (x_pos %in% target$x && y_pos %in% target$y) {
23      n_works <- n_works + 1
24      break
25    }
26
27    # Atualizar velocidades
28    x_vel <- if (x_vel > 0) x_vel - 1 else 0
29    y_vel <- y_vel - 1
30  }
31}
32
33# Retornar número de velocidades que funcionam
34n_works

Peixe-Caracol (A) #

Chegou o dia 18 do AoC e mais uma vez o problema não foi muito difícil apesar do enunciado monstruoso. Uma coisa que notei hoje é que havia vários caminhos para resolver o exercício que pareciam igualmente razoáveis. No final eu decidi usar regex, uma das melhores e mais temidas funcionalidades de qualquer linguagem de programação.

O enunciado pedia para aprendermos a fazer somas usando os números dos peixes-caracol… A primeira característica desse sistema aritmético é que um número é representado por pares de elementos na forma [x,y], que podem ser números normais ou outros pares; por exemplo [[1,2],3]. Além disso, há duas limitações para os números: nunca pode haver um par dentro de 4 ou mais pares e nenhum número normal pode ser maior que 9.

A soma dos peixes-caracol coloca cada um dos dois números como elementos de um novo par. Se o primeiro número for [a,b] e o segundo [x,y], então a soma deles é [[a,b],[x,y]]. Obviamente isso pode criar um número que viola a as limitações acima, então precisamos aplicar as regras da explosão e da quebra. Abaixo eu descrevo as regras e as funções que criei para implementar cada uma:

A regra da explosão sempre vem primeiro e ela deve ser aplicada o maior número possível de vezes antes de partirmos para a regra da quebra.

 1# Exemplo:
 2# [[6,[5,[4,[3,2]]]],1]
 3#
 4# Passos da explosão:
 5# 1. Encontrar o primeiro par simples que está dentro de 4 ou mais pares
 6# [3,2]
 7#
 8# 2. Denominar as partes do par com x e y:
 9# [x,y] = [3,2]
10#
11# 3. Somar x ao número normal mais próximo à esquerda (se houver)
12# [[6,[5,[4 + 3,[3,2]]]],1]
13# [[6,[5,[7,[3,2]]]],1]
14#
15# 4. Somar y ao número normal mais próximo à direita (se houver)
16# [[6,[5,[7,[3,2]]]],1 + 2]
17# [[6,[5,[7,[3,2]]]],3]
18#
19# 5. Substituir o par por 0
20# [[6,[5,[7,0]]],3]
 1# Encontrar posição de um par que precisa ser explodido
 2find_explode <- function(num) {
 3  chrs <- stringr::str_split(num, "")[[1]]
 4
 5  # Iterar nos caracteres para encontrar um par profundo demais
 6  counter <- 0
 7  for (i in seq_along(chrs)) {
 8    if (chrs[i] == "[") {
 9      counter <- counter + 1
10    } else if (chrs[i] == "]") {
11      counter <- counter - 1
12
13      # Se o par for profundo demais, retornar
14      if (counter >= 4) {
15
16        # Encontrar o começo do par
17        len <- num |>
18          stringr::str_sub(end = i) |>
19          stringr::str_extract("\\[[^\\[]*?$") |>
20          stringr::str_length() |>
21          magrittr::subtract(1)
22
23        # Retornar "coordenadas" do par
24        return(c(i - len, i))
25      }
26    }
27  }
28
29  # Se não ouver par para explodir, returnar NULL
30  return(NULL)
31}
32
33# Aplicar o algoritmo da explosão
34explode <- function(num) {
35
36  # Encontrar um par para explodir
37  pos <- find_explode(num)
38
39  # Se não houver par, retornar o número
40  if (is.null(pos)) return(num)
41
42  # Extrair números normais do par
43  pair <- num |>
44    stringr::str_sub(pos[1], pos[2]) |>
45    stringr::str_extract_all("[0-9]+") |>
46    purrr::pluck(1) |>
47    as.numeric()
48
49  # Pegar a parte esquerda do número (até o par que vai explodir)
50  lhs <- stringr::str_sub(num, end = pos[1] - 1)
51
52  # Encontrar o número normal mais próximo de pair[1] e somar
53  left_num <- lhs |>
54    stringr::str_extract("[0-9]+(?=[^0-9]+$)") |>
55    as.numeric() |>
56    magrittr::add(pair[1])
57
58  # Pegar a parte direita do número (a partir do par que vai explodir)
59  rhs <- stringr::str_sub(num, pos[2] + 1)
60
61  # Encontrar o número normal mais próximo de pair[2] e somar
62  right_num <- rhs |>
63    stringr::str_extract("^[^0-9]+[0-9]+") |>
64    stringr::str_remove("^[^0-9]+") |>
65    as.numeric() |>
66    magrittr::add(pair[2])
67
68  # Substituir os números normais que mudamos
69  lhs <- stringr::str_replace(lhs, "[0-9]+([^0-9]+)$", paste0(left_num, "\\1"))
70  rhs <- stringr::str_replace(rhs, "^([^0-9]+)[0-9]+", paste0("\\1", right_num))
71
72  # Colar as partes esquerda e direita de volta
73  return(paste0(lhs, "0", rhs))
74}

Se não houver mais como aplicar a explosão, então podemos fazer uma quebra e voltar para o começo do algoritmo: aplicar quantas explosões forem possíveis e depois tentar uma quebra. Quando nenhuma regra puder ser aplicada, então encontramos o resultado da soma.

 1# Exemplo:
 2# [11,1]
 3#
 4# Passos da quebra:
 5# 1. Encontrar o primeiro número normal maior que 9
 6# 11
 7#
 8# 2. Criar um novo par onde o elemento da esquerda é o número dividido por 2
 9#    arredondado para baixo e o elemento da direita é o número dividido por 2
10#    arredondado para cima.
11# [5,6]
12#
13# 3. Substituir o número normal pelo par criado
14# [[5,6],1]
 1# Aplicar o algoritmo da quebra
 2split <- function(num) {
 3
 4  # Verificar se algo precisa ser quebrado e retornar o número se não
 5  if (!stringr::str_detect(num, "[0-9]{2,}")) return(num)
 6
 7  # Criar um par a partir das metades do primeiro número normal > 9
 8  pair <- num |>
 9    stringr::str_extract("[0-9]{2,}") |>
10    as.numeric() |>
11    {\(n) paste0("[", floor(n / 2), ",", ceiling(n / 2), "]")}()
12
13  # Substituir o número normal pelo par criado
14  stringr::str_replace(num, "[0-9]{2,}", pair)
15}

Agora que sabemos como explodir e qubrar, podemos implementar o algoritmo completo da soma dos peixes-caracol. Notem o next no loop; ele é essencial por causa da exigência de aplicarmos a explosão quantas vezes forem necessárias.

 1# Soma dos peixes-caracol
 2snailfish_sum <- function(num1, num2) {
 3
 4  # Juntar números como elementos de um novo par
 5  num <- paste0("[", num1, ",", num2, "]")
 6
 7  # Aplicar explosão e quebra até o número não mudar mais
 8  num_ <- ""
 9  while (num_ != num) {
10    num_ <- num
11
12    # Explodir e, se o número tiver mudado, voltar
13    num <- explode(num)
14    if (num_ != num) next
15
16    # Qubrar
17    num <- split(num)
18  }
19
20  return(num)
21}

Mas o enunciado não pedia para simplesmente implementarmos a soma dos peixes-caracol… A resposta final deveria ser a magnitude do número obtido a partir de somas sucessivas. Essencialmente, a nossa entrada era uma sequência de números A, B, C, D, etc. e devíamos calcular (((A + B) + C) + D) + .... Já a magnitude de um número envolve outro algoritmo; a magnitude de um [x,y] qualquer é 3*x + 2*y, mas devemos aplicar isso recursivamente, entrando nas camadas mais profundas do número e voltando para a superfície.

 1# Fazer uma rodada do algoritmo da magnitude
 2get_one_magnitude <- function(num) {
 3
 4  # Pegar a magnitude do par mais à esquerda
 5  val <- num |>
 6    stringr::str_extract("\\[[^\\[\\]]+\\]") |>
 7    stringr::str_extract_all("[0-9]+") |>
 8    purrr::pluck(1) |>
 9    as.numeric() |>
10    {\(n) 3 * n[1] + 2 * n[2]}() |>
11    as.character()
12
13  # Trocar o par pela sua magnitude
14  stringr::str_replace(num, "\\[[^\\[\\]]+\\]", val)
15}
16
17# Aplicar o algoritmo completo da magnitude
18get_magnitude <- function(num) {
19
20  # Enquanto ainda houver pares, fazer uma rodada do cálculo
21  while (stringr::str_detect(num, "\\[")) {
22    num <- get_one_magnitude(num)
23  }
24
25  # Retornar magnitude convertida para um valor numérico
26  return(as.numeric(num))
27}

Enfim, depois de uma parede de texto e uma parede de código, podemos finalmente juntar tudo na solução do primeiro item.

1# Reduce list of numbers with snalfish addition and get magnitude
2"data-raw/18a_snailfish.txt" |>
3  readr::read_lines() |>
4  purrr::reduce(snailfish_sum) |>
5  get_magnitude()
6#> [1] 4124

Peixes-Caracol (B) #

Em um ato de bondade, o autor do Advent of Code fez um item 2 bem simples. Dados todos os números A, B, C, D, etc. que recebemos como entrada, precisávamos combinar todos para encontrar a maior magnitude possível. Minha solução foi gerar todas as somas possíveis (A + B, B + A, A + C, C + A, etc., notando que A + B != B + A) e simplesmente calcular a magnitude de todas. A resposta do item devia ser justamente essa maior magnitude possível.

1# Cruzar os números consigo mesmos e somar toda combinação
2"data-raw/18b_snailfish.txt" |>
3  readr::read_lines() |>
4  {\(ns) list(ns, ns)}() |>
5  purrr::cross(`==`) |>
6  purrr::map_dbl(~get_magnitude(snailfish_sum(.x[[1]], .x[[2]]))) |>
7  max()
8#> [1] 4673

Detectores de Sinalizadores (A) #

Neville Chamberlain tem uma frase que eu gosto muito: “na guerra não há vencedores, todos são perdedores.” É assim que eu me senti com o dia 19 do AoC. No total eu demorei mais de 6 horas de programação intensa para resolver o problema de hoje. Joguei meu código fora múltiplas vezes, quase desisti, mas no final perseverei. Não acho que eu tenha resolvido o problema; assim como Chamberlain, acredito que o problema só perdeu antes.

Por esse motivo, o post de hoje vai ser um pouco diferente. Em primeiro lugar, é impossível resumir as mais de 400 linhas do enunciado de forma efetiva e, em segundo, explicar o raciocínio por trás da minha solução seria tão exaustivo quanto. Sendo assim, vou fazer um super resumo do enunciado e deixar a explicação do código a cargo dos comentários. Quem sabe um dia eu não revisito esse exercício para dar um passo-a-passo melhor.

O grosso da pergunta é o seguinte: temos 36 detectores e uma série de sinalizadores espalhados pelo oceano em posições fixas. A entrada são as coordenadas dos sinalizadores que são vistos por cada detector relativas à posição desse detector. Cada detector também pode estar em uma de 24 orientações (olhando para +x com o topo apontado para +y, olhando para -y com o topo apontado para +z, etc.). Se dois detectores tiverem uma intersecção entre os seus cubos de detecção, então deve haver pelo menos 12 sinalizadores nesse volume. A pergunta pede para calcularmos o número de sinalizadores que estão nessa região do mar.

  1# Converter c(x,y,z) para "x,y,z"
  2vec_to_str <- function(vec) {
  3  stringr::str_c(vec, collapse = ",")
  4}
  5
  6# Converter "x,y,z" para c(x,y,z)
  7str_to_vec <- function(str) {
  8  as.integer(stringr::str_split(str, ",")[[1]])
  9}
 10
 11# Atalho para escolhe(n,2) de uma lista
 12choose_pairs <- function(l) {
 13  seq_along(l) |>
 14    list(seq_along(l)) |>
 15    purrr::cross(`==`) |>
 16    purrr::transpose() |>
 17    purrr::map(purrr::flatten_int) |>
 18    purrr::set_names("a", "b") |>
 19    dplyr::as_tibble() |>
 20    dplyr::rowwise() |>
 21    dplyr::mutate(ordered = paste0(sort(c(a, b)), collapse = ",")) |>
 22    dplyr::group_by(ordered) |>
 23    dplyr::slice_head(n = 1) |>
 24    dplyr::ungroup() |>
 25    dplyr::select(-ordered) |>
 26    dplyr::mutate(
 27      a = purrr::map(a, ~l[[.x]]),
 28      b = purrr::map(b, ~l[[.x]])
 29    )
 30}
 31
 32# Aplicar todas as rotações de um ponto
 33apply_rotations <- function(point) {
 34  rotations <- list(
 35    list(c(-1, 0, 0), c(0, -1, 0), c(0, 0, 1)),
 36    list(c(-1, 0, 0), c(0, 0, -1), c(0, -1, 0)),
 37    list(c(-1, 0, 0), c(0, 0, 1), c(0, 1, 0)),
 38    list(c(-1, 0, 0), c(0, 1, 0), c(0, 0, -1)),
 39    list(c(0, -1, 0), c(-1, 0, 0), c(0, 0, -1)),
 40    list(c(0, -1, 0), c(0, 0, -1), c(1, 0, 0)),
 41    list(c(0, -1, 0), c(0, 0, 1), c(-1, 0, 0)),
 42    list(c(0, -1, 0), c(1, 0, 0), c(0, 0, 1)),
 43    list(c(0, 0, -1), c(-1, 0, 0), c(0, 1, 0)),
 44    list(c(0, 0, -1), c(0, -1, 0), c(-1, 0, 0)),
 45    list(c(0, 0, -1), c(0, 1, 0), c(1, 0, 0)),
 46    list(c(0, 0, -1), c(1, 0, 0), c(0, -1, 0)),
 47    list(c(0, 0, 1), c(-1, 0, 0), c(0, -1, 0)),
 48    list(c(0, 0, 1), c(0, -1, 0), c(1, 0, 0)),
 49    list(c(0, 0, 1), c(0, 1, 0), c(-1, 0, 0)),
 50    list(c(0, 0, 1), c(1, 0, 0), c(0, 1, 0)),
 51    list(c(0, 1, 0), c(-1, 0, 0), c(0, 0, 1)),
 52    list(c(0, 1, 0), c(0, 0, -1), c(-1, 0, 0)),
 53    list(c(0, 1, 0), c(0, 0, 1), c(1, 0, 0)),
 54    list(c(0, 1, 0), c(1, 0, 0), c(0, 0, -1)),
 55    list(c(1, 0, 0), c(0, -1, 0), c(0, 0, -1)),
 56    list(c(1, 0, 0), c(0, 0, -1), c(0, 1, 0)),
 57    list(c(1, 0, 0), c(0, 0, 1), c(0, -1, 0)),
 58    list(c(1, 0, 0), c(0, 1, 0), c(0, 0, 1))
 59  )
 60
 61  # Criar uma tabela com (x, y, z) rotacionados e um ID de rotação
 62  rotations |>
 63    purrr::map(purrr::map, `*`, point) |>
 64    purrr::map(purrr::map, sum) |>
 65    purrr::map(purrr::flatten_dbl) |>
 66    dplyr::tibble() |>
 67    purrr::set_names("point") |>
 68    dplyr::mutate(rotation = rotations) |>
 69    tibble::rowid_to_column() |>
 70    tidyr::unnest(point) |>
 71    dplyr::mutate(coord = rep(c("x", "y", "z"), dplyr::n() / 3)) |>
 72    tidyr::pivot_wider(names_from = coord, values_from = point) |>
 73    dplyr::mutate(rotation = purrr::map_chr(rotation, paste, collapse = ",")) |>
 74    dplyr::select(x, y, z, rotation)
 75}
 76
 77# Fábrica de função para transformar um ponto com rotação + translação
 78factory_transform <- function(df) {
 79
 80  # Extrair a operação de rotação da df
 81  rot <- df$rotation |>
 82    stringr::str_split("c\\(") |>
 83    purrr::pluck(1) |>
 84    stringr::str_remove("\\),?") |>
 85    stringr::str_subset(",") |>
 86    stringr::str_split(", ") |>
 87    purrr::map(as.numeric)
 88
 89  # Extrair a operação de translação da df
 90  trans <- c(df$dif_x, df$dif_y, df$dif_z)
 91
 92  # Retornar função que aplica a transformação
 93  function(vec) {
 94    rot |>
 95      purrr::map(`*`, vec) |>
 96      purrr::map(sum) |>
 97      purrr::flatten_dbl() |>
 98      magrittr::add(trans)
 99  }
100}
101
102# Pegar todas as intersecções entre detectores
103get_intersections <- function(points) {
104
105  # Parear os detectores e retornar as suas intersecções
106  points |>
107    purrr::map(choose_pairs) |>
108    purrr::map(
109      dplyr::mutate, # Intersecções são baseadas nas distâncias entre pontos
110      dist = purrr::map2_dbl(a, b, ~sum((.x - .y)**2))
111    ) |>
112    choose_pairs() |>
113    dplyr::rowwise() |>
114    dplyr::group_split() |>
115    purrr::map(~dplyr::inner_join(.x[["a"]][[1]], .x[["b"]][[1]], "dist")) |>
116    purrr::keep(~nrow(.x) >= 66) # 66 = C(12, 2) = 12 pontos na intersec.
117}
118
119# Pegar todas as transformações que podem converter pairs1 em pairs2
120get_transforms <- function(pairs1, pairs2) {
121
122  # Criar uma função que leva pairs1[2] a pairs2[2a] ou pairs2[2b]
123  dplyr::bind_rows(
124    dplyr::mutate(
125      apply_rotations(pairs1$a.x[[2]]),
126      ref_x = pairs2$a.y[[2]][1],
127      ref_y = pairs2$a.y[[2]][2],
128      ref_z = pairs2$a.y[[2]][3]
129    ),
130    dplyr::mutate(
131      apply_rotations(pairs1$a.x[[2]]),
132      ref_x = pairs2$b.y[[2]][1],
133      ref_y = pairs2$b.y[[2]][2],
134      ref_z = pairs2$b.y[[2]][3]
135    )
136  ) |>
137    dplyr::mutate(
138      dif_x = ref_x - x,
139      dif_y = ref_y - y,
140      dif_z = ref_z - z
141    ) |>
142    dplyr::rowwise() |>
143    dplyr::group_split() |>
144    purrr::map(factory_transform)
145}
146
147# Encontrar a função correta de transformação
148find_transform <- function(df, funs) {
149
150  # Dadas as funções de transformação, encontrar uma que converte os pontos de
151  # df (conjunto de intersecções) corretamente
152  df |>
153    tibble::rowid_to_column("pair_id") |>
154    dplyr::rowwise() |>
155    dplyr::group_split() |>
156    purrr::map(~{
157      .x |>
158        dplyr::mutate(,
159          fun_a.x = list(purrr::map(funs, ~.x(a.x[[1]]))),
160          fun_id = list(seq_along(funs))
161        ) |>
162        tidyr::unnest(dplyr::starts_with("fun")) |>
163        dplyr::select(-dist) |>
164        tidyr::unnest(dplyr::everything())
165    }) |>
166    dplyr::bind_rows() |>
167    dplyr::mutate(
168      a_works = a.y == fun_a.x,
169      b_works = b.y == fun_a.x
170    ) |>
171    dplyr::group_by(pair_id, fun_id) |>
172    dplyr::summarise(
173      some_works = all(a_works) || all(b_works), .groups = "drop"
174    ) |>
175    dplyr::ungroup() |>
176    dplyr::group_by(fun_id) |>
177    dplyr::summarise(works = sum(some_works)) |>
178    dplyr::slice_max(works) |>
179    dplyr::pull(fun_id)
180}
181
182# Ler pontos como uma lista de vetores
183points <- "data-raw/19a_beacon_scanner.txt" |>
184  readr::read_lines() |>
185  tibble::tibble() |>
186  purrr::set_names("point") |>
187  dplyr::mutate(
188    scanner = as.integer(stringr::str_detect(point, "scanner")),
189    scanner = cumsum(scanner) - 1
190  ) |>
191  dplyr::filter(!stringr::str_detect(point, "scanner")) |>
192  dplyr::filter(point != "") |>
193  dplyr::group_split(scanner) |>
194  purrr::map(dplyr::pull, point) |>
195  purrr::map(purrr::map, str_to_vec)
196
197
198# Reduzir detectores a uma única região
199while (length(points) > 1) {
200
201  # Pegar um par de detectores que tem uma intersecção
202  pairs <- get_intersections(points)[[1]]
203
204  # Pegar todas as funções de transformação
205  funs <- get_transforms(
206    dplyr::select(pairs, a.x, b.x),
207    dplyr::select(pairs, a.y, b.y)
208  )
209
210  # Encontrar a função correta
211  transformation <- funs[[find_transform(pairs, funs)]]
212
213  # Converter pontos para strings
214  pairs <- pairs |>
215    dplyr::select(-dist) |>
216    dplyr::mutate_all(purrr::map_chr, vec_to_str)
217
218  # Criar uma cópia dos pontos que também é strings
219  points_ <- purrr::map(points, purrr::map_chr, vec_to_str)
220
221  # Encontrar detector usado como referência por transformation()
222  for (i in seq_along(points_)) {
223
224    ref <- all(c(pairs$a.y, pairs$b.y) %in% points_[[i]])
225    if (ref) reference <- i
226  }
227
228  # Encontrar detector que foi transformado por transformation()
229  for (i in seq_along(points_)) {
230
231    trns <- all(c(pairs$a.x, pairs$b.x) %in% points_[[i]])
232    if (trns) transformed <- i
233  }
234
235  # Aplicar transformation() em todos os pontos do detector e adicionar pontos
236  # transformados ao detector de referência
237  points_[[reference]] <- points[[transformed]] |>
238    purrr::map(transformation) |>
239    purrr::map_chr(vec_to_str) |>
240    c(points_[[reference]]) |>
241    unique()
242
243  # Atualizar lista de pontos
244  points_[[transformed]] <- NULL
245  points <- purrr::map(points_, purrr::map, str_to_vec)
246}
247
248# Calcular o número de pontos em uma única região contígua
249sum(lengths(points))
250#> [1] 408

Detectores de Sinalizadores (B) #

O segundo item pedia para que encontrássemos a maior distância de Manhattan entre detectores distintos.

 1# Reduzir detectores a uma única região, guardando as funções de tranform.
 2save_funs <- list()
 3while (length(points) > 1) {
 4
 5  # Pegar um par de detectores que tem uma intersecção
 6  pairs <- get_intersections(points)[[1]]
 7
 8  # Pegar todas as funções de transformação
 9  funs <- get_transforms(
10    dplyr::select(pairs, a.x, b.x),
11    dplyr::select(pairs, a.y, b.y)
12  )
13
14  # Encontrar a função correta
15  transformation <- funs[[find_transform(pairs, funs)]]
16  save_funs <- c(save_funs, transformation)
17
18  # Converter pontos para strings
19  pairs <- pairs |>
20    dplyr::select(-dist) |>
21    dplyr::mutate_all(purrr::map_chr, vec_to_str)
22
23  # Criar uma cópia dos pontos que também é strings
24  points_ <- purrr::map(points, purrr::map_chr, vec_to_str)
25
26  # Encontrar detector usado como referência por transformation()
27  for (i in seq_along(points_)) {
28
29    ref <- all(c(pairs$a.y, pairs$b.y) %in% points_[[i]])
30    if (ref) reference <- i
31  }
32
33  # Encontrar detector que foi transformado por transformation()
34  for (i in seq_along(points_)) {
35
36    trns <- all(c(pairs$a.x, pairs$b.x) %in% points_[[i]])
37    if (trns) transformed <- i
38  }
39
40  # Aplicar transformation() em todos os pontos do detector e adicionar pontos
41  # transformados ao detector de referência
42  points_[[reference]] <- points[[transformed]] |>
43    purrr::map(transformation) |>
44    purrr::map_chr(vec_to_str) |>
45    c(points_[[reference]]) |>
46    unique()
47
48  # Atualizar lista de pontos
49  points_[[transformed]] <- NULL
50  points <- purrr::map(points_, purrr::map, str_to_vec)
51}
52
53# Aplicar transformações aos detectores e tirar distância de Manhattan
54save_funs |>
55  purrr::map(~.x(c(0, 0, 0))) |>
56  choose_pairs() |>
57  dplyr::mutate(dist = purrr::map2_dbl(a, b, ~sum(abs(.x - .y)))) |>
58  dplyr::slice_max(dist) |>
59  dplyr::pull(dist)

Mapa da Fossa (A) #

Depois de um domingo assustadoramente difícil, o problema do dia 20 do AoC foi bastante tranquilo de resolver. Tanto o enunciado quanto a solução me pareceram simples (apesar de algumas reclamações na internet sobre uma pegadinha que vou explicar em breve).

Hoje nós recebemos uma imagem na forma de uma matriz composta por pontos luminosos # e pontos escuros .. O outro componente da entrada era uma lista de “conversões”: nós deveríamos converter cada quadrado 3x3 da imagem em um número binário onde # = 1 e . = 0 e encontrar o elemento de índice correspondente da lista de conversões; o ponto do centro do quadrado deveria ser substituido por esse elemento da lista.

 1# Um quadrado 3x3
 2# # . . # .
 3# #[. . .].
 4# #[# . .]#
 5# .[. # .].
 6# . . # # #
 7#
 8# Número correspondente
 9# ...#...#. = 000100010 = 34
10#
11# 34o elemento da lista de conversões
12# 0         10        20        30 [34]   40        50        60        70
13# |         |         |         |   |     |         |         |         |
14# ..#.#..#####.#.#.#.###.##.....###.##.#..###.####..#####..#....#..#..##..##

Entretanto, essa operação, denominada realce, tinha um detalhe a mais. A nossa imagem de entrada era, na verdade, infinita! Em todas as direções, a imagem deveria ser completa por infinitos pontos escuros. Nosso objetivo era contar o número de pontos luminosos que restavam na nossa imagem após 2 aplicações do realce.

Como é possível imaginar, os pontos escuros infinitos não podem fazer diferença nessa contagem (senão a resposta seria incalculável). Note que um quadrado composto só por pontos escuros equivale ao índice 0 da lista e, no exemplo acima, isso é convertido para um novo ponto escuro; ou seja, as bordas infinitas continuam sendo escuras após o realce.

A pegadinha, porém, era que a lista de conversões na entrada do problema começava com # e não ., ou seja, os infinitos pontos escuros iam virar infinitos pontos luminosos depois de um realce. Felizmente, na segunda aplicação, todos os quadrados luminosos apontariam para o 511º elemento da lista e esse sim era um .. Em conclusão, desde que aplicássemos um número par de realces, as fronteiras infinitas da imagem seriam escuras e o número de pontos luminosos poderia ser contado.

Sendo assim, o código que resolvia o problema era bem simples, bastava adicionar uma borda escura à imagem para levar em conta a fronteira infinita e seguir em frente.

 1# Converter uma região 3x3 em um número
 2img_to_int <- function(image) {
 3
 4  # Achatar a matriz para uma só coluna
 5  bits <- ifelse(image == ".", 0, 1)
 6  binary <- paste0(as.vector(t(bits)), collapse = "")
 7
 8  # String para inteiro
 9  strtoi(binary, base = 2)
10}
11
12# Aplicar realce
13enhance <- function(image, algo) {
14
15  # Iterar nas linhas e colunas, sem passar pela borda
16  new_image <- image
17  for (i in 2:(nrow(image) - 1)) {
18    for (j in 2:(ncol(image) - 1)) {
19
20      # Trocar [i,j] pelo índice correspondente em `algo`
21      ind <- img_to_int(image[(-1:1 + i), (-1:1 + j)])
22      new_image[i, j] <- algo[ind + 1]
23    }
24  }
25
26  # Remover borda e retornar
27  new_image[2:(nrow(image) - 1), 2:(ncol(image) - 1)]
28}
29
30# Adicionar borda
31add_padding <- function(image) {
32
33  # Adicionar mais 2 linhas em cima e embaixo
34  image <- rbind(
35    image[1, ], image[1, ],
36    image,
37    image[nrow(image), ], image[nrow(image), ]
38  )
39
40  # Adicionar 2 colunas na esquerda e na direita
41  image <- cbind(
42    image[, 1], image[, 1],
43    image,
44    image[, ncol(image)], image[, ncol(image)]
45  )
46
47  return(image)
48}
49
50# Ler lista de realce como um vetor de strings
51algo <- "data-raw/20a_trench_map.txt" |>
52  readr::read_lines(n_max = 1) |>
53  stringr::str_split("") |>
54  purrr::pluck(1)
55
56# Ler imagem como uma matriz (e adicionar bordas)
57image <- "data-raw/20a_trench_map.txt" |>
58  readr::read_lines(skip = 2) |>
59  purrr::prepend(rep(paste0(rep(".", 100), collapse = ""), 3)) |>
60  append(rep(paste0(rep(".", 100), collapse = ""), 3)) |>
61  {\(s) stringr::str_c("...", s, "...")}() |>
62  stringr::str_split("") |>
63  purrr::flatten_chr() |>
64  matrix(106, 106, byrow = TRUE)
65
66# Aplicar o realce duas vezes e contar pontos luminosos
67image |>
68  enhance(algo) |>
69  add_padding() |>
70  enhance(algo) |>
71  magrittr::equals("#") |>
72  sum()
73#> [1] 5498

Mapa da Fossa (B) #

O segundo item pedia apenas para aplicarmos o algoritmo 50 ao invés de 2 vezes e contar o número de pontos luminosos. Como o nosso algoritmo generaliza as bordas, podemos simplesmente aplicá-lo mais vezes.

 1# Aplicar o realce 50 vezes
 2image <- enhance(image, algo)
 3for (i in seq_len(49)) {
 4  image <- enhance(add_padding(image), algo)
 5}
 6
 7# Contar pontos luminosos
 8image |>
 9  magrittr::equals("#") |>
10  sum()
11#> [1] 16014

Dados de Dirac (A) #

O dia 21 do AoC começou bem. O primeiro item foi bastante direto e tranquilo… O que complicou tudo foi o segundo.

Começamos aprendendo as regras de um jogo chamado Dados de Dirac. Ele é composto um tabuleiro circular que vai de 1 a 10, um dado e dois peões para representar os dois jogadores. Cada jogador rola o dado 3 vezes, soma os resultados e anda aquele número de casas no tabuleiro; o número da casa em que ele caiu é então adicionado à pontuação do jogador. Cada jogador começa em uma casa escolhida aleatoriamente e ganha o primeiro a atingir 1000 ou mais pontos.

O primeiro item pedia para simularmos um jogo de Dados de Dirac com um dado determinístico antes de partirmos para a versão oficial. Nós recebemos como entrada a posição de início de cada jogador e a mecânica de funcionamento do dado: ele ia de 1 a 100 e seu resultado sempre vinha nessa ordem (ou seja, o primeiro jogador rolaria 1, 2, 3, o segundo rolaria 4, 5, 6, etc.). Nosso objetivo era simular o jogo até que alguém ganhasse e retornar a pontuação do jogador perdedor multiplicada pelo número de vezes que o dado foi rolado naquele jogo.

 1# Ler posições iniciais
 2pos <- "data-raw/21a_dirac_dice.txt" |>
 3  readr::read_lines() |>
 4  stringr::str_extract("[0-9]+$") |>
 5  as.numeric()
 6
 7# Posições iniciais
 8p1_pos <- pos[1]
 9p2_pos <- pos[2]
10
11# Pontuações iniciais
12p1_pts <- 0
13p2_pts <- 0
14
15# Fazer os dados irem do valor máximo para 1
16die_mod <- function(e1, e2) ((e1 - 1) %% e2) + 1
17
18# Iterar até o jogo acabar
19die <- 1
20counter <- 0
21while (TRUE) {
22
23  # J1 rola 3 vezes
24  p1_rolls <- die:(die + 2)
25  p1_rolls <- die_mod(p1_rolls, 100)
26
27  # Atualizar estado do dado e contador de rolagem
28  die <- die_mod(p1_rolls[3] + 1, 100)
29  counter <- counter + 3
30
31  # Atualizar pontuação do J1
32  p1_pos <- p1_pos + sum(p1_rolls)
33  p1_pos <- die_mod(p1_pos, 10)
34  p1_pts <- p1_pts + p1_pos
35
36  # Parar se J1 ganhou
37  if (p1_pts >= 1000) break
38
39  # J2 rola 3 vezes
40  p2_rolls <- die:(die + 2)
41  p2_rolls <- die_mod(p2_rolls, 100)
42
43  # Atualizar estado do dado e contador de rolagem
44  die <- die_mod(p2_rolls[3] + 1, 100)
45  counter <- counter + 3
46
47  # Atualizar pontuação do J2
48  p2_pos <- p2_pos + sum(p2_rolls)
49  p2_pos <- die_mod(p2_pos, 10)
50  p2_pts <- p2_pts + p2_pos
51
52  # Parar se J2 ganhou
53  if (p2_pts >= 1000) break
54}
55
56# Contador * pontuação do perdedor
57min(p1_pts, p2_pts) * counter
58#> [1] 597600

Dados de Dirac (B) #

Bem direto, certo? Uma pena que o segundo item não tinha nada a ver… Agora deveríamos simular o jogo com o epônimo Dado de Dirac. Ele tem 3 lados (de 1 a 3) e, cada vez que ele é rolado, um universo paralelo é criado para cada possível resultado. Em suma, no final do jogo haveria um universo para cada caminho que o jogo poderia hipoteticamente tomar. Felizmente, com o Dado de Dirac, o jogo ia só até 21 pontos.

Nossa missão era, dadas as posições iniciais, calcular em quantos universos ganhava o jogador que ganhava mais vezes. Não parece tão difícil até você perceber que teremos algo em torno de 700 trilhões de universos para considerar. Espero que esteja claro que tentar gerar todas as rodadas não vai funcionar.

A solução ideal para esse problema é programação dinâmica (PD) que, apesar do nome esotérico, não é tão misteriosa assim. De forma bem superficial, um algoritmo que usa PD começa dividindo o problema principal em sub-problemas mais simples e armazenando seus resultados; a parte vital é, então, utilizar esses resultados já calculados para evitar contas desnecessárias mais para frente.

Concretamente, queremos dividir o jogo em estados distintos definidos pelos quartetos (p1_pos, p2_pos, p1_pts, p2_pts). Vejamos como funcionaria um trecho desse algoritmo:

  1. Começamos por um estado no final do jogo: (3, 8, 19, 21). Neste universo, sabemos que o J2 ganhou, então salvamos a informação (3, 8, 19, 21) = (0, 1).

  2. Mais para frente, encontramos o estado (3, 5, 19, 13). O J2 pode rolar uma série de valores aqui que precisamos verificar, mas, se ele rolar 1 + 1 + 1, sabemos que cairemos no estado (3, 8, 19, 21)! Sendo assim, podemos pular este cálculo e verificar apenas as outras rolagens possíveis.

  3. Com PD, calcularemos primeiro estados mais fáceis e, conforme formos evoluindo para o começo do jogo, já teremos calculado o número de vitórias de cada jogador em cada futuro. Assim, basta somar esses futuros e passar para um estado anterior.

 1# Ler posições iniciais
 2pos <- "data-raw/21b_dirac_dice.txt" |>
 3  readr::read_lines() |>
 4  stringr::str_extract("[0-9]+$") |>
 5  as.numeric()
 6
 7# Posições iniciais
 8p1_pos <- pos[1]
 9p2_pos <- pos[2]
10
11# Fazer os dados irem do valor máximo para 1
12die_mod <- function(e1, e2) ((e1 - 1) %% e2) + 1
13
14# Criar um identificar para `states`
15id <- function(a, b, c, d) paste0(a, ",", b, ",", c, ",", d)
16
17# Contar vitórias de cada jogador a partir de cada estado do jogo
18states <- list()
19count_states <- function(p1_pos, p2_pos, p1_pts = 0, p2_pts = 0) {
20  this_id <- id(p1_pos, p2_pos, p1_pts, p2_pts)
21
22  # Condições de parada
23  if (p1_pts >= 21) return(c(1, 0))
24  if (p2_pts >= 21) return(c(0, 1))
25  if (this_id %in% names(states)) return(states[[this_id]])
26
27  # Todas as combinações possíveis de rolagens
28  rolls <- list(1:3, 1:3, 1:3) |>
29    purrr::cross() |>
30    purrr::map(purrr::flatten_int) |>
31    purrr::map_int(sum)
32
33  # Iterar nas rolagens e fazer a recursão para os próximos estados
34  wins_total <- c(0, 0)
35  for (roll in rolls) {
36    p1_pos_ <- die_mod(p1_pos + roll, 10)
37
38    # Ir para o próximo estado e somar vitórias
39    wins <- count_states(p2_pos, p1_pos_, p2_pts, p1_pts + p1_pos_)
40    wins_total <- wins_total + rev(wins)
41  }
42
43  # Atualizar `states` e retornar
44  states[[this_id]] <<- wins_total
45  return(wins_total)
46}
47
48# Rodar programação dinâmica
49count_states(p1_pos, p2_pos) |>
50  max() |>
51  format(scientific = FALSE)
52#> [1] 634769613696613

Reinicialização do Reator (A) #

O dia 22 do AoC foi mais um cujo enunciado não apresentou dificuldades. Não que a resolução tenha sido fácil, mas pelo menos o problema foi fácil de entender.

Essencialmente tínhamos que reiniciar o reator do submarino seguindo uma série de instruções (a entrada do problema). O reator era composto por uma grade gigantesca feita de cubos 1x1x1 que começavam todos desligados; cada instrução nos dava uma região do reator que precisava ser desligada ou ligada:

1# on x=10..12,y=10..12,z=10..12
2# on x=11..13,y=11..13,z=11..13
3# off x=9..11,y=9..11,z=9..11
4# on x=10..10,y=10..10,z=10..10

O primeiro comando da lista acima, por exemplo, ligava todos os cubos dentro da matrix reator[10:12, 10:12, 10:12]. Nosso objetivo no primeiro item era contar todos os cubos que estariam acessos no final do processo de reinicialização, mas levando em conta apenas os cubos dentro da região denotada por x=-50..50,y=-50..50,z=-50..50.

O código era bastante simples de escrever usando a função array() do R, prestando atenção apenas ao fato de que as coordenadas da array deveríam ir de 1 a 101 e não de -50 a 50.

 1# Ler todos os passos como uma tabela
 2steps <- "data-raw/22a_reactor_reboot.txt" |>
 3  readr::read_lines() |>
 4  stringr::str_split("[ ,]|(\\.\\.)") |>
 5  purrr::transpose() |>
 6  purrr::set_names("state", "x1", "x2", "y1", "y2", "z1", "z2") |>
 7  purrr::map(purrr::flatten_chr) |>
 8  tibble::as_tibble() |>
 9  dplyr::mutate(
10    dplyr::across(dplyr::ends_with("1"), stringr::str_remove, "[a-z]="),
11    dplyr::across(c(-state), as.integer),
12    x = purrr::map2(x1, x2, `:`),
13    y = purrr::map2(y1, y2, `:`),
14    z = purrr::map2(z1, z2, `:`)
15  ) |>
16  dplyr::select(state, x, y, z)
17
18# Criar reator como uma array 3D
19reactor <- array(rep("off", 303), dim = c(101, 101, 101))
20
21# Iterar nos passos
22for (i in seq_len(nrow(steps))) {
23
24  # Coordenadas do cubóide
25  x <- steps$x[[i]] + 51
26  y <- steps$y[[i]] + 51
27  z <- steps$z[[i]] + 51
28
29  # Eliminar o que estiver fora do cubo -50:50
30  x <- x[x >= 1 & x <= 101]
31  y <- y[y >= 1 & y <= 101]
32  z <- z[z >= 1 & z <= 101]
33
34  # Atribuir estado
35  reactor[x, y, z] <- steps$state[i]
36}
37
38# Contar cubos ligados
39sum(reactor == "on")
40#> [1] 647076

Reinicialização do Reator (B) #

Sem muita surpresa, o item 2 pedia para contarmos o número de cubos ligados ao final do processo de reinicialização em todo o reator. Olhando o código acima, parece que só seria necessário mudar as dimensões da array e tirar os filtros dentro do loop, certo? Infelizmente não, pois com esse algoritmo ineficiente precisaríamos contar aproximadamente 2 quadrilhões de cubos…

A solução foi, então, calcular apenas os limites das regiões e lidar com as suas intersecções. Ou seja, se dois cubóides tiverem que ser ligados, então podemos tomar nota das suas coordenadas e adicionar um novo cubóide de “subtração” na nossa lista que servirá para remover uma cópia da intersecção que foi ligada “duas vezes”. Resumidamente, estaremos contando apenas os volumes de cada cubóide ligado e subtraíndo o volume de cada intersecção para não contar nada duas vezes.

 1# Ler todos os passos como uma tabela
 2steps <- "data-raw/22b_reactor_reboot.txt" |>
 3  readr::read_lines() |>
 4  stringr::str_split("[ ,]|(\\.\\.)") |>
 5  purrr::transpose() |>
 6  purrr::set_names("state", "x1", "x2", "y1", "y2", "z1", "z2") |>
 7  purrr::map(purrr::flatten_chr) |>
 8  tibble::as_tibble() |>
 9  dplyr::mutate(
10    dplyr::across(dplyr::ends_with("1"), stringr::str_remove, "[a-z]="),
11    dplyr::across(c(-state), as.integer),
12    state = ifelse(state == "on", 1L, -1L),
13  )
14
15# Iterar nos passos Iterate over steps
16cuboids <- dplyr::slice_head(steps, n = 1)
17for (i in 2:nrow(steps)) {
18
19  # Iterar nos cubóides que já vimos
20  for (j in seq_len(nrow(cuboids))) {
21
22    # Calcular intersecção
23    x1_inter <- max(steps$x1[i], cuboids$x1[j])
24    x2_inter <- min(steps$x2[i], cuboids$x2[j])
25    y1_inter <- max(steps$y1[i], cuboids$y1[j])
26    y2_inter <- min(steps$y2[i], cuboids$y2[j])
27    z1_inter <- max(steps$z1[i], cuboids$z1[j])
28    z2_inter <- min(steps$z2[i], cuboids$z2[j])
29
30    # Adicionar intersecção à lista (com sinal virado)
31    if (x1_inter <= x2_inter && y1_inter <= y2_inter && z1_inter <= z2_inter) {
32      cuboids <- tibble::add_row(cuboids,
33        state = cuboids$state[j] * -1L,
34        x1 = x1_inter, x2 = x2_inter,
35        y1 = y1_inter, y2 = y2_inter,
36        z1 = z1_inter, z2 = z2_inter,
37      )
38    }
39  }
40
41  # Adicionar cubóide à lista se ele estiver ligado
42  if (steps$state[i] == 1) {
43    cuboids <- tibble::add_row(cuboids,
44      state = steps$state[i],
45      x1 = steps$x1[i], x2 = steps$x2[i],
46      y1 = steps$y1[i], y2 = steps$y2[i],
47      z1 = steps$z1[i], z2 = steps$z2[i],
48    )
49  }
50}
51
52# Contar cubos ligados
53on <- 0
54for (i in seq_len(nrow(cuboids))) {
55
56  # Calcular volume
57  x <- cuboids$x2[i] - cuboids$x1[i] + 1
58  y <- cuboids$y2[i] - cuboids$y1[i] + 1
59  z <- cuboids$z2[i] - cuboids$z1[i] + 1
60
61  # Adicionar/remover à/da conta
62  on <- on + (x * y * z * cuboids$state[i])
63}
64
65# Imprimir
66format(on, scientific = FALSE)
67#> [1] 1233304599156793

Anfípodes (A e B) #

O dia 23 do AoC foi… Estranho. O enunciado era fácil de entender, mas o código foi impossível de fazer. E não estou exagerando: eu literamente não consegui fazer o código para resolver o exercício. É verdade que eu fiquei doente hoje, então não sei se meus neurônios estavam de cama.

No meu desespero, fui olhar o subreddit do Advent em busca de sugestões de outros programadores e, quando cheguei lá, descobri que várias pessoas estavam resolvendo o problema na mão! Uma boa alma tinha até criado um helper online!

No final, a minha lição do dia de hoje é que nem sempre o jeito mais rápido de resolver um problema é programando; às vezes é mais fácil usar a cabeça mesmo. No caso, a cabeça da Renata Hirota, que resolveu o problema na mão em 10 minutos depois de eu ter passado o dia inteiro na frente do computador tentando achar uma solução.

Sendo assim, deixo vocês com uma tirinha do XKCD:

Unidade lógica e aritmética (A e B) #

O penúltimo dia do AoC de 2021 chegou e, com ele, mais um problema que era mais fácil de resolver na mão! Hoje e ontem vão ficar na história como exercícios de lógica e não de programação.

Sem mais delongas, deixo vocês com outra tirinha do XKCD:

Pepino-do-mar (A) #

Finalmente chegamos ao último dia do AoC deste ano! O problema de hoje foi um verdadeiro presente de Natal: bem mais simples que todos os dias anteriores. Nossa missão era acompanhar os movimentos de dois grupos de pepinos-do-mar e encontrar o momento em que eles não poderiam mais se mover.

Os pepinos estavam dispostos em uma matriz retangular e se moviam na direção para a qual estavam apontando. Se o espaço em frente ao pepino estivesse vago (.), então ele se movia.

 1# Estado inicial:
 2# ...>...
 3# .......
 4# ......>
 5# v.....>
 6# ......>
 7# .......
 8# ..vvv..
 9#
10# Depis de 1 passo:
11# ..vv>..
12# .......
13# >......
14# v.....>
15# >......
16# .......
17# ....v..
18#
19# Depois de 58 passos (todos travados):
20# ..>>v>vv..
21# ..v.>>vv..
22# ..>>v>>vv.
23# ..>>>>>vv.
24# v......>vv
25# v>v....>>v
26# vvv.....>>
27# >vv......>
28# .>v.vv.v..

Meu código ficou simples. Eu li o mapa do fundo do mar como uma matriz e calculei todos os pepinos que podiam se mover; quando nenhum mais pudesse, eu retornava o número de passos transcorridos.

 1# Ler fundo do mar como matriz
 2seafloor <- "data-raw/25a_sea_cucumber.txt" |>
 3  readr::read_lines() |>
 4  stringr::str_split("") |>
 5  purrr::flatten_chr() |>
 6  matrix(nrow = 137, ncol = 139, byrow = TRUE)
 7
 8# Iterar enquanto ainda há movimentos
 9i <- 0
10while (TRUE) {
11  i <- i + 1
12
13  # Todos os pepinos
14  e <- which(seafloor == ">")
15  s <- which(seafloor == "v")
16
17  # As suas próximas posições
18  next_e <- ((e + 137) %% 19043) + ((e + 137) %% 19043 == 0) * 19043
19  next_s <- s + 1 - (s %% 137 == 0) * 137
20
21  # Mover todos os pepinos virados para a esquerda
22  allowed_e <- seafloor[next_e] == "."
23  seafloor[next_e[allowed_e]] <- seafloor[e[allowed_e]]
24  seafloor[e[allowed_e]] <- "."
25
26  # Mover todos os pepinos virados para baixo
27  allowed_s <- seafloor[next_s] == "."
28  seafloor[next_s[allowed_s]] <- seafloor[s[allowed_s]]
29  seafloor[s[allowed_s]] <- "."
30
31  # Verificar condição de parada
32  if (all(!allowed_e) && all(!allowed_s)) break
33}
34
35# Imprimir
36print(i)
37#> [1] 518

Pepino-do-mar (B) #

O segundo item me pegou de surpresa porque… Não havia segundo item! A historinha que estava sendo contada ao longo do AoC foi finalmente concluída e ganhamos a última estrela de graça.

E esse foi o fim da aventura. Muito obrigado por me acompanhar nesses últimos 25 dias de programação intensa! Espero que tenham gostado e, até que enfim, boas festas!