#!/usr/bin/env perl

use strict;
use warnings;
use 5.010;

my $total = 0;

for my $line (<>) {
    my @nums = ($line =~ /\d/g);
    $total += $nums[0] * 10 + $nums[-1];
}

say $total;

#!/usr/bin/env perl

use strict;
use warnings;
use v5.010;

my %nums = (one => 1, two => 2, three => 3, four => 4, five => 5, six => 6, seven => 7, eight => 8, nine => 9);
$nums{$_} = $_ for 1..9;

my $regex = join "|", keys %nums;

my $total = 0;

for my $line (<>) {
    $line =~ /($regex)/;
    my $first_num = $nums{$1};

    my $window = 1;
    my $sub = substr $line, -1;
    while ($sub !~ /($regex)/) {
        $window ++;
        $sub = substr $line, -$window;
    }

    $sub =~ /($regex)/;
    my $second_num = $nums{$1};

    $total += $first_num * 10 + $second_num;
}

say $total;

Part 2 gave me a surprising amount of trouble. I resolved it by looking at longer and longer substrings from the end of the line in order to find the very last word even if it overlapped, which you can’t do with normal regex split. I doubt this is the most efficient possible solution.

This problem feels a bit more Scheme-shaped. To keep things interesting, I have chosen to stick to pure functional programming.

A card consists of three components – a card number (which turned out to be completely unnecessary), a list of winning numbers, and a list of numbers. Here’s a function to parse a card from a string, turning it into a 3-element list:

(define (parse-card card)
  (let* ((parts (string-split card ":"))
         (numlists (string-split (cadr parts) "|")))
    (list (string->number (string-drop (car parts) 5))
          (map string->number (string-split (car numlists) " "))
          (map string->number (string-split (cadr numlists) " "))

The value of a card is easy enough to compute. The first matched winning number sets the value to 1, every subsequent one doubles it.

(define (card-value card)
  (let* ((card-parts (parse-card card))
         (winning-numbers (cadr card-parts)))
    (let loop ((nums (caddr card-parts)) (val 0))
      (cond ((null? nums) val)
            ((and (= val 0) (memq (car nums) winning-numbers)) (loop (cdr nums) 1))
            ((memq (car nums) winning-numbers) (loop (cdr nums) (* val 2)))
            (else (loop (cdr nums) val))))))

Solving part 1 is now straightforward:

(define (solve-part-1 cards)
  (apply + (map card-value cards)))

But oh no! Turns out I (or the elf) got the rules wrong, and apparently the game requires so many dead trees to play that I think it was probably designed by Jair Bolsonaro.

A function to count the card matches (eg. how many numbers match a winning number) is easily adapted from the above:

(define (card-matches card)
  (let* ((card-parts (parse-card card))
         (winning-numbers (cadr card-parts)))
    (let loop ((nums (caddr card-parts)) (val 0))
      (cond ((null? nums) val)
            ((memq (car nums) winning-numbers) (loop (cdr nums) (+ val 1)))
            (else (loop (cdr nums) val))))))

My strategy here is to have two lists: One of the card matches of all cards, the other of how many instances I have of each card. The second list will start as (1 1 1 1 ... ), and I need to be able to add some number x to the first n cards in the list. For example, if I have 4 instances of the first card, and it has 2 matches, then I’ll want to add 4 to however many instances I have of the next 2 cards. Here’s a function that reaches into a list and does just that:

(define (reach x n l)
  (if (or (= n 0) (null? l))
    l
    (cons (+ x (car l)) (reach x (- n 1) (cdr l)))))

Using this, here’s a recursive function that counts cards, given the two aforementioned lists:

(define (count-cards matches cards)
  (if (null? cards) 0
    (+ (car cards)
       (count-cards (cdr matches)
                    (reach (car cards) (car matches) (cdr cards))))))

Solving part 2 is now easy:

(define (solve-part-2 lines)
  (count-cards (map card-matches lines) (map (lambda (x) 1) lines)))

There you have it. It’d have been shorter if I had allowed myself some side effects, but pure functional programming is terrific fun.

To avoid annoying special cases for dealing with reading past the edges of the schematic, I start by adding one cell of padding on all sides.

(define (pad-schematic lines)
  (let* ((width (string-length (car lines)))
         (empty-line (make-string (+ width 2) #\.)))
    (append (list empty-line)
            (map (lambda (str) (string-append "." str ".")) lines)
            (list empty-line))))

I’m also going to define a few utility functions. The schematic-pos function reads what’s on the x,y position of the schematic, and is here to compensate for Scheme being awkward for dealing with two-dimensional structures. The two others check whether some position is a symbol (other than .) or a digit.

(define (schematic-pos s x y)
  (string-ref (list-ref s y) x))

(define (pos-symbol? s x y)
  (let ((chr (schematic-pos s x y)))
    (and (not (char=? chr #\.))
         (not (char-set-contains? char-set:digit chr)))))

(define (pos-digit? s x y)
  (let ((chr (schematic-pos s x y)))
    (char-set-contains? char-set:digit chr)))

I want a list of all positions of symbols in the schematic, so I can check them for adjacent numbers. I could also have gone with a list of numbers instead, but symbols seemed easier to find adjacencies for.

(define (symbol-positions s)
  (let ((width (string-length (car s)))  (height (length s)))
    (let loop ((x 0) (y 0) (syms '()))
      (cond ((>= y height) syms)
            ((>= x width) (loop 0 (+ y 1) syms))
            ((pos-symbol? s x y)
             (loop (+ x 1) y (cons (cons x y) syms)))
            (else (loop (+ x 1) y syms))))))

This produces a list of (x y) pairs, one for each symbol. Finding adjacent numbers is a bit tricky: Since there are three relevant positions above and below the symbol’s own position, there could be one or two numbers above or below, and if there are two, then I might be reading the same number twice. I accept this, and keep the numbers in an lset (which means that a duplicate simply won’t be inserted). The number reader itself produces triples on the form (x y n), where x is the position of the first character in the number, and n is a string containing the number itself. The coordinates are stored to ensure that if there are several instances of the same number in different positions in the schematic, they get treated separately.

(define (get-number-pos s x y)
  (letrec
    ((num_l (lambda (x) (if (pos-digit? s x y) (num_l (- x 1)) (+ x 1))))
     (num_r (lambda (x) (if (pos-digit? s x y) (num_r (+ x 1)) x))))
    (list (num_l x) y (string-copy (list-ref s y) (num_l x) (num_r x)))))

(define (get-adjacent-numbers s xpos ypos)
  (let loop ((x (- xpos 1)) (y (- ypos 1)) (nums '()))
    (cond
      ((> y (+ ypos 1)) nums)
      ((> x (+ xpos 1)) (loop (- xpos 1) (+ y 1) nums))
      ((pos-digit? s x y)
       (loop (+ x 1) y (lset-adjoin equal? nums (get-number-pos s x y))))
      (else (loop (+ x 1) y nums)))))

From here, solving the two parts is easy. For part 1, we get all the lists of number adjacencies and unpack them into a single list:

(define (get-part-numbers s)
  (let ((sym-nums (map (lambda (c) (get-adjacent-numbers s (car c) (cdr c)))
                       (symbol-positions s))))
    (let loop ((curr (car sym-nums)) (syms (cdr sym-nums)) (nums '()))
      (cond ((and (null? curr) (null? syms)) nums)
            ((null? curr) (loop (car syms) (cdr syms) nums))
            (else (loop (cdr curr) syms (cons (car curr) nums)))))))

(define (solve-part-1 schematic)
  (apply + (map (lambda (x) (string->number (caddr x)))
                (get-part-numbers schematic))))

For part 2, we need a list of gears. We can just get all the symbols, filter out everything that isn’t a *, and then filter out everything that doesn’t have exactly two adjacencies.

(define (gears s)
  (filter (lambda (x) (= (length x) 2))
          (map (lambda (x) (get-adjacent-numbers s (car x) (cdr x)))
               (filter
                 (lambda (x) (char=? (schematic-pos s (car x) (cdr x)) #\*))
                 (symbol-positions s)))))

(define (solve-part-2 s)
  (apply + (map (lambda (y) (* (string->number (caddr (car y)))
                               (string->number (caddr (cadr y)))))
                (gears s))))

I could probably have written nicer code if I weren’t still a bit sick (though I’m getting better!). However, the moment I realized this one would be about mucking around with two-dimensional structures, I knew Scheme was going to be a bit awkward. But here you have it.

#!/usr/bin/env jq -n -R -f

# Get and reduce every "pretty" line
reduce inputs as $line (
  0;
  # Add extracted number
  . + ( $line / "" | [ .[] | tonumber? ] | [first * 10 , last] | add )
)

#!/usr/bin/env jq -n -R -f

# Define string to num value map
{
  "one":   1,  "1": 1,
  "two":   2,  "2": 2,
  "three": 3,  "3": 3,
  "four":  4,  "4": 4,
  "five":  5,  "5": 5,
  "six":   6,  "6": 6,
  "seven": 7,  "7": 7,
  "eight": 8,  "8": 8,
  "nine":  9,  "9": 9
} as $to_num |

# Get and reduce every "pretty" line
reduce inputs as $line (
  0;
  . + (
    $line |
    # Try two capture two numbers
    capture("(^.*?(?(one|two|three|four|five|six|seven|eight|nine|[1-9])).*(?(one|two|three|four|five|six|seven|eight|nine|[1-9])).*?$)?") |
    # If no capture, get one number twice
    if .f == "" then $line | capture("^.*?(?(one|two|three|four|five|six|seven|eight|nine|[1-9]))") | .l = .f else . end |
    # Add extracted number
    $to_num[.f] * 10 + $to_num[.l]
  )
)

#!/usr/bin/env jq -n -R -f

# For each game: Is 12 red cubes, 13 green cubes, and 14 blue cubes possible ?
# Line Format =
# Game 1: 3 blue, 4 red; 1 red, 2 green, 6 blue; 2 green
[
  # Splitting input game id and content
  inputs / ": " |
  # Saving id
  (.[0] / " " | .[1] | tonumber ) as $id |
  # Parsing game
  .[1] / "; " | [
    .[] / ", " | [ .[] / " " | {(.[1]): .[0] | tonumber} ] | add |
    # Is given sample possible ?
    .red <= 12 and .green <= 13 and .blue <= 14
  ] |
  # If all samples possible, return id, else 0
  if all then $id else 0 end
] |

# Return sum of all possible game ids
add

#!/usr/bin/env jq -n -R -f

# Line Format =
# Game 1: 3 blue, 4 red; 1 red, 2 green, 6 blue; 2 green
[
  # Splitting input game id and content
  inputs / ": " |
  # Parsing game
  .[1] / "; " |
    [ .[] / ", " | [ .[] / " " | {(.[1]): .[0] | tonumber} ] | add ] |
    # Getting minimum required mumber for each color,
    # and computing the power
    {
      r: ([.[].red]   | max),
      g: ([.[].green] | max),
      b: ([.[].blue]  | max)
    } | .r * .g * .b
] |

# Return sum of all powers
add

#!/usr/bin/env jq -n -R -f

# Getting input with padding, and padded width
[ "." + inputs + "." ] as $inputs | ( $inputs[0] | length ) as $w |

# Working with flattened string, convert all symbols to '#'
[
  ([range($w) | "."]|join("")), # Padding
  $inputs[],
  ([range($w) | "."]|join(""))  # Padding
] | join("") | gsub("[^0-9.]";"#") as $inputs |

reduce (
  # Get all indices for symbols, in box pattern around symbols
  $inputs | indices("#")[] |
  . - $w -1  , . - $w , . - $w + 1 ,
  . - 1      , empty  , . + 1      ,
  . + $w - 1 , . + $w , . + $w + 1
) as $i (
  # Numbers containes bounding indices,
  # of numbers bordering symbols
  {numbers: []};

  # Test if current index isn't included in any found number
  def new_number($i): [ .numbers[] | .[0] <= $i and $i <= .[1] ] | any | not ;
  # Make "number" as bounding indices, by extending left and right
  def make_number($i):
    {a: $i, b: ($i+1 )}
      | until( $inputs[.a:.b] | test("^[^0-9]"); .a -= 1 )
      | until( $inputs[.a:.b] | test("[^0-9]$"); .b += 1 )
      | [ .a +1 , .b -1 ]
  ;

  # Add numbers if bordering symbol and new
  if ($inputs[$i:$i+1] | test("[0-9]")) and new_number($i) then .numbers += [ make_number($i) ] else . end
) |

# Output sum of all found numbers
[ .numbers[] | $inputs[.[0]:.[1]] | tonumber ] | add

#!/usr/bin/env jq -n -R -f

# Getting input with padding, and padded width
[ "." + inputs + "." ] as $inputs | ( $inputs[0] | length ) as $w |

# Working with flattened string, only keep gear '*' symbols
[
  ([range($w) | "."]|join("")), # Padding
  $inputs[],
  ([range($w) | "."]|join(""))  # Padding
] | join("") | gsub("[^0-9*]";".") as $inputs |

# Iterate over index positions of all gears
reduce ($inputs | indices("*")[]) as $i (
  0;
  # Re-use part-1 functions
  def new_number($i):
    [ .numbers[] | .[0] <= $i and $i <= .[1] ] | any | not
  ;
  def make_number($i):
    {a: $i, b: ($i+1 )}
      | until( $inputs[.a:.b] | test("^[^0-9]"); .a -= 1 )
      | until( $inputs[.a:.b] | test("[^0-9]$"); .b += 1 )
      | [ .a +1 , .b -1 ]
  ;
  # Reset and add numbers for each "box" ids
  def add_numbers($box_idx):
    reduce $box_idx[] as $i ({numbers:[]};
      if ($inputs[$i:$i+1] | test("[0-9]")) and new_number($i) then
        .numbers += [ make_number($i) ]
      else
        .
      end
    )
  ;
  add_numbers([
    $i - $w -1 , $i - $w , $i -$w + 1 ,
    $i - 1     , empty   , $i + 1     ,
    $i + $w - 1, $i + $w , $i + $w + 1
  ]).numbers as $numbers |

  if $numbers | length == 2 then
    # Add product if exactly two bordering numbers
    . += ( $numbers | map($inputs[.[0]:.[1]]|tonumber) | .[0] * .[1] )
  else
    .
  end
)

The string format of a game is, for example: "Game 1: 3 blue, 4 red; 1 red, 2 green, 6 blue; 2 green". I’ll transform a game string into a list, such that the above example becomes (1 (4 0 3) (1 2 6) (0 2 0)).

I start by simply splitting on : and chopping off "Game" from the first string to get the game number. The second string consists of a sequence of draws, which need a bit further parsing effort.

(define (parse-game game)
  (let* ((parts (string-split game ":"))
         (number (string->number (string-drop (car parts) 5)))
         (draws (map parse-draws (string-split (cadr parts) ";"))))
    (cons number draws)))

Parsing a draw is done by first splitting it on ;, to yield strings on the form "3 blue, 4 red". Each such string represents a cubeset, which I represent as lists on the form (r g b). Since the input strings don’t have any well-defined ordering of cube colours, I split on , and iterate on the resulting list of strings until I find one that has the proper colour name as its suffix, in the order red -> green -> blue. If none exists, I return 0 for that colour.

(define (parse-draws cstr)
  (let ((cubes (map string-trim (string-split cstr ","))))
    (list (get-col cubes "red")
          (get-col cubes "green")
          (get-col cubes "blue"))))

(define (get-col cubeset col)
  (cond ((null? cubeset) 0)
        ((string-suffix? col (car cubeset))
         (string->number (car (string-split (car cubeset) " "))))
        (else (get-col (cdr cubeset) col))))

To determine whether a game is possible given some numbers of different colours, I need to find the maxima of each colour for all draws in a game:

(define (maxima cubesets)
  (let loop ((cubesets cubesets) (r 0) (g 0) (b 0))
    (if (null? cubesets)
      (list r g b)
      (loop (cdr cubesets)
            (max r (caar cubesets))
            (max g (cadar cubesets))
            (max b (caddar cubesets))))))

The maxima of the draw ((4 0 3) (1 2 6) (0 2 0)) is (4 2 6). With that, it’s easy to determine whether a game is possible:

(define (game-possible? game r g b)
  (let ((mx (maxima (cdr game))))
    (and (>= r (car mx))
         (>= g (cadr mx))
         (>= b (caddr mx)))))

The solution to part 1 is now simple:

(define (solve-part1 lines)
  (let solve ((sum 0) (games (map parse-game lines)))
    (cond ((null? games) sum)
          ((game-possible? (car games) 12 13 14)
           (solve (+ sum (caar games)) (cdr games)))
          (else (solve sum (cdr games))))))

…where lines is all the lines of the input file.

Part 2 is simple, given that I already have a way to get the maxima of the draws in a game. All I need to do is to multiply them together:

(define (power-cubeset cubeset)
  (* (car cubeset) (cadr cubeset) (caddr cubeset)))

(define (solve-part2 lines)
  (let solve ((sum 0) (games (map parse-game lines)))
    (cond ((null? games) sum)
          (else (solve (+ sum (power-cubeset (maxima (cdar games))))
                       (cdr games))))))

Do you remember highschool algebra? Can you (or your compiler) remember highschool algebra fast enough to beat out a naïve implementation?

#!/usr/bin/env jq -n -R -f
[
  inputs
  # Split winning numbers | card
  | split(" | ")
  # Get numbers, remove game id
  | .[] |= [ match("\\d+"; "g").string | tonumber ] | .[0] |= .[1:]
  # Get score for each line
  | .[1] - (.[1] - .[0]) | length | select(. > 0) | pow(2; . - 1)
]

# Output total score sum
| add

Very suited to JQ, extra trick learned using: [ match("\\d+"; "g").string | tonumber ] as a parse all ints in line.

#!/usr/bin/env jq -n -R -f
[
  inputs
  # Split winning numbers | card
  | split(" | ")
  # Get numbers, remove game id
  | .[] |= [ match("\\d+"; "g").string | tonumber ] | .[0] |= .[1:]
  # Set number of cards to 1, and further cards count
  | .[1] - (.[1] - .[0]) | [ 1, length ]
]

| { cards: ., i: 0, l: length } | until (.i == .l;
  # Get number for current card
  .cards[.i][0] as $num
  # Increase range of futher cards, by current number
  | .cards[.i + range(.cards[.i][1]) + 1 ][0] += $num
  | .i += 1
)

# Output total sum of cards
| [ .cards[][0] ] | add

Not too much of an edit compared to part one, being able to easily do operations on range of indices is convenient.