/g/ - Technology

https://adventofcode.com/2019/about
One last week in November, and then it starts.
Are you competing this year?
What language(s) are you going to use?
Where are you going to talk about the puzzles? nano/g/ maybe?

If you've never participated, from 1Dec to Christmas a Christmas-themed programming puzzle is posted on midnight, and if you solve the puzzle you get a follow-up. The site records how long it takes you to answer both puzzles, and you can stay anonymous on the site. The easiest way to create an account is through linking a github.
The fun of Advent of Code
1. getting the first part done fast
2. adapting your part1 solution to part 2. Part2 tends to punish inefficient solutions and corner-cutting.
3. keeping track of how other people in your private group and on the top100 leaderboard are fairing with what you just did
4. posting your code and comparing it against other solutions. microbenchmarking, smoller-than-thouing
5. learning or getting comfortable with a new language. I've used two Advents this way. By the end of the contest you have the confidence required to embark on any programming task with the language used.

>(((github)))
no thanks

I am probably just going to boring and use Java this year. I used Haskell last year, but the challenges usually favor imperative languages making some day annoying.

deploy the raccoons

Steve Klabnik here, back for another AoC.

>>9579
reddit's the least offensive option then, probably. create a throwaway reddit account, don't give them an email, use it as your AoC login.
>>9581
You've got a whole week to try get comfortable with Kotlin, you know.
I'd actually like to see Java solutions, but as a Christian I feel I should advise you against self-harm.
>>9593
cool. I will also be using a language with a borrow checker this time around.

>>9599
as of this year (IIRC) reddit no longer is remotely usable over tor. same with microsoft github

Day 1: I got a late start and was tripped up a little by accidentally calculating the extra fuel needed for the fuel for the mass of the modules together instead of per module.

import Data.Function

totalFuelNeeded :: Integer -> Integer
totalFuelNeeded = fix totalFuel
where
totalFuel :: (Integer -> Integer) -> Integer -> Integer
totalFuel _ 0 = 0
totalFuel rest mass = let fuel = fuelNeeded mass in fuel + rest fuel
fuelNeeded :: Integer -> Integer
fuelNeeded mass = max 0 $ mass `div` 3 - 2

day1 :: IO ()
day1 = do
rawInput <- readFile "input"
let input = read <$> lines rawInput
print $ sum $ totalFuelNeeded <$> input

main :: IO ()
main = day1

>>9866
The fix was not needed since I bound the totalFuel function to a label

totalFuel :: Integer -> Integer
totalFuel 0 = 0
totalFuel mass = let fuel = fuelNeeded mass in
fuel + totalFuel fuel
where
fuelNeeded :: Integer -> Integer
fuelNeeded mass = max 0 $ mass `div` 3 - 2

day1 :: IO ()
day1 = do
rawInput <- readFile "input"
let input = read <$> lines rawInput
print $ sum $ totalFuel <$> input

main :: IO ()
main = day1

>>9602
I had trouble with github but registering for reddit over tor using guerillamail was fine.

>I can't be bothered to find out how loop works edition

(defun read-lines (path)
(let ((lines))
(with-open-file (stream path)
(loop
(let ((line (read-line stream nil)))
(unless line (return))
(push line lines))))
(reverse lines)))

(defun fuel-required (m)
(- (floor m 3) 2))

(defun answer (path f)
(apply #'+
(mapcar
(lambda (s) (funcall f (parse-integer s)))
(read-lines path))))

(defun answer-1 (path)
(answer path #'fuel-required))

(fuel-required 12)
2

(fuel-required 14)
2

(fuel-required 1969)
654

(fuel-required 100756)
33583

(answer-1 "input")
3291356

(defun fuel-required-2 (m)
(let ((fuel (- (floor m 3) 2)))
(if (> fuel 0)
(+ fuel (fuel-required-2 fuel))
0)))

(fuel-required-2 14)
2

(fuel-required-2 1969)
966

(fuel-required-2 100756)
50346

(defun answer-2 (path)
(answer path #'fuel-required-2))

(answer-2 "input")
4934153

Is it possible to see the challenges without logging in?

Is it possible to sign up for one of the OAuth services withous js? Tried Reddit, even old.reddit.com, seems to require js.

> To play, please identify yourself via one of these services
Goddammit fuck that, why is that even there

Today was pretty straight forward. You are just creating a simple virtual machine.
>>9887
You can see the first part of the challenge without logging in, but you will not be given an input, nor will you be able to check the solution. If you wanted I could post the parts, input, and answers **all separate of course** for you.

import Control.Arrow
import Data.List.Split
import Data.Vector as V hiding (filter)

runIntCode :: Vector Int -> Int
runIntCode code = V.head $ step 0 code
where
step :: Int -> Vector Int -> Vector Int
step ip code =
case toList $ V.drop ip code of
1 : x : y : z : _ -> step (ip + 4) $ code // [(z, (code ! x) + (code ! y))]
2 : x : y : z : _ -> step (ip + 4) $ code // [(z, (code ! x) * (code ! y))]
99 : _ -> code

runIntCodeFromState :: Vector Int -> (Int, Int) -> Int
runIntCodeFromState code (noun, verb) = runIntCode $ code // [(1, noun), (2, verb)]

day2 :: IO ()
day2 = do
rawInput <- readFile "input"
let input = fromList $ read <$> splitOn "," rawInput
let space = (,) <$> [0 .. 99] <*> [0 .. 99]
print $ filter (\(_, y) -> y == 19690720) $ (id &&& runIntCodeFromState input) <$> space

main :: IO ()
main = day2

>learned nothing from yesterday edition

(defun read-csv (path &key (delim #\,))
(let ((toks)
(s)
(i 0))
(with-open-file (stream path)
(setf s (read-line stream)))
(loop
(let ((pos (position delim s :start i)))
(unless pos (return))
(push (subseq s i pos) toks)
(setf i (1+ pos))))
(push (subseq s i) toks)
(reverse toks)))

(defun get-data (path)
(mapcar #'parse-integer (read-csv path)))

(defun execute (data)
(let ((ip 0))
(loop
(let ((opcode (nth ip data)))
(case opcode
(99 (return))
((1 2) (let* ((a0 (nth (nth (1+ ip) data) data))
(a1 (nth (nth (+ 2 ip) data) data))
(dst (nth (+ 3 ip) data))
(res (funcall (if (= 1 opcode) #'+ #'*) a0 a1)))
(setf (nth dst data) res)))

(t (break)))
(incf ip 4))))
data)

(defun fuck-shit-up (data &optional (noun 12) (verb 2))
(setf (nth 1 data) noun)
(setf (nth 2 data) verb)
data)

(execute '(1 0 0 0 99))
(2 0 0 0 99)

(execute '(2 3 0 3 99))
(2 3 0 6 99)

(execute '(2 4 4 5 99 0))
(2 4 4 5 99 9801)

(execute '(1 1 1 4 99 5 6 0 99))
(30 1 1 4 2 5 6 0 99)

(execute (fuck-shit-up (get-data "input")))
(5110675 12 2 2 1 1 2 3 1 3 4 3 1 5 0 3 2 9 1 36 1 5 19 37 2 9 23 111 1 27 5
112 2 31 13 560 1 35 9 563 1 39 10 567 2 43 9 1701 1 47 5 1702 2 13 51 8510 1
9 55 8513 1 5 59 8514 2 6 63 17028 1 5 67 17029 1 6 71 17031 2 9 75 51093 1 79
13 51098 1 83 13 51103 1 87 5 51104 1 6 91 51106 2 95 13 255530 2 13 99
1277650 1 5 103 1277651 1 107 10 1277655 1 111 13 1277660 1 10 115 1277664 1 9
119 1277667 2 6 123 2555334 1 5 127 2555335 2 6 131 5110670 1 135 2 5110672 1
139 9 0 99 2 14 0 0)

(defun part-2 (initial-data)
(do ((noun 0 (1+ noun)))
((> noun 99))
(let ((res (do* ((verb 0 (1+ verb))
(data (copy-list initial-data) (copy-list initial-data)))
((> verb 99))
;(format t "~A, ~A~%" noun verb)
(let ((out (car (execute (fuck-shit-up data noun verb)))))
(when (= out 19690720) (return (+ (* 100 noun) verb)))))))
(when res (return res)))))

(part-2 (get-data "input"))
4847

All that code is cluttering up the recent view
Im assuming that this is gonna go on for the rest of the month huh
Awesome

Today was not very suited towards functional programming.

import Data.HashMap as HM
import Data.List
import Data.List.Split

data Direction
= U Integer
| L Integer
| R Integer
| D Integer
deriving (Show)

parseDirection ('U' : x) = U $ read x
parseDirection ('L' : x) = L $ read x
parseDirection ('R' : x) = R $ read x
parseDirection ('D' : x) = D $ read x

offset (U _) (x, y) = (x, y + 1)
offset (L _) (x, y) = (x - 1, y)
offset (R _) (x, y) = (x + 1, y)
offset (D _) (x, y) = (x, y - 1)

normalize :: [Direction] -> [Direction]
normalize [] = []
normalize (U 0 : xs) = normalize xs
normalize (L 0 : xs) = normalize xs
normalize (R 0 : xs) = normalize xs
normalize (D 0 : xs) = normalize xs
normalize (U d : xs) = U 1 : (normalize $ U (d - 1) : xs)
normalize (L d : xs) = L 1 : (normalize $ L (d - 1) : xs)
normalize (R d : xs) = R 1 : (normalize $ R (d - 1) : xs)
normalize (D d : xs) = D 1 : (normalize $ D (d - 1) : xs)

trackDistance :: [Direction] -> Map (Int, Int) Int
trackDistance ds = aux 0 (0, 0) ds
where
aux :: Int -> (Int, Int) -> [Direction] -> Map (Int, Int) Int
aux _ _ [] = empty
aux n (x, y) (d : ds) =
let map = aux (n + 1) (offset d (x, y)) ds
in HM.insert (x, y) n map

manhattan :: (Int, Int) -> Int
manhattan (x, y) = abs x + abs y

day3 :: IO ()
day3 = do
rawInput <- readFile "input"
let input = fmap parseDirection <$> splitOn "," <$> lines rawInput
let d1 = trackDistance $ normalize $ input !! 0
let d2 = trackDistance $ normalize $ input !! 1
print $ head $ drop 1 $ sort $ manhattan <$> (keys $ intersection d1 d2)
print $ head $ drop 1 $ sort $ elems $ intersectionWith (+) d1 d2

main :: IO ()
main = day3

(load "../common.lisp")

(defstruct vec
dir
mag)

(defun parse-vec (s)
(let ((dirc (elt s 0))
(mag (parse-integer (subseq s 1))))
(make-vec :dir dirc
:mag mag)))

(defun get-input (path)
(mapcar (lambda (l) (mapcar #'parse-vec l)) (read-csv path)))

(defun wire-dirs-posns (vecs)
(let ((posns (make-hash-table :test #'equalp))
(pos (cons 0 0))
(steps 0))
(dolist (vec vecs)
(let ((delta (case (vec-dir vec)
(#\U (cons 0 1))
(#\R (cons 1 0))
(#\D (cons 0 -1))
(#\L (cons -1 0)))))
(dotimes (i (vec-mag vec))
(let ((tpos (cons (+ (car pos) (car delta))
(+ (cdr pos) (cdr delta)))))
(incf steps)
(setf (gethash tpos posns) steps)
(setf pos tpos)))))
posns))

(defun ht-pos-intersections (hta htb)
(let ((pts))
(maphash (lambda (k v)
(let ((bv (gethash k htb)))
(when bv
(push (cons k (+ v bv)) pts))))
hta)
pts))

(defun get-intersections (path)
(apply #'ht-pos-intersections (mapcar #'wire-dirs-posns (get-input path))))


(defun part-1 (path)
(apply #'min (mapcar
(lambda (p) (let ((cp (car p)))
(+ (abs (car cp)) (abs (cdr cp)))))
(get-intersections path))))

(part-1 "eg0")
6

(part-1 "eg1")
159

(part-1 "eg2")
135

(part-1 "input")
316

(defun part-2 (path)
(apply #'min (mapcar #'cdr (get-intersections path))))

(part-2 "eg0")
30

(part-2 "eg1")
610

(part-2 "eg2")
410

(part-2 "input")
16368

Easy one today. The group function saved me a lot of time on part 2.

import Data.List

range :: Integer -> Integer -> Integer -> Bool
range low high x = x >= low && x <= high

six :: Integer -> Bool
six = range 100000 999999

double :: Integer -> Bool
double x = any ((== 2) . length) $ group $ show x

monotonicIncreasing :: Integer -> Bool
monotonicIncreasing 0 = True
monotonicIncreasing x = x `mod` 10 >= x `div` 10 `mod` 10 && (monotonicIncreasing $ x `div` 10)

valid :: Integer -> Integer -> Integer -> Bool
valid low high x = six x && range low high x && double x && monotonicIncreasing x

day4 :: IO ()
day4 = do
let low = 367479
let high = 893698
print $ length $ filter id $ valid low high <$> [low .. high]

main :: IO ()
main = day4

(defparameter +input+ (cons 125730 579381))

(defun gen-inputs (p)
(do ((input (car p) (1+ input))
(inputs))
((> input (cdr p)) inputs)
(push (format nil "~A" input) inputs)))

(defun rle (s)
(let ((ss)
(rld))
(map nil (lambda (c)
(if (and ss (not (eq c (car ss))))
(progn
(push (cons (car ss) (length ss)) rld)
(setf ss (list c)))
(push c ss)))
s)
(when ss
(push (cons (car ss) (length ss)) rld))
(reverse rld)))

(defun repeatsp (r &optional mr)
(dolist (g r)
(let ((nr (cdr g)))
(when (and (> nr 1) (or (not mr) (<= nr mr)))
(return t)))))

(defun increasesp (r)
(let ((sr (mapcar (lambda (g) (char-int (car g))) r)))
(equalp sr (sort (copy-list sr) #'<))))

(defun passesp (s &optional mr)
(let ((r (rle s)))
(and (repeatsp r mr) (increasesp r))))

(passesp "111111")
T

(passesp "223450")
NIL

(passesp "123789")
NIL

(defun part (p &optional mr)
(length (remove-if-not (lambda (v) (passesp v mr)) (gen-inputs p))))

(part +input+)
2081

(part +input+ 2)
1411

Got part 1 quickly, but had to spend a while debugging part 2 to find a simple mistake where I misinterpreted the specification. I hope you did not delete, day 2.

runIntCode :: Vector Int -> Int -> [Int]
runIntCode code ii = step 0 code
where
step :: Int -> Vector Int -> [Int]
step ip code =
let start = V.drop ip code
param1 = start ! 0 `div` 100 `mod` 10 == 1
param2 = start ! 0 `div` 1000 `mod` 10 == 1
param3 = start ! 0 `div` 10000 `mod` 10 == 1
in case V.head start `mod` 100 : (toList $ V.tail start) of
1 : x : y : z : _ -> step (ip + 4) $ code // [(z, (if param1 then x else code ! x) + (if param2 then y else code ! y))]
2 : x : y : z : _ -> step (ip + 4) $ code // [(z, (if param1 then x else code ! x) * (if param2 then y else code ! y))]
3 : x : _ -> step (ip + 2) $ code // [(x, ii)]
4 : x : _ -> (if param1 then x else code ! x) : (step (ip + 2) code)
5 : x : y : _ -> let new = if param1 then x else code ! x in step (if new /= 0 then if param2 then y else code ! y else ip + 3) code
6 : x : y : _ -> let new = if param1 then x else code ! x in step (if new == 0 then if param2 then y else code ! y else ip + 3) code
7 : x : y : z : _ -> step (ip + 4) $ code // if (if param1 then x else code ! x) < (if param2 then y else code ! y) then [(z, 1)] else [(z, 0)]
8 : x : y : z : _ -> step (ip + 4) $ code // if (if param1 then x else code ! x) == (if param2 then y else code ! y) then [(z, 1)] else [(z, 0)]
99 : _ -> []

day5 :: IO ()
day5 = do
rawInput <- readFile "input"
let input = fromList $ read <$> splitOn "," rawInput
let ii = 5
print $ runIntCode input ii

main :: IO ()
main = day5

...I ended up rewriting everything

(load "../common.lisp")

(defun get-instructions (path)
(mapcar #'parse-integer (car (read-csv path))))

(defun decode-op (op)
(let ((s (format nil "~5,'0d" op)))
(cons (parse-integer (subseq s 3)) (reverse (subseq s 0 3)))))

(defun execute (instructions input)
(let ((output)
(ip 0))
(loop
(let* ((op (decode-op (nth ip instructions)))
(optype (car op))
(nargs (case optype
((1 2 7 8) 3)
((3 4) 1)
((5 6) 2)
(99 0)
(t (break))))
(nextip (+ 1 nargs ip))
(args (subseq instructions (1+ ip) nextip))
(argvals (map 'list (lambda (arg mode)
(case mode
(#\0 (nth arg instructions))
(#\1 arg)
(t (break))))
args (cdr op))))
(case optype
((1 2) (setf (nth (caddr args) instructions)
(funcall (nth (1- optype) (list #'+ #'*))
(car argvals)
(cadr argvals))))
(3 (setf (nth (car args) instructions) (pop input)))
(4 (push (car argvals) output))
((5 6) (setf ip (if (not (eq (/= (car argvals) 0) (= optype 6)))
(cadr argvals)
nextip)))
((7 8) (setf (nth (caddr args) instructions)
(if (funcall (nth (- optype 7) (list #'< #'=))
(car argvals) (cadr argvals))
1
0)))
(99 (return (reverse output)))
(t (break)))
(when (not (member optype '(5 6)))
(setf ip nextip))))))

(execute (get-instructions "input") '(1))
; (0 0 0 0 0 0 0 0 0 16574641)

(execute (get-instructions "input") '(5))
; (15163975)

> that based anon who is ready to sacrifice his anonymity in favour of shitposting ready solutions
nice work, mate, but could you please elaborate what language is this >>9958 ?

>>9974
It's haskell, a functional language for people who enjoy masturbating with types.

If you're interested in learning,
http://learnyouahaskell.com/
is a great resource.

>>9974
>>9982
That is not a great resource. This is.
https://haskellbook.com/

I expected this one to be worse than it actually way.

makeTree :: [(String, String)] -> [(String, String)] -> Map String (String, Int) -> Map String (String, Int)
makeTree [] [] map = map
makeTree [] failed map = makeTree failed [] map
makeTree ((px, py) : ps) failed map = if member px map then makeTree ps failed $ HM.insert py (px, snd (map ! px) + 1) map else makeTree ps ((px, py) : failed) map

parents :: Map String (String, Int) -> String -> [String]
parents map "COM" = []
parents map p = let parent = fst (map ! p) in parent : parents map parent

commonAncestor :: [String] -> [String] -> String
commonAncestor (x : xs) ys = if elem x ys then x else commonAncestor xs ys

lengthUpTo :: [String] -> String -> Int
lengthUpTo (x : xs) y = if x == y then 0 else 1 + lengthUpTo xs y

day6 :: IO ()
day6 = do
rawInput <- readFile "input"
let input = (\[x, y] -> (x, y)) <$> splitOn ")" <$> lines rawInput
let tree = makeTree input [] $ HM.insert "COM" ("KYQ", 0) HM.empty
let p1 = parents tree "YOU"
let p2 = parents tree "SAN"
let common = commonAncestor p1 p2
print $ sum $ snd <$> (elems $ tree)
print $ lengthUpTo p1 common + lengthUpTo p2 common

main :: IO ()
main = day6

Thanks to Haskell's lazyness I finally got my first top 50 in part 2. I was surprised when the recursive let actually worked.

import Data.List
import Data.List.Split
import Data.Vector as V hiding (filter)

runIntCode :: Vector Int -> [Int] -> [Int]
runIntCode code inputs = step 0 code inputs
where
step :: Int -> Vector Int -> [Int] -> [Int]
step ip code inputs =
let start = V.drop ip code
param1 = start ! 0 `div` 100 `mod` 10 == 1
param2 = start ! 0 `div` 1000 `mod` 10 == 1
param3 = start ! 0 `div` 10000 `mod` 10 == 1
in case V.head start `mod` 100 : (toList $ V.tail start) of
1 : x : y : z : _ -> step (ip + 4) (code // [(z, (if param1 then x else code ! x) + (if param2 then y else code ! y))]) inputs
2 : x : y : z : _ -> step (ip + 4) (code // [(z, (if param1 then x else code ! x) * (if param2 then y else code ! y))]) inputs
3 : x : _ -> step (ip + 2) (code // [(x, Data.List.head inputs)]) $ Data.List.tail inputs
4 : x : _ -> (if param1 then x else code ! x) : (step (ip + 2) code inputs)
5 : x : y : _ -> let new = if param1 then x else code ! x in step (if new /= 0 then if param2 then y else code ! y else ip + 3) code inputs
6 : x : y : _ -> let new = if param1 then x else code ! x in step (if new == 0 then if param2 then y else code ! y else ip + 3) code inputs
7 : x : y : z : _ -> step (ip + 4) (code // if (if param1 then x else code ! x) < (if param2 then y else code ! y) then [(z, 1)] else [(z, 0)]) inputs
8 : x : y : z : _ -> step (ip + 4) (code // if (if param1 then x else code ! x) == (if param2 then y else code ! y) then [(z, 1)] else [(z, 0)]) inputs
99 : _ -> []

runAmplifiers :: Vector Int -> [Int] -> Int
runAmplifiers input [v, w, x, y, z] =
let a = runIntCode input (v : 0 : e)
b = runIntCode input (w : a)
c = runIntCode input (x : b)
d = runIntCode input (y : c)
e = runIntCode input (z : d)
in Data.List.last e

day7 :: IO ()
day7 = do
rawInput <- readFile "input"
let input = fromList $ read <$> splitOn "," rawInput
print $ Data.List.last $ sort $ runAmplifiers input <$> filter (\[v, w, x, y, z] -> not (v == w || v == x || v == y || v == z || w == x || w == y || w == z || x == y || x == z || y == z)) ((\v w x y z -> [v, w, x, y, z]) <$> [0 .. 4] <*> [0 .. 4] <*> [0 .. 4] <*> [0 .. 4] <*> [0 .. 4])
print $ Data.List.last $ sort $ runAmplifiers input <$> filter (\[v, w, x, y, z] -> not (v == w || v == x || v == y || v == z || w == x || w == y || w == z || x == y || x == z || y == z)) ((\v w x y z -> [v, w, x, y, z]) <$> [5 .. 9] <*> [5 .. 9] <*> [5 .. 9] <*> [5 .. 9] <*> [5 .. 9])

main :: IO ()
main = day7

>>10032
Here you go.

Day 1: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/1/
Day 1 Input: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/1/input
Day 1 Solutions: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/1/solutions
Day 2: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/2/
Day 2 Input: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/2/input
Day 2 Solutions: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/2/solutions
Day 3: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/3/
Day 3 Input: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/3/input
Day 3 Solutions: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/3/solutions
Day 4: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/4/
Day 4 Solutions: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/4/solutions
Day 5: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/5/
Day 5 Input: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/5/input
Day 5 Solutions: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/5/solutions
Day 6: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/6/
Day 6 Input: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/6/input
Day 6 Solutions: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/6/solutions
Day 7: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/7/
Day 7 Input: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/7/input
Day 7 Solutions: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/7/solutions

Finally a chance to whip out fmap fmap fmap fmap fmap fmap fmap fmap. The pixel combination made a good monoid, so I wanted to implement it using one.

Day 8: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/8/
Day 8 Input: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/8/input
Day 8 Solutions: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/8/solutions

import Control.Arrow
import Control.Monad
import Data.Foldable
import Data.List
import Data.List.Split

data Pixel = Pixel Char

instance Show Pixel where
show (Pixel c) = [c]

instance Semigroup Pixel where
Pixel '2' <> y = y
x <> _ = x

instance Monoid Pixel where
mempty = Pixel '2'

count :: Char -> [String] -> Int
count c = length . filter (== c) . join

overlapRows :: [[Pixel]] -> [Pixel]
overlapRows = fmap fold . transpose

day8 :: IO ()
day8 = do
rawInput <- readFile "input"
let width = 2
let height = 2
let input = chunksOf height $ chunksOf width rawInput
let front = fst $ head $ sortOn snd $ (id &&& count '0') <$> input
print $ (count '1' front) * (count '2' front)
let pixels = fmap fmap fmap fmap fmap fmap fmap fmap Pixel input
let image = overlapRows <$> transpose pixels
mapM_ print image

main :: IO ()
main = day8

Finally I can put to rest the mess of code I have been using for the intcode computer. Today was the last challenge using it. A really useful hint for part one is that if you made a mistake implementing the new changes it will output the instruction and some of its operands to help you debug the issue. It was very helpful in finding the instruction I had messed up on.

Day 9: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/9/
Day 9 Input: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/9/input
Day 9 Solutions: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/9/solutions

import Data.List
import Data.List.Split
import Data.Vector as V hiding (filter)

runIntCode :: Vector Int -> [Int] -> [Int]
runIntCode code inputs = step 0 code inputs 0
where
step :: Int -> Vector Int -> [Int] -> Int -> [Int]
step ip code inputs base =
let start = V.drop ip code
param1 = start ! 0 `div` 100 `mod` 10
param2 = start ! 0 `div` 1000 `mod` 10
param3 = start ! 0 `div` 10000 `mod` 10
in case V.head start `mod` 100 : (toList $ V.tail start) of
1 : x : y : z : _ -> step (ip + 4) (code // [(if param3 == 2 then base + z else z, (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)) + (if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y)))]) inputs base
2 : x : y : z : _ -> step (ip + 4) (code // [(if param3 == 2 then base + z else z, (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)) * (if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y)))]) inputs base
3 : x : _ -> step (ip + 2) (code // [(if param1 == 2 then base + x else x, Data.List.head inputs)]) (Data.List.tail inputs) base
4 : x : _ -> (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)) : (step (ip + 2) code inputs base)
5 : x : y : _ -> let new = if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x) in step (if new /= 0 then if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y) else ip + 3) code inputs base
6 : x : y : _ -> let new = if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x) in step (if new == 0 then if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y) else ip + 3) code inputs base
7 : x : y : z : _ -> step (ip + 4) (code // if (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)) < (if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y)) then [(if param3 == 2 then base + z else z, 1)] else [(if param3 == 2 then base + z else z, 0)]) inputs base
8 : x : y : z : _ -> step (ip + 4) (code // if (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)) == (if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y)) then [(if param3 == 2 then base + z else z, 1)] else [(if param3 == 2 then base + z else z, 0)]) inputs base
9 : x : _ -> step (ip + 2) code inputs (base + (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)))
99 : _ -> []

day9 :: IO ()
day9 = do
rawInput <- readFile "input"
let input = fromList $ (read <$> splitOn "," rawInput) <> (Data.List.take 1000 $ repeat 0)
print $ runIntCode input [1]
print $ runIntCode input [2]

main :: IO ()
main = day9

>Advent of (((Code)))
Good goy! Program the goyim into submission.

>>10075
<Stop having fun
Some people enjoy doing recreational programming as a group. If you do not want to make an account to compete feel free to play along anonymously with us by using my copy of the site.
http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion

The atan2 function came in handy today, but I had to override the edge case for when the point exists on the "positive x axis."

Day 10: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/10/
Day 10 Input: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/10/input
Day 10 Solutions: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/10/solutions

import Control.Arrow
import Data.List

sides :: (Int, Int) -> [(Int, Int)] -> Int
sides _ [] = 0
sides (x, _) ps = if foldr (\(px, _) acc -> px < x && acc) True ps then 1 else 2

canSee :: [(Int, Int)] -> (Int, Int) -> (Int, Int) -> Bool
canSee ps (x, y) (px, py) =
(x, y) == (px, py)
|| if px == x
then
let colinear = filter (\(ax, _) -> ax == x) ps
los = filter (\(_, ay) -> if py < y then ay < y else ay > y) colinear
closest = head $ sortOn (\(ax, ay) -> (ay - y) ^ 2) los
in (px, py) == closest
else
let ratio = fromIntegral (py - y) / fromIntegral (px - x)
colinear = fst <$> (filter ((== ratio) . snd) $ (id &&& (\(ax, ay) -> fromIntegral (ay - y) / fromIntegral (ax - x))) <$> ps)
los = filter (\(ax, _) -> if px < x then ax < x else ax > x) colinear
closest = head $ sortOn (\(ax, ay) -> (ax - x) ^ 2 + (ay - y) ^ 2) los
in (px, py) == closest

toRadians :: (Int, Int) -> Float
toRadians (0, y) | y < 0 = - pi
toRadians (x, y) = atan2 (fromIntegral $ negate x) (fromIntegral y)

lazer :: (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
lazer _ [] = []
lazer (cx, cy) ps =
let (h : t) = fst <$> (filter snd $ (id &&& canSee ps (cx, cy)) <$> (\(x, y) -> (x + cx, y + cy)) <$> (sortOn toRadians $ (\(x, y) -> (x - cx, y - cy)) <$> filter (/= (cx, cy)) ps))
in h : lazer (cx, cy) t

day10 :: IO ()
day10 = do
rawInput <- readFile "input"
let input = lines rawInput
let width = length $ head input
let height = length input
let asteroids = filter (\(x, y) -> input !! y !! x == '#') $ (\x y -> (x, y)) <$> [0 .. width - 1] <*> [0 .. height - 1]
let best = head $ sortOn snd $ (\p -> (p, negate $ length $ filter (canSee asteroids p) asteroids)) <$> asteroids
print $ (\x -> x - 1) $ negate $ snd best
print $ (lazer (fst best) asteroids) !! 199

main :: IO ()
main = day10

Did not have enough time to finish yesterday's challenge, but here it is. It was another Intcode problem but now the computer needed to support doing computations between inputs and outputs. I kind of gave up on this challenge and just wrote enough code until it worked. I really hope I do not need to return to this mess.

Day 11: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/11/
Day 11 Input: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/11/input
Day 11 Solutions: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/11/solutions

import Data.HashMap as HM hiding ((!))
import Data.List
import Data.List.Split
import Data.Vector as V hiding (elem, filter)

runIntCode :: Vector Int -> Bool -> [Int] -> [Int]
runIntCode code part2 inputs = step 0 code inputs 0 [] [] ([], U, (0, 0))
where
step :: Int -> Vector Int -> [Int] -> Int -> [Int] -> [Int] -> ([(Int, Int)], Direction, (Int, Int)) -> [Int]
step ip code inputs base outBuf output state =
let start = V.drop ip code
param1 = start ! 0 `div` 100 `mod` 10
param2 = start ! 0 `div` 1000 `mod` 10
param3 = start ! 0 `div` 10000 `mod` 10
in case V.head start `mod` 100 : (V.toList $ V.tail start) of
1 : x : y : z : _ -> step (ip + 4) (code // [(if param3 == 2 then base + z else z, (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)) + (if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y)))]) inputs base outBuf output state
2 : x : y : z : _ -> step (ip + 4) (code // [(if param3 == 2 then base + z else z, (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)) * (if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y)))]) inputs base outBuf output state
3 : x : _ -> let (inp, s) = (if part2 then runBot3 else runBot2) state outBuf in step (ip + 2) (code // [(if param1 == 2 then base + x else x, inp)]) inputs base (Data.List.drop 2 outBuf) output s
4 : x : _ -> let new = [if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)] in step (ip + 2) code inputs base (outBuf <> new) (output <> new) state
5 : x : y : _ -> let new = if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x) in step (if new /= 0 then if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y) else ip + 3) code inputs base outBuf output state
6 : x : y : _ -> let new = if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x) in step (if new == 0 then if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y) else ip + 3) code inputs base outBuf output state
7 : x : y : z : _ -> step (ip + 4) (code // if (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)) < (if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y)) then [(if param3 == 2 then base + z else z, 1)] else [(if param3 == 2 then base + z else z, 0)]) inputs base outBuf output state
8 : x : y : z : _ -> step (ip + 4) (code // if (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)) == (if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y)) then [(if param3 == 2 then base + z else z, 1)] else [(if param3 == 2 then base + z else z, 0)]) inputs base outBuf output state
9 : x : _ -> step (ip + 2) code inputs (base + (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x))) outBuf output state
99 : _ -> output

data Direction
= U
| L
| R
| D
deriving (Show)

offset :: Direction -> (Int, Int) -> (Int, Int)
offset U (x, y) = (x, y + 1)
offset L (x, y) = (x - 1, y)
offset R (x, y) = (x + 1, y)
offset D (x, y) = (x, y - 1)

left :: Direction -> Direction
left U = L
left L = D
left R = U
left D = R

right :: Direction -> Direction
right U = R
right L = U
right R = D
right D = L

runBot3 :: ([(Int, Int)], Direction, (Int, Int)) -> [Int] -> (Int, ([(Int, Int)], Direction, (Int, Int)))
runBot3 _ [] = (1, ([(0, 0)], U, (0, 0)))
runBot3 (white, dir, pos) (a : b : os) =
let newWhite = if a == 1 then Data.List.union white [pos] else Data.List.delete pos white
newDir = if b == 1 then right dir else left dir
newPos = offset newDir pos
color = if newPos `elem` newWhite then 1 else 0
in (color, (newWhite, newDir, newPos))

runBot2 :: ([(Int, Int)], Direction, (Int, Int)) -> [Int] -> (Int, ([(Int, Int)], Direction, (Int, Int)))
runBot2 _ [] = (0, ([], U, (0, 0)))
runBot2 (white, dir, pos) (a : b : os) =
let newWhite = if a == 1 then Data.List.union white [pos] else Data.List.delete pos white
newDir = if b == 1 then right dir else left dir
newPos = offset newDir pos
color = if newPos `elem` newWhite then 1 else 0
in (color, (newWhite, newDir, newPos))

runBot :: [(Int, Int)] -> Direction -> (Int, Int) -> [Int] -> [(Int, (Int, Int))]
runBot white dir pos [] = [(if pos `elem` white then 1 else 0, pos)]
runBot white dir pos (a : b : os) =
let newWhite = if a == 1 then Data.List.union white [pos] else Data.List.delete pos white
newDir = if b == 1 then right dir else left dir
newPos = offset newDir pos
color = if pos `elem` newWhite then 1 else 0
in (color, pos) : runBot newWhite newDir newPos os

printCoords :: [(Int, (Int, Int))] -> IO ()
printCoords coords =
let map = Data.List.foldr (\(color, pos) acc -> HM.insert pos color acc) HM.empty coords
in Prelude.mapM_ print $ (\x -> (\y -> case HM.lookup (y, - x) map of Just 1 -> '#'; _ -> ' ') <$> [-100 .. 100]) <$> [-100 .. 100]

day11 :: IO ()
day11 = do
rawInput <- readFile "input"
let input = V.fromList $ (read <$> splitOn "," rawInput) <> (Data.List.take 1000 $ repeat 0)
let output = runIntCode input False []
let coords = runBot [(0, 0)] U (0, 0) output
let res = nubBy (\(_, x) (_, y) -> x == y) $ Data.List.reverse coords
print $ Data.List.length res
let output2 = runIntCode input True []
let coords2 = runBot [(0, 0)] U (0, 0) output2
let res2 = nubBy (\(_, x) (_, y) -> x == y) $ Data.List.reverse coords2
printCoords res2

Pretty standard problem if you have done an AoC of a previous year.

Day 11: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/12/
Day 11 Input: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/12/input
Day 11 Solutions: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/12/solutions

import Data.HashMap as HM hiding ((!))
import Data.List
import Data.List.Split

comp :: Int -> Int -> Int
comp x y = if x > y then -1 else if x < y then 1 else 0

getVelocities :: [Int] -> (Int) -> (Int)
getVelocities pos x = sum $ (\a -> comp x a) <$> pos

applyGravity :: [Int] -> [Int] -> [Int]
applyGravity pos vel = zipWith (+) ((\p -> getVelocities pos p) <$> pos) vel

step :: [Int] -> [Int] -> ([Int], [Int])
step pos vel =
let newVel = applyGravity pos vel
in (zipWith (+) pos newVel, newVel)

runSteps :: [Int] -> Int -> ([Int], [Int])
runSteps pos n = runStepsAux pos (take (length pos) $ repeat 0) n
where
runStepsAux :: [Int] -> [Int] -> Int -> ([Int], [Int])
runStepsAux pos vel 0 = (pos, vel)
runStepsAux pos vel n =
let (newPos, newVel) = step pos vel
in runStepsAux newPos newVel $ n - 1

runStepsMatch :: [Int] -> Int
runStepsMatch pos = runStepsAux pos (take (length pos) $ repeat 0) HM.empty 0
where
runStepsAux :: [Int] -> [Int] -> Map ([Int], [Int]) Int -> Int -> Int
runStepsAux pos vel map n =
if member (pos, vel) map
then n
else
let (newPos, newVel) = step pos vel
in runStepsAux newPos newVel (HM.insert (pos, vel) n map) $ n + 1

energy :: (Int, Int, Int) -> (Int, Int, Int) -> Int
energy (a, b, c) (x, y, z) = (abs a + abs b + abs c) * (abs x + abs y + abs z)

day12 :: IO ()
day12 = do
rawInput <- readFile "input"
let input = (\[x, y, z] -> (read x, read y, read z)) <$> ((fmap $ drop 2) <$> splitOn ", ") <$> (tail . init) <$> lines rawInput
let xs = (\(x, _, _) -> x) <$> input
let ys = (\(_, y, _) -> y) <$> input
let zs = (\(_, _, z) -> z) <$> input
let (finalPosX, finalVelX) = runSteps xs 1000
let (finalPosY, finalVelY) = runSteps ys 1000
let (finalPosZ, finalVelZ) = runSteps zs 1000
let finalPos = zip3 finalPosX finalPosY finalPosZ
let finalVel = zip3 finalVelX finalVelY finalVelZ
print $ sum $ (\(pos, vel) -> energy pos vel) <$> zip finalPos finalVel
let cx = runStepsMatch xs
let cy = runStepsMatch ys
let cz = runStepsMatch zs
print $ lcm cx $ lcm cy cz

main :: IO ()
main = day12

>>10148
*Day 12

>>10185
Today involved running breakout on your intcode computer.

Day 13: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/13/
Day 13 Input: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/13/input
Day 13 Solutions: http://aoc3ernictpwupe5o7lahkovoag6f23ka54q32hq6hspuj3bb5asgvad.onion/2019/day/13/solutions

import Data.HashMap as HM hiding ((!))
import Data.List
import Data.List.Split
import Data.Vector as V hiding (elem, filter)

runIntCode :: Vector Int -> (([Int], (Int, Int)) -> ([Int], (Int, Int))) -> (Int, Int) -> [Int] -> [Int]
runIntCode code pollInput st inputs = step 0 code inputs 0 [] [] st
where
step :: Int -> Vector Int -> [Int] -> Int -> [Int] -> [Int] -> (Int, Int) -> [Int]
step ip code inputs base outBuf output state =
let start = V.drop ip code
param1 = start ! 0 `div` 100 `mod` 10
param2 = start ! 0 `div` 1000 `mod` 10
param3 = start ! 0 `div` 10000 `mod` 10
in case V.head start `mod` 100 : (V.toList $ V.tail start) of
1 : x : y : z : _ -> step (ip + 4) (code // [(if param3 == 2 then base + z else z, (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)) + (if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y)))]) inputs base outBuf output state
2 : x : y : z : _ -> step (ip + 4) (code // [(if param3 == 2 then base + z else z, (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)) * (if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y)))]) inputs base outBuf output state
3 : x : _ -> let (inp, s) = pollInput (outBuf, state) in step (ip + 2) (code // [(if param1 == 2 then base + x else x, (Data.List.head (inputs <> inp)))]) (Data.List.tail (inputs <> inp)) base [] output s
4 : x : _ -> let new = [if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)] in step (ip + 2) code inputs base (outBuf <> new) (output <> new) state
5 : x : y : _ -> let new = if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x) in step (if new /= 0 then if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y) else ip + 3) code inputs base outBuf output state
6 : x : y : _ -> let new = if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x) in step (if new == 0 then if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y) else ip + 3) code inputs base outBuf output state
7 : x : y : z : _ -> step (ip + 4) (code // if (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)) < (if param2 == 2 then code ! (base + y) else (if param2 == 1 then y
else code ! y)) then [(if param3 == 2 then base + z else z, 1)] else [(if param3 == 2 then base + z else z, 0)]) inputs base outBuf output state
8 : x : y : z : _ -> step (ip + 4) (code // if (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x)) == (if param2 == 2 then code ! (base + y) else (if param2 == 1 then y else code ! y)) then [(if param3 == 2 then base + z else z, 1)] else [(if param3 == 2 then base + z else z, 0)]) inputs base outBuf output state
9 : x : _ -> step (ip + 2) code inputs (base + (if param1 == 2 then code ! (base + x) else (if param1 == 1 then x else code ! x))) outBuf output state
99 : _ -> output

poll :: ([Int], (Int, Int)) -> ([Int], (Int, Int))
poll (output, (x, y)) =
let out = Data.List.reverse $ chunksOf 3 output
pads = Data.List.filter (\[x, y, z] -> z == 3) out
pad = if Data.List.null pads then (x, y) else (\[px, py, 3] -> (px, py)) $ Data.List.head pads
balls = Data.List.filter (\[x, y, z] -> z == 4) out
in if Data.List.null balls
then ([], pad)
else
let [bx, by, 4] = Data.List.head balls
in if bx > fst pad
then ([1], pad)
else
if bx < fst pad
then ([-1], pad)
else ([0], pad)

tile :: Int -> Char
tile t =
case t of
0 -> ' '
1 -> '#'
2 -> '@'
3 -> '_'
4 -> 'o'
_ -> '?'

printCoords :: Map (Int, Int) Int -> [[Int]] -> IO (Map (Int, Int) Int)
printCoords map coords =
let newMap = Data.List.foldr (\[x, y, z] acc -> HM.insert (x, y) z acc) map coords
in do
Prelude.mapM_ print $ (\x -> (\y -> case HM.lookup (y, x) newMap of Just z -> tile z; _ -> ' ') <$> [0 .. 45]) <$> [0 .. 25]
print $ HM.lookup (-1, 0) newMap
pure newMap

printScreens :: Map (Int, Int) Int -> [[Int]] -> IO ()
printScreens map coords = do
newMap <- printCoords map $ [Data.List.head coords]
printScreens newMap $ Data.List.tail coords

day13 :: IO ()
day13 = do
rawInput <- readFile "input"
let input = V.fromList $ (read <$> splitOn "," rawInput) <> (Data.List.take 1000 $ repeat 0)
let output = chunksOf 3 $ runIntCode input poll (0, 0) []
print $ Data.List.length $ Data.List.filter (\[_, _, t] -> t == 2) $ Data.List.takeWhile (\[x, y, _] -> not (x == -1 && y == 0)) output
printScreens HM.empty output

main :: IO ()
main = day13

Haskell autist, please come back! We love you!

>>9994
Just got back from a trip, working through these when I have the time

Day 6:

(load "../common.lisp")

(defun get-al (input)
(mapcar (lambda (p) (cons (cadr p) (car p))) (read-csv input :delim #\))))

(defun num-orbits (al s)
(let ((count 0))
(loop
(when (equal s "COM") (return count))
(incf count)
(setf s (cdr (assoc s al :test #'equal))))))

(defun part-1 (input)
(let ((al (get-al input))
(torb 0))
(mapcar (lambda (p) (incf torb (num-orbits al (car p)))) al)
torb))

(defun make-ght (al)
(let ((ght (make-hash-table :test #'equalp)))
(dolist (p al)
(dolist (j (list p (cons (cdr p) (car p))))
(multiple-value-bind (htp present) (gethash (car j) ght)
(unless present
(setf htp (cons nil (make-hash-table :test #'equal)))
(setf (gethash (car j) ght) htp))
(setf (gethash (cdr j) (cdr htp)) t))))
ght))

(defun dfs-steps (ght start end &optional (n 0))
(if (equal start end)
n
(let ((htp (gethash start ght))
(nsteps nil))
(unless (car htp)
(setf (car htp) n)
(maphash (lambda (k v)
(let ((res (dfs-steps ght k end (1+ n))))
(when (numberp res)
(setf nsteps res))))
(cdr htp)))
nsteps)))

(defun part-2 (input)
(let* ((al (get-al input))
(ght (make-ght al)))
(dfs-steps ght
(cdr (assoc "YOU" al :test #'equal))
(cdr (assoc "SAN" al :test #'equal)))))