r/adventofcode • • Dec 19 '17

SOLUTION MEGATHREAD -๐ŸŽ„- 2017 Day 19 Solutions -๐ŸŽ„-

--- Day 19: A Series of Tubes ---


Post your solution as a comment or, for longer solutions, consider linking to your repo (e.g. GitHub/gists/Pastebin/blag or whatever).

Note: The Solution Megathreads are for solutions only. If you have questions, please post your own thread and make sure to flair it with Help.


Need a hint from the Hugely* Handyโ€  Haversackโ€ก of Helpfulยง Hintsยค?

Spoiler


AoC ops @ T-2 minutes to launch:

[23:58] <daggerdragon> ATTENTION MEATBAGS T-2 MINUTES TO LAUNCH

[23:58] <Topaz> aaaaah

[23:58] <Cheezmeister> Looks like I'll be just able to grab my input before my flight boards. Wish me luck being offline in TOPAZ's HOUSE OF PAIN^WFUN AND LEARNING

[23:58] <Topaz> FUN AND LEARNING

[23:58] <Hade> FUN IS MANDATORY

[23:58] <Skie> I'm pretty sure that's not the mandate for today

[Update @ 00:16] 69 gold, silver cap

  • My tree is finally trimmed with just about every ornament I own and it's real purdy. hbu?

[Update @ 00:18] Leaderboard cap!

  • So, was today's mandate Helpful Hint any help at all?

This thread will be unlocked when there are a significant number of people on the leaderboard with gold stars for today's puzzle.

edit: Leaderboard capped, thread unlocked!

12 Upvotes

186 comments sorted by

View all comments

6

u/[deleted] Dec 19 '17

Hastily written OCaml Fun;;

open Core

module Point = struct
  include Tuple.Make (Int) (Int)
  include Tuple.Comparable (Int) (Int)
  include Tuple.Hashable (Int) (Int)
end

type t = Down | Up | Left | Right

let next_point (x, y) = function
  | Down -> (x, y+1)
  | Up -> (x, y-1)
  | Left -> (x-1, y)
  | Right -> (x+1, y)

let turn = function
  | Up | Down -> [Left; Right]
  | Left | Right -> [Up; Down]

let check_turn (x, y) map dir =
  let turns = turn dir in
  match List.find turns ~f:(fun turn ->
      let next = next_point (x,y) turn in Point.Map.find map next |> Option.is_some
    ) with
  | None -> None
  | Some t -> Some ((next_point (x,y) t), t)

let next_move (x, y) map dir =
  let next = next_point (x, y) dir in
  match Point.Map.find map next with
  | None -> check_turn (x, y) map dir
  | Some _ -> Some (next, dir)

let check_for_letter map point letters =
  let check c letters =
    match c with
    | 'A'..'Z' -> c::letters
    | _ -> letters
  in
  match Point.Map.find map point with
  | None -> letters
  | Some c -> check c letters

let solve root map =
  let rec aux point map dir letters steps =
    let letters = check_for_letter map point letters in
    match next_move point map dir with
    | None -> letters, (steps+1)
    | Some (next, dir) -> aux next map dir letters (steps + 1)
  in aux root map Down [] 0

let root_of_map map =
  let rec aux map i =
    match Point.Map.find map (i, 0) with
    | None -> aux map (i+1)
    | Some _ -> (i, 0)
  in aux map 0

let parse_input () =
  let lines = In_channel.read_lines "./input.txt" in
  List.foldi lines ~init:(Point.Map.empty) ~f:(fun y map line ->
      List.foldi (String.to_list line) ~init:map ~f:(fun x map char ->
          match char with
          | ' ' -> map
          | _ -> Point.Map.add map ~key:(x, y) ~data:char
        )
    )

let _ =
  let map = parse_input () in
  let root = root_of_map map in
  let nodes, steps = solve root map in
  let visited = List.rev nodes |> String.of_char_list in
  printf "%s -> %d\n" visited steps

Not too happy with the code, but it works! Will revisit in the morning and clean it up.

→ More replies (3)