Aoc 2019: mehalter

Table of Contents

mehalter

mehalter

1591837?v=4

mehalter
: mehalter

About me

I am a researcher at the Georgia Tech Research Institute and Co-Owner/Mixologist of Kindred Spirits Atlanta. My main research is in scientific knowledge representation, and am currently working on SemanticModels.jl that uses Category Theory based representations of scientific models to enhance meta-modeling tasks such as model augmentation, construction, and verification.

More information on myself can be found at mehalter.com.

Day 00: haskell

Hello, World!

I have written my solutions in Haskell. I am using this year’s Advent of Code to brush up on my functional programming.

To run the final program you need Haskell installed, and simply run the run.sh.

Solution

main = do
  putStrLn "Hello, World!"

#!/bin/bash

runhaskell answer.hs

Day 01: haskell

The Tyranny of the Rocket Equation

I have written my solutions in Haskell. I am using this year’s Advent of Code to brush up on my functional programming.

To run the final program you need Haskell installed, and simply run the run.sh bash script to feed in the inputs defined in the input file as arguments to the Haskell script defined in answer.hs.

My solutions define the math equation as a function for both part one and part two, and maps the function across the array of integers passed in as command line arguments.

Solution

import System.Environment

mass1 :: Int -> Int
mass1 x = (x `div` 3) - 2

mass2 :: Int -> Int
mass2 x = do
  let m = mass1 x
  if m > 0 then m + mass2 m else 0

main = do
  inputs <- getArgs
  let ints = map (read::String->Int) inputs
  print $ sum $ map mass1 ints
  print $ sum $ map mass2 ints

#!/bin/sh

runhaskell answer.hs `< input`

Day 02: haskell

1202 Program Alarm

To run the final program you need Haskell installed, and simply run the ./run.sh.

My solution for part 1 defines a recursive function comp, that computes a single step of the computer and then continues to call itself with the next instruction address until it encounters an error or the halt opcode, 99.

My solution for part 2 defines a brute force recursive function findParamsBrute, that checks to see if a set of params results in the expected output. If it doesn’t, it calls itself with the parameters updated accordingly, and runs until the desired output is found.

I also added a O(1) solution specific to the challenege input, that calculates the correct params for a given final answer based on the rate of change caused by the first and second parameters. A single unit increase in the first parameter causes a change of +243000, while a single unit increase in the second parameter causes a change of +1. Knowing this, and the fact that the initial result given parameters [0, 0] is 493708, we can solve for the correct parameters in a single calculation.

Solution

import System.Environment
import qualified Data.Map.Strict as Map

import Intcode

computeTilHalt2 :: ((Map.Map Int Int, Int, Int), ([Int], [Int])) -> Int
computeTilHalt2 ((prog, y, z), io) =
  if y == -1 then prog Map.! 0
  else computeTilHalt2 $ compute (prog, y, z) io

findParams :: Int -> Int
findParams goal = 100*first + second
  where
    first = (goal-493708) `div` 243000
    second = goal - 493708 - 243000*first

main = do
  input <- getArgs
  let parsed = parseProg $ input!!0

  let map = Map.insert 1 12 parsed
  let newMap = Map.insert 2 2 map
  print $ computeTilHalt2 $ startingState newMap []
  print $ findParams 19690720

module Intcode
( parseProg
, compute
, computeTilHalt
, startingState
) where

import Data.List as List
import Data.Maybe
import Data.Ord
import Data.List.Split
import qualified Data.Map.Strict as Map

parseProg :: String -> Map.Map Int Int
parseProg str = Map.fromList $ List.zip [0..] $ map (read :: String -> Int) $ splitOn "," str

compute :: (Map.Map Int Int, Int, Int) -> ([Int], [Int]) -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
compute (x, y, z) (input_orig, output) =
  if op == 99
    then ((x, -1, z), (input_orig, output))
  else if op == 1 || op == 2
    then compute ((Map.insert dest ((if op == 1 then (+) else (*)) left right) x), (y+4), z) (input_orig, output)
  else if op == 3
    then compute ((Map.insert dest input x), (y+2), z) (inputs, output)
  else if op == 4
    then ((x, y+2, z), (input_orig, (left:output)))
  else if op == 5 || op == 6
    then compute (x, (if (if op == 5 then (/=) else (==)) left 0 then right else (y+3)), z) (input_orig, output)
  else if op == 7 || op == 8
    then compute ((Map.insert dest (if (if op == 7 then (<) else (==)) left right then 1 else 0) x), (y+4), z) (input_orig, output)
  else if op == 9
    then compute (x, y+2, z+left) (input_orig, output)
  else
    ((Map.empty, -1, z), (input_orig, output))
  where
    (input:inputs) = if Prelude.length input_orig > 0 then input_orig else (0:input_orig)
    indexOfIndex y = Map.findWithDefault 0 (x Map.! y) x
    digits = Prelude.reverse $ Prelude.map (read . return) $ show $ x Map.! y
    op = (if Prelude.length digits > 1 then 10 * digits!!1 else 0) + digits!!0
    left = if Prelude.length digits > 2 && digits!!2 == 1 then x Map.! (y+1)
           else if Prelude.length digits > 2 && digits!!2 == 2 then x Map.! (z+(x Map.! (y+1)))
           else indexOfIndex (y+1)
    right = if Prelude.length digits > 3 && digits!!3 == 1 then x Map.! (y+2)
            else if Prelude.length digits > 3 && digits!!3 == 2 then x Map.! (z+(x Map.! (y+2)))
            else indexOfIndex (y+2)
    dest = if op == 3 then (if Prelude.length digits > 2 && digits!!2 == 2 then z+(x Map.! (y+1)) else x Map.! (y+1))
           else (if Prelude.length digits > 4 && digits!!4 == 2 then z else 0)+(x Map.! (y+3))

computeTilHalt :: ((Map.Map Int Int, Int, Int), ([Int], [Int])) -> [Int]
computeTilHalt ((prog, y, z), (inputs, outputs)) =
  if y == -1 then outputs
  else computeTilHalt $ compute (prog, y, z) (inputs, outputs)

startingState :: Map.Map Int Int -> [Int] -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
startingState prog input = ((prog, 0, 0), (input, []))

#!/bin/sh

runhaskell answer.hs `< input`

Day 03: haskell

Crossed Wires

To run the final program you need Haskell installed, and simply run the ./run.sh.

My solution takes a brute force approach that generates all the points each wire touches using the getAllPoints function, then gets the intersection of the two wire points to get all the places the wires cross.

My solution for part 1 then takes the intersection, finds the closest one to the central point, and calculates the Manhattan distance.

My solution for part 2 takes the intersection, calculates how many steps it takes to get to each of the crosses, and returns the minimum steps to reach a cross.

Solution

import System.Environment
import Data.Set as Set
import Data.List as List
import Data.List.Split
import Data.Maybe as Maybe

parse :: [String] -> [[String]]
parse = List.map (splitOn ",")

-- Calculate given a direction, whether the length should be added or subtracted
getDir :: Char -> Int
getDir dir = if dir == 'L' || dir == 'D' then -1 else 1

-- Calculate an array of points in a single step of the wire
getPoints :: Char -> Int -> [[Int]] -> [[Int]]
getPoints dir len points = do
  let [x,y] = last points
  points ++ [if dir == 'L' || dir == 'R' then [x + point, y] else [x, y + point]
    | point <- Prelude.map ((getDir dir)*) [1..len]]

-- Calculate all the points for all the steps
getAllPoints :: [String] -> [[Int]] -> [[Int]]
getAllPoints [] points = points
getAllPoints (d:ds) points = getAllPoints ds (getPoints (head d) (read (tail d)::Int) points)

-- Convert two wire array of points to sets, and find where they cross
getIntersectionSet :: [[Int]] -> [[Int]] -> Set [Int]
getIntersectionSet a b = (fromList a) `Set.intersection` (fromList b)

-- Calculate Manhattan distance of point to (0,0)
getDis :: [Int] -> Int
getDis [x,y] = (abs x) + (abs y)

-- Calculate Manhattan distance for all the intersection points, and return the smallest that isn't 0
getMinManhattan :: Set [Int] -> Int
getMinManhattan points = elemAt 1 $ Set.map getDis points

-- Calculate number of steps needed to get to a given intersection point
getPointStep :: [[Int]] -> [[Int]] -> [Int] -> Int
getPointStep a b point = (fromMaybe 0 $ List.elemIndex point a) + (fromMaybe 0 $ List.elemIndex point b)

-- Calculate steps for all the intersection points, and return the smallest that isn't 0
getMinSteps :: [[Int]] -> [[Int]] -> Set [Int] -> Int
getMinSteps a b points = elemAt 1 $ Set.map (getPointStep a b) points

main = do
  input <- getArgs

  let x = parse input

  -- Get all the points for wires a and b
  let pointsA = getAllPoints (x!!0) [[0,0]]
  let pointsB = getAllPoints (x!!1) [[0,0]]

  -- Find all the points where the wires cross
  let intersection = pointsA `getIntersectionSet` pointsB

  -- Print the minimum Manhattan distance of an intersection
  print $ getMinManhattan intersection
  -- Print the minimum steps needed to get to an intersection
  print $ getMinSteps pointsA pointsB intersection

#!/bin/sh

runhaskell answer.hs `< input`

Day 04: haskell

Secure Container

To run the final program you need Haskell installed, and simply run the ./run.sh.

My solution takes a brute force approach that checks to see if all the numbers in the specified range have sorted digits and duplicate items. The second part makes sure that at least one item has exactly 2 appearances.

Solution

import System.Environment
import Data.List
import Data.List.Split

parse :: String -> [Int]
parse = map (read :: String -> Int) . splitOn "-"

-- convert a number to a list of digits
digits :: Int -> [Int]
digits = map (read . return) . show

-- check if list is sorted
isSorted :: Ord a => [a] -> Bool
isSorted list = all (uncurry (<=)) $ zip list $ tail list

-- check if the number an item appears satisfies a supplied function
containsN :: Ord a => (Int -> Bool) -> [a] -> Bool
containsN func = (<) 0 . length . filter (\l -> func $ length l) . group

-- Check if digits are sorted and if there is a digit who's appearance satisfies a function
valid :: Ord a => (Int -> Bool) -> [a] -> Bool
valid func list = isSorted list && containsN func list

main = do
  input <- getArgs
  let [x, y] = parse  $ input!!0
  let ints = map digits [x..y]
  print $ length $ filter (valid (>1)) ints
  print $ length $ filter (valid (==2)) ints

#!/bin/sh

runhaskell answer.hs `< input`

Day 05: haskell

Sunny with a Chance of Asteroids

To run the final program you need Haskell installed, and simply run the ./run.sh.

This solution extends my Day 02 solution by adding extra checks and functionality for the new op codes.

Solution

import System.Environment

import Intcode

main = do
  input <- getArgs
  let parsed = parseProg $ input!!0

  print $ flip (!!) 0 $ computeTilHalt $ startingState parsed [1]
  print $ flip (!!) 0 $ computeTilHalt $ startingState parsed [5]

module Intcode
( parseProg
, compute
, computeTilHalt
, startingState
) where

import Data.List as List
import Data.Maybe
import Data.Ord
import Data.List.Split
import qualified Data.Map.Strict as Map

parseProg :: String -> Map.Map Int Int
parseProg str = Map.fromList $ List.zip [0..] $ map (read :: String -> Int) $ splitOn "," str

compute :: (Map.Map Int Int, Int, Int) -> ([Int], [Int]) -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
compute (x, y, z) (input_orig, output) =
  if op == 99
    then ((x, -1, z), (input_orig, output))
  else if op == 1 || op == 2
    then compute ((Map.insert dest ((if op == 1 then (+) else (*)) left right) x), (y+4), z) (input_orig, output)
  else if op == 3
    then compute ((Map.insert dest input x), (y+2), z) (inputs, output)
  else if op == 4
    then ((x, y+2, z), (input_orig, (left:output)))
  else if op == 5 || op == 6
    then compute (x, (if (if op == 5 then (/=) else (==)) left 0 then right else (y+3)), z) (input_orig, output)
  else if op == 7 || op == 8
    then compute ((Map.insert dest (if (if op == 7 then (<) else (==)) left right then 1 else 0) x), (y+4), z) (input_orig, output)
  else if op == 9
    then compute (x, y+2, z+left) (input_orig, output)
  else
    ((Map.empty, -1, z), (input_orig, output))
  where
    (input:inputs) = if Prelude.length input_orig > 0 then input_orig else (0:input_orig)
    indexOfIndex y = Map.findWithDefault 0 (x Map.! y) x
    digits = Prelude.reverse $ Prelude.map (read . return) $ show $ x Map.! y
    op = (if Prelude.length digits > 1 then 10 * digits!!1 else 0) + digits!!0
    left = if Prelude.length digits > 2 && digits!!2 == 1 then x Map.! (y+1)
           else if Prelude.length digits > 2 && digits!!2 == 2 then x Map.! (z+(x Map.! (y+1)))
           else indexOfIndex (y+1)
    right = if Prelude.length digits > 3 && digits!!3 == 1 then x Map.! (y+2)
            else if Prelude.length digits > 3 && digits!!3 == 2 then x Map.! (z+(x Map.! (y+2)))
            else indexOfIndex (y+2)
    dest = if op == 3 then (if Prelude.length digits > 2 && digits!!2 == 2 then z+(x Map.! (y+1)) else x Map.! (y+1))
           else (if Prelude.length digits > 4 && digits!!4 == 2 then z else 0)+(x Map.! (y+3))

computeTilHalt :: ((Map.Map Int Int, Int, Int), ([Int], [Int])) -> [Int]
computeTilHalt ((prog, y, z), (inputs, outputs)) =
  if y == -1 then outputs
  else computeTilHalt $ compute (prog, y, z) (inputs, outputs)

startingState :: Map.Map Int Int -> [Int] -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
startingState prog input = ((prog, 0, 0), (input, []))

#!/bin/sh

runhaskell answer.hs `< input`

Day 06: haskell

Universal Orbit Map

I have written my solutions in Haskell. I am using this year’s Advent of Code to brush up on my functional programming.

To run the final program you need Haskell installed, and simply run the ./run.sh.

This solution takes a dynamic programming approach to finding the total orbits, and maps to find the path between you and Santa

Solution

import System.Environment
import Data.Map.Lazy as Map
import Data.List.Split
import Control.Arrow
import Control.Monad (join)
import Data.Tuple (swap)
import Data.List (unfoldr)
import Data.Function (on)

parse :: String -> (String, String)
parse input = (x,y) where
  [x,y] = splitOn ")" input

orbits :: [(String, String)] -> Map String [String]
orbits input = fromListWith (++) $ second (:[]) <$> input

totalOrbits :: Map String [String] -> Int
totalOrbits orbits = sum checksums where
  checksums = checksum <$> orbits
  checksum = sum . Prelude.map (maybe 1 (+ 1) . flip Map.lookup checksums)

solveA :: [String] -> Int
solveA input = totalOrbits $ orbits $ Prelude.map parse input

rorbits :: [(String, String)] -> Map String String
rorbits input = Map.fromList $ swap <$> input

dropCommonPrefix :: [String] -> [String] -> ([String], [String])
dropCommonPrefix (x:xs) (y:ys) | x == y = dropCommonPrefix xs ys
dropCommonPrefix xs ys = (xs, ys)

path :: [(String, String)] -> String -> [String]
path orbits = (reverse .) . unfoldr $ fmap (join (,)) . flip Map.lookup (rorbits orbits)

solveB :: [String] -> Int
solveB input = uncurry ((+) `on` length) $ dropCommonPrefix (path parsed "SAN") (path parsed "YOU") where parsed = Prelude.map parse input

main = do
  input <- getArgs
  print $ solveA input
  print $ solveB input

#!/bin/sh

runhaskell answer.hs `< input`

Day 07: haskell

Amplification Circuit

To run the final program you need Haskell installed, and simply run the ./run.sh.

This solution extends my Day 05 solution by changing the inputs and outputs to the compute function to allow for daisy chaining computers together, and for part 2, have the ability to start a computer back up at a given state.

Solution

import System.Environment
import Data.Sequence
import Data.List
import Data.List.Split
import Data.Ord
import qualified Data.Map.Strict as Map

import Intcode

startingStates :: Map.Map Int Int -> [Int] -> Seq ((Map.Map Int Int, Int, Int), ([Int], [Int]))
startingStates prog comps = update 0 (state, (input ++ [0], output)) out
  where
    out = fromList $ map (\i -> startingState prog [i]) comps
    (state, (input, output)) = out `index` 0

runSeries :: Seq ((Map.Map Int Int, Int, Int), ([Int], [Int])) -> [Int] -> Int -> Int
runSeries states comps idx = do
  let (state, (newInput, newOutput:outputs)) = uncurry compute $ index states idx
  let newStates = update idx (state, (newInput, newOutput:outputs)) states
  let newIdx = if idx+1 == Data.List.length comps then 0 else idx+1
  let ((nextProg, nextY, nextZ), (nextInput, nextOutput)) = index newStates newIdx
  if nextY == -1
    then newOutput
  else
    runSeries (update newIdx ((nextProg, nextY, nextZ), (nextInput ++ [newOutput], nextOutput)) newStates) comps newIdx

findMax :: Map.Map Int Int -> [[Int]] -> Int
findMax prog comps = snd $ maximumBy (comparing snd) $ map (\i -> (i, runSeries (startingStates prog i) i 0)) comps

main = do
  input <- getArgs
  let parsed = parseProg $ input!!0

  print $ findMax parsed $ permutations [0..4]
  print $ findMax parsed $ permutations [5..9]

module Intcode
( parseProg
, compute
, computeTilHalt
, startingState
) where

import Data.List as List
import Data.Maybe
import Data.Ord
import Data.List.Split
import qualified Data.Map.Strict as Map

parseProg :: String -> Map.Map Int Int
parseProg str = Map.fromList $ List.zip [0..] $ map (read :: String -> Int) $ splitOn "," str

compute :: (Map.Map Int Int, Int, Int) -> ([Int], [Int]) -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
compute (x, y, z) (input_orig, output) =
  if op == 99
    then ((x, -1, z), (input_orig, output))
  else if op == 1 || op == 2
    then compute ((Map.insert dest ((if op == 1 then (+) else (*)) left right) x), (y+4), z) (input_orig, output)
  else if op == 3
    then compute ((Map.insert dest input x), (y+2), z) (inputs, output)
  else if op == 4
    then ((x, y+2, z), (input_orig, (left:output)))
  else if op == 5 || op == 6
    then compute (x, (if (if op == 5 then (/=) else (==)) left 0 then right else (y+3)), z) (input_orig, output)
  else if op == 7 || op == 8
    then compute ((Map.insert dest (if (if op == 7 then (<) else (==)) left right then 1 else 0) x), (y+4), z) (input_orig, output)
  else if op == 9
    then compute (x, y+2, z+left) (input_orig, output)
  else
    ((Map.empty, -1, z), (input_orig, output))
  where
    (input:inputs) = if Prelude.length input_orig > 0 then input_orig else (0:input_orig)
    indexOfIndex y = Map.findWithDefault 0 (x Map.! y) x
    digits = Prelude.reverse $ Prelude.map (read . return) $ show $ x Map.! y
    op = (if Prelude.length digits > 1 then 10 * digits!!1 else 0) + digits!!0
    left = if Prelude.length digits > 2 && digits!!2 == 1 then x Map.! (y+1)
           else if Prelude.length digits > 2 && digits!!2 == 2 then x Map.! (z+(x Map.! (y+1)))
           else indexOfIndex (y+1)
    right = if Prelude.length digits > 3 && digits!!3 == 1 then x Map.! (y+2)
            else if Prelude.length digits > 3 && digits!!3 == 2 then x Map.! (z+(x Map.! (y+2)))
            else indexOfIndex (y+2)
    dest = if op == 3 then (if Prelude.length digits > 2 && digits!!2 == 2 then z+(x Map.! (y+1)) else x Map.! (y+1))
           else (if Prelude.length digits > 4 && digits!!4 == 2 then z else 0)+(x Map.! (y+3))

computeTilHalt :: ((Map.Map Int Int, Int, Int), ([Int], [Int])) -> [Int]
computeTilHalt ((prog, y, z), (inputs, outputs)) =
  if y == -1 then outputs
  else computeTilHalt $ compute (prog, y, z) (inputs, outputs)

startingState :: Map.Map Int Int -> [Int] -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
startingState prog input = ((prog, 0, 0), (input, []))

#!/bin/sh

runhaskell answer.hs `< input`

Day 08: haskell

Space Image Format

To run the final program you need Haskell installed, and simply run the ./run.sh.

This solution takes the input as an array of characters, splits it into the layers, and does a search through the layers to calculate part 1 and to decode the image for part 2.

Solution

import System.Environment
import Data.Char
import Data.List
import Data.List.Split
import Data.Ord

count :: Char -> [Char] -> Int
count char = length . filter (char ==)

getPixel :: Char -> Char
getPixel input = if input == '0' then ' ' else if input == '1' then '█' else input

mergeAllLayers :: [[Char]] -> [Char]
mergeAllLayers [input] = input
mergeAllLayers (inp:inps) = foldl merge2Layers inp inps

merge2Layers :: [Char] -> [Char] -> [Char]
merge2Layers in1 [] = in1
merge2Layers (in1:in1s) (in2:in2s) = (if in1 == '2' then getPixel in2 else getPixel in1) : merge2Layers in1s in2s

solveA :: [Char] -> (Int, Int) -> Int
solveA input (x, y) = count '1' found * count '2' found where
    found = fst $ minimumBy (comparing snd) $ map (\i -> (i, count '0' i)) $ chunksOf (x*y) input

solveB :: [Char] -> (Int, Int) -> [Char]
solveB input (x, y) = foldl (\i j->i ++ (j ++ ['\n'])) [] $ chunksOf x $ mergeAllLayers $ chunksOf (x*y) input

main = do
  inputs <- getArgs
  let input = inputs!!0
  let x = 25
  let y = 6

  print $ solveA input (x, y)
  putStr $ solveB input (x, y)

#!/bin/sh

runhaskell answer.hs `< input`

Day 09: haskell

Sensor Boost

To run the final program you need Haskell installed, and simply run the ./run.sh.

This solution extends my Day 07 solution by adding an parameter mode to treat a parameter as a relative memory offset from a base.

Solution

import System.Environment
import Data.List
import Data.List.Split
import Data.Ord
import qualified Data.Map.Strict as Map

import Intcode

main = do
  input <- getArgs
  let parsed = parseProg $ input!!0

  print $ flip (!!) 0 $ computeTilHalt $ startingState parsed [1]
  print $ flip (!!) 0 $ computeTilHalt $ startingState parsed [2]

module Intcode
( parseProg
, compute
, computeTilHalt
, startingState
) where

import Data.List as List
import Data.Maybe
import Data.Ord
import Data.List.Split
import qualified Data.Map.Strict as Map

parseProg :: String -> Map.Map Int Int
parseProg str = Map.fromList $ List.zip [0..] $ map (read :: String -> Int) $ splitOn "," str

compute :: (Map.Map Int Int, Int, Int) -> ([Int], [Int]) -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
compute (x, y, z) (input_orig, output) =
  if op == 99
    then ((x, -1, z), (input_orig, output))
  else if op == 1 || op == 2
    then compute ((Map.insert dest ((if op == 1 then (+) else (*)) left right) x), (y+4), z) (input_orig, output)
  else if op == 3
    then compute ((Map.insert dest input x), (y+2), z) (inputs, output)
  else if op == 4
    then ((x, y+2, z), (input_orig, (left:output)))
  else if op == 5 || op == 6
    then compute (x, (if (if op == 5 then (/=) else (==)) left 0 then right else (y+3)), z) (input_orig, output)
  else if op == 7 || op == 8
    then compute ((Map.insert dest (if (if op == 7 then (<) else (==)) left right then 1 else 0) x), (y+4), z) (input_orig, output)
  else if op == 9
    then compute (x, y+2, z+left) (input_orig, output)
  else
    ((Map.empty, -1, z), (input_orig, output))
  where
    (input:inputs) = if Prelude.length input_orig > 0 then input_orig else (0:input_orig)
    indexOfIndex y = Map.findWithDefault 0 (x Map.! y) x
    digits = Prelude.reverse $ Prelude.map (read . return) $ show $ x Map.! y
    op = (if Prelude.length digits > 1 then 10 * digits!!1 else 0) + digits!!0
    left = if Prelude.length digits > 2 && digits!!2 == 1 then x Map.! (y+1)
           else if Prelude.length digits > 2 && digits!!2 == 2 then x Map.! (z+(x Map.! (y+1)))
           else indexOfIndex (y+1)
    right = if Prelude.length digits > 3 && digits!!3 == 1 then x Map.! (y+2)
            else if Prelude.length digits > 3 && digits!!3 == 2 then x Map.! (z+(x Map.! (y+2)))
            else indexOfIndex (y+2)
    dest = if op == 3 then (if Prelude.length digits > 2 && digits!!2 == 2 then z+(x Map.! (y+1)) else x Map.! (y+1))
           else (if Prelude.length digits > 4 && digits!!4 == 2 then z else 0)+(x Map.! (y+3))

computeTilHalt :: ((Map.Map Int Int, Int, Int), ([Int], [Int])) -> [Int]
computeTilHalt ((prog, y, z), (inputs, outputs)) =
  if y == -1 then outputs
  else computeTilHalt $ compute (prog, y, z) (inputs, outputs)

startingState :: Map.Map Int Int -> [Int] -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
startingState prog input = ((prog, 0, 0), (input, []))

#!/bin/sh

runhaskell answer.hs `< input`

Day 10: haskell

Monitoring Station

To run the final program you need Haskell installed, and simply run the ./run.sh.

This solution uses a brute force method for part 1 to check which asteroid can see the most number of other asteroids.

For part 2, I used arctangent to calculate the angle an asteroid is from straight up from the asteroid firing the laser. Then sorts by the angles to get the vaporization order.

Solution

import System.Environment
import Data.Set as Set
import Data.List
import Data.Ord

-- Convert input to a set of points
parse :: [String] -> Set.Set (Int, Int)
parse = Set.fromList . Prelude.filter (\i->i /= (-1, -1)) . mkMap
  where
    mkMap m = concatMap idxY $ zip m [0..]
    idxY (r, y) = Prelude.map (idxX y) $ zip r [0..]
    idxX y ('#', x) = (x, y)
    idxX y ('.', x) = (-1,-1)

-- Check if any points along the line between 2 points are an asteroid
isVisible :: (Int, Int) -> (Int, Int) -> Set.Set (Int, Int) -> Bool
isVisible (x1,y1) (x2,y2) input = divisor == 1 || (not $ any (\n -> Set.member (x1 + ((div dx divisor)*n), y1 + ((div dy divisor)*n)) input) [1..(divisor-1)])
  where
    (dx,dy) = (x2-x1, y2-y1)
    divisor = gcd dx dy

-- Filter all points that are visible from a given point
allVisible :: (Int, Int) -> Set.Set (Int, Int) -> Set.Set (Int, Int)
allVisible x input = Set.delete x $ Set.filter (\i -> isVisible x i input) input

-- Find point with the maximum number of visible asteroids
maxVisible :: Set.Set (Int, Int) -> ((Int, Int), Int)
maxVisible input = maximumBy (comparing snd) $ Prelude.map (\i -> (i, Set.size $ allVisible i input)) $ Set.toList input

-- Calculate the angle an asteroid is from straight up using arctangent
angle :: (Int, Int) -> (Int, Int) -> Float
angle (x1, y1) (x2, y2) = (if angle < 0 then 2*pi else 0) + angle
  where angle = atan2 (fromIntegral $ x2-x1) (fromIntegral $ y1-y2)

-- Get all asteroids in order of clockwise sweeps of visible asteroids
vaporizeOrder :: (Int, Int) -> Set.Set (Int, Int) -> [(Int, Int)]
vaporizeOrder x input = if Set.null input then [] else ((sortBy (comparing (angle x))) (Set.toList visible)) ++ (vaporizeOrder x (Set.difference input visible))
  where visible = allVisible x input

main = do
  input <- getArgs
  let x = parse input

  let (maxPos, occ) = maxVisible x
  print occ
  let (foundX, foundY) = (vaporizeOrder maxPos x)!!199
  print $ foundX*100 + foundY

#!/bin/bash

runhaskell answer.hs `< input`

Day 11: haskell

Space Police

To run the final program you need Haskell installed, and simply run the ./run.sh.

This solution extends my Day 09 by adding a paint function that controls the paint robot. First I get all the points that are painted from the computer, then I fold them into a multiline string that prints the picture

Solution

import System.Environment
import Data.Sequence
import Data.List
import Data.List.Split
import Data.Ord
import Data.Foldable
import qualified Data.Map.Strict as Map

import Intcode

getPoints :: ((Map.Map Int Int, Int, Int), ([Int], [Int])) -> Map.Map (Int, Int) Int -> Int -> (Int, Int) -> Map.Map (Int, Int) Int
getPoints (prog, (inputs, outputs)) map dir (x, y) = if nextY2 == -1 then newMap
                                                     else getPoints ((nextProg2, nextY2, nextZ2), (newInput2, (newDir:newOutputs2))) newMap newDir2 (newX, newY)
  where
    currColor = Map.findWithDefault 0 (x, y) map
    ((nextProg1, nextY1, nextZ1), (newInput1, (newColor:newOutputs1))) = compute prog ((currColor:inputs), outputs)
    newMap = if nextY1 == -1 || newColor == currColor then map else Map.insert (x, y) newColor map
    ((nextProg2, nextY2, nextZ2), (newInput2, (newDir:newOutputs2))) = if nextY1 == -1 then ((nextProg1, nextY1, nextZ1), (newInput1, (newColor:newOutputs1)))
                                                                       else compute (nextProg1, nextY1, nextZ1) (newInput1, (newColor:newOutputs1))
    newDir2 = mod (dir+(if newDir == 0 then -1 else 1)) 4
    newX = if newDir2 == 1 then x+1 else if newDir2 == 3 then x-1 else x
    newY = if newDir2 == 0 then y+1 else if newDir2 == 2 then y-1 else y

paint :: Map.Map (Int, Int) Int -> [Char]
paint map = foldl (\i j->i ++ (j ++ ['\n'])) [] $ Data.List.Split.chunksOf width $ toList seq
  where
    minX = fst $ minimumBy (comparing fst) $ Map.keys map
    maxX = fst $ maximumBy (comparing fst) $ Map.keys map
    minY = snd $ minimumBy (comparing snd) $ Map.keys map
    maxY = snd $ maximumBy (comparing snd) $ Map.keys map
    width = abs minX + abs maxX + 1
    height = abs minY + abs maxY + 1
    output = fromList $ Prelude.take (width*height) (repeat ' ')
    seq = Map.foldlWithKey (\seq (x, y) color->update ((abs (y - maxY))*width + (x+abs minX)) (if color == 1 then '█' else ' ') seq) output map

main = do
  input <- getArgs
  let parsed = parseProg $ input!!0

  print $ Map.size $ getPoints (startingState parsed []) (Map.empty) 0 (0, 0)
  putStr $ paint $ getPoints (startingState parsed []) (Map.singleton (0,0) 1) 0 (0, 0)

module Intcode
( parseProg
, compute
, computeTilHalt
, startingState
) where

import Data.List as List
import Data.Maybe
import Data.Ord
import Data.List.Split
import qualified Data.Map.Strict as Map

parseProg :: String -> Map.Map Int Int
parseProg str = Map.fromList $ List.zip [0..] $ map (read :: String -> Int) $ splitOn "," str

compute :: (Map.Map Int Int, Int, Int) -> ([Int], [Int]) -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
compute (x, y, z) (input_orig, output) =
  if op == 99
    then ((x, -1, z), (input_orig, output))
  else if op == 1 || op == 2
    then compute ((Map.insert dest ((if op == 1 then (+) else (*)) left right) x), (y+4), z) (input_orig, output)
  else if op == 3
    then compute ((Map.insert dest input x), (y+2), z) (inputs, output)
  else if op == 4
    then ((x, y+2, z), (input_orig, (left:output)))
  else if op == 5 || op == 6
    then compute (x, (if (if op == 5 then (/=) else (==)) left 0 then right else (y+3)), z) (input_orig, output)
  else if op == 7 || op == 8
    then compute ((Map.insert dest (if (if op == 7 then (<) else (==)) left right then 1 else 0) x), (y+4), z) (input_orig, output)
  else if op == 9
    then compute (x, y+2, z+left) (input_orig, output)
  else
    ((Map.empty, -1, z), (input_orig, output))
  where
    (input:inputs) = if Prelude.length input_orig > 0 then input_orig else (0:input_orig)
    indexOfIndex y = Map.findWithDefault 0 (x Map.! y) x
    digits = Prelude.reverse $ Prelude.map (read . return) $ show $ x Map.! y
    op = (if Prelude.length digits > 1 then 10 * digits!!1 else 0) + digits!!0
    left = if Prelude.length digits > 2 && digits!!2 == 1 then x Map.! (y+1)
           else if Prelude.length digits > 2 && digits!!2 == 2 then x Map.! (z+(x Map.! (y+1)))
           else indexOfIndex (y+1)
    right = if Prelude.length digits > 3 && digits!!3 == 1 then x Map.! (y+2)
            else if Prelude.length digits > 3 && digits!!3 == 2 then x Map.! (z+(x Map.! (y+2)))
            else indexOfIndex (y+2)
    dest = if op == 3 then (if Prelude.length digits > 2 && digits!!2 == 2 then z+(x Map.! (y+1)) else x Map.! (y+1))
           else (if Prelude.length digits > 4 && digits!!4 == 2 then z else 0)+(x Map.! (y+3))

computeTilHalt :: ((Map.Map Int Int, Int, Int), ([Int], [Int])) -> [Int]
computeTilHalt ((prog, y, z), (inputs, outputs)) =
  if y == -1 then outputs
  else computeTilHalt $ compute (prog, y, z) (inputs, outputs)

startingState :: Map.Map Int Int -> [Int] -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
startingState prog input = ((prog, 0, 0), (input, []))

#!/bin/sh

runhaskell answer.hs `< input`

Day 12: haskell

The N-Body Problem

To run the final program you need Haskell installed, and simply run the ./run.sh.

My solution for part 1 is pretty straight forward, define a timeStep function that calculates the new velocities and then positions for each of the moons for a single time step. Then the timeSteps function loops for a given number of time steps, and then a totalEnergy function calculates the sum of all the positions times velocities of each moon.

Part 2 was a little trickier, and came after realizing that the positions and velocities are periodic, and therefore the first repeated state must be the same as the initial state. Then because the 3 axes are changing independently of each other, you can find cycle of each axis, and calculate the least common multiple of the 3. This allows you to go through much fewer time steps and still find the total cycle of the system.

Solution

import System.Environment
import Text.Regex.PCRE
import Data.List.Split
import Data.List

type PosVel = ([Int],[Int])

-- Convert input to a list of (positions, velocities)
parse :: [String] -> [PosVel]
parse ss = zip (chunksOf 3 $ foldl (\a s -> a ++ map (\i -> read (i!!1) :: Int) (s =~ "=([-\\d]*)" :: [[String]])) [] ss) $ take (length ss) $ repeat [0,0,0]

-- Update velocity of moon 1 based on moon 2
newVelocity :: PosVel -> PosVel -> [Int]
newVelocity ([px1, py1, pz1], [vx1, vy1, vz1]) ([px2, py2, pz2], [vx2, vy2, vz2]) =
  [(velChange px1 px2),(velChange py1 py2),(velChange pz1 pz2)]
  where
    velChange v1 v2 = if v2 > v1 then 1 else if v2 < v1 then (-1) else 0

sumTriple :: [Int] -> [Int] -> [Int]
sumTriple [x1, y1, z1] [x2, y2, z2] = [x1+x2, y1+y2, z1+z2]

-- Update position based on velocity
updatePosition :: PosVel -> PosVel
updatePosition ([px, py, pz], [vx, vy, vz]) = ([px+vx, py+vy, pz+vz], [vx, vy, vz])

-- Get unique pairs of indexes relative to a given index
uniquePairs :: [Int] -> Int -> [(Int, Int)]
uniquePairs l i = [(x,y) | x<-l, y<-l, x /= y && x == i]

-- Calculate a single timestep
timeStep :: [PosVel] -> [PosVel]
timeStep moons = map (\i->updatePosition ((fst $ moons!!i), foldl sumTriple (snd $ moons!!i) $ map (\(i1, i2) -> newVelocity (moons!!i1) (moons!!i2)) (uniquePairs idxs i))) idxs
  where idxs = [0..((length moons)-1)]

-- Loop for a number of steps
timeSteps :: [PosVel] -> Int -> [PosVel]
timeSteps moons steps = foldl (\posvels step -> timeStep posvels) moons [1..steps]

-- Find equilibrium step by finding cycle in each axis and finding the least common multiple between the 3 cycles
equilibrium :: [PosVel] -> [PosVel] -> [Int] -> Int -> Int
equilibrium initial moons [xc, yc, zc] step = if xc /= 0 && yc /= 0 && zc /= 0 then lcm xc $ lcm yc zc
                                              else equilibrium initial newMoons [checkCycle xc 0, checkCycle yc 1, checkCycle zc 2] (step+1)
  where
    newMoons = timeStep moons
    checkCycle val idx = if val == 0 && equalAxis initial newMoons idx then step+1 else val
    equalAxis initial currMoons idx = (getAxis idx initial) == (getAxis idx currMoons)
    getAxis axis = map (\(p, v) -> (p!!axis, v!!axis))

-- Calculate total energy in the system
totalEnergy :: [PosVel] -> Int
totalEnergy = sum . map (\(p, v) -> sum (map abs p) * sum (map abs v))

main = do
  input <- getArgs
  let parsed = parse input

  print $ totalEnergy $ timeSteps parsed 1000
  print $ equilibrium parsed parsed [0,0,0] 0

#!/bin/bash

runhaskell answer.hs `< input`

Day 13: haskell

Care Package

To run the final program you need Haskell installed, and simply run the ./run.sh.

Part 1 is a pretty straight forward solution, run the program, count the number of elements that are block items.

Part 2 took some more time because I couldn’t figure out an elegant solution to making the game interactive, so instead I went into the input and gave myself an entire row of paddles instead of the one, and let the game play out like that!

Solution

import System.Environment
import Data.List
import Data.List.Split
import qualified Data.Map.Strict as Map

import Intcode

getElements :: ((Map.Map Int Int, Int, Int), ([Int], [Int])) -> [((Int, Int), Int)]
getElements ((prog, y, z), (inputs, outputs)) = if y == -1 then map (\[x, y, i] -> ((x, y), i)) $ Data.List.Split.chunksOf 3 $ Data.List.reverse outputs else getElements $ compute (prog, y, z) (inputs, outputs)

solveA :: [((Int, Int), Int)] -> Int
solveA = Prelude.length . Data.List.filter (\(pos, i) -> i == 2)

solveB :: [((Int, Int), Int)] -> Int
solveB = snd . last

main = do
  input <- getArgs
  let parsed = parseProg $ input!!0

  let output = getElements $ startingState parsed []
  print $ solveA output
  print $ solveB output

module Intcode
( parseProg
, compute
, computeTilHalt
, startingState
) where

import Data.List as List
import Data.Maybe
import Data.Ord
import Data.List.Split
import qualified Data.Map.Strict as Map

parseProg :: String -> Map.Map Int Int
parseProg str = Map.fromList $ List.zip [0..] $ map (read :: String -> Int) $ splitOn "," str

compute :: (Map.Map Int Int, Int, Int) -> ([Int], [Int]) -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
compute (x, y, z) (input_orig, output) =
  if op == 99
    then ((x, -1, z), (input_orig, output))
  else if op == 1 || op == 2
    then compute ((Map.insert dest ((if op == 1 then (+) else (*)) left right) x), (y+4), z) (input_orig, output)
  else if op == 3
    then compute ((Map.insert dest input x), (y+2), z) (inputs, output)
  else if op == 4
    then ((x, y+2, z), (input_orig, (left:output)))
  else if op == 5 || op == 6
    then compute (x, (if (if op == 5 then (/=) else (==)) left 0 then right else (y+3)), z) (input_orig, output)
  else if op == 7 || op == 8
    then compute ((Map.insert dest (if (if op == 7 then (<) else (==)) left right then 1 else 0) x), (y+4), z) (input_orig, output)
  else if op == 9
    then compute (x, y+2, z+left) (input_orig, output)
  else
    ((Map.empty, -1, z), (input_orig, output))
  where
    (input:inputs) = if Prelude.length input_orig > 0 then input_orig else (0:input_orig)
    indexOfIndex y = Map.findWithDefault 0 (x Map.! y) x
    digits = Prelude.reverse $ Prelude.map (read . return) $ show $ x Map.! y
    op = (if Prelude.length digits > 1 then 10 * digits!!1 else 0) + digits!!0
    left = if Prelude.length digits > 2 && digits!!2 == 1 then x Map.! (y+1)
           else if Prelude.length digits > 2 && digits!!2 == 2 then x Map.! (z+(x Map.! (y+1)))
           else indexOfIndex (y+1)
    right = if Prelude.length digits > 3 && digits!!3 == 1 then x Map.! (y+2)
            else if Prelude.length digits > 3 && digits!!3 == 2 then x Map.! (z+(x Map.! (y+2)))
            else indexOfIndex (y+2)
    dest = if op == 3 then (if Prelude.length digits > 2 && digits!!2 == 2 then z+(x Map.! (y+1)) else x Map.! (y+1))
           else (if Prelude.length digits > 4 && digits!!4 == 2 then z else 0)+(x Map.! (y+3))

computeTilHalt :: ((Map.Map Int Int, Int, Int), ([Int], [Int])) -> [Int]
computeTilHalt ((prog, y, z), (inputs, outputs)) =
  if y == -1 then outputs
  else computeTilHalt $ compute (prog, y, z) (inputs, outputs)

startingState :: Map.Map Int Int -> [Int] -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
startingState prog input = ((prog, 0, 0), (input, []))

#!/bin/sh

runhaskell answer.hs `< input`

Day 14: haskell

Space Stoichiometry

To run the final program you need Haskell installed, and simply run the ./run.sh.

Part 1 ended up being pretty tricky since you can have excess resources after a reaction, but basically recurses down to get the amount of ore needed for each element and as it does so, keeps track of the excess items.

Part 2 was pretty simple after that, doing a simple binary search to find the max amount of fuel you can produce with a given amount of ore.

Solution

import System.Environment
import Control.Monad
import Data.Maybe
import Data.List as List
import Data.List.Split
import qualified Data.Map.Strict as Map

type Chemical = (String, Int)
type Recipe = ([Chemical], [Chemical])
type Recipes = Map.Map String Recipe

parseSingleChem :: String -> (String, Int)
parseSingleChem s = (chemical, (read amount :: Int))
  where [amount, chemical] = splitOn " " s

parseString :: String -> (String, Recipe)
parseString s = (goal, (needs, [(goal, yield)]))
  where
    leftright = splitOn " => " s
    (goal, yield) = parseSingleChem (leftright!!1)
    needs = List.map parseSingleChem $ splitOn ", " (leftright!!0)

parse :: [String] -> Recipes
parse = Map.fromList . List.map parseString

reduce :: Recipe -> Recipe
reduce (inputs, output) = ([ (r, -n) | (r, n) <- totals, n < 0 ], [ (r, n) | (r, n) <- totals, n > 0 ])
  where totals = Map.toList $ Map.fromListWith (+) ([ (r, -n) | (r, n) <- inputs ] ++ output)

expand :: Recipes -> Recipe -> Maybe Recipe
expand recipes (inputs, outputs) = listToMaybe $ do
  (i, amount) <- inputs
  guard $ i `Map.member` recipes
  let (newI, [(_, newAmount)]) = recipes Map.! i
  let times = amount `div` newAmount + if amount `mod` newAmount == 0 then 0 else 1
  return $ reduce ((inputs ++ [(j, n * times) | (j, n) <- newI]), (outputs ++ [(i, newAmount * times)]))

findRecipe :: Recipes -> Recipe -> Int
findRecipe recipes = snd . flip (!!) 0 . fst . last . unfoldr (liftM (\x->(x,x)) . (expand recipes))

maxFuel :: Recipes -> Int -> Int
maxFuel recipes ore = uncurry search $ grow 1
  where
    totalOre m = findRecipe recipes ([("FUEL", m)], [("FUEL", m)])
    grow m = if totalOre (2*m) <= ore then grow (2*m) else (m, 2*m)
    search min max = if min >= max - 1 then min else let mid = (min + max) `div` 2 in if totalOre mid <= ore then search mid max else search min mid

main :: IO()
main = do
  input <- readFile "input"
  let recipes = parse $ lines input

  print $ findRecipe recipes (recipes Map.! "FUEL")
  print $ maxFuel recipes 1000000000000

#!/bin/sh

runhaskell answer.hs

Day 15: haskell

Oxygen System

To run the final program you need Haskell installed, and simply run the ./run.sh.

I used the same function for both part 1 and part 2. First I found all of the points on the grid using a breadth first search on the given intcode program. Then I used breadth first search again to find the maximum empty space away from the found oxygen tank.

Solution

import System.Environment
import Data.List as List
import Data.Maybe
import Data.Ord
import qualified Data.Map.Strict as Map

import Intcode

getPoints :: ((Map.Map Int Int, Int, Int), ([Int], [Int])) -> Map.Map (Int, Int) Int -> (Int, Int) -> Map.Map (Int, Int) Int
getPoints ((prog, y, z), (inputs, outputs)) map pos = if y == -1 then map else if lastObj == 0 then map else List.foldl Map.union Map.empty $ List.map (\(i, p) -> calcNext ((prog, y, z), (inputs, outputs)) map i p) (unmappedNeighbors map pos)
  where
    lastObj = if length outputs > 0 then outputs!!0 else -1
    unmappedNeighbors m (x, y) = filter (\(i, p) -> not . isJust $ Map.lookup p m) [(1, (x, y+1)), (2, (x, y-1)), (3, (x-1, y)), (4, (x+1, y))]

calcNext :: ((Map.Map Int Int, Int, Int), ([Int], [Int])) -> Map.Map (Int, Int) Int -> Int -> (Int, Int) -> Map.Map (Int, Int) Int
calcNext (state, (inputs, outputs)) map dir newPos = getPoints (nextState, (newInput, newObj:newOutputs)) (Map.insert newPos newObj map) newPos
    where (nextState, (newInput, newObj:newOutputs)) = compute state ((dir:inputs), outputs)

bfs :: Map.Map (Int, Int) Int -> Map.Map (Int, Int) (Int, Int) -> (Int, Int) -> Int -> Map.Map (Int, Int) (Int, Int)
bfs map seen pos dis = if lastObj == 0 then seen else List.foldl Map.union Map.empty $ List.map (\p -> bfs map (Map.insert p ((map Map.! p), dis+1) seen) p (dis+1)) (unmappedNeighbors seen pos)
  where
    lastObj = map Map.! pos
    unmappedNeighbors m (x, y) = filter (\p -> not . isJust $ Map.lookup p m) [(x, y+1), (x, y-1), (x-1, y), (x+1, y)]

getMaxDis :: Map.Map (Int, Int) Int -> (Int, Int) -> Int -> Int
getMaxDis map pos item = snd $ maximumBy (comparing snd) $ Map.elems $ Map.filter ((== item) . fst) $ bfs map (Map.singleton pos (2, 0)) pos 0

main = do
  input <- getArgs
  let parsed = parseProg $ input!!0

  let map = getPoints (startingState parsed []) (Map.singleton (0, 0) 1) (0, 0)
  print $ getMaxDis map (0, 0) 2
  print $ getMaxDis map (-16, -12) 1

module Intcode
( parseProg
, compute
, computeTilHalt
, startingState
) where

import Data.List as List
import Data.Maybe
import Data.Ord
import Data.List.Split
import qualified Data.Map.Strict as Map

parseProg :: String -> Map.Map Int Int
parseProg str = Map.fromList $ List.zip [0..] $ map (read :: String -> Int) $ splitOn "," str

compute :: (Map.Map Int Int, Int, Int) -> ([Int], [Int]) -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
compute (x, y, z) (input_orig, output) =
  if op == 99
    then ((x, -1, z), (input_orig, output))
  else if op == 1 || op == 2
    then compute ((Map.insert dest ((if op == 1 then (+) else (*)) left right) x), (y+4), z) (input_orig, output)
  else if op == 3
    then compute ((Map.insert dest input x), (y+2), z) (inputs, output)
  else if op == 4
    then ((x, y+2, z), (input_orig, (left:output)))
  else if op == 5 || op == 6
    then compute (x, (if (if op == 5 then (/=) else (==)) left 0 then right else (y+3)), z) (input_orig, output)
  else if op == 7 || op == 8
    then compute ((Map.insert dest (if (if op == 7 then (<) else (==)) left right then 1 else 0) x), (y+4), z) (input_orig, output)
  else if op == 9
    then compute (x, y+2, z+left) (input_orig, output)
  else
    ((Map.empty, -1, z), (input_orig, output))
  where
    (input:inputs) = if Prelude.length input_orig > 0 then input_orig else (0:input_orig)
    indexOfIndex y = Map.findWithDefault 0 (x Map.! y) x
    digits = Prelude.reverse $ Prelude.map (read . return) $ show $ x Map.! y
    op = (if Prelude.length digits > 1 then 10 * digits!!1 else 0) + digits!!0
    left = if Prelude.length digits > 2 && digits!!2 == 1 then x Map.! (y+1)
           else if Prelude.length digits > 2 && digits!!2 == 2 then x Map.! (z+(x Map.! (y+1)))
           else indexOfIndex (y+1)
    right = if Prelude.length digits > 3 && digits!!3 == 1 then x Map.! (y+2)
            else if Prelude.length digits > 3 && digits!!3 == 2 then x Map.! (z+(x Map.! (y+2)))
            else indexOfIndex (y+2)
    dest = if op == 3 then (if Prelude.length digits > 2 && digits!!2 == 2 then z+(x Map.! (y+1)) else x Map.! (y+1))
           else (if Prelude.length digits > 4 && digits!!4 == 2 then z else 0)+(x Map.! (y+3))

computeTilHalt :: ((Map.Map Int Int, Int, Int), ([Int], [Int])) -> [Int]
computeTilHalt ((prog, y, z), (inputs, outputs)) =
  if y == -1 then outputs
  else computeTilHalt $ compute (prog, y, z) (inputs, outputs)

startingState :: Map.Map Int Int -> [Int] -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
startingState prog input = ((prog, 0, 0), (input, []))

#!/bin/sh

runhaskell answer.hs `< input`

Day 16: haskell

Sensor Boost

To run the final program you need Haskell installed, and simply run the ./run.sh.

My solution for part 1 is the trivial solution of applying the pattern to the input for 100 iterations and then return the first 8 characters

Part 2 was tricky because of the large input overflowing the stack and taking forever trying to run the FFT algorithm on the input repeated 10,000 times. To optimize this, you have to realize the fact that the offset is over half the list, and therefore you are only adding numbers with the pattern and never multiplying by 0 or -1. So you can keep track of a cumulative summation of the rest of the digits after the offset.

Solution

import System.Environment
import Data.Char
import Data.List

parse :: String -> [Int]
parse = map digitToInt

fft :: Int -> [Int] -> [Int]
fft num input = foldl (\arr i -> step arr) input [1..num]
  where
    pattern i = tail . concat . repeat . concatMap (replicate i) $ [0, 1, 0, -1]
    step input = map (\(i, k) -> (abs . foldl (+) 0 $ zipWith (*) (pattern i) input) `mod` 10) $ zip [1..] input

partfft :: Int -> [Int] -> [Int]
partfft n = head . drop n . iterate (map ((`mod` 10). abs) . reverse . tail . scanl (+) 0 . reverse)

solveA :: [Int] -> String
solveA = concatMap show . take 8 . fft 100

solveB :: [Int] -> String
solveB input = concatMap show $ take 8 $ partfft 100 $ drop offset $ concat $ replicate 10000 input
  where
    offset = (read :: String -> Int) $ concatMap show $ take 7 input

main = do
  input <- getArgs
  let parsed = parse $ input!!0

  print $ solveA parsed
  print $ solveB parsed

#!/bin/sh

runhaskell answer.hs `< input`

Day 17: haskell

Set and Forget

To run the final program you need Haskell installed, and simply run the ./run.sh.

I took a simple bruteforce solution for Part 1 of collecting the points from the Intcode computer, and searching for points were character '' and were also surrounded by ''s.

For Part 2 for speed, I printed the map and manually found the ideal path since the output was simple enough to parse easily by hand. I included the way I went from the path to the solution as comments in answer.hs, as well as a copy of the outputted map as map.txt

Solution

import System.Environment
import Data.Char
import Data.List.Split
import qualified Data.Map.Strict as Map

import Intcode

getPoints :: [Int] -> ((Int, Int), Map.Map (Int, Int) Int) -> Map.Map (Int, Int) Int
getPoints [] (pos, map) = map
getPoints (input:inputs) ((y, x), map) = getPoints inputs (if input == 10 then ((y+1,0), map) else ((y,x+1), Map.insert (y, x) input map))

drawMap :: Map.Map (Int, Int) Int -> String
drawMap m = foldl (\s l -> s ++ (map chr l) ++ "\n") "" $ chunksOf width $ Map.elems m
  where width = (+) 1 $ snd $ last $ Map.keys m

isIntersection :: (Int, Int) -> Map.Map (Int, Int) Int -> Bool
isIntersection (x, y) m = and (map (\k -> 35 == (Map.findWithDefault (-1) k m)) [(x-1,y), (x+1,y), (x,y-1), (x,y+1)])

calibrate :: Map.Map (Int, Int) Int -> Int
calibrate m = Map.foldlWithKey (\total (x,y) i -> total + (if (isIntersection (x, y) m) && i == 35 then (x*y) else 0)) 0 m

getInput :: [String] -> [Int]
getInput = foldl (\out i -> out ++ i ++ [ord '\n']) [] . map (map ord)

main = do
  input <- getArgs
  let parsed = parseProg $ input!!0

  let points = getPoints (reverse $ computeTilHalt $ startingState parsed []) ((0, 0), Map.empty)
  putStr $ drawMap points

  print $ calibrate points

  let directions = ["A,C,A,C,B,B,C,A,C,B",
                    "L,10,R,10,L,10,L,10",
                    "R,12,L,12,R,6",
                    "R,10,R,12,L,12",
                    "n"]
  print (flip (!!) 0 $ computeTilHalt $ startingState (Map.insert 0 2 parsed) $ getInput directions)


  -- L10R10L10L10R10R12L12L10R10L10L10R10R12L12R12L12R6R12L12R6R10R12L12L10R10L10L10R10R12L12R12L12R6
  --
  -- A L10R10L10
  --   L10
  --
  -- C R10
  --   R12L12
  --
  -- A L10R10L10
  --   L10
  --
  -- C R10
  --   R12L12
  --
  -- B R12L12
  --   R6
  --
  -- B R12L12
  --   R6
  --
  -- C R10
  --   R12L12
  --
  -- A L10R10L10
  --   L10
  --
  -- C R10
  --   R12L12
  --
  -- B R12L12
  --   R6
  --
  -- A,C,A,C,B,B,C,A,C,B
  -- L,10,R,10,L,10,L,10
  -- R,12,L,12,R,6
  -- R,10,R,12,L,12

..............................................#######................................
..............................................#......................................
..............................................#......................................
..............................................#......................................
..............................................#......................................
..............................................#......................................
..........................................#############..............................
..........................................#...#.......#..............................
..........................................#...#.......#.........###########..........
..........................................#...#.......#.........#.........#..........
..........................................#...#.......#.........#.........#..........
..........................................#...#.......#.........#.........#..........
..................................#############.......#.........#.........#..........
..................................#.......#...........#.........#.........#..........
..................................#.......#...........#.........#.........#..........
..................................#.......#...........#.........#.........#..........
................................###########...........#.........#.........#..........
................................#.#...................#.........#.........#..........
................................#.#...................###########.........##########^
................................#.#..................................................
................................#.#..................................................
................................#.#..................................................
................................#.#..................................................
................................#.#..................................................
......................#############..................................................
......................#.........#....................................................
......................#.........###########..........................................
......................#...................#..........................................
......................#...................#..........................................
......................#...................#..........................................
......................#...................#..........................................
......................#...................#..........................................
......................#...................#..........................................
......................#...................#..........................................
......................###########.........#..........................................
................................#.........#..........................................
..............................#############..........................................
..............................#.#....................................................
..............................#.#....................................................
..............................#.#....................................................
..............................#.#....................................................
..............................#.#....................................................
###########...................#.#....................................................
#.........#...................#.#....................................................
#.........#...........###########....................................................
#.........#...........#.......#......................................................
#.........#...........#.......#......................................................
#.........#...........#.......#......................................................
#############.....#############......................................................
..........#.#.....#...#..............................................................
..........#.#.....#...#..............................................................
..........#.#.....#...#..............................................................
..........#.#.....#...#..............................................................
..........#.#.....#...#..............................................................
..........#############..............................................................
............#.....#..................................................................
............#.....#..................................................................
............#.....#..................................................................
............#.....#..................................................................
............#.....#..................................................................
............#######..................................................................

module Intcode
( parseProg
, compute
, computeTilHalt
, startingState
) where

import Data.List as List
import Data.Maybe
import Data.Ord
import Data.List.Split
import qualified Data.Map.Strict as Map

parseProg :: String -> Map.Map Int Int
parseProg str = Map.fromList $ List.zip [0..] $ map (read :: String -> Int) $ splitOn "," str

compute :: (Map.Map Int Int, Int, Int) -> ([Int], [Int]) -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
compute (x, y, z) (input_orig, output) =
  if op == 99
    then ((x, -1, z), (input_orig, output))
  else if op == 1 || op == 2
    then compute ((Map.insert dest ((if op == 1 then (+) else (*)) left right) x), (y+4), z) (input_orig, output)
  else if op == 3
    then compute ((Map.insert dest input x), (y+2), z) (inputs, output)
  else if op == 4
    then ((x, y+2, z), (input_orig, (left:output)))
  else if op == 5 || op == 6
    then compute (x, (if (if op == 5 then (/=) else (==)) left 0 then right else (y+3)), z) (input_orig, output)
  else if op == 7 || op == 8
    then compute ((Map.insert dest (if (if op == 7 then (<) else (==)) left right then 1 else 0) x), (y+4), z) (input_orig, output)
  else if op == 9
    then compute (x, y+2, z+left) (input_orig, output)
  else
    ((Map.empty, -1, z), (input_orig, output))
  where
    (input:inputs) = if Prelude.length input_orig > 0 then input_orig else (0:input_orig)
    indexOfIndex y = Map.findWithDefault 0 (x Map.! y) x
    digits = Prelude.reverse $ Prelude.map (read . return) $ show $ x Map.! y
    op = (if Prelude.length digits > 1 then 10 * digits!!1 else 0) + digits!!0
    left = if Prelude.length digits > 2 && digits!!2 == 1 then x Map.! (y+1)
           else if Prelude.length digits > 2 && digits!!2 == 2 then Map.findWithDefault 0 (z+(x Map.! (y+1))) x
           else indexOfIndex (y+1)
    right = if Prelude.length digits > 3 && digits!!3 == 1 then x Map.! (y+2)
            else if Prelude.length digits > 3 && digits!!3 == 2 then x Map.! (z+(x Map.! (y+2)))
            else indexOfIndex (y+2)
    dest = if op == 3 then (if Prelude.length digits > 2 && digits!!2 == 2 then z+(x Map.! (y+1)) else x Map.! (y+1))
           else (if Prelude.length digits > 4 && digits!!4 == 2 then z else 0)+(x Map.! (y+3))

computeTilHalt :: ((Map.Map Int Int, Int, Int), ([Int], [Int])) -> [Int]
computeTilHalt ((prog, y, z), (inputs, outputs)) =
  if y == -1 then outputs
  else computeTilHalt $ compute (prog, y, z) (inputs, outputs)

startingState :: Map.Map Int Int -> [Int] -> ((Map.Map Int Int, Int, Int), ([Int], [Int]))
startingState prog input = ((prog, 0, 0), (input, []))

#!/bin/sh

runhaskell answer.hs `< input`