Advent of Code 2022 (Friendship Edition)

Let's all enjoy a friendly thread about the yearly programming challenge called Advent of Code! Note that it requires authentication via Github, Google, Twitter, or Reddit. Link: https://adventofcode.com/2022 Rules: Don't say the answer! But code blocks are OK

I am having trouble with the formatting: import Data.List day1 :: IO () day1 = do cals <- readFile "inputs/input1.txt" let held = map (sum . map read) $ splitOn (/= "") (lines cals) putStr "The most cals held by a single elf is: " part1 held putStr "The top three elves together hold: " part2 held part1 :: [Int] -> IO () part1 = do print . maximum part2 :: [Int] -> IO () part2 = do print . sum . take 3 . reverse . sort splitOn :: (String -> Bool) -> [String] -> [[String]] splitOn _ [] = [[]] splitOn p xs = takeWhile p xs : if null remainder then [[]] else splitOn p (tail remainder) where remainder = dropWhile p xs

```py with open('i')as ෂ:ඡ=ෂ.readlines();ඞ,䨻=[],0; for ﺧ in ඡ: if ﺧ!='\n':䨻+=int(ﺧ) else:ඞ.append(䨻);䨻-=䨻 ඞ.sort();print(ඞ[-1],sum(ඞ[-3:])) ```

I'm doing during the boring hours of my new C++/Qt job in Common Lisp with iterate and arrow-macros as only USEd packages (maybe I'll consider str and others if the need arises). Part 1: (format t "~A~%" (iter (for line in-file "input" using #'read-line) (if (= (length line) 0) (progn (maximize sum) (setf sum 0)) (sum (parse-integer line) into sum)))) Part 2: (defconstant +most-loaded-elf-count+ 3) (format t "~A~%" (-<> (iter (for line in-file "input" using #'read-line) (if (= (length line) 0) (progn (collect sum) (setf sum 0)) (sum (parse-integer line) into sum))) (sort #'>) (subseq 0 +most-loaded-elf-count+) (apply #'+ <>)))

Small refactor to better segment IO import Data.List day1 :: IO () day1 = do cals <- lines <$> readFile "inputs/input1.txt" let held = map (sum . map read) $ splitOn (/= "") cals putStr $ "The most cals held by a single elf is: " ++ part1 held putStr $ "The top three elves together hold: " ++ part2 held part1 :: [Int] -> String part1 = show . maximum part2 :: [Int] -> String part2 = show . sum . take 3 . reverse . sort splitOn :: (String -> Bool) -> [String] -> [[String]] splitOn _ [] = [[]] splitOn p xs = takeWhile p xs : if null remainder then [[]] else splitOn p (tail remainder) where remainder = dropWhile p xs

>>33534 Shit, didn't handle the last chunk properly. (format t "~A~%" (with-open-file (stream "input") (iter (for line = (read-line stream nil)) (if (or (null line) (= (length line) 0)) (progn (collect sum) (setf sum 0)) (sum (parse-integer line) into sum)) (while line)))) Works okay but is quite ugly, something more functional like Haskell anon might have been a better idea.

>>33537 Forgot Lainchan's retarded tab handling... (let ((cal-count (with-open-file (stream "input") (iter (for line = (read-line stream nil)) (if (or (null line) (= (length line) 0)) (progn (collect sum) (setf sum 0)) (sum (parse-integer line) into sum)) (while line))))) (format t "Maximum calorie load: ~A~%" (apply #'max cal-count)) (format t "Sum of top three calorie loads: ~A~%" (-<> cal-count (sort #'>) (subseq 0 3) (apply #'+ <>))))

In Tcl too, for fun. namespace path {::tcl::mathop ::tcl::mathfunc} set cal_detail [regexp -all -inline {(?:[0-9]+\n)+} [read [open input]]] set cal_total_per_elf [lmap x $cal_detail {+ {*}$x}] puts "Maximum calorie load: [max {*}$cal_total_per_elf]" puts "Sum of top three calorie loads: [+ {*}[lrange [lsort -int -decr $cal_total_per_elf] 0 2]]"

Looking good, lain; here's one more refactor to traverse the list only once: import Data.List day1 :: IO () day1 = do cals <- lines <$> readFile "inputs/input1.txt" let top3 = winners $ map (sum . map read) $ splitOn (/= "") cals putStrLn $ "The most cals held by a single elf is: " ++ part1 top3 putStrLn $ "The top three elves together hold: " ++ part2 top3 winners :: [Int] -> [Int] winners = take 3 . reverse . sort part1 :: [Int] -> String part1 = show . head part2 :: [Int] -> String part2 = show . sum splitOn :: (String -> Bool) -> [String] -> [[String]] splitOn _ [] = [[]] splitOn p xs = takeWhile p xs : if null remainder then [[]] else splitOn p (tail remainder) where remainder = dropWhile p xs I could also avoid reversing in the winners function, could refactor splitOn to go straight to Ints... I see those things but better not to get brned out on day 1. >>33539 Neat!

I feel like a fool doing this in python. I'm alright at lisp and I prefer how it works, but python is just so fast to write. I think I'll probably redo this in lisp since it only took 5 minutes. temp=open("input", "r") file=temp.read() temp.close() cals = [] tempCals = 0 for i in file.splitlines(): if i == "": cals.append(tempCals) tempCals = 0 else: tempCals += int(i) totalCals = 0 for i in range(3): totalCals += max(cals) cals.remove(max(cals)) print(totalCals)

>>33541 Should have used heapq.nlargest or at least sort, walking the list and deleting (thus shifting everything after, since Python "lists" are arrays) is quite expensive.

(define (calc elve) (apply + (map (lambda (n) (string->number n)) (string-split elve "\n")))) (define elves (map calc (string-split (file->string "input") "\n\n"))) (println (apply max elves)) (println (apply + (take (sort elves <) 3)))

sed ':a;N;$!ba;s/\n/+/g;s/++/\n/g' input | bc | sort -n | tail -n1 sed ':a;N;$!ba;s/\n/+/g;s/++/\n/g' input | bc | sort -n | tail -n3 | awk '{s+=$1}END{print s}'

>>33545 What's that Lisp? Scheme? Didn't think it had something like string-split.

day one, part two in rust use std::fs; fn main() { let mut elves: Vec<usize> = fs::read_to_string("input") .unwrap() .split("\n\n") .map(str::lines) .map(|meals| meals.map(|meal| meal.parse::<usize>().unwrap()).sum()) .collect(); elves.sort(); println!("{}", elves.iter().rev().take(3).sum::<usize>()); }

>>33547 GNU Guile has it but that isn't that since in Guile the separator is given as a character and not a string. Common Lisp has subseq as well.

Bit of the old raku $*ARGFILES.split(/\n\n/)».lines».sum.max.say; $*ARGFILES.split(/\n\n/)».lines».sum.sort[*-3..*].sum.say;

>>33531 file = open("food.txt") count = max_count = max_idx = 0 idx = 1 line = file.readline() while line: if line.strip() == "": if count > max_count: max_count = count max_idx = idx idx += 1 count = 0 else: count += int(line) line = file.readline() print("Ask elf ", max_idx)

>>33531 Raku ftw! my Channel $chan = Channel.new; my @elfs = split "\n\n", open('input.txt', :r).slurp; for @elfs -> $elf { start { $chan.send($elf.lines.sum); } } my Int $count = 0; my Int @maxes = (); while not $count eq @elfs.elems { @maxes.push($chan.receive); if @maxes.elems >= 4 { @maxes = @maxes.sort.tail(3); } $count++; } # First problem (68787) say @maxes.max; # Second problem (198041) say @maxes.sum;

js require("fs").readFile("input", "utf8", (err, data) => { y = data.split("\n\n").map(chunk => chunk.split("\n").map(Number).reduce((b, v) => v+b)).sort((a, b) => b-a); console.log("1:", y[0]); console.log("2:", y.slice(0, 3).reduce((b, v) => v+b)); });

2nd day (defun decode (rune) (ecase rune ((a x) 0) ((b y) 1) ((c z) 2))) ;; (aref me opp) <=> (* (mod (- me opp 2) 3) 3) (defparameter +pt1-lut+ (make-array '(3 3) :initial-contents '((3 0 6) (6 3 0) (0 6 3)))) (defun round-score-pt1 (opp me) (+ 1 me (aref +pt1-lut+ me opp))) ;; (aref res opp) <=> (+ (mod (+ res opp 2) 3) 1) (defparameter +pt2-lut+ (make-array '(3 3) :initial-contents '((3 1 2) (1 2 3) (2 3 1)))) (defun round-score-pt2 (opp res) (+ (* res 3) (aref +pt2-lut+ res opp))) (with-open-file (stream "input") (iter (for sym1 = (read stream nil)) (for sym2 = (read stream nil)) (while (and sym1 sym2)) (let ((val1 (decode sym1)) (val2 (decode sym2))) (sum (round-score-pt1 val1 val2) into s1) (sum (round-score-pt2 val1 val2) into s2)) (finally (format t "Part 1 score: ~A~%" s1) (format t "Part 2 score: ~A~%" s2))))

>>33550 Day 2 lines.map({ $1 + ($1 - $0) % 3 * 3 if TR/ABCXYZ/012123/ ~~ /(.).(.)/ }).sum.say lines.map({ $1 + ($1 / 3 + $0) % 3 + 1 if TR/ABCXYZ/234036/ ~~ /(.).(.)/ }).sum.say

Added a few macros to ease data reading: (defmacro read-repeat ((&optional (stream *standard-input*) (eof-error-p t) eof-val) count &key (reader #'read)) "Read either until count successful reader calls or until EOF and return the collected results" (once-only (eof-val) `(or (iter (repeat ,count) (for ret = (funcall ,reader ,stream nil ,eof-val)) (until (eq ret ,eof-val)) (collect ret)) (if ,eof-error-p (error 'end-of-file) ,eof-val)))) (defmacro read-until ((&optional (stream *standard-input*) (eof-error-p t) eof-val) end-val &key (test #'eql) (reader #'read) (incl-end-val nil)) "Read either until (test obj-read end-val) is true or until EOF and return the collected results" (once-only (eof-val end-val) `(or (iter (for ret = (funcall ,reader ,stream nil ,eof-val)) (until (eq ret ,eof-val)) (when (funcall ,test ret ,end-val) (when ,incl-end-val (collect ret)) (finish)) (collect ret)) (if ,eof-error-p (error 'end-of-file) ,eof-val)))) The main loop of 2nd day becomes a much cleaner (as does the 1st) (iter (for (sym1 sym2) in-file "input" using (lambda (s e r) (read-repeat (s e r) 2))) (let ((val1 (decode sym1)) (val2 (decode sym2))) (sum (round-score-pt1 val1 val2) into s1) (sum (round-score-pt2 val1 val2) into s2)) (finally (format t "Part 1 score: ~A~%" s1) (format t "Part 2 score: ~A~%" s2))) with it.

>>33557 Impressive code golfing, anon. Anything to say about Raku? Looks like it has many features I like (macros, grammars, ADT-like junctions, gradual typing, fixed and improved function parameter lists), even if the overall syntax remains a bit noisy. What about compiler quality/runtime speed?

>>33531 our %ops = Map.new('A', 'Y', 'B', 'Z', 'C', 'X'); sub calculate(@move) { my $score = 0; if (@move[0].ord - @move[1].ord).abs eq 23 { $score += 3; } if %ops{@move[0]} eq @move[1] { $score += 6; } return $score + (@move[1].ord - 87); } sub calculate2(@move) { if @move[1] eq 'Y' { return 3 + (@move[0].ord - 64); } if @move[1] eq 'X' { return (@move[0].ord % 3) + 1; } return 6 + %ops{@move[0]}.ord - 87; } # Part 1 (14531) say "input.txt".IO.slurp.chomp.split("\n")>>.split(" ").map(&calculate).sum; # Part 2 (11258) say "input.txt".IO.slurp.chomp.split("\n")>>.split(" ").map(&calculate2).sum; >>33557 Incredible. I hope to be that good at Raku one day!

>>33560 You probably know more about it than I do. I'm doing AoC in it and Perl simultaneously because I wanted to learn them understand what the difference is.

>>33560 Rakudo is fast on MoarVM, the concurrency model is powerful. I would recommend it if you want to use a language that has everything you need, but it does have quite the learning curve. Similar to people picking up perl for the first time.

Yes, it is deliberately over-engineered; no, I will not apologize (mfw type system) data Move = Rock | Paper | Scissors deriving (Show, Eq, Enum) data Outcome = Win | Draw | Lose deriving (Show, Eq) day2 :: IO () day2 = do moveList <- lines <$> readFile "inputs/input2.txt" print $ part1 moveList print $ part2 moveList return () part1 :: [String] -> Int part1 moveList = sum $ map calcScore parsedList where parsedList = map (\[x,_,y] -> (parseM x, parseM y)) moveList part2 :: [String] -> Int part2 moveList = sum $ map calcScore parsedList where parsedList = map parse moveList parse [x,_,y] = (parseM x, deduceMove (parseO y) (parseM x)) calcScore :: (Move, Move) -> Int calcScore (theirs, mine) | mine == winAgainst theirs = 0 + mScore mine | mine == loseAgainst theirs = 6 + mScore mine | otherwise = 3 + mScore mine winAgainst :: Move -> Move winAgainst m | m == Rock = Scissors | otherwise = pred m loseAgainst :: Move -> Move loseAgainst m | m == Scissors = Rock | otherwise = succ m mScore m = 1 + fromEnum m deduceMove :: Outcome -> Move -> Move deduceMove o = case o of Win -> winAgainst Draw -> id Lose -> loseAgainst parseM :: Char -> Move parseM c | c `elem` "AX" = Rock | c `elem` "BY" = Paper | otherwise = Scissors parseO :: Char -> Outcome parseO c | c == 'X' = Win | c == 'Y' = Draw | otherwise = Lose

>>33547 That's Racket, the same Lisp I use for advent of code.

>>33563 >Rakudo is fast on MoarVM I'm not sure this is true. All of my AoCs come out like a hundred times slower in Raku than in Perl.

>>33566 Perl has been optimized for trillions of years. Raku is fairly new still, I think it's certainly fast enough for most things.

>>33567 Yeah, that's a good excuse but excuses don't get you anything. I've done a few more tests and I'm guessing that it's closer to about 20 times slower with a 202ms startup lag on my machine. The actual tests were basically just writing a bunch of random array elements to stdout, but that seems pretty significant when these languages are used a lot for scripting. I'm not sure how it would be for other tasks, but it's a pretty noticeable difference just for what I'm doing here. I don't know how active development on Raku is, but I don't think it stands a good chance of even getting close to Perl.

>>33547 It is racket. part 1 (apply + (map (λ (ln) (match ln ["A X"4]["A Y"8]["A Z"3]["B X"1]["B Y"5]["B Z"9]["C X"7]["C Y"2]["C Z"6])) (file->lines "input"))) part 2 (apply + (map (λ (ln) (match ln ["A X"3]["A Y"4]["A Z"8]["B X"1]["B Y"5]["B Z"9]["C X"2]["C Y"6]["C Z"7])) (file->lines "input"))) And my shell solution ``` #!/bin/sh cat 'input' | while read ln; do case $ln in 'A X') echo 4 3;; 'A Y') echo 8 4;; 'A Z') echo 3 8;; 'B X') echo 1 1;; 'B Y') echo 5 5;; 'B Z') echo 9 9;; 'C X') echo 7 2;; 'C Y') echo 2 6;; 'C Z') echo 6 7 esac; done | awk '{a+=$1;b+=$2}END{print a" "b}' ```

day 3 in rust use std::{char, fs, str::Lines}; fn main() { let input = fs::read_to_string("input").unwrap(); println!( "Part one: {}", input .lines() .map(|line| { let (one, two) = line.split_at(line.len() / 2); one.chars().find(|c| two.contains(*c)).unwrap() }) .map(crate::convert) .sum::<usize>() ); let mut lines = input.lines(); let mut sum = 0; while let Some(one) = lines.next() { let (two, three) = (lines.next().unwrap(), lines.next().unwrap()); sum += convert( one.chars() .filter(|c| two.contains(*c)) .find(|c| three.contains(*c)) .unwrap(), ); } println!("Part two: {}", sum); } fn convert(c: char) -> usize { if c.is_uppercase() { c as usize - 38 } else { c as usize - 96 } }

>>33576 use itertools::Itertools; use std::{char, fs}; fn main() { let input = fs::read_to_string("input").unwrap(); println!( "Part one: {}", input .lines() .map(|line| { let (one, two) = line.split_at(line.len() / 2); one.chars().find(|c| two.contains(*c)).unwrap() }) .map(crate::convert) .sum::<usize>() ); println!( "Part two: {}", input .lines() .tuples::<(&str, &str, &str)>() .map(|(one, two, three)| { one.chars() .filter(|c| two.contains(*c)) .find(|c| three.contains(*c)) .unwrap() }) .map(crate::convert) .sum::<usize>() ); } fn convert(c: char) -> usize { if c.is_uppercase() { c as usize - 38 } else { c as usize - 96 } } a second go using the itertools crate for part two to make it a little more functional

Here is my scheme for day 3. (use-modules (ice-9 rdelim) (ice-9 match) (ice-9 receive) (srfi srfi-1)) (define (read-input name) (call-with-input-file name (lambda (port) (let loop [(line (read-line port)) (lines '())] (if (eof-object? line) (reverse lines) (loop (read-line port) (cons line lines))))))) (define (item-value item) (define a (char->integer #\a)) (define A (char->integer #\A)) (let [(value (char->integer item))] (if (char-upper-case? item) (+ 27 (- value A)) (- value (1- a))))) (define (solution1 filename) (let* [(rucksacks (map string->list (read-input filename))) (rucksack-lengths (map length rucksacks)) (compartments (map (lambda (len lst) (receive (compartment1 compartment2) (split-at lst (/ len 2)) (list compartment1 compartment2))) rucksack-lengths rucksacks)) (common-items (map (lambda (rucksack) (apply lset-intersection eq? rucksack)) compartments)) (values (map (lambda (commons) (item-value (car commons))) common-items))] (reduce + 0 values))) (define (solution2 filename) (let loop [(rucksacks (map string->list (read-input filename))) (values '())] (if (null? rucksacks) (reduce + 0 values) (receive (group rest) (split-at rucksacks 3) (loop rest (cons (item-value (car (apply lset-intersection eq? group))) values)))))) >>33578 that looks very clean. I've always considered Rust's syntax as cluttered but I like what you wrote

>>33557 Day 3 lines.map({ [∩] .comb.batch(.chars +> 1) })».keys.flat.map((*.ord - 38) % 58).sum.say; lines.batch(3).map({ [∩] $_».comb })».keys.map((*.ord - 38) % 58).sum.say

Day 3 in Common Lisp (added alexandria as USEd package and split-list/vector->list helpers that I doubt you want to see). (defun split-rucksack (rucksack) (let* ((len (length rucksack)) (half (/ len 2))) (list (subseq rucksack 0 half) (subseq rucksack half len)))) (defun common-items (pockets) (remove-duplicates (reduce #'nintersection (mapcar #'vector->list pockets)))) (defun priority (item) (- (char-code item) (if (upper-case-p item) 38 96))) (let ((rucksacks (uiop:read-file-lines "input"))) (format t "Sum of priorities of common items in each rucksack: ~A~%" (-<>> rucksacks (mapcar #'split-rucksack) (mapcar #'common-items) (funcall #'flatten) (mapcar #'priority) (apply #'+))) (format t "Sum of priorities of badges: ~A~%" (-<>> rucksacks (split-list <> 3 :shared-p t) (mapcar #'common-items) (funcall #'flatten) (mapcar #'priority) (apply #'+))))

I hope I used code formating correctly, since I'm posting code for the first time here. Day 3, learning OCaml: let c0 = Char.chr 0;; let alphabet_full = ['A';'B';'C';'D';'E';'F';'G';'H';'I';'J';'K';'L';'M';'N';'O';'P';'Q';'R';'S';'T';'U';'V';'W';'X';'Y';'Z'; 'a';'b';'c';'d';'e';'f';'g';'h';'i';'j';'k';'l';'m';'n';'o';'p';'q';'r';'s';'t';'u';'v';'w';'x';'y';'z'];; let priority c = let code = Char.code c in if isupper c then code - 38 else code - 96;; (* index in alphabet: [A,...,Z,a,...,z] *) let char_to_index c = let code = Char.code c in if isupper c then code - 65 else code - 71;; let alphabet_of_str s = let alph = Array.make 52 c0 in List.iter (fun c -> alph.(char_to_index c) <- c) @@ string_to_list s; Array.to_list alph;; let alphabet_match a1 a2 = List.map2 (fun c1 c2 -> if c1 = c2 then c1 else c0) a1 a2;; let alphabet_first alph = List.find_opt (fun c -> c != c0) alph;; (* find the first character that appears in all strings *) let find_common_char_opt strings = alphabet_first @@ List.fold_left alphabet_match alphabet_full @@ List.map alphabet_of_str strings;; let find_common_char strings = Option.get @@ find_common_char_opt strings;; let common_item sack = let half = String.length sack / 2 in let left, right = String.sub sack 0 half, String.sub sack half half in find_common_char [left;right];; (* === SOLVE === *) let rucksacks = file_to_lines "input";; Printf.printf "Part 1 answer: %d\n" @@ list_sum @@ List.map priority @@ List.map common_item rucksacks;; Printf.printf "Part 2 answer: %d\n" @@ list_sum @@ List.map priority @@ List.map find_common_char @@ list_split_n 3 rucksacks;;

Nice and simple haskell solution. Still technically can get a runtime exception but since the input is already clean... import Data.Maybe import Data.List day3 = do sacks <- lines <$> readFile "inputs/input3.txt" print $ part1 sacks print $ part2 sacks return () part1 :: [String] -> Int part1 = sum . fromJust . mapM (priority . uniq . makeTuple) part2 :: [String] -> Int part2 = sum . fromJust . mapM (priority . shared . map nub) . clean . chunksOf3 priority :: Char -> Maybe Int priority c = lookup c $ zip (['a'..'z'] <> ['A'..'Z']) [1..] uniq :: Eq a => ([a], [a]) -> a uniq = head . uncurry intersect makeTuple :: String -> (String, String) makeTuple s = splitAt (length s `div` 2) s shared :: Eq a => [[a]] -> a shared [xs,ys,zs] = let elemAll c = c `elem` (ys `intersect` zs) in head $ filter elemAll xs clean :: [[a]] -> [[a]] clean = filter (not . null) chunksOf3 :: [String] -> [[String]] chunksOf3 [] = [[]] chunksOf3 (x:y:z:rest) = [x,y,z] : chunksOf3 rest

; Prio converts the given charcher to a priority. (define (prio c) (- (char->integer c) (if (char-upper-case? c) 38 96))) ; Start with intersecting the first 3 lists, then convert ; the first intersecting charcher to a priority. Return the ; calculated priority + part2(drop lines 3) (define (part2 lines) (if (not (empty? lines)) (+ (prio (first (apply set-intersect (map (λ (l) (string->list l)) (take lines 3))))) (part2 (drop lines 3))) 0)) (display (part2 (file->lines "input")))

>>33589 Can compiler optimize away that + in recursive return call? Would be interesting to test if any scheme implementation stack overflows on such code and big input

day 4, in rust this was my first pass when just trying to get it done as quickly as possible (though using a language as verbose as rust is not a good idea for getting on the leaderboard - still only missed it by a minute) use std::fs; fn main() { let input = fs::read_to_string("input").unwrap(); println!( "{}", input .lines() .map(|line| line.split_once(',').unwrap()) .filter(|(one,two)| { let (start1, end1) = one.split_once('-').unwrap(); let (start1, end1) = ( start1.parse::<usize>().unwrap(), end1.parse::<usize>().unwrap(), ); let (start2, end2) = two.split_once('-').unwrap(); let (start2, end2) = ( start2.parse::<usize>().unwrap(), end2.parse::<usize>().unwrap(), ); //p1: (start1 <= start2 && end1 >= end2) || (start2 <= start1 && end2 >= end1) (start1 <= start2 && end1 >= start2) || (start2 <= start1 && end2 >= start1) }) .count() ); } this is the refactor use std::fs; #[derive(Copy, Clone)] struct Range { start: usize, end: usize, } impl Range { fn contains(self, other: Range) -> bool { self.start <= other.start && self.end >= other.end } fn overlaps(self, other: Range) -> bool { if self.start <= other.start && self.end >= other.start { true } else { other.start <= self.start && other.end >= self.start } } } impl From<&str> for Range { fn from(item: &str) -> Self { let (start, end) = item.split_once('-').unwrap(); Range { start: start.parse::<usize>().unwrap(), end: end.parse::<usize>().unwrap(), } } } fn main() { let input = fs::read_to_string("input").unwrap(); let mapped_input = input .lines() .map(|line| line.split_once(',').unwrap()) .map(|(a, b)| (Range::from(a), Range::from(b))); println!( "part 1: {}", mapped_input .clone() .filter(|(a, b)| a.contains(*b) || b.contains(*a)) .count() ); println!( "part 2: {}", mapped_input.filter(|(a, b)| a.overlaps(*b)).count() ); } >>33581 thanks lain.

day 4 in scheme. It was kinda boring. (use-modules (ice-9 rdelim) (ice-9 match) (ice-9 receive) (srfi srfi-1)) (define (read-input name) (call-with-input-file name (lambda (port) (let loop [(line (read-line port)) (lines '())] (if (eof-object? line) (reverse lines) (loop (read-line port) (cons line lines))))))) (define (get-sections filename) (let* [(pairs (map (lambda (pair) (string-split pair #\,)) (read-input filename))) (intervals (map (lambda (pair) (map (lambda (section) (map string->number (string-split section #\-))) pair)) pairs))] intervals)) (define (subsection? section-pair) (define (test section-pair) (match section-pair [((a1 a2) (b1 b2)) (and (>= a1 b1) (<= a1 b2) (>= a2 b1) (<= a2 b2))])) (or (test section-pair) (test (reverse section-pair)))) (define (overlap? section-pair) (define (test section-pair) (match section-pair [((a1 a2) (b1 b2)) (or (and (>= a1 b1) (<= a1 b2)) (and (>= a2 b1) (<= a2 b2)))])) (or (test section-pair) (test (reverse section-pair)))) (define (solution filename) (let [(sections (get-sections filename))] (cons (count subsection? sections) (count overlap? sections)))) anyone got any recommendation for that ugly mapping in get-sections ?

>>33590 I have actually no idea, am really new to racket or any lisp in general. I tested my solution for day 4 and it doesn't seem to crash on large inputs(~100MB) but it does use a lot of memory. (define (part1 pairs) (if (empty? pairs) 0 (+ (let* ([sec (first pairs)][s1 (first sec)][s2 (second sec)][s3 (third sec)][s4 (fourth sec)]) (if (or (and (>= s1 s3) (>= s4 s2)) (and (>= s3 s1) (>= s2 s4))) 1 0)) (part1 (rest pairs))))) (define (part2 pairs) (if (empty? pairs) 0 (+ (let ([sec (first pairs)]) (if (empty? (set-intersect (range (first sec) (+ 1 (second sec))) (range (third sec) (+ 1 (fourth sec))))) 0 1)) (part2 (rest pairs))))) (define input (map (λ (line) (map (λ (str) (string->number str)) (string-split line #rx"[,-]"))) (file->lines "input"))) (part1 input) (part2 input)

Day 4 in CL, was an easy one. Also realised I didn't need alexandria in day 3: just had to use mapcan instead of mapcar to avoid the flatten. (defun parse-range (range-str) (-<>> range-str (uiop:split-string <> :separator '(#\-)) (mapcar #'parse-integer) (apply #'cons))) (defun parse-pair (pair-str) (-<>> pair-str (uiop:split-string <> :separator '(#\,)) (mapcar #'parse-range))) (defun redudant-pair-p (range-pair) (destructuring-bind ((s1 . e1) (s2 . e2)) range-pair (or (and (>= s1 s2) (<= e1 e2)) (and (>= s2 s1) (<= e2 e1))))) (defun overlapping-pair-p (range-pair) (destructuring-bind ((s1 . e1) (s2 . e2)) range-pair (and (<= s1 e2) (>= e1 s2)))) (let ((pairs (mapcar #'parse-pair (uiop:read-file-lines "input")))) (format t "Redundant pair count: ~A~%" (count-if #'redudant-pair-p pairs)) (format t "Overlapping pair count: ~A~%" (count-if #'overlapping-pair-p pairs)))

>>33534 >boring c++/qt job are we coworkers ?

>>33582 Day 4 say lines.map({ so ([|] .cache) ⊆ [∩] $_ with [Z..] [Z] .comb(/\d+/)».Int.batch(2) }).sum; say lines.map({ so [∩] [Z..] [Z] .comb(/\d+/)».Int.batch(2) }).sum; Not super happy with part 1, might try to golf it later. Part two was so easy though.

>>33531 This is a brilliant way to dox people using github code search.

>>33600 I think you may have a lot of "coworkers" in this world.

Today Hlint taught me what a bifunctor is. I feel smart because I fused a filter into my mapping that Hlint didn't suggest, and then I got humbled by seeing the gigabrain solutions in the Haskell subreddit. This one was a bit shorter than day 2 or 3; almost busted out a parsing lib but so far my "base packages only" run is proceeding smoothly. import Data.Char import Data.List import Data.Bifunctor day4 = do assignments <- lines <$> readFile "inputs/input4.txt" print $ part1 assignments print $ part2 assignments return () part1 :: [String] -> Int part1 as = length $ filter ((==True) . doesContain . pairify) as part2 :: [String] -> Int part2 as = length $ filter ((==True) . doesOverlap . pairify) as pairify :: String -> ([Int], [Int]) pairify a = bimap makeRange makeRange (makePair a) --HLINT MY BELOVED makePair :: String -> (String,String) makePair s = tail <$> break (==',') s makeRange :: String -> [Int] makeRange r = [low .. high] where low = read (takeWhile isDigit r) :: Int high = read (tail $ dropWhile isDigit r) :: Int doesContain :: ([Int],[Int]) -> Bool doesContain (as,bs) | length as < length bs = isSubsequenceOf as bs | otherwise = isSubsequenceOf bs as doesOverlap :: ([Int],[Int]) -> Bool doesOverlap (as,bs) = (not . null) (as `intersect` bs)

>>33605 >(==True) Why exactly?

>>33602 People here use github? I haven't yet learnt how to assign memory in C so here's weird solution to day 4. Part 1: c #include <stdio.h> #include <stdlib.h> int priority(char c); int main(void) { FILE *fp; char *line = NULL; size_t len = 0; ssize_t read; /* line length */ int elf1_lower = 0; int elf1_upper = 0; int elf2_lower = 0; int elf2_upper = 0; int n = 0; int dash1 = 0; int dash2 = 0; int comma = 0; fp = fopen("input.txt", "r"); if (fp == NULL) exit(EXIT_FAILURE); while ((read = getline(&line, &len, fp)) != -1) { /* Seperate the numbers with \0s and * remember those positions */ for (int i = 0; i < read-1; i++) { if (line[i] == '-') { if (!dash1) { dash1 = i; line[i] = '\0'; } else { dash2 = i; line[i] = '\0'; } } else if (line[i] == ',') { comma = i; line[i] = '\0'; } } /* Read in the numbers */ elf1_lower = atoi(line); elf1_upper = atoi(line+dash1+1); elf2_lower = atoi(line+comma+1); elf2_upper = atoi(line+dash2+1); /* Reset positions */ dash1 = 0; dash2 = 0; comma = 0; /* Main logic */ if (elf1_lower >= elf2_lower && elf1_upper <= elf2_upper || elf2_lower >= elf1_lower && elf2_upper <= elf1_upper) n++; } printf("%d\n", n); fclose(fp); return 0; } Part 2: c #include <stdio.h> #include <stdlib.h> int priority(char c); int main(void) { FILE *fp; char *line = NULL; size_t len = 0; ssize_t read; /* line length */ int elf1_lower = 0; int elf1_upper = 0; int elf2_lower = 0; int elf2_upper = 0; int n = 0; int dash1 = 0; int dash2 = 0; int comma = 0; fp = fopen("input.txt", "r"); if (fp == NULL) exit(EXIT_FAILURE); while ((read = getline(&line, &len, fp)) != -1) { /* Seperate the numbers with \0s and * remember those positions */ for (int i = 0; i < read-1; i++) { if (line[i] == '-') { if (!dash1) { dash1 = i; line[i] = '\0'; } else { dash2 = i; line[i] = '\0'; } } else if (line[i] == ',') { comma = i; line[i] = '\0'; } } /* Read in the numbers */ elf1_lower = atoi(line); elf1_upper = atoi(line+dash1+1); elf2_lower = atoi(line+comma+1); elf2_upper = atoi(line+dash2+1); /* Reset positions */ dash1 = 0; dash2 = 0; comma = 0; /* Main logic */ if (!(elf1_upper < elf2_lower || elf2_upper < elf1_lower)) n++; } printf("%d\n", n); fclose(fp); return 0; }

>>33612 ffs it ate all the tabs... Here it is with spaces instead. If someone could delete the first post that'd be great. Part 1: #include <stdio.h> #include <stdlib.h> int priority(char c); int main(void) { FILE *fp; char *line = NULL; size_t len = 0; ssize_t read; /* line length */ int elf1_lower = 0; int elf1_upper = 0; int elf2_lower = 0; int elf2_upper = 0; int n = 0; int dash1 = 0; int dash2 = 0; int comma = 0; fp = fopen("input.txt", "r"); if (fp == NULL) exit(EXIT_FAILURE); while ((read = getline(&line, &len, fp)) != -1) { /* Seperate the numbers with \0s and * remember those positions */ for (int i = 0; i < read-1; i++) { if (line[i] == '-') { if (!dash1) { dash1 = i; line[i] = '\0'; } else { dash2 = i; line[i] = '\0'; } } else if (line[i] == ',') { comma = i; line[i] = '\0'; } } /* Read in the numbers */ elf1_lower = atoi(line); elf1_upper = atoi(line+dash1+1); elf2_lower = atoi(line+comma+1); elf2_upper = atoi(line+dash2+1); /* Reset positions */ dash1 = 0; dash2 = 0; comma = 0; /* Main logic */ if (elf1_lower >= elf2_lower && elf1_upper <= elf2_upper || elf2_lower >= elf1_lower && elf2_upper <= elf1_upper) n++; } printf("%d\n", n); fclose(fp); return 0; } Part 2: #include <stdio.h> #include <stdlib.h> int priority(char c); int main(void) { FILE *fp; char *line = NULL; size_t len = 0; ssize_t read; /* line length */ int elf1_lower = 0; int elf1_upper = 0; int elf2_lower = 0; int elf2_upper = 0; int n = 0; int dash1 = 0; int dash2 = 0; int comma = 0; fp = fopen("input.txt", "r"); if (fp == NULL) exit(EXIT_FAILURE); while ((read = getline(&line, &len, fp)) != -1) { /* Seperate the numbers with \0s and * remember those positions */ for (int i = 0; i < read-1; i++) { if (line[i] == '-') { if (!dash1) { dash1 = i; line[i] = '\0'; } else { dash2 = i; line[i] = '\0'; } } else if (line[i] == ',') { comma = i; line[i] = '\0'; } } /* Read in the numbers */ elf1_lower = atoi(line); elf1_upper = atoi(line+dash1+1); elf2_lower = atoi(line+comma+1); elf2_upper = atoi(line+dash2+1); /* Reset positions */ dash1 = 0; dash2 = 0; comma = 0; /* Main logic */ if (!(elf1_upper < elf2_lower || elf2_upper < elf1_lower)) n++; } printf("%d\n", n); fclose(fp); return 0; }

>>33613 C is a real pain when working with strings but I just found this guy's solution and the scanf function seems ideal. I'll probably be using that from now on. #include <stdio.h> int main() { int lf, lt, rf, rt; int p1 = 0, p2 = 0; while( scanf("%d-%d,%d-%dn", &lf, &lt, &rf, &rt) == 4) { if(lf <= rf && lt >= rt || rf <= lf && rt >= lt) ++p1; if( !(lt < rf || rt < lf)) ++p2; } printf("pt1 = %dnpt2 = %dn", p1, p2); }

>>33606 Because I was not paying attention while refactoring from my initial spaghetti mess...

>>33614 Since it sounds like you're learning c and this is your first time seeing scanf, make sure to read up on scanf/printf related vulnerabilities. It's really easy to mess up. >>33613 >If someone could delete the first post that'd be great. If you haven't cleared your browser cache, you may be able to delete it yourself. Click the box in the top left of your post and then click on on the delete button.

Day 5 in CL. Added cl-ppcre and some list splitting utilities (sigh). Tried to stay readable, but parsing the draw and having to wrap stacks in a cons to pass around didn't help. (defun parse-drawing (lines) (iter outer (for line in (nreverse lines)) (with crates) (when (first-iteration-p) (setf crates (make-array (truncate (length line) 3))) (iter (for i index-of-vector crates) (setf (aref crates i) (cons nil nil)))) (iter (for c in-string line from 1 by 4) (for stack-num from 0) (if (char/= c #\Space) (in outer (push c (cdr (aref crates stack-num)))))) (finally (return-from outer crates)))) (defun parse-instructions (lines) (mapcar (lambda (line) (-<>> line (cl-ppcre:all-matches-as-strings "\\d+") (mapcar #'parse-integer))) lines)) (defun move-pt1 (count from to) (dotimes (i count) (push (pop (cdr from)) (cdr to)))) (defun move-pt2 (count from to) (if (= count 1) (push (pop (cdr from)) (cdr to)) (let ((rev-stack nil)) (dotimes (i count) (push (pop (cdr from)) rev-stack)) (dotimes (i count) (push (pop rev-stack) (cdr to)))))) (defun copy-crates (crates) (map 'vector #'copy-list crates)) (defun rearrange-crates (crates move-args move-fun) (iter (for (count from to) in move-args) (funcall move-fun count (aref crates (- from 1)) (aref crates (- to 1)))) crates) (destructuring-bind (drawing instructions) (-<>> (uiop:read-file-lines "sample") (split-list-if <> (lambda (line) (cl-ppcre:scan "^( 1|$)" line))) (delete nil)) (let ((crates (parse-drawing drawing)) (move-args (parse-instructions instructions))) (iter (for move-fun in (list #'move-pt1 #'move-pt2)) (for caption in '("Top crates with CrateMover 9000" "Top crates with CrateMover 9001")) (format t "~A: ~A~%" caption (-<>> (copy-crates crates) (rearrange-crates <> move-args move-fun) (map 'list #'cadr) (remove nil) (coerce <> 'string))))))

I wasn't paying attention and moved the crates in the same order for the first part so I got the wrong answer... I then reversed the in transit stack and got the right answer, submitted, and immediately saw the second part was the same thing without the reverse... import Data.Maybe import qualified Data.Map as M day5 = do t <- lines <$> readFile "inputs/input5.txt" let ship = makeShip (take 8 t) iList = map (parseInstructions . words) $ drop 10 t putStrLn $ part1 ship iList putStrLn $ part2 ship iList part1 :: Foldable t => Ship -> t Instruction -> Answer part1 ship iList = map head $ M.elems $ foldl' exec ship iList part2 :: Foldable t => Ship -> t Instruction -> Answer part2 ship iList = map head $ M.elems $ foldl' exec' ship iList type Answer = String type CrateStack = String type Ship = M.Map Int CrateStack type Instruction = (Int,Int,Int) --originally record makeShip :: [String] -> Ship --this function came to me in a dream makeShip = M.fromList . zip [1..] . map (unwords . words) . transpose . map (map snd . filter (\(a,b) -> a `elem` [2,6..35]) . zip [1..]) parseInstructions :: [String] -> Instruction --very safe function parseInstructions s' = (n, f, t) where n = read ((!!) s' 1) :: Int f = read ((!!) s' 3) :: Int t = read ((!!) s' 5) :: Int exec :: Ship -> Instruction -> Ship exec ship (moving, losingStack, gainingStack) = M.adjust (drop moving) losingStack tempShip where tempShip = M.adjust (poppedStack ++) gainingStack ship poppedStack = reverse $ take moving $ fromJust $ M.lookup losingStack ship exec' :: Ship -> Instruction -> Ship exec' ship (moving, losingStack, gainingStack) = M.adjust (drop moving) losingStack tempShip where tempShip = M.adjust (poppedStack ++) gainingStack ship poppedStack = {-reverse $-} take moving $ fromJust $ M.lookup losingStack ship

>>33618 >scanf vulnerabilities This seems like a pretty great overview of scanf for that: https://sekrit.de/webdocs/c/beginners-guide-away-from-scanf.html

>>33623 Heh, I made the same mistake, then realized it how dumb it was. Now I can finally go to bed.

took me longer than expected, but it was fun (use-modules (ice-9 rdelim) (ice-9 match) (ice-9 receive) (srfi srfi-1)) (define (read-input name) (call-with-input-file name (lambda (port) (let loop [(line (read-line port)) (lines '())] (if (eof-object? line) (reverse lines) (loop (read-line port) (cons line lines))))))) (define (list->stack lst) (let* [(crude-stack (apply map list lst)) (stack (map (lambda (lst) (filter identity lst)) crude-stack))] stack)) (define (command-string str) (match (string-split str #\space) [(_ num _ from-id _ to-id) (map string->number (list num from-id to-id))])) (define (parse-init-stacks lines) (let row-loop [(lines lines) (stacks '())] ;;(format #t "~s" (car lines)) (let [(row (car lines))] (if (string= " 1" row 0 2 0 2) (values (list->stack (reverse stacks)) (map command-string (drop lines 2))) (let loop [(line (string->list row)) (found '())] (match line [(#\[ value #\] #\space . rest) (loop rest (cons value found))] [(#\[ value #\] . rest) (loop rest (cons value found))] [() (row-loop (cdr lines) (cons (reverse found) stacks))] [_ (loop (drop line (min 4 (length line))) (cons #f found))])))))) (define (exec-command command stacks grab-op) (match command [(number from-id to-id) (let* [(from (1- from-id)) (to (1- to-id)) (from-stack (list-ref stacks from)) (to-stack (list-ref stacks to)) (transport (grab-op (list-head from-stack number))) (new-from (list-tail from-stack number)) (new-to (append transport to-stack))] (list-set! stacks from new-from) (list-set! stacks to new-to) stacks)])) (define (solution filename) (receive (stacks commands) (parse-init-stacks (read-input filename)) (let* [(stacks2 (list-copy stacks));;modify in exec-cmd (result-stack1 (fold (lambda (stack cmd) (exec-command stack cmd reverse)) stacks commands)) (result-stack2 (fold (lambda (stack cmd) (exec-command stack cmd identity)) stacks2 commands))] (cons (list->string (map car result-stack1)) (list->string (map car result-stack2))))))

>>33623 If anyone is curious, here's the profiling output of mine using 4chans "bigboy.txt" which is 5 million lines of instructions. The only difference is I changed the bounds to get the new (bigger) ship dimensions and swapped in Data.Map.Strict

>>33614 >>33618 This is another good explanation: https://c-faq.com/stdio/scanfprobs.html It looks like scanf is useful when the input is highly structured. So it's the wrong tool for user input but seems to be pretty perfect for stuff like advent of code right? You know exactly the structure of the input in AoC.

Newbie C guy here again. fuarrrk reading the crate stacks in that orientation in C. I just hand wrote the data structure in the code. Here's my Day 5: Part 1: #include <stdio.h> #include <stdlib.h> #define TOTAL_CRATES 56 int main(void) { /* Holds the "crates" and the first value in * each column is the number of crates. * Also, needs to be big enough to not overflow * in case all crates are moved into the same column. * So, the size of each crate stack is the total number * of crates + 1 for the first number */ int crates[9][TOTAL_CRATES+1] = {{7,'F','C','J','P','H','T','W'}, {8,'G','R','V','F','Z','J','B','H'}, {4,'H','P','T','R'}, {6,'Z','S','N','P','H','T'}, {8,'N','V','F','Z','H','J','C','D'}, {7,'P','M','G','F','W','D','Z'}, {8,'M','V','Z','W','S','J','D','P'}, {3,'N','D','S'}, {5,'D','Z','S','F','M'}}; FILE *fp; char *line = NULL; size_t len = 0; ssize_t read; /* line length */ fp = fopen("input.txt", "r"); if (fp == NULL) exit(EXIT_FAILURE); /* skip the crates representation */ while ((read = getline(&line, &len, fp)) != -1) { if (line[0] == '\n') break; } int n, from, to; while (fscanf(fp, "move %d from %d to %d\n", &n, &from, &to) == 3) { for (; n>0; n--) { /* move */ crates[to-1][crates[to-1][0]+1] = crates[from-1][crates[from-1][0]]; crates[to-1][0] += 1; /* remove old */ crates[from-1][crates[from-1][0]] = 0; crates[from-1][0] -= 1; } } for (int i = 0; i < 9; i++) { printf("%c", crates[i][crates[i][0]]); } printf("\n"); fclose(fp); return 0; } Part 2: #include <stdio.h> #include <stdlib.h> #define TOTAL_CRATES 56 int main(void) { /* Holds the "crates" and the first value in * each column is the number of crates. * Also, needs to be big enough to not overflow * in case all crates are moved into the same column. * So, the size of each crate stack is the total number * of crates + 1 for the first number */ int crates[9][TOTAL_CRATES+1] = {{7,'F','C','J','P','H','T','W'}, {8,'G','R','V','F','Z','J','B','H'}, {4,'H','P','T','R'}, {6,'Z','S','N','P','H','T'}, {8,'N','V','F','Z','H','J','C','D'}, {7,'P','M','G','F','W','D','Z'}, {8,'M','V','Z','W','S','J','D','P'}, {3,'N','D','S'}, {5,'D','Z','S','F','M'}}; FILE *fp; char *line = NULL; size_t len = 0; ssize_t read; /* line length */ fp = fopen("input.txt", "r"); if (fp == NULL) exit(EXIT_FAILURE); /* skip the crates representation */ while ((read = getline(&line, &len, fp)) != -1) { if (line[0] == '\n') break; } int n, from, to, crates_removed; while (fscanf(fp, "move %d from %d to %d\n", &n, &from, &to) == 3) { crates_removed = n; for (; n>0; n--) { /* move */ crates[to-1][crates[to-1][0]+1] = crates[from-1][crates[from-1][0]-n+1]; crates[to-1][0] += 1; /* remove old */ crates[from-1][crates[from-1][0]-n+1] = 0; } /* have to correct number of crates in from stack in one go */ crates[from-1][0] -= crates_removed; } for (int i = 0; i < 9; i++) { printf("%c", crates[i][crates[i][0]]); } printf("\n"); fclose(fp); return 0; }

>>33631 I don't know how to reallocate memory yet or resize arrays which is why I didn't write a parser. It probably wouldn't have been that difficult really because each line of the input for the crates part is a function of the width of the crate stacks. Also, I've realised a bug in my code. It wouldn't output the right answer if one of the crate stack was empty at the end. My printing function should've checked for that and printed a space or something in that case.

>>33633 Don't worry, when i tried the bigboy.txt from 4chan I got a runtime exception that I thought should be impossible in my exec function on line 36 of >>33623 so I added in a case statement to catch them; turns out I had forgotten how my makeShip function worked and I was running the filter over too small of a range. That messy jumble to make the ship out of the raw text bit me even in two lines of code.

>>33631 You're supposed to make a stack data structure if your language doesn't have one, anon.

>>33635 Well a stack fits the first problem really well but you don't "have" to. Regardless, the way I moved the crates was essentially push and pop. If I made the push and pop functions, the code I already wrote would've been in them.

An easy one, today. (defun find-marker (data size) (let ((lut (make-array 128 :element-type 'fixnum :initial-element 0)) (dup-count 0)) (iter (for c in-string data to (- size 1)) (if (= (incf (aref lut (char-code c))) 2) (incf dup-count))) (+ size (if (= dup-count 0) 0 (iter (for tail in-string data) (for head in-string data from size) (for i from 1) (if (= (decf (aref lut (char-code tail))) 1) (decf dup-count)) (if (= (incf (aref lut (char-code head))) 2) (incf dup-count)) (if (= dup-count 0) (return i))))))) (let ((datastream (uiop:read-file-string "sample"))) (format t "Start-of-packet marker found at postion: ~A~%" (find-marker datastream 4)) (format t "Start-of-message marker found at postion: ~A~%" (find-marker datastream 14)))

>>33638 Smaller, but had to use a macro because iterate's "previous" needs a compile-time value and probably slower, since this adds unconditional branching to each loop iteration. (defmacro find-marker (data size) `(iter (with lut = (make-array 128 :element-type 'fixnum :initial-element 0)) (with dup-count = 0) (for head in-string ,data) (for tail previous head back ,size) (for i from 1) (if (= (incf (aref lut (char-code head))) 2) (incf dup-count)) (if (and tail (= (decf (aref lut (char-code tail))) 1)) (decf dup-count)) (if (and (>= i ,size) (= dup-count 0)) (return i)))) (let ((datastream (uiop:read-file-string "sample"))) (format t "Start-of-packet marker found at postion: ~A~%" (find-marker datastream 4)) (format t "Start-of-message marker found at postion: ~A~%" (find-marker datastream 14)))

Pretty easy today. I don't have much going on so I might try something new. I saw someone else's haskell solution using Conduit for streams, maybe I'll kick that around. import Data.List day6 = do s <- readFile "inputs/input6.txt" print $ "part1: " ++ solve 4 s print $ "part2: " ++ solve 14 s type Marker = Int solve :: Marker -> String -> String solve m = show . (+) m . length . takeWhile (not . isMarker) . scan' m scan' :: Marker -> String -> [String] scan' _ [] = [] scan' m list = take m list : scan' m (tail list) isMarker :: String -> Bool isMarker chunk = nub chunk == chunk

>>33641 Well here's a meme pointfree solution: import Data.List import Control.Monad (liftM2, forM) day6 = do s <- readFile "inputs/input6.txt" let solve :: Int -> String -> String solve = (show .) . liftM2 (.) (+) (((length . takeWhile (not . ((==) =<< nub))) .) . (. tails) . fmap . take) forM [4,14] (putStrLn . flip solve' s)

scheme (define (solve line num) (let loop [(line line) (i 0)] (let [(marker (list-head line num))] (if (= num (length (delete-duplicates marker eq?))) (+ num i) (loop (drop line 1) (1+ i)))))) (define (solution filename) (let [(line (string->list (car (read-input filename))))] (cons (solve line 4) (solve line 14))))

def read_chars (file,chars): for line in open(file).readlines(): count = 0 for char in line: if len(set(line[count:count+chars:])) == chars: break count += 1 return count+chars print(f"Part 1 chars: {read_chars('input6.txt',4)}") print(f"Part 2 chars: {read_chars('input6.txt',14)}")

Common Lisp day 07. Added a split-{vector,string} utility (uiop:split-string doesn't remove nil sequences and it's simple enough to make to avoid importing split-sequence) and imported the amazing trivia to get match. A bit of CLOS to make stuff cleaner, today. (defclass node () ((name :initarg :name :accessor name) (size :initarg :size :initform 0 :accessor size))) (defclass dir-node (node) ((children :initform (make-hash-table :test #'equal) :accessor children) (parent :initarg :parent :accessor parent))) (defclass file-node (node) ()) (defun make-dir (name parent) (make-instance 'dir-node :name name :parent parent)) (defun make-file (name size) (make-instance 'file-node :name name :size size)) (defmethod add-child ((dir dir-node) name &optional size) (if size ;; file (progn (setf (gethash name (children dir)) (make-file name size)) (iter (for node initially dir then (parent node)) (while node) (incf (size node) size))) (setf (gethash name (children dir)) (make-dir name dir)))) (defmethod get-child ((dir dir-node) name) (gethash name (children dir))) (iter (with root = (make-instance 'dir-node :parent nil :name "/")) (with cwd) (with dirlist) (for line in-file "input" using #'read-line) (match (split-string line) ((list "$" "cd" "/") (setf cwd root)) ((list "$" "cd" "..") (setf cwd (parent cwd))) ((list "$" "cd" name) (setf cwd (get-child cwd name))) ((list "$" "ls") nil) ((list "dir" name) (push (add-child cwd name) dirlist)) ((list size name) (add-child cwd name (parse-integer size)))) (finally (let ((dirsizes (mapcar #'size dirlist))) (format t "Total size of directories with more than 100000: ~A~%" (-<>> dirsizes (remove-if (lambda (s) (> s 100000))) (apply #'+))) (format t "Size of the smallest directory to get enough free space back when deleted: ~A~%" (let* ((avail (- 70000000 (size root))) (to-free (- 30000000 avail))) (-<>> dirsizes (sort <> #'<) (find-if (lambda (s) (> s to-free)))))))))

>>33659 I have a very similar solution in OCaml. It's over 100 lines though, so I won't be posting it. Did you try to construct the file tree in a purely functional way?

>>33662 Might have made it smaller still, as file simply aren't useful in this tree (only need to backpropagate their size). >Did you try to construct the file tree in a purely functional way? No and I don't have a clear idea of what it means or how to so, here. Care to illustrate?

>>33664 What I meant is building a tree without mutating state using recursion. I managed to do so solving a similar problem (building a tree for an XML docuemnt), however this one is slightly different. Our input is a stream of tokens that we use to build a tree. As opposed to XML, where the next token is always either a child or a sibling of current node, day 7 input contains the tricky "cd .." tokens, which break the unidirectional hierarchy. I am unable to provide the code, since I failed to implement it.

>>33665 I failed as well. Its so god damn simple to do it imperatively but that damn cd .. broke my functional tree parse descent. ~scheme guy

>>33668 I think it could be doable with continuations, but I don't know how

>>33669 I don't know a lot about parsing in a functional way, but would lenses be of any help? I've heard they can be used for stuff like this where you might need some pseudo mutation?

I missed day 7 because I got home late from work, which is probably a good thing because I have no idea how to do it. I'll go back to it later. Here's part1 of day 8; it makes my computer fan spin like a helicopter and takes forever. I have to go do other stuff but I'll do part 2 later. import Data.Maybe import Data.Char import Data.List day8 = do t <- lines <$> readFile "inputs/input8.txt" print $ part1 (grid t) -- (map (take 15) (take 15 t)) return () part1 :: Grid -> Int part1 grid = length $ filter (\tree -> visibleFromUp grid tree || visibleFromLeft grid tree || visibleFromRight grid tree || visibleFromDown grid tree) grid type Table = [String] type Coords = (Int, Int) type Grid = [Tree] type Tree = (Coords, Int) grid :: Table -> Grid grid table = zip (coords table) (map digitToInt $ concat table) where coords side = [ (y,x) | x <- [1..(length side)], y <- [1..(length side)] ] visibleFromLeft :: Grid -> Tree -> Bool visibleFromLeft grid ((x,y), t) = Just t > maximum (queryLeft (x-1,y)) where queryLeft (x,y) = let lk = lookup (x,y) grid in lk : if (lk > Just t) || isNothing (lookup (x-1,y) grid) then [Nothing] else queryLeft (x-1,y) visibleFromRight :: Grid -> Tree -> Bool visibleFromRight grid ((x,y), t) = Just t > maximum (queryRight (x+1,y)) where queryRight (x,y) = let lk = lookup (x,y) grid in lk : if isNothing (lookup (x+1,y) grid) then [Nothing] else queryRight (x+1,y) visibleFromUp :: Grid -> Tree -> Bool visibleFromUp grid ((x,y), t) = Just t > maximum (queryUp (x,y-1)) where queryUp (x,y) = let lk = lookup (x,y) grid in lk : if isNothing (lookup (x,y-1) grid) then [Nothing] else queryUp (x,y-1) visibleFromDown :: Grid -> Tree -> Bool visibleFromDown grid ((x,y), t) = Just t > maximum (queryUp (x,y+1)) where queryUp (x,y) = let lk = lookup (x,y) grid in lk : if isNothing (lookup (x,y+1) grid) then [Nothing] else queryUp (x,y+1) --isOnEdge || (tallerThan any neighbors) --takeWhile (not . isNothing ) $ map (fmap ) [ (`lookup` grid) (a,y) | a <- [x,x-1..] ]

Starting to take a bit more time. Added array-operation and numerical-utilities (that I'll promptly remove after I've made a proper map-array that works like map). Is there a smarter way to do the second part? I feel like an ape using SBCL to bruteforce this. (defun width (forest) (array-dimension forest 0)) (defun height (forest) (array-dimension forest 1)) (defmacro find-visible-trees (forest direction) (assert (member direction '(:right :left :down :up))) (once-only (forest) `(iter outer (with visible = (make-array (array-dimensions ,forest) :initial-element t)) ,(case direction ((:right :left) `(for y below (height ,forest))) ((:down :up) `(for x below (width ,forest)))) (iter ,(case direction (:right `(for x below (width ,forest))) (:left `(for x from (- (width ,forest) 1) downto 0)) (:down `(for y below (height ,forest))) (:up `(for y from (- (height ,forest) 1) downto 0))) (if (not (first-iteration-p)) (setf (aref visible y x) (> (aref forest y x) max))) (maximize (aref forest y x) into max)) (finally (return-from outer visible))))) (defun greatest-scenic-score (forest) (iter outer (with (w h) = (array-dimensions forest)) (for ty from 1 below (- h 1)) (iter (for tx from 1 below (- w 1)) (for cur = (aref forest ty tx)) (in outer (maximize (* (iter (for x from (+ tx 1) below (- w 1)) ;; right (while (> cur (aref forest ty x))) (finally (return (- x tx)))) (iter (for x from (- tx 1) downto 1) ;; left (while (> cur (aref forest ty x))) (finally (return (- tx x)))) (iter (for y from (+ ty 1) below (- h 1)) ;; down (while (> cur (aref forest y tx))) (finally (return (- y ty)))) (iter (for y from (- ty 1) downto 1) ;; up (while (> cur (aref forest y tx))) (finally (return (- ty y)))))))))) (let* ((forest (-<>> (uiop:read-file-lines "input") (apply #'array-operations:stack-rows) (num-utils:map-array <> #'digit-char-p))) (right (find-visible-trees forest :right)) (left (find-visible-trees forest :left)) (down (find-visible-trees forest :down)) (up (find-visible-trees forest :up))) (-<>> (array-operations:vectorize (right left down up) (or right left down up)) (array-operations:flatten) (count t) (format t "Number of visible trees: ~A~%")) (format t "Greatest scenic score: ~A~%" (greatest-scenic-score forest)))

>>33679 Here's my part 2; only took half an hour kicking it around, not as painfully slow as part 1 either but still please tell me if there's a less imbecilic way to do this: part2 :: Grid -> Int part2 grid = maximum $ map (\t -> distanceFromLeft grid t * distanceFromRight grid t * distanceFromUp grid t * distanceFromDown grid t) grid distanceFromLeft :: Grid -> Tree -> Int distanceFromLeft grid ((x,y), t) | isNothing lk = 0 | Just t <= lk = 1 | otherwise = 1 + distanceFromLeft grid ((x-1,y), t) where lk = lookup (x-1,y) grid distanceFromRight :: Grid -> Tree -> Int distanceFromRight grid ((x,y), t) | isNothing lk = 0 | Just t <= lk = 1 | otherwise = 1 + distanceFromRight grid ((x+1,y), t) where lk = lookup (x+1,y) grid distanceFromUp :: Grid -> Tree -> Int distanceFromUp grid ((x,y), t) | isNothing lk = 0 | Just t <= lk = 1 | otherwise = 1 + distanceFromUp grid ((x,y-1), t) where lk = lookup (x,y-1) grid distanceFromDown :: Grid -> Tree -> Int distanceFromDown grid ((x,y), t) | isNothing lk = 0 | Just t <= lk = 1 | otherwise = 1 + distanceFromDown grid ((x,y+1), t) where lk = lookup (x,y+1) grid

Alright after some bullying I got it under 50 lines. I haven't made it any faster though. import Data.Maybe import Data.Char import Data.List day8 = do t <- lines <$> readFile "inputs/input8.txt" print $ part1 (grid t) print $ part2 (grid t) type Table = [String] type Coords = (Int, Int) type Grid = [Tree] type Tree = (Coords, Int) up (x,y) = (x,y-1) down (x,y) = (x,y+1) left (x,y) = (x-1,y) right (x,y) = (x+1,y) grid :: Table -> Grid grid table = zip (coords table) (map digitToInt $ concat table) where coords side = [ (y,x) | x <- [1..(length side)], y <- [1..(length side)] ] part1 :: Grid -> Int part1 grid = length $ filter (\tree -> visibleFrom up grid tree || visibleFrom left grid tree || visibleFrom right grid tree || visibleFrom down grid tree) grid part2 :: Grid -> Int part2 grid = maximum $ map (\t -> distanceFrom left grid t * distanceFrom right grid t * distanceFrom up grid t * distanceFrom down grid t) grid distanceFrom :: (Coords -> Coords) -> Grid -> Tree -> Int distanceFrom dir grid ((x,y), t) | isNothing lk = 0 | Just t <= lk = 1 | otherwise = 1 + distanceFrom dir grid (dir (x,y), t) where lk = lookup (dir (x,y)) grid visibleFrom :: (Coords -> Coords) -> Grid -> Tree -> Bool visibleFrom dir grid ((x,y), t) = Just t > maximum (query $ dir (x,y)) where query (x,y) = let lk = lookup (x,y) grid in lk : if isNothing (lookup (dir (x,y)) grid) then [Nothing] else query $ dir (x,y)

Beginning racket lainon here, switched to go because it got too difficult for me in racket. Really like to see lains lisp solutions. Any tips to get better at functional programming besides just solving problems? package main import ( "bufio" "fmt" "math" "os" ) type dir struct { dirs map[string]dir files map[string]int } func (d dir) size() (sum int) { for _, file := range d.files { sum += file } for _, dir := range d.dirs { sum += dir.size() } return } func part1(root dir) (sum int) { for _, dir := range root.dirs { if size := dir.size(); size <= 100000 { sum += size } sum += part1(dir) } return } func part2(root dir, target int) int { closest := math.MaxInt32 check := func(num int) { if num >= target && num < closest { closest = num } } for _, dir := range root.dirs { check(dir.size()) check(part2(dir, target)) } return closest } func read() dir { file, _ := os.Open("input") scn := bufio.NewScanner(file) scn.Scan() return parse(scn, []dir{{map[string]dir{}, map[string]int{}}})[0] } func parse(scn *bufio.Scanner, pwd []dir) []dir { switch scn.Text() { case "$ cd /": pwd = pwd[:1] case "$ cd ..": pwd = pwd[:len(pwd)-1] case "$ ls": for scn.Scan() { if scn.Text()[0] == '$' { return parse(scn, pwd) } else if scn.Text()[0:3] == "dir" { continue } else { size, name := 0, "" fmt.Sscanf(scn.Text(), "%d %s", &size, &name) pwd[len(pwd)-1].files[name] = size } } default: // $ cd [x] dir := dir{map[string]dir{}, map[string]int{}} pwd[len(pwd)-1].dirs[scn.Text()[5:]] = dir pwd = append(pwd, dir) } if scn.Scan() { return parse(scn, pwd) } else { return pwd } } func main() { root := read() fmt.Println(part1(root), " ", part2(root, root.size()-40000000)) } package main import ( "bufio" "fmt" "math" "os" ) const ( up = iota left down right ) func isVisible(arr [][]byte, row, col, direction int) (bool, int) { switch direction { case up: for i := row; ; i-- { if i == 0 { return true, row - i } else if arr[row][col] <= arr[i-1][col] { return false, (row - i) + 1 } } case right: for i := col; ; i++ { if i == len(arr[row])-1 { return true, i - col } else if arr[row][col] <= arr[row][i+1] { return false, (i - col) + 1 } } case down: for i := row; ; i++ { if i == len(arr)-1 { return true, i - row } else if arr[row][col] <= arr[i+1][col] { return false, (i - row) + 1 } } case left: for i := col; ; i-- { if i == 0 { return true, col - i } else if arr[row][col] <= arr[row][i-1] { return false, (col - i) + 1 } } } return false, 0 } func read() (arr [][]byte) { var ( file, _ = os.Open("input") scn = bufio.NewScanner(file) ) for scn.Scan() { var row []byte for _, c := range scn.Text() { row = append(row, byte(c-'0')) } arr = append(arr, row) } return } func main() { var ( arr = read() count, score int ) for row := range arr { for col := range arr[row] { var ( up, upScr = isVisible(arr, row, col, up) right, rightScr = isVisible(arr, row, col, right) down, downScr = isVisible(arr, row, col, down) left, leftScr = isVisible(arr, row, col, left) ) if up || down || right || left { count++ } score = int(math.Max(float64(upScr*rightScr*downScr*leftScr), float64(score))) } } fmt.Println(count, " ", score) }

Day 09 in CL. Had way too much difficulty because I somehow wanted to be smarter than just translating the text. A bit dense, but meh. (defun move (knots direction) (iter (initially (case direction (R (incf (caar knots))) (L (decf (caar knots))) (D (incf (cdar knots))) (U (decf (cdar knots))))) (for kl on knots) (while (cdr kl)) (for head = (car kl)) (for tail = (cadr kl)) (symbol-macrolet ((hx (car head)) (hy (cdr head)) (tx (car tail)) (ty (cdr tail))) (let ((dx (- hx tx)) (dy (- hy ty))) (if (= (abs dx) 2) (progn (incf tx (signum dx)) (if (/= dy 0) (incf ty (signum dy)))) (when (= (abs dy) 2) (incf ty (signum dy)) (if (/= dx 0) (incf tx (signum dx))))))))) (defun process-rope (instructions rope-size) (iter outer (for (dir . count) in instructions) (with knots = (iter (repeat rope-size) (collect (cons 0 0)))) (with tail = (last knots)) (with visited-by-tail = (make-hash-table :test #'equal)) (if (first-iteration-p) (setf (gethash (copy-list tail) visited-by-tail) t)) (iter (repeat count) (in outer (move knots dir) (setf (gethash (copy-list tail) visited-by-tail) t))) (finally (format t "Tail of rope of length ~A visited ~A cells~%" rope-size (hash-table-count visited-by-tail))))) (let ((instructions (iter outer (for (dir count) in-file "input" using (lambda (s e v) (read-repeat 2 (s e v)))) (collect (cons dir count))))) (process-rope instructions 2) (process-rope instructions 10)) Finished the map-array macros I wanted to have during Day 08, here you go for other CL anons. They use iter and once-only (alexandria); thank god for row-major-aref saving me from loop nesting hell. ;; These are macros to use funcall instead of apply+consing (defmacro map-array-into (dest fun &rest arrays) "Like map but for arrays, not just sequences. Only the arrays' total size must be equal." (assert arrays () "map-array-into needs at least one array argument") (let ((array-num (length arrays))) (once-only (dest (arrays ``(,,@arrays))) `(iter (initially (assert (apply #'= (array-total-size ,dest) (mapcar #'array-total-size ,arrays)) () "map-array-into array arguments must have the same total size")) (for i below (array-total-size (car ,arrays))) (with arrays-vec = (coerce ,arrays 'vector)) (setf (row-major-aref ,dest i) (funcall ,fun ,@(iter (for i below array-num) (collect `(row-major-aref (aref arrays-vec ,i) i))))) (finally (return ,dest)))))) (defmacro map-array (fun &rest arrays) "Like map but for arrays, not just sequences. Only the arrays' total size must be equal. The resulting array uses the dimensions of the first array." (assert arrays () "map-array needs at least one array argument") (let ((array-num (length arrays))) (once-only ((arrays ``(,,@arrays))) `(iter (initially (assert (apply #'= (mapcar #'array-total-size ,arrays)) () "map-array array arguments must have the same total size")) (with ret = (make-array (array-dimensions (car ,arrays)))) (for i below (array-total-size (car ,arrays))) (with arrays-vec = (coerce ,arrays 'vector)) (setf (row-major-aref ret i) (funcall ,fun ,@(iter (for i below array-num) (collect `(row-major-aref (aref arrays-vec ,i) i))))) (finally (return ret))))))

>>33693 Forgot about cond, way better than the strange unbalanced if: ... (let ((dx (- hx tx)) (dy (- hy ty))) (cond ((= (abs dx) 2) (incf tx (signum dx)) (if (/= dy 0) (incf ty (signum dy)))) ((= (abs dy) 2) (incf ty (signum dy)) (if (/= dx 0) (incf tx (signum dx)))))))))

Today was interesting, solved it in ~130 lines of OCaml, which I think is a lot. Also it's kind of hard to read. I find it difficult to write clean OCaml code, indenting lines is uncomfortable, especially when pattern matching. Got a little scared when I saw part 2, but then quickly generalized my solution and got the right answer on the first attempt. Also, I didn't mutate any state, which I think is pretty cool.

>>33584 >Option.get Please god no. Use matching!

Yep, and that's gonna be it for me. The part 2 refactor was damn frustrating so I'll have to revisit it later. You can see I started on it but hopefully I'll have some time tomorrow. import Data.List day9 = do iList <- map parseI . lines <$> readFile "inputs/input9.txt" print $ part1 iList putStrLn "Hello" part1 :: [Instruction] -> Int part1 = length . nub . map snd . concat . walk ((0,0),[(0,0)]) parseI :: String -> Instruction parseI ('U':' ':int) = (U, read int :: Int ) parseI ('D':' ':int) = (D, read int :: Int ) parseI ('L':' ':int) = (L, read int :: Int ) parseI ('R':' ':int) = (R, read int :: Int ) type Instruction = (Dir, Dist) data Dir = U | D | L | R deriving (Show, Eq, Read) type Dist = Int type H = (Int, Int) type T = [(Int, Int)] type S = (H,T) up (x,y) = (x,y+1) down (x,y) = (x,y-1) left (x,y) = (x-1,y) right (x,y) = (x+1,y) walk :: S -> [Instruction] -> [[S]] walk s [] = [] walk s (i:is) = exec i s : walk (last $ exec i s) is exec :: Instruction -> S -> [S] exec (dir, 0) (h,t) = [(h,t)] exec (dir, dist) (h,t) = (h,t) : exec (dir, dist-1) (move dir (h,t)) move :: Dir -> S -> S move dir (h,t:ts) = let chase n = if t `needsToChase` n then h else t in case dir of U -> (up h, chase (up h) : []) D -> (down h, chase (down h):[]) L -> (left h, chase (left h):[]) R -> (right h, chase (right h):[]) needsToChase (x,y) (x1,y1) | x1 > x + 1 || x1 < x - 1 = True | y1 > y + 1 || y1 < y - 1 = True | otherwise = False

>>33698 thanks for feedback. in that particular case I knew that it's never going to be None, so I omitted matching.

>>33679 what language is this?

Day 10 CL. Nothing hard if you don't try to be too smart. Little print-char-grid helper added, came in handy for the ropes too. (defun ins-latency (ins) (match ins ((list 'noop) 1) ((list 'addx _) 2))) (defun execute (ins xreg) (match ins ((list 'noop) nil) ((list 'addx arg) (incf (car xreg) arg)))) (let ((instructions (iter (for line in-file "input" using #'read-line) (collect (mapcar #'read-from-string (split-string line)))))) (iter (for cycle from 1) (with screen = (make-array '(6 40) :element-type 'character :initial-element #\.)) (with pc = instructions) (with xreg = (cons 1 nil)) (with cur-ins-countdown = (ins-latency (car pc))) (if (= cur-ins-countdown 0) (setf pc (cdr pc) cur-ins-countdown (ins-latency (car pc)))) (if (<= (- (car xreg) 1) (mod (- cycle 1) 40) (+ (car xreg) 1)) (setf (row-major-aref screen (- cycle 1)) #\#)) (if (= (mod cycle 40) 20) (sum (* cycle (car xreg)) into sum)) (while pc) (if (= (decf cur-ins-countdown) 0) (execute (car pc) xreg)) (finally (format t "Sum of signal strengths: ~A~%" sum) (format t "CRT display:~%") (print-char-grid screen))))

>>33705 Exceptions in OCaml should be avoided at all costs. It's good practice to use matching instead with Result or Option monads. Your solution is fine for the problem but don't make a habit out of unwrapping monads with things like Option.get

I have half a solution but I got ride of my state lookup because I couldn't squash an off-by-one error that I don't understand. I should rewrite this to use the state monad but it's too late for today. import Data.Char (digitToInt) import Data.Maybe import Data.Tuple import Control.Monad day10 = do iList <- map parseInstructions . lines <$> readFile "inputs/input10.txt" print $ part1 (registers iList) [20,60,100,140,180,220] part1 :: [(Register, Int)] -> [Register] -> Register part1 rs pos = sum $ pos `strength` map (getState rs) pos where strength = zipWith (*) type Register = Int data Instruction a = Add a | Noop deriving Show registers :: [Instruction Int] -> [(Register, Int)] registers = scanl cyc (1,0) cyc :: (Register, Int) -> Instruction Int -> (Register, Int) cyc (r, c) Noop = (r, c + 1) cyc (r, c) (Add x) = (r + x, c + 2) getState :: [(Register, Int)] -> Int -> Register getState rs c = undefined -- I am broken spritePos :: [(Register, Int)] -> [(Int,Int,Int)] spritePos rs = map ((\i -> translate i) . getState rs) [1..240] where translate i = (i, i+1,i+2) niceTry rs = zipWith (\pixel (a,b,c) -> if pixel `elem` [a,b,c] then '#' else '.') (concat $ replicate 6 [1..40]) (spritePos rs ) parseInstructions :: String -> Instruction Int parseInstructions "noop" = Noop parseInstructions addx = Add (read (last $ words addx) :: Int)

>>33706 This is Haskell >>33688 If learning a different language is an option, then you might benefit from learning Haskell. Not being able to solve any problems in a nonfunctional way forces new ways of thinking. You could take a crack at haskell.mooc.fi which is a free mooc that comes with a book (as an html) and a set of questions (like homework) that you answer and check with the accompanying test suite.

>>33708 I think lisp fits this problem very well. Your solution is very nice!

>>33594 fell a couple days behind. finally got caught up. day 5 use std::fs; fn main() { let input = fs::read_to_string("input").unwrap(); let input = input.lines(); let mut towers: Vec<Vec<char>> = vec![vec![]; 9]; input .clone() .take(8) .map(str::chars) .flat_map(|chars| { chars.skip(1).step_by(4).enumerate().filter(|(_,c)| c.is_alphabetic()) }) .for_each(|(i, c)| { towers[i].insert(0, c); }); input.clone() .skip(10) .map(crate::to_instruction) .for_each(|(amount, from, to)| { let mut pops = vec![]; for _ in 0..amount { pops.push(towers[from - 1].pop().unwrap()); } pops.reverse(); towers[to - 1].append(&mut pops); }); for tower in &towers { print!("{}", tower.last().unwrap()); } println!(); } fn to_instruction(line: &str) -> (usize, usize, usize) { let parts: Vec<usize> = line .split_whitespace() .skip(1) .step_by(2) .map(str::parse::<usize>) .map(Result::unwrap) .collect(); (parts[0], parts[1], parts[2]) } [/code] day 6 use std::fs; fn main() { let input = fs::read_to_string("input").unwrap(); println!("part 1: {}", find_token(&input, 4).unwrap()); println!("part 1: {}", find_token(&input, 14).unwrap()); } fn find_token(input: &str, length: usize) -> Option<usize> { for i in 0..(input.len() - length) { let substring = &input[i..i + length]; if !substring.chars().any(|c| substring.matches(c).count() > 1) { return Some(i + length); } } None } day 7 - I represented the file system as a graph of folders, which definitely over-complicated this. use std::borrow::Borrow; use std::fmt; use std::rc::Weak; use std::{cell::RefCell, fmt::Display, fs, rc::Rc}; type FolderNode = Rc<RefCell<Folder>>; #[derive(Debug, Clone)] struct File { name: String, size: usize, } #[derive(Debug, Clone)] struct Folder { name: String, folders: Vec<FolderNode>, files: Vec<File>, parent: Option<Weak<RefCell<Folder>>>, } impl Display for Folder { fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { write!(f, "{}", self.to_string(0)) } } impl Folder { fn new(name: String) -> Folder { Folder { name, folders: vec![], files: vec![], parent: None, } } fn all(&self) -> Vec<FolderNode> { let mut all = self.folders.clone(); for folder in &self.folders { all.append(&mut folder.as_ref().borrow_mut().all()); } all } fn get_folder(&self, name: &str) -> Option<&FolderNode> { self.folders .iter() .find(|f| f.as_ref().borrow().name.eq(name)) } fn get_size(&self) -> usize { self.folders .iter() .map(Rc::as_ref) .map(RefCell::borrow) .map(|f| f.get_size()) .sum::<usize>() + self.files.iter().map(|f| f.size).sum::<usize>() } fn add(&mut self, other: &FolderNode) { self.folders.push(Rc::clone(other)); } fn set_parent(&mut self, other: &FolderNode) { self.parent = Some(Rc::downgrade(other)); } fn to_string(&self, level: usize) -> String { let mut pad = String::from(""); for _ in 0..level { pad.push(' '); } let mut s = format!("{} {} (dir) ({}b)", pad, self.name, self.get_size()); for folder in &self.folders { s = format!( "{}\n{}", s, folder.as_ref().borrow().to_owned().to_string(level + 4) ); } for file in &self.files { s = format!( "{}\n{}{} -{} (file) ({}b)", s, pad, pad, file.name, file.size ); } s } } fn main() { let root = Rc::new(RefCell::new(Folder::new(String::from("/")))); let mut current_folder = Rc::clone(&root); for line in fs::read_to_string("input").unwrap().lines() { let mut tokens = line.split_whitespace(); match tokens.next().unwrap() { "$" => { if tokens.next().unwrap() == "cd" { match tokens.next().unwrap() { "/" => { current_folder = Rc::clone(&root); } ".." => { let parent_folder = Rc::clone( &current_folder // lmfao .as_ref() .borrow() .parent .as_ref() .unwrap() .borrow() .upgrade() .unwrap(), ); current_folder = parent_folder; } dir => { let new_folder = Rc::clone( current_folder.as_ref().borrow().get_folder(dir).unwrap(), ); current_folder = new_folder; } }; } } "dir" => { let name = tokens.next().unwrap().to_string(); if !current_folder .as_ref() .borrow() .folders .iter() .any(|f| f.as_ref().borrow().name.eq(&name)) { let mut new_folder = Folder::new(name); new_folder.set_parent(&current_folder); current_folder .as_ref() .borrow_mut() .add(&Rc::new(RefCell::new(new_folder))); } } size => { let size: usize = size.parse().unwrap(); let name = tokens.next().unwrap().to_string(); current_folder .as_ref() .borrow_mut() .files .push(File { name, size }); } } } println!( "Part one: {}", root.as_ref() .borrow() .all() .iter() .map(Rc::as_ref) .map(RefCell::borrow) .map(|f| f.get_size()) .filter(|s| *s <= 100_000) .sum::<usize>() ); let unused = 70_000_000 - root.as_ref().borrow().get_size(); println!( "Part two: {}", root.as_ref() .borrow() .all() .iter() .map(Rc::as_ref) .map(RefCell::borrow) .map(|f| f.get_size()) .filter(|s| unused + *s >= 30_000_000) .min() .unwrap() ); } post too long (1/?)

>>33719 day 8 - ugly, don't like it, but wanted to move on instead of refactoring. use std::{collections::HashSet, fs}; #[derive(PartialEq, Eq, Hash, Debug, Copy, Clone)] struct Point { x: usize, y: usize, } fn main() { let input = fs::read_to_string("input").unwrap(); let mut forest: Vec<Vec<isize>> = vec![]; input .lines() .map(str::chars) .map(|chars| { chars .map(String::from) .map(|c| c.parse::<isize>()) .map(Result::unwrap) }) .map(Iterator::collect) .for_each(|row| forest.push(row)); let mut visible_trees: HashSet<Point> = HashSet::new(); let size = forest.len(); let mut top_maxes = vec![-1; size]; let mut bottom_maxes = vec![-1; size]; let mut max_score = -1; for y in 0..size { let mut left_max = -1; let mut right_max = -1; for x in 0..size { if forest[y][x] > left_max { visible_trees.insert(Point { x, y }); left_max = forest[y][x]; } if forest[y][size - x - 1] > right_max { visible_trees.insert(Point { x: size - x - 1, y }); right_max = forest[y][size - x - 1]; } if forest[y][x] > top_maxes[x] { visible_trees.insert(Point { x, y }); top_maxes[x] = forest[y][x]; } if forest[size - y - 1][x] > bottom_maxes[x] { visible_trees.insert(Point { x, y: size - y - 1 }); bottom_maxes[x] = forest[size - y - 1][x]; } // find the score let tree = forest[y][x]; let mut left_score = 0; let mut right_score = 0; let mut bottom_score = 0; let mut top_score = 0; for i in (0..x).rev() { left_score += 1; if forest[y][i] >= tree { break; } } for i in x + 1..size { right_score += 1; if forest[y][i] >= tree { break; } } for i in (0..y).rev() { top_score += 1; if forest[i][x] >= tree { break; } } for i in y + 1..size { bottom_score += 1; if forest[i][x] >= tree { break; } } let score = left_score * right_score * bottom_score * top_score; if score > max_score { max_score = score; } } } println!("{:?}", visible_trees.len()); println!("{:?}", max_score); } day 9 - probably should have renamed "head" and "tail" to something more appropriate when refactoring use std::{cell::RefCell, collections::HashSet, fs, rc::Rc}; #[derive(Debug, Copy, Clone, Hash, Eq, PartialEq)] struct Coordinate { x: isize, y: isize, } #[derive(Copy, Clone)] enum Direction { Up, Down, Left, Right, } impl From<&str> for Direction { fn from(s: &str) -> Self { match s { "U" => Direction::Up, "D" => Direction::Down, "L" => Direction::Left, "R" => Direction::Right, _ => panic!("error parsing direction"), } } } impl Coordinate { fn add(&mut self, other: Coordinate) { self.x += other.x; self.y += other.y; } fn distance_to(&self, other: Coordinate) -> Coordinate { Coordinate { x: other.x - self.x, y: other.y - self.y, } } fn move_to(&mut self, direction: Direction) { match direction { Direction::Up => self.add(Coordinate { x: 0, y: 1 }), Direction::Down => self.add(Coordinate { x: 0, y: -1 }), Direction::Left => self.add(Coordinate { x: -1, y: 0 }), Direction::Right => self.add(Coordinate { x: 1, y: 0 }), } } fn touches(&self, other: Coordinate) -> bool { (other.x - self.x).abs() <= 1 && (other.y - self.y).abs() <= 1 } } #[derive(Debug)] struct Rope { head: Coordinate, tail: Option<Rc<RefCell<Rope>>>, history: HashSet<Coordinate>, } impl Rope { fn new() -> Rope { let head = Coordinate { x: 0, y: 0 }; let mut history = HashSet::new(); history.insert(head); Rope { head, history, tail: None, } } fn append(&mut self, other: Rc<RefCell<Rope>>) { if let Some(tail) = self.tail.as_ref() { tail.as_ref().borrow_mut().append(other); } else { self.tail = Some(other); } } fn step(&mut self, direction: Direction) { self.head.move_to(direction); println!("head {:?},", self.head); self.update(); } fn update(&mut self) { self.history.insert(self.head); if let Some(tail) = self.tail.clone() { let mut tail = tail.as_ref().borrow_mut(); if tail.head.touches(self.head) { return; } let distance = tail.head.distance_to(self.head); if distance.x.is_positive() { tail.head.move_to(Direction::Right); } else if distance.x.is_negative() { tail.head.move_to(Direction::Left); } if distance.y.is_positive() { tail.head.move_to(Direction::Up); } else if distance.y.is_negative() { tail.head.move_to(Direction::Down); } tail.update(); } } fn get_end_history(&self) -> HashSet<Coordinate> { if let Some(tail) = self.tail.as_ref() { tail.as_ref().borrow().get_end_history() } else { self.history.clone() } } } fn main() { let mut rope = Rope::new(); for _ in 0..9 { rope.append(Rc::new(RefCell::new(Rope::new()))); } fs::read_to_string("input") .unwrap() .lines() .map(str::split_whitespace) .map(Iterator::collect) .map(|tokens: Vec<&str>| (tokens[0], tokens[1])) .map(|(dir, steps)| (Direction::from(dir), steps.parse::<usize>().unwrap())) .for_each(|(dir, step)| { for _ in 0..step { rope.step(dir); } }); println!( "{:?}", rope.tail.as_ref().unwrap().as_ref().borrow().history.len() ); println!("{:?}", rope.get_end_history().len()); } (2/3)

>>33719 >>33720 day 10 use std::fs; #[derive(Copy, Clone)] enum OpCode { Noop, Add(isize), } impl From<&str> for OpCode { fn from(tokens: &str) -> Self { let mut tokens = tokens.split_whitespace(); if tokens.next().unwrap() == "addx" { OpCode::Add(tokens.next().unwrap().parse().unwrap()) } else { OpCode::Noop } } } struct Machine { cycle: isize, x: isize, signal_sum: isize, screen: String, } impl Machine { fn execute(&mut self, op_code: OpCode) { self.step(); if let OpCode::Add(operand) = op_code { self.step(); self.x += operand; } } fn step(&mut self) { self.cycle += 1; if (self.cycle - 20) % 40 == 0 { self.signal_sum += self.cycle * self.x; } if (self.cycle - 1) % 40 >= self.x - 1 && (self.cycle - 1) % 40 <= self.x + 1 { self.screen.push('#'); } else { self.screen.push('.'); } if self.cycle % 40 == 0 { self.screen.push('\n'); } } } fn main() { let mut machine = Machine { x: 1, cycle: 0, signal_sum: 0, screen: "".to_string(), }; fs::read_to_string("input") .unwrap() .lines() .map(OpCode::from) .for_each(|op| machine.execute(op)); println!("part 1: {}", machine.signal_sum); println!("part 2:\n{}", machine.screen); } (3/3)

Day 11, fascinating part 2. Did part 1, then had to leave the house and didn't have time to read part 2, but caught a glimpse of some posts on r/adventofcode that mentioned "keeping the worry levels manageable". So while being AFK I was trying to guess what the part 2 based on my limited knowledge and thought about least common multiple. What's funny is that when I came back home and actually read part 2, I got stuck on the problem for 2 hours or so, without even trying to use the approach I came up with while being AFK. I guess this means that sometimes reading the task details can jumble up your thoughts and divert your from the right solution. Once again my OCaml solution is ~130 lines, especially with all that parsing. Maybe I will clean it up a little and post later.

>>33724 You could pull in Mehnir or OCamllex for this one. Would really make parsing a little more straight forward.

Made a thread by mistake, and no JS means no password for deletion. Day 11 in CL, took me something like 4 hours because: 1) Had to improve my split-vector/list and string utilities. 2) Took way too long to think about the LCM solution. Shameful display. 3) Wanted to use runtime compilation (took a bit of time to use , which forced me to refactor my whole soykaf into note parsing -> monkey making steps. 4) My simple queue data structure didn't copy its initial-content parameter. (defclass monkey () ((items :initarg :items :accessor items) (inspect-fun :initarg :inspect-fun :accessor inspect-fun) (choose-target-fun :initarg :choose-target-fun :accessor choose-target-fun) (inspect-count :initform 0 :accessor inspect-count))) (defmethod play-turn ((obj monkey) monkeys) (with-slots (items inspect-fun choose-target-fun inspect-count) obj (iter (while (not (queue:empty-p items))) (for item = (queue:pop items)) (incf inspect-count) (setf item (funcall inspect-fun item)) (queue:push item (items (aref monkeys (funcall choose-target-fun item))))))) (define-constant +empty-line+ (format nil "~2%")) (defun parse-notes (full-notes &key relief-mod relief-div) (let ((text-chunks (split-string +empty-line+ full-notes))) (iter (for text-chunk in text-chunks) (destructuring-bind (items op-infix-expr test-div monkey-if monkey-else) (-<>> text-chunk (cl-ppcre:scan-to-strings (join-strings #\Newline "Monkey \\d+:" " Starting items: (.*)" " Operation: new = (.*)" " Test: divisible by (\\d+)" " If true: throw to monkey (\\d+)" " If false: throw to monkey (\\d+)")) (nth-value 1) (vector->list)) (collect (list (-<>> items (split-string '(#\Space #\,)) (mapcar #'read-from-string)) (-<>> op-infix-expr (read-all-from-string) (list-swap <> 0)) (parse-integer test-div) (parse-integer monkey-if) (parse-integer monkey-else))))))) (defun get-lcm (notes-data) (apply #'lcm (iter (for (items inspect-body target-div target1 target2) in notes-data) (collect target-div)))) (defun make-monkeys (notes-data &key relief-mod relief-div) (iter (for (items inspect-body target-div target1 target2) in notes-data) (collect (make-instance 'monkey :items (queue:make items) :inspect-fun (compile nil `(lambda (old) ,(cond (relief-div `(truncate ,inspect-body ,relief-div)) (relief-mod `(mod ,inspect-body ,relief-mod))))) :choose-target-fun (compile nil `(lambda (item) (if (= (mod item ,target-div) 0) ,target1 ,target2)))) result-type vector))) (defun monkey-business-level (monkeys) (-<>> monkeys (map 'list #'inspect-count) (sort <> #'>) (subseq <> 0 2) (apply #'*))) (let* ((notes-data (parse-notes (uiop:read-file-string "input")))) (iter (with monkeys = (make-monkeys notes-data :relief-div 3)) (repeat 20) (iter (for monkey in-vector monkeys) (play-turn monkey monkeys)) (finally (format t "Monkey business level, part 1: ~A~%" (monkey-business-level monkeys)))) (iter (with monkeys = (make-monkeys notes-data :relief-mod (get-lcm notes-data))) (repeat 10000) (iter (for monkey in-vector monkeys) (play-turn monkey monkeys)) (finally (format t "Monkey business level, part 2: ~A~%" (monkey-business-level monkeys)))))

day 11 in rust. rushing to finish before going to bed so really phoned it in on this one. incorrectly expected part two to involve more operations so used it as an opportunity to play with Rust's syntax for returning closures. use std::{ collections::VecDeque, fs, ops::{Add, Mul}, }; #[derive(Debug, Clone, Copy)] enum Operation { Add(usize), // didn't realize the old * old lines at first, so hackily letting None = multiply by old Multiply(Option<usize>), } impl From<&str> for Operation { fn from(s: &str) -> Self { let mut tokens = s.split_whitespace().rev(); if let Ok(operand) = tokens.next().unwrap().parse::<usize>() { if tokens.next().unwrap() == "*" { Operation::Multiply(Some(operand)) } else { Operation::Add(operand) } } else { Operation::Multiply(None) } } } impl Operation { fn execute(&self) -> impl Fn(usize) -> usize + '_ { move |x| -> usize { match self { Operation::Add(y) => x.add(y), Operation::Multiply(Some(y)) => x.mul(y), Operation::Multiply(_) => x.mul(x), } } } } #[derive(Debug, Clone)] struct Monkey { items: VecDeque<usize>, divisor: usize, operation: Operation, good_monkey: usize, bad_monkey: usize, inspections: usize, } impl From<&str> for Monkey { fn from(s: &str) -> Self { let mut lines = s.lines().skip(1); let items: VecDeque<usize> = lines .next() .unwrap() .split_once(": ") .unwrap() .1 .split(", ") .map(|s| s.parse().unwrap()) .collect(); let operation = Operation::from(lines.next().unwrap()); let mut last_num = move || -> usize { lines.next().unwrap().split_whitespace().rev().next().unwrap().parse().unwrap() }; let divisor = last_num(); let good_monkey = last_num(); let bad_monkey = last_num(); Monkey { items, divisor, operation, good_monkey, bad_monkey, inspections: 0, } } } impl Monkey { /// Returns the id of the monkey to pass to and the worry level of the item being passed fn pass(&mut self, divide: bool, lcm: usize) -> (usize, usize) { self.inspections += 1; let mut item = self.items.pop_front().unwrap(); item = self.operation.execute()(item); if divide { item /= 3; } else { // prevent overflow item %= lcm; } if item % self.divisor == 0 { (self.good_monkey, item) } else { (self.bad_monkey, item) } } } fn main() { let mut p1_monkeys: Vec<Monkey> = fs::read_to_string("input") .unwrap() .split("\n\n") .map(Monkey::from) .collect(); let mut p2_monkeys = p1_monkeys.clone(); let lcm = p2_monkeys .iter() .map(|m| m.divisor) .reduce(std::ops::Mul::mul) .unwrap(); for _ in 0..20 { for i in 0..p1_monkeys.len() { while !p1_monkeys[i].items.is_empty() { let (to, item) = p1_monkeys[i].pass(true, lcm); p1_monkeys[to].items.push_back(item); } } } let mut inspections = p1_monkeys .iter() .map(|m| m.inspections) .collect::<Vec<usize>>(); inspections.sort(); println!( "part one: {}", inspections[inspections.len() - 2] * inspections[inspections.len() - 1] ); for _ in 0..10_000 { for i in 0..p2_monkeys.len() { while !p2_monkeys[i].items.is_empty() { let (to, item) = p2_monkeys[i].pass(false, lcm); p2_monkeys[to].items.push_back(item); } } } inspections = p2_monkeys .iter() .map(|m| m.inspections) .collect::<Vec<usize>>(); inspections.sort(); println!( "part two: {}", inspections[inspections.len() - 2] * inspections[inspections.len() - 1] ); }

Day 12 in CL. Added an array version of position (and a position-all too). Maybe I should be ashamed as a CS MSc graduate of my use of BFS instead of A*, but I don't give a damn. A bit useless to store the full path, but I didn't know what part 2 had in mind. (defmacro aref-map (map pos) `(apply #'aref ,map ,pos)) (defun find-next-nodes (hmap vmap node) (iter (with (y x) = (car node)) (for (yoff xoff) in '((0 -1) (-1 0) (0 1) (1 0))) (for ylook = (+ y yoff)) (for xlook = (+ x xoff)) (when (and (array-in-bounds-p hmap ylook xlook) (not (aref vmap ylook xlook)) (<= (aref hmap ylook xlook) (+ (aref hmap y x) 1))) (setf (aref vmap ylook xlook) t) (collect (cons (list ylook xlook) node))))) ;; node: (cons (cons y x) parent-node) (defun pathfind-bfs (hmap start end) (iter outer (with to-visit = (queue:make (list (cons start nil)))) (with vmap = (let ((ret (make-array (array-dimensions hmap) :initial-element nil))) (setf (aref-map ret start) t) ret)) (while (not (queue:empty-p to-visit))) (for node = (queue:pop to-visit)) (if (equal (car node) end) (return-from outer (cdr (nreverse node)))) (until (equal (car node) end)) (queue:pushm (find-next-nodes hmap vmap node) to-visit))) (let* ((hmap (-<>> (uiop:read-file-lines "input") (apply #'array-operations:stack-rows))) (start (position-array #\S hmap)) (end (position-array #\E hmap))) (setf (aref-map hmap start) #\a (aref-map hmap end) #\z hmap (map-array (lambda (c) (- (char-code c) #.(char-code #\a))) hmap)) (format t "Length of shortest path from S to E: ~A~%" (length (pathfind-bfs hmap start end))) (format t "Length of shortest path from bottom to E: ~A~%" (iter (for start in (position-array-all 0 hmap)) (let ((path (pathfind-bfs hmap start end))) (if path (minimize (length path)))))))

Day 13 in CL. Added positions and positions-if (better name than position-all, really). Was prepared to do memoization in the sort lambda for part 2, but no need, eh. At the beginning, I wanted to modify the readtable to parse the input, but I didn't bother in the end. (defun compare-packet (l r) (typecase (cons l r) ((cons list list) (iter (for lc initially l then (cdr lc)) (for rc initially r then (cdr rc)) (cond ((not (or lc rc)) (return 0)) ((not lc) (return 1)) ((not rc) (return -1))) (for order = (compare-packet (car lc) (car rc))) (if (/= order 0) (return order)))) ((cons integer integer) (signum (- r l))) ((cons list integer) (compare-packet l (list r))) ((cons integer list) (compare-packet (list l) r)))) (define-constant +div-packets+ '(((2)) ((6)))) (let* ((input (-<>> (uiop:read-file-lines "input") (mapcar (lambda (s) (nsubstitute #\( #\[ s))) (mapcar (lambda (s) (nsubstitute #\) #\] s))) (mapcar (lambda (s) (nsubstitute #\Space #\, s))))) (packet-pairs (-<>> input (split-list "" <> :test #'string=) (mapcar (lambda (pair) (mapcar #'read-from-string pair)))))) (format t "Sum of indices of well ordered packet pairs: ~A~%" (-<>> packet-pairs (mapcar (lambda (p) (apply #'compare-packet p))) (positions 1) (mapcar #'1+) (apply #'+))) (format t "Distress signal decoder key: ~A~%" (-<>> packet-pairs (apply #'nconc (copy-list +div-packets+)) (sort <> (lambda (l r) (= (compare-packet l r) 1))) (positions-if (lambda (p) (member p +div-packets+))) (mapcar #'1+) (apply #'*))))

OCaml anon reporting: Day 13 went smooth, I used continuations to parse those lists. As I mentioned last week about that XML parsing I was doing, it came in handy, since the parsing problem is very similar. I like how in Lisp you don't even need to parse anything, simply eval the input. Day 12, however, hit me in the face. I still haven't solved it. I tried bruteforcing my way through, but got trapped in that maze. To be honest, it really shook my confidence, but I haven't given up yet... (* Day 13 *) type value = | Int of int | List of value list;; let convert v = match v with | Int i -> List [v] | v -> v;; let rec find_map f = function | [], [] -> None | [], rh :: rt -> Some true | lh :: lt, [] -> Some false | lh :: lt, rh :: rt -> match f (lh, rh) with | None -> find_map f (lt, rt) | s -> s;; let rec cmp = function | Int i1, Int i2 -> if i1 = i2 then None else Some (i1 < i2) | List lst1, List lst2 -> find_map cmp (lst1, lst2) | v1, v2 -> cmp (convert v1, convert v2);; let parse_int chars = let str = str_of_chars chars in Scanf.sscanf str "%d%s" (fun i s -> i, (str_explode s));; let parse str = let rec parse_chars k = function | [] -> k [] [] | '[' :: t -> parse_chars (fun vals tail -> parse_chars (fun kvals ktail -> k (List vals :: kvals) ktail) tail) t | ']' :: t -> k [] t | ',' :: t -> parse_chars k t | chars -> let (i, rest_chars) = parse_int chars in parse_chars (fun kvals ktail -> k (Int i :: kvals) ktail) rest_chars in parse_chars (fun vals tail -> List.hd vals) (str_explode str);; let packets = List.map parse @@ List.filter (Fun.negate string_empty) @@ file_to_lines "input";; let part1 () = let pairs = List.map list_to_pair @@ list_windowed 2 @@ packets in let part1 = list_sum @@ List.mapi (fun i p -> match cmp p with | None -> failwith "cmp returned None" | Some true -> i + 1 | Some false -> 0) pairs in printf "Part 1: %d\n" part1;; let part2 () = let div2 = List [List [Int 2]] in let div6 = List [List [Int 6]] in let sorted = List.sort (fun p1 p2 -> match cmp (p1, p2) with | None -> 0 | Some true -> -1 | Some false -> 1) (div2 :: div6 :: packets) in let div2_ind = 1 + (list_ind div2 sorted) in let div6_ind = 1 + (list_ind div6 sorted) in let key = div2_ind * div6_ind in printf "Part 2: %d\n" key;;

>>33741 Look at Wikipedia's BFS article pseudo-code if you have trouble, it's very readable.

Day 14 CL. Nothing to report, except that I don't know what to do about these ugly nested mapcars. (defconstant +sand-source+ '(500 0)) (defmacro aref-coord (cave coord) (assert (or (constantp coord) (symbolp coord))) `(aref ,cave (cadr ,coord) (car ,coord))) (defun build-line (cave from to) (destructuring-bind ((xf yf) (xt yt)) (list from to) (if (= xf xt) (iter (for y from (min yf yt) to (max yf yt)) (setf (aref cave y xf) :rock)) (iter (for x from (min xf xt) to (max xf xt)) (setf (aref cave yf x) :rock))))) (defun cave-cave-dim (scan-data ymargin) (iter outer (for path in scan-data) (iter (for (x y) in path) (in outer (maximize (+ y ymargin) into h) (finally (return-from outer (list h (+ (car +sand-source+) h)))))))) (defun build-cave (scan-data &key (ymargin 1)) (let ((cave (make-array (cave-cave-dim scan-data ymargin) :initial-element :air))) (iter (for path in scan-data) (iter (for (from to) on path) (while to) (build-line cave from to))) cave)) (defun step-sand (cave coord) (destructuring-bind (x y) coord (cond ((= (+ y 1) (array-dimension cave 0)) :bottom) ((eq (aref cave (+ y 1) x) :air) (list x (+ y 1))) ((eq (aref cave (+ y 1) (- x 1)) :air) (list (- x 1) (+ y 1))) ((eq (aref cave (+ y 1) (+ x 1)) :air) (list (+ x 1) (+ y 1))) (t :settled)))) (defun move-sand (cave) (if (eq (aref-coord cave +sand-source+) :sand) :blocked (iter (for s initially +sand-source+ then (step-sand cave s)) (for sprev previous s) (while (consp s)) (finally (setf (aref-coord cave sprev) :sand) (return s))))) (let ((scan-data (-<>> (uiop:read-file-lines "input") (mapcar (lambda (line) (split-string " -> " line))) (mapcar (lambda (path) (mapcar (lambda (coord) (split-string #\, coord)) path))) (mapcar (lambda (path) (mapcar (lambda (coord) (mapcar #'parse-integer coord)) path)))))) (format t "How many units of sand before falling into the abyss: ~A~%" (let ((cave (build-cave scan-data))) (iter (for i from 0) (while (not (eq (move-sand cave) :bottom))) (finally (return i))))) (format t "How many units of sand before source is blocked: ~A~%" (let ((cave (build-cave scan-data :ymargin 2))) (iter (for i from 0) (while (not (eq (move-sand cave) :blocked))) (finally (return i))))))

>>33742 Thank you for the tip. It's amazing how simple the solution is. I still spent quite some time debugging, because of a silly mistake: I was starting at position (0,0) instead of at 'S'.

playing catch up and let me just rage about day 13 a bit: I WASTED SO MUCH GODDAMN TIME DEBUGGING AN ISSUE THAT WASN'T THERE BECAUSE I GLANCED OVER THE "INDEX STARTS AT 1" INSTRUCTION. FUUUCK

Day 15 CL. Was quite hard and I hit a performance wall by using vectors instead of range lists at the start. Had to realize that the beacons and sensors would always be contained in a range (duh). (defun parse-sensors-data (lines) (iter (for line in lines) (ppcre:register-groups-bind (sx sy bx by) ("Sensor at x=(-?\\d+), y=(-?\\d+): closest beacon is at x=(-?\\d+), y=(-?\\d+)" line) (collect `((,(parse-integer sy) . ,(parse-integer sx)) (,(parse-integer by) . ,(parse-integer bx))))))) (defun nmerge-ranges (ranges) (nreverse (iter (for r in (sort ranges #'< :key #'car)) (for head = (car res)) (if (or (first-iteration-p) (< (cdr head) (car r))) (collect r into res at start) (setf (cdr head) (max (cdr head) (cdr r)))) (finally (return res))))) (defun scan-line (ytarget sdata) (iter (for ((sy . sx) (by . bx)) in sdata) (declare (type fixnum sy sx by bx)) (for dist = (+ (abs (- sx bx)) (abs (- sy by)))) (for ydiff = (abs (- sy ytarget))) (for pradius = (- dist ydiff)) (with beacons-and-sensors) (with no-beacon-ranges) (if (= ytarget sy) (pushnew sx beacons-and-sensors)) (if (= ytarget by) (pushnew bx beacons-and-sensors)) (when (> pradius 0) (push (cons (- sx pradius) (+ sx pradius)) no-beacon-ranges) (minimize (- sx pradius) into xmin) (maximize (+ sx pradius) into xmax)) (finally (return (list beacons-and-sensors (nmerge-ranges no-beacon-ranges)))))) (define-constant +beacon-max-pos+ '(4000000 4000000)) (define-constant +pt1-ytarget+ 2000000) ;; (define-constant +beacon-max-pos+ '(20 20)) ;; (define-constant +pt1-ytarget+ 10) (let ((sdata (parse-sensors-data (uiop:read-file-lines "input")))) (format t "Number of positions that can't contain the distress beacon at y=~A: ~A~%" +pt1-ytarget+ (iter (with (b&s ranges) = (scan-line +pt1-ytarget+ sdata)) (for (start . end) in ranges) (sum (+ (- end start) 1) into res) (finally (return (- res (length b&s)))))) (format t "Distress beacon frequency: ~A~%" (iter outer (for y from 0 below (cadr +beacon-max-pos+)) (iter (with (b&s ranges) = (scan-line y sdata)) (for rc on ranges) (while (cdr rc)) (for (s1 . e1) = (car rc)) (for (s2 . e2) = (cadr rc)) (if (/= (+ e1 1) s2) (return-from outer (+ (* 4000000 (+ e1 1)) y)))))))