From d01e6a98d05cb356738cf1fe4ea3e39ead0f8f35 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tristan=20Dani=C3=ABl=20Maat?= <tm@tlater.net> Date: Sun, 12 Dec 2021 00:02:27 +0000 Subject: [PATCH 1/7] day9: Complete puzzles --- 9/Parsing.hs | 23 +++++++++++ 9/input.txt | 100 +++++++++++++++++++++++++++++++++++++++++++++++ 9/smokescreen.hs | 77 ++++++++++++++++++++++++++++++++++++ 3 files changed, 200 insertions(+) create mode 100644 9/Parsing.hs create mode 100644 9/input.txt create mode 100644 9/smokescreen.hs diff --git a/9/Parsing.hs b/9/Parsing.hs new file mode 100644 index 0000000..8ad0f3f --- /dev/null +++ b/9/Parsing.hs @@ -0,0 +1,23 @@ +module Parsing ( + splitByString + ) where + +import Data.List (isPrefixOf) + +splitByString :: String -> String -> [String] +splitByString _ "" = [] +splitByString splitter string = + let (chunk, rest) = spanNextSplit string + in + chunk:(splitByString splitter rest) + where + spanNextSplit :: String -> (String, String) + spanNextSplit [] = ([], []) + spanNextSplit everything@(char:rest) + | splitter `isPrefixOf` rest = + ([char], (drop ((length splitter) + 1) everything)) + | otherwise = + let + (start, end) = spanNextSplit rest + in + (char:start, end) diff --git a/9/input.txt b/9/input.txt new file mode 100644 index 0000000..860ccaa --- /dev/null +++ b/9/input.txt @@ -0,0 +1,100 @@ +9987675345698765453987654321234589999899878923493212345678999998656782467898999899878301234578998787 +9876543234789765322398743210123567898789767899986101239899789876543101567897898798763212355989987656 +3987784014897654310987654331235679965697644998765232345997654989765212799956999679854343466799976545 +2199875323998765421298776542346789434595433498754345456789543499876353489549876542975858977899876439 +1012965439899896432359987667457896546789322349987656987898932445987454578932987621986767898943989598 +2125976598798989943467898876589999858899910959898767898976101234598966689431298320987898999432399987 +3234987987656579894578989987679998769999899898769879999965422345679298995420139434598999896543459875 +4346799876545456789679877898789769878989798799656989899876563496799109989591298548999689789656598764 +5956998765434345698989765679895456989678679678943496789988689989898997979989987657987565698787989543 +6899898764321234567999876989954345696534598789432134679999799976987656765778998769766464989999865432 +7987679653210155789999997899875456789323999899521012345899899765698943254667999898954353578999654321 +9696598654323234589788998998986567898919894958933423456789999753459892123458998987893212467898765432 +8543498765434545679567899987987679987898743147894934567898989432398789334767987876789101298989876543 +7656789878545656789338989876598789986797654235679895678997878941987678975879896545698914345678987654 +9868998989656877892129678965439899975498754346998796789986867932954569986798765434567895458989998765 +8979987798787898921012567894321999874329985459876589899985457899873458987987654323469986567899869876 +7899876549898959999923456789432398765909876567987678999875322987654567898998773212378997698998754987 +6534997831999943987894567897543999899899987878998789789964201298765678919679654323456789799987632399 +5424598942689899876789678987659899988788999989019895699865362349986989103498795434567899899996549989 +4212349653498789765699989798798789877697898999999924789976457899798993212379986747698946999897998878 +5334569878989678934998995679987678954545987899789935689987567987649898763467897858789235798789887867 +6446878989876569976897893459876567893239876797689898789397679893234789654598998979999546999698785458 +7557989199987457898956789998984348994124965323486789895498798789123569875989109989898969898598654345 +8998994398796346899545699876543236789549876412345678979569987679023456989878992398767898767469643234 +9999689987654235695434689987652125678956987954456789768979876568994568999867989987659999955398759345 +7887578976543123489545679698983234789768998765677993457899765456789878997654878998767899843229898956 +6543469998768245678956789529865445899879999896798912349998987347899989989653467899879998732019987897 +7672398999875456989767895439876556789989989999899102356987798456789899878932356789989987643498976789 +8954987899986567899878976546989667993498979978976212469996549567895798969991245699899998754987685698 +9769876989987898901989997656898789101997768769895433498765439878934987656789346789788999869876564567 +9898765778998979312397899767999893249876753656789656569976524989423976546789498997697986998765473456 +3987654569789765434456976978999974756965432345678987678987734694319887635689989998456894219874321567 +2198733477678978645797895989989865669876543766799998789599848789998765212678979999367975323985432378 +3989821234568999756898934599878976798998754567898999897679959899899874323599867895459876434596543458 +9876432347679549887969423498969987897989865698997899979898767998798765435679756899567987546987654567 +9876543489789832998953210987658998996579878789876588965939989987659987546789645688979987657898785678 +3987654579898721239998723976547899987467989999995477894321098765545698687895436577898998898999896789 +2398766789989654359899644597656999876345697679654356965434197543434989798954323456987899939998987893 +1239887894678965498788987698987999765234789598765467896545976532129879899996534567896789123976798912 +0945998923567896997687898999298987653123696439876588987679876549098765945987965778945693239875459901 +9896789434678999876575999899399199762064594321987678998789989698987654326599878989238789459954345899 +6797898645789998767434598798989349872165689410198989769899898997898543212367989994345678998986254678 +5789949756894987654323497687878959989278796521239797653998767876799654302456999965456899987432123689 +4569439887893998799934598576967898995478897432345698992989545665698775212567899876697899876543234567 +5678921998969899987899974475459997898567998945456789989878932124569854323498976989989965987654345678 +6799990199656789876798863212349976987678999896897899879767893234698765434578965699878974598785458789 +9899989989543298765987652101267895999799998789998998968456789345999879545679854598767943459987569893 +3998979678932129894598543323458934889934987698999987654345895469876997656789765987659894567998678942 +1987667569892099989679656445667895679899876597896596543256896567989998789899876798547689978999789531 +9876553456789989878998767986898996798788995456789987752125789678998999897999987899534567899989898940 +8765432345679878967999899597959789987576789347899876543234589789987899975689999987656789929876967891 +8764321234698766556899995329345678987455678956789989684348678999876798764567898998769893212975456932 +9863210123459654345688989910258789876323589969894398765457789998765679923459987869878999109864349894 +9854525234598743234567979891345897995474567898989239878767899997654567895678996555989998919753239789 +9765434545987655455679865789457896986567678967878946989878959876543456789789789434599987898954398679 +9896565656898766767999954567978965497678989656567898998989245988652346799894698765679876767895976532 +9987879768999879879878323489989654398789893432349899987690159899721278967923989876798965456987987699 +8998989879988989998965412397898765219899762101234789996521998798754367899999878987987654347898998987 +7659395989876897987654323456789898323998753242345678989439887699865456899989769999876543236789019986 +8543214598765456798987654589896987536789894355456989879598754589876967999877658999997655345678998965 +7654323679876578969999865678945698545678976566567898769987653479989898998766546898998786457799987654 +8795498793997989657899976789234987657799987677678965657898794567998789987653234567899898568899998723 +9989989932398996546789989890123498968989998788789654346789887679899678996442123458901987678999899812 +9878879993989875237899999989254989979878999899898766869895998997676567894321015667892398789999798923 +7767767989878943123978999878969978998967899922939878998953219876565456976534124578943469999988697654 +6553459876767894234568986767898767987656789210125989987994101985432389997645234567894590129876598785 +5432345985458995679799875456989659876545456991234899876789919996676569987656545678965989239988439986 +4321359894346789789987654345678943965434345789546799765679898987787878998787656989879879998895321298 +5430198765497899894298763234567899876521234899987987654598787999898989109898767899998967897654210129 +6541679876989945999987654345678989987752345678999999766987656579999793212999878999987656789775323234 +6432589989877899998998765476989978998843459789998939878996545468989654329989999998798787894989876545 +7543458998965778987679976687898767898754678999987923989876432345678976498978989987659898943497987676 +8654567987854567896563987798998656899865789019876894599987321238789098987967878998743989932346798888 +9766779876543488997432398899987745679877892198765789998765450139989129876754568999974567895459999999 +9877898765632356789543459921096434567988943989654567899986521234678998765323467899865679976598897912 +9988987654521237989699567899987558978999659876543457899987634656899986544212456789877889987987656893 +9999996543210357678987998998998667989431968997652346998998785667901997432101348995998994398996545789 +8932987987631234589476789987689978999599878994321345997899996778929899546712467894239987469997434679 +7891098876546349679345678965578899998989989989935459876979897889298778994324578943190296599989323567 +6989129989865478993234567893456799987878998776896567965468789990199656989435678954989987989978934569 +5678949999976569310123689932345689876569899565789778984345688999987645678945789769979999878767897698 +4567898999987679453294594321017992985498765434698999993234567898765434899656899998768999765457898987 +7698987898799789564989695532399891996309899323456789832125678919876325999797999887657987654346789876 +8999876789654998679879989649989799876212987437899898761012348901985476789898998765431298743235689985 +9899965689543249998765679998767678965429876556945987652125667899876787899979459963210139852123798954 +8788754799932129879654587789656567896578987987899876543234799998989898998764349854321298764234567893 +7656543458794298965443445678932456789789598998901997654345678997693939789943298765432359879876899952 +6543252345679987654352237899751577899895459789212398897656889986542124599892109887545456989987896541 +8432101489989999875210128932967698998901345699924569998767994987431023999789213998676569995699965430 +7654312678999998996321239999878789767892396989895678989879993976545129897678954598789678934567976521 +8976433589998767987542356789999891557789989978789789467998989897685398789569899989899789325679897432 +9987544567899655698653468999987910345679878765678992345987878799896987667348798976949895434599789545 +9999655778999543219766567899876621234598765454567891249876567689929876543237667895435976565987679656 +8798789989988959309877678999765432545699654323479910134995456578912997632123456789523498878996598977 +6549891299876898912988989789876547686987543212567891239984323469329876321014567898654569989985456799 +1234932997764667893499995678987658798998654403459932398765012478998765432125678979866789699876345678 +0356799876543456994567894567898967899019873212378993987654139989219876843336789565977896579843234589 +1235789987532345789978943456899878978929764323456789398543248892101998765459895434598965498765445678 +2356897698421234567899432346789989767899875435668891239654356789432789887567976323699654329876786789 +3567896543210246788987541457892499848921986546879910129767568996545699998678988434789543210989897899 diff --git a/9/smokescreen.hs b/9/smokescreen.hs new file mode 100644 index 0000000..4e10187 --- /dev/null +++ b/9/smokescreen.hs @@ -0,0 +1,77 @@ +import Data.Char (digitToInt) +import Data.List (nub, sortBy) +import Data.Ord + +main :: IO () +main = do + input <- getContents + let + heightMap = parseHeights input + (putStrLn . show . solution1) heightMap + (putStrLn . show . solution2) heightMap + +solution1 :: [[Int]] -> Int +solution1 heights = sum (map (\p -> heights !!! p + 1) (lowPoints heights)) + +solution2 :: [[Int]] -> Int +solution2 heights = product (take 3 (sortBy (comparing Down) (map length basins))) + where + basins :: [[(Int, Int)]] + basins = map (flip basin heights) (lowPoints heights) + +basin :: (Int, Int) -> [[Int]] -> [(Int, Int)] +basin point heights + | null next = [] + | otherwise = nub (point:(next)++flatmap (flip basin heights) next) + where + next = filter partOfBasin (adjacent point heights) + partOfBasin x = + let + xHeight = heights !!! x + in + xHeight > heights !!! point && xHeight /= 9 + +flatmap :: (t -> [a]) -> [t] -> [a] +flatmap _ [] = [] +flatmap f (x:xs) = f x ++ flatmap f xs + +lowPoints :: [[Int]] -> [(Int, Int)] +lowPoints heights = filter (flip isLowPoint heights) (indices heights) + where + indices :: [[Int]] -> [(Int, Int)] + indices m = [(x, y) | + x <- [0..length(m)-1], + y <- [0..length(m !! 0)-1]] + +isLowPoint :: (Int, Int) -> [[Int]] -> Bool +isLowPoint point m = all (> (m !!! point)) (map ((!!!) m) (adjacent point m)) + +(!!!) :: [[Int]] -> (Int, Int) -> Int +(!!!) m index = m !! (fst index) !! (snd index) + +adjacent :: (Int, Int) -> [[Int]] -> [(Int, Int)] +adjacent (x, y) m = + [(i+x, j+y) | + i <- [-1..1], + j <- [-1..1], + abs i /= abs j, + i+x >= 0 && i+x < length(m), + j+y >= 0 && j+y < length(m !! 0)] + +parseHeights :: String -> [[Int]] +parseHeights = map (map digitToInt) . lines + +-- Tests + +testInput = unlines [ + "2199943210", + "3987894921", + "9856789892", + "8767896789", + "9899965678" + ] + +testInputParsed = parseHeights testInput + +test1 = solution1 testInputParsed -- 15 +test2 = solution2 testInputParsed -- 1134 From d6739d00f6802ef56e338127629ca1c44e68d21a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tristan=20Dani=C3=ABl=20Maat?= <tm@tlater.net> Date: Sun, 12 Dec 2021 01:36:59 +0000 Subject: [PATCH 2/7] day10: Complete puzzles --- 10/input.txt | 98 +++++++++++++++++++++++++++++++++++++++++++++ 10/syntaxchecker.hs | 95 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 193 insertions(+) create mode 100644 10/input.txt create mode 100644 10/syntaxchecker.hs diff --git a/10/input.txt b/10/input.txt new file mode 100644 index 0000000..cf96421 --- /dev/null +++ b/10/input.txt @@ -0,0 +1,98 @@ +[[{(<({[(([[([()<>][()<>])]][<{[[]<>]}<<[]{}>>>])[({<[{}[]]<{}<>>><{()[]}[{}[]]>}<<(<>[])[[]{}]>{(< +{{{[[<{<{({({(<>{})}<(()[])([]<>)>)})(<[([{}()]([]{}))[([][])([]<>)]]((<{}<>>[[]{}])({<>()}{()}))> +[(<<[(<[[[<{(([]{})){<{}{}>{()<>}})><(<[()()][<>]>([[]]))[(([]<>)(<><>))((<>)({}[]))]>]{<<{{()[]}<[]<>>} +{{({{{([<((<[[<>[]](<>[])]><<(()<>)<<><>>>{(()<>)(<>{})}>))>]({(([{{()()}>{{{}{}}{<><>}}]{({()<> +<<{(<<{<<{([{{(){}}{()()}}{<[]{}>(<>{}))][({<>{}}[[]<>])<{{}{}}{{}()}>])[<<{{}{}}[()[]]>{{ +[[<{[<((<[[{{{{}{}}{{}[]}}}[[<{}<>>]]]({<([][]){{}<>}>((()<>)<<>[]>)})]><[({{<{}()>{()()}}})]{(<({[]{}}[{ +<<[{([[[[[<{[([]())({}[])]{[{}[]]}}<(<[]{}>({}{})){{[]<>}[()]}>>{(<{[]}[<>[]]>)}][(([[{}[]]<[] +[(<[<{{((<{<[<{}[]>[<>{}]][<{}<>>]><<({}[])[[]<>]>}}>)<(([{<{}<>>(()[])}[[{}()]([])]]<<{<>()}({}{})> +<{{[[<(<<<([({{}())([]{})){<()<>>{<>{}}}]<{[[]{}][[]<>]}{<{}()>{[]()}}>)<<{(<>())[<><>]}[{{}[]}(<>( +{{{{<{{<{<<[[[{}()]<[][])]<{(){}}{[]{}}>][{<[]()>{<>{}}}]>><{(<<<>[]>{(){}}>{{[]()}[<><>]}){(<{}()>){[[][]]( +{(<{{([[(<{[((()<>){()()})<[<>{}]{()}>]<{[()[]]}>}([{<()>{{}[]}}[([][]){()[]}]]{{<<>[]>}{([]{}){<><>}}}) +[(((({[{<<{[{([]())(<>[])}[<{}()>{()()}]]}>>[<[[{{{}()}{()<>}}(<()<>>[{}[]])]{[({}<>)<<>>]}]<({<<><> +<([[[((<[<<((<[][]>))<<{[][]}>>>{<([()()>)>}><([[[()[]]({}())]({<>{}}{()[]})]{{{<><>}[[]()]}[[[] +(((<({([[({{({[][]})(({}())[()<>])}(<[[][]]>(<{}>[<>{}]))})](<{((<<><>>[()()]){<[]<>>[[]<>]})}([< +[[{[[{[[{[{{[<{}()><()[]>]}}]<<{{<<><>>{{}{}}}[(<>{})(()())]}[{([]<>)[{}()]}<[[]][()()]>]><<{{[]{}} +((<<((<(<[{[({()<>}{()()}){<{}{}>}]}[{<[<>()][[]()]>}]]{[{[<()>{[]{}}]}<{[{}{}}}[([]{})(<><>)]>](({(<>{}) +[[<[<({[[<<{[[()()]{(){}}]<[{}<>](()())>>(<[()[]][[]()]>)>[{(([][])([]{}))}[<<<><>><()<>>>(<<>[]>)] +[({(<{(<{[{[{([]){{}{}}}(<[][]>(<>[]))](<{<>[]}<[]()>>{<()><{}>})}{[([<>{}]{[]()})[(<>{})<[]()>]][{[()<> +[[<<{[(<({(((([]{})[[][]])<<{}{}>{[]()}>))})<[(<<(<>[])<[]()>><((){})[()<>]>>{<({}[])>{<<>{}>{(){}}}} +<<([[({(<{<[[({}()){()[]}]]>((<<()[]>(<>{})>(([]())))(((()<>)({}[]))))}>{<{((([])<()[]>)<({}())<()< +<<({[<{<({{{{[()()]<<>[]>}[{{}<>}[()()]]}{(([]()))})})[[[{[<<>[]>[<>()]]<{[]{}}[<>{}]>}]([{{[][]}{ +{((((([[([<{([<>{}]<{}[]>){({}())[{}[]]}}{(<()()>({}[]))<{<><>}(<>[])>}>([<{()<>}[()[]]><[()<>]>]{[{ +{[((((({<[{<{[(){}][[]()]}[({}[])]>{[[<>{}]{{}}]{[<>[]]<<>[]>}}}({[([]{})]{[[]<>]<[]{}>}}(<(()[])[{}()] +((<<{<{{{<(<<[<>()]{{}<>}>({<>{}}[[]()])>(<<{}<>>({}<>)><[{}<>]{(){}}>))<(((()[])([]())){(< +{(<(<([{{{((([<>[]]([]<>))({<>[]}<<>[]>)}{<(<><>)<<>{}>>(({}[])(()<>))}){[{{{}{}}}]{[<{}()>(<>{})][{[]}]} +{{{([([(<[<[{<()>{()()}}<[()()]<<><>>>]{<<()<>>>(((){}){()<>})}>{<{({}[])<<><>>}((()())<{}{}>)> +{(({(<<([[({<{[][]}<<><>>>}(<({}<>){{}<>}>{<<><>>(<>())}))<{{[{}<>]<[]()>}<<{}{}>>}[{<{}[]><(){}>}{ +[[[([[(([<[<{<<>{}><{}[]>}>((<[][]>[{}[]]))]{({<<><>>[()[])}[{{}()}<{}>])}>]){[{{((<<>{}>([]<>))([ +([<<<[(<(<{[[({}{}](<>)]{{{}<>}({}{})}][({()}{[]()})[({})]]}{<[(<><>)({}{})]<{<>}{[]}>>}>)>){{<[(<{(()() +{{{<{(<(([<<<{{}[]}[<>{}]}>([<<>()>{<>()}]<<<><>>[{}<>]>)>{[([<>()]{()[]}){{<>{}}[<>[]]}]}][(<[(() +<<<[[{(([<<{{(()())[{}[]]}{[[]<>]<<>>}}[(<<>><{}<>>){{{}[]}[{}()])]>([(<{}()>[[]()])[(()()) +{{{([[[<{(<<{[[]()](<>{})})[(<[]{}><[]{}>)[<[]{}>{{}()}]]>[[[(()()){{}{}}][[<>[]](())]]<([{}()][{ +([{{([[[({[(((<>)(()<>)){[{}{}](()())}){(((){})([]()))[(<>{})<[][]>]}]([({[]()}[(){}])<[{}()>(()<>)> +[[[<<(({<<(([({}[])<(){}>][[{}]([]())])<{{[]()}[[]]><{<><>}<()[]>>>)>{<{<[[][]]<{}<>>>([[]<>]{{}< +[[[<[<([{<[{{{()<>}({}<>)}}(<{{}<>}{[]()}>[<()())(<>())])]>[[(<{()}<[]()>><[()[]]<<>{}>>){<[()< +{{(<({((<[<<[([][])<[]<>>](<<>[]>)>>{<([(){}]{[]{}})>{[({}<>)]<[(){}]{{}}}}}]>)[[[[<{<[][]>( +[[[[{{{{([(((({}<>){()()})[{()()}([]<>)])[{<{}{}><[]{}>}([()<>][[]()])])]))}(<[[[{[[()[]]<()[]>]}]{(( +({{[(((([<({{(<>())<{}()>}([{}{}]<{}{}>)}[{[{}{}]}<[[]]<()[]>>])[([<{}{}><[]{}>])<<[(){}]({}{} +(<<({<({[({[{{()[]}[()<>]}<{<>{}}({}{})>](<{<>{}}>[{{}<>}{(){}}])})(({<<{}[]>{<>()}>}{{<<>()> +[[[[<<<({<({({[]}[[]{}])(<{}()>[{}{}])}[[({}())][{<>{}}{[]<>}]])>})<([<(<(()[])([]())>)<[[{}[]][{}<>]][[( +{<{<{<[[{[[<(([]{})){[()[]][{}[]]}><[{<>{}}({}{})]{({}())<<>[]>}>]]}(([<[{<>()}{(){}}]<<[]{}>(()())>>] +{<<<{<{<(<{([(<>)<[][]>][(()[]){{}<>}])}(((({}<>)<[][]>){([]<>){()<>}})<<<<>()>{{}()}>{<[]()><[]()>}>)})[<{ +([<<[[{{<[{(<{[]()}>)<<<<>()>([]<>)>>}]{(({{<>()](()<>)}(({}())[[]()])))}>{(<[<(<><>)[{}<>] +[{<<{[[<[<<{{<<>()>}[[{}[]]({}{})]}([[<>[]]][(<><>)<()()>])>[({[<><>][[]<>]})({<[][]>(()<>)})]>}>][{(([<[{ +{([[[<[(([[<<<()<>>[<>()]>[<()<>><(){}>]>[<<[][]>(<><>)>]][(([<>()]<<>()>))<([{}()]{{}{}}){<()[]){[]()}}>]]{[ +{{<<[<{{([({[([]<>)[{}()]]{[()[]>[()()]}}<[[<>{}](<><>)]>)[<(<<><>><[]{}>)([<>{}])><<{[]}[{}()]>{<<>{}>[<>[] +{{<(<<((<[<<<[{}[]]<<><>>>[({}[]){{}()}]>>]>){(<([(<<>[]><{}>)({<><>}<{}[]>)]{{([]{}>(()())} +[(<<<{[<([[(({()()}<{}[]>){[{}<>]([]<>)})({(<>[])(()<>)}[([][])<())])]])({[<(([][]){()()})>{[[( +[<[[(({[<<([{({}[])[{}{}]}{<<>[]>[{}{}]}])[[({{}}<[]>){<[]()>{{}{}}}]<{[<>[]](<>())}<[()()][()<>]>>]>(<[[[[ +{<{[([[<<<{<<({}{})(<>())>{<<><>><{}{}>}>{({()()}<{}()>)<(<>{}){<>[]}}}}({[{[]{}}{()<>}](<<><>>( +{{<<([{([[(([{()<>}<(){}>]<<()()>(()<>)>)({[{}()]}<<()[]><()()>>))][[<(((){})<[][]>)><(<<><>> +{(([{({<{[({[(<><>)(()()]]<[<>[]][{}<>]>})]}>{(([[(<()[]>(()<>)){{[]<>}(<>())}]([<[]()>[{}[ +{{({{{<{{{[([[<><>]]<{[][]}[[]<>]>)(<<<><>><<><>>>[(()())({}<>)])]((<(<><>)<(){}>>[{{}{}}[{}<>]])([<()[]> +{(<<{{<<{{{{<<[]<>>[{}()]><<()[]>{{}[]}>}}}}([({<<{}{}>[()]>[[{}[]]<[]{}>]}(<{()()}<()[]>>))]{ +{<<([((<<[<{({{}[]}<()()>)(([]{})<{}[]>)}<(((){})[()<>])>><(<(<><>)<<><>>>){[((){})([]<>)](([][])[< +<{[{<{<<({<<([{}()]{[]{}})[({}())<{}()>]>>[[[(()[])[()<>]](<[][]><{}()>)][(([]()]([]))]]})>>{<[<[((<{}<>>{( +[{[[[({<<[[([{<>{}}[[]]]<<{}<>><[]<>>>)(<<{}()>[()<>]>[<(){}>])][<{<()()><<>[]>}<[[][]][<>()]>><[[{}()](<>) +<{{[{[{[([[[([<><>]({}[]))([[][]](<>{})}][[{[]()}{{}()}][{[][]}<{}<>>]]][(({[]<>}[<>()])[<()<>><[][]>])<(({} +{(({[{(<[<(<[{<><>}<{}[]>]<[{}<>]((){})>>([{()}(<><>)])){<[<()<>>[{}()]]({<>{}}(<><>))>{{(< +<<[[(<{<({<<[[<>()]((){})]>{[({})<{}<>>]((<>{}){[]<>})>>})>}>({{(<<{([()[]])[{{}[]}(<>[])]}>>)}<((<<< +[[([{{((<(<({{[]<>}}<{<>()}([]())>)<[<<>()>(<>{})][[()()]<<>{}>]>>)>(<[[{[{}{}]({}[])}({{}{}}[[]() +<{[[{[([<([{<<()()>><<<>[]>>}][[((<>)(<><>))<({}{})<()<>>>]<{[<>()]<[]{}>}>])({[[{[]{}}]]}{({[<>() +<<[<{<([([<({<(){}>{[]()}}<<{}<>><[]<>>>)>{{<[(){}]{<>()}>(<<>()>[{}<>])]}](<(<(()())<<><>> +[{[<[<[<<(<[(<<>{}>)[<{}{}>({}{})]]})>[[(((<<>[]>[<>()])<{(){}}<(){}>>){{(<><>)}[(<>()){{}<>}]}) +{<{<({{(<(<([[<>()][[]()]][(()[])[[]<>]])[([[]{}]{{}<>})]>[[<({}()){<><>}><{()[]}({}())>]([{<>{}} +({(([(<[[{{<([[]()]{{}{}})[{{}{}}[{}<>]]>[{([]<>)(()())}(<<><>>{<>{}})]}<<({()()}{()<>})[(<> +[<[<((({{<{([({}())([]{})]<(()())(<>())>)({<()[]>{<>[]}})}<[([()<>]{{}<>})](<{[]()}(<>())>)>>[({[([])( +({[<[(<((<{(<[()[]>[{}<>]>)<{<[]<>>{<>[]}}(({}{}))>}{{<[[]{}][{}{}]>{(())<[]()>}}}><<<{(<>[])<[]()>}({[][ +(<<<({({<[[<<(<><>}<()<>>>{<{}<>><[]<>>}>[<<[]<>>(()[])>{<()()>}]]]{{(([<>[]]<[]{}>){({}{})([][] +({<[[<[({[{<{(()<>)}[(()[])<<>{}>]>}({{(<><>)[<><>]}[{[]()}<(){}>]}{{[()()]<(){}>}[[{}[]]([]{})]})]([[<{{}()} +[[[(<({(({{{<{()<>}[<>{}]><<[][]>({}[])>}[[[{}{}]<<>{}>][[(){}]]]}[<([{}{}][[]])[{<><>}[()[]]]>]}<<[({{ +[<[[{[(([[<{(<{}{}>)}(<{(){}}([][])>{<(){}><<>{}>})>([([{}{}])(<[]><(){}>)])][({<<{}<>><[]<>>>[[[]{}]{[]{}}] +[{{[(<<{{{[([(()())<<><>>])<([()()]((){}))<([][]){[]<>}>>]{<<{(){}}(<><>)>({()<>}<()[]})>}}}}[{{<< +<[{[(({({<(<<<{}{}>{{}{}}>{([])({})}>{[{<>>(<>)]{[<>{}]<{}<>>}})[<({{}[]}<{}{}>)<([]())({}())>>({<[] +(<[<({[{{(((({{}[]}{{}<>}){(<>[])})[[({}<>)[[]<>]]<[{}]{[][]}>])(<[(<>()){<>()}]<(<><>){(){}}>> +[([{([{[<{<[<(<>{}){{}[]}>{([][]){()}}]{[<[]{}><<>{}>]{[(){}){[]{}}}}>([<[{}]<{}[]>>{<[][]>{()[]}}][{{<>()}{{ +<{{(({({[<(({({}[]){{}<>}}[(<>()){[]{}}]))[[<{()()}[{}{}]>(<{}{}>(<>[]))]<<{()()}<{}{}>><{<><>}<<>[] +{{[[<[<[{[<{{[[]<>]<[]>}[({}{})(<>)]}>](<<((<>)<[]<>>)[<{}()><<>[]>]>[<{<>()}<(){}>>[[()<>]]]>(<[{ +({[<(<{<[<<<(<<>()><[]<>>)<<()<>>({}[])>>(<[()()]{<><>}>)>>]>(<<({[<{}[]>{()}]}<<{()<>}({}())>({[]<>}([]()))> +<{<{{[({{(<{<<<><>><(){}>>[([][])([]{})]}<{([][]){{}}}<<[]()>([][])>>>[<{{[]()}[()<>]}<[<>{}]([]{})>>]) +{({[{(<[<<<<(([]<>)<{}{}>)>((({}{})<{}<>>)<<{}{}>>}>{{[<()()>[{}()]]}((<<>()>[(){}])<{[]<>}[<>{}]>)}>>{<<{ +((([<[[[<{{<<<{}[]><<>{}>>(([]<>)[[]])>((<{}[]><{}>)(({}[])[()[]]))}{{<(<>[])(<><>)>(<<>[] +[[([{<(<(<[({[[][]]{()<>}}{{<>[]}<[][]>})]>)<{[((((){})([]<>))[<<><>>(<><>)]>[{<{}[]><[][]> +[<<(<(({{{<((([]())[<>{}])<[[][]]{()()}>)><[<((){})<()()]>[<[]>[(){}]]]({([]())([]{})}([<>( +(<{<<{<((({(<{(){}}[()<>]>{[[]<>][()[]]})<<{[][]}{{}[]}>[(<><>)<{}{}>]>}(<[{{}<>}{[]()}]({()[]}(( +<[[([<<[{{<(<[()[]]{<><>}>([<>[]]<{}[]>))[({{}()}<[]<>>)<(<>{})>]>{{{<<>{}>(<>)}<{<>()}[<>()]>}<[<<>() +[[((<({<[{{<[[[]()][<>]](<()()>[{}<>])>{<(()<>)>([()<>]{()[]})}}{[[(()<>><[]<>>]]<{(<><>){{}<>}} +[<{([{[{<<<(<[<><>]({}())>{([]<>][[]{}]})[<{[]<>}[<>{}]>[<[][]>]]>>({([(<><>){<>{}}][{{}[]}({}<>) +{({{<[([{([<<{<>()}>[{<>[]}[{}[]]]>](<{{[]{}}[{}<>]}({<>[]}[{}[]])>[<([][])({}{})><<{}()>(()<>) +(<({[<(<[<[{([[]{}][{}[]])([{}[]])}{({<>[]}{()[]})[[<><>](()<>)]}]><(({[()[]]}([{}()][{}{}]))<[(()<>)]>)[[< +<(<(<<({({[<{<<><>>[()<>]}{<[]()><<><>>}>[(([][])<{}[]>)(({}{})<<>()>)]](<<(<><>){[]<>}>([[][]][<>()])>{<( +[({<[[<{[[{[{{<>()}{{}[]}}](([{}[]}{[][]})<{<>[]}({}<>)>)}{[(([]{})<{}[]>)<<{}>{(){}}>]}]<[ +<[({<<[[({{{((<><>)<[]<>>)<<{}><{}<>>>}(([(){}]{()})[{[][]}[[]<>]])}}[[<[<()[]>[{}()]]><{<{}<>><<>[]>}{[[] +<[{[[[[[<{[<([<>()]([]{}))<{[]{}}<[][]>>>([{[]<>}([]<>)]{[{}()][<>{}]}}]<[[(<><>)[{}{}]][(()( +{<{{[<({{<[([{()()}[{}<>]]{({}())<(){}>})[[{(){}}<[]<>>}<(<>()){{}{}}>]]{{(([]{})[[]()])[{{}{}}[[]{}]]}{<[ +(([<([<<{[{{[({}{})][(<>{})]}}]{{([<<>{}>(<>())])}}}>[{<<(({{}<>}<<>[]>){({}())<{}()>})><(<[()<>]><{()<>}< +[<[{[[[({[{[(((){}){(){}}){{<><>}{{}[]}}]<{({}()){<>{}}}>}<{[{[]{}}({}{})])>]}{(<(((()[]){{}[]})[<()<> +({<<([{{{{({[{<>[]}[{}{}]]{<[]{}><{}{}>}}[<[<>()](<><>)><[{}{}]>])(<{[<>()]<<>()>}<(<>[])>>(([() diff --git a/10/syntaxchecker.hs b/10/syntaxchecker.hs new file mode 100644 index 0000000..129ee0c --- /dev/null +++ b/10/syntaxchecker.hs @@ -0,0 +1,95 @@ +import Data.List (foldl', sort) + +main :: IO () +main = do + input <- getContents + let + code = lines input + (putStrLn . show . solution1) code + (putStrLn . show . solution2) code + +solution1 :: [String] -> Int +solution1 = sum . map charScore . map (head . fst . resolveChunks) + where + charScore :: Char -> Int + charScore ')' = 3 + charScore ']' = 57 + charScore '}' = 1197 + charScore '>' = 25137 + charScore _ = 0 + +solution2 :: [String] -> Int +solution2 = middle . sort . map score . completed . nonCorrupt + where + completed = map (completeChunks . fst) + nonCorrupt = filter notCorrupt . map resolveChunks + score :: [Char] -> Int + score = foldl' (\s x -> s * 5 + (charScore x)) 0 + where + charScore :: Char -> Int + charScore ')' = 1 + charScore ']' = 2 + charScore '}' = 3 + charScore '>' = 4 + charScore _ = undefined + notCorrupt :: ([Char], Bool) -> Bool + notCorrupt (_, corrupt) = not corrupt + middle :: [a] -> a + middle [] = undefined + middle l = l !! (length l `quot` 2) + +completeChunks :: String -> String +completeChunks = map close + where + close :: Char -> Char + close c + | c == '(' = ')' + | c == '[' = ']' + | c == '{' = '}' + | c == '<' = '>' + | otherwise = undefined + +resolveChunks :: String -> ([Char], Bool) +resolveChunks = foldl' resolve ([], False) + where + resolve :: ([Char], Bool) -> Char -> ([Char], Bool) + resolve (stack, broken) c + | broken = (stack, broken) + | isOpen c = (c:stack, False) + | close c == head stack = (tail stack, False) + | close c /= head stack = (c:stack, True) + | otherwise = undefined + + isOpen :: Char -> Bool + isOpen c + | c == '(' = True + | c == '[' = True + | c == '{' = True + | c == '<' = True + | otherwise = False + + close :: Char -> Char + close c + | c == ')' = '(' + | c == ']' = '[' + | c == '}' = '{' + | c == '>' = '<' + | otherwise = undefined + +-- Tests + +testInput = [ + "[({(<(())[]>[[{[]{<()<>>", + "[(()[<>])]({[<{<<[]>>(", + "{([(<{}[<>[]}>{[]{[(<()>", + "(((({<>}<{<{<>}{[]{[]{}", + "[[<[([]))<([[{}[[()]]]", + "[{[{({}]{}}([{[{{{}}([]", + "{<[[]]>}<{[{[{[]{()[[[]", + "[<(<(<(<{}))><([]([]()", + "<{([([[(<>()){}]>(<<{{", + "<{([{{}}[<[[[<>{}]]]>[]]" + ] + +test1 = solution1 testInput -- 26397 +test2 = solution2 testInput -- 288957 From 6723ef2021fb2cf2d7bcd97096b13c71adce203f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tristan=20Dani=C3=ABl=20Maat?= <tm@tlater.net> Date: Tue, 14 Dec 2021 00:40:52 +0000 Subject: [PATCH 3/7] day11: Complete puzzles --- 11/input.txt | 10 ++++++ 11/octoflash.hs | 93 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 103 insertions(+) create mode 100644 11/input.txt create mode 100644 11/octoflash.hs diff --git a/11/input.txt b/11/input.txt new file mode 100644 index 0000000..cfbdc33 --- /dev/null +++ b/11/input.txt @@ -0,0 +1,10 @@ +5421451741 +3877321568 +7583273864 +3451717778 +2651615156 +6377167526 +5182852831 +4766856676 +3437187583 +3633371586 diff --git a/11/octoflash.hs b/11/octoflash.hs new file mode 100644 index 0000000..eb16571 --- /dev/null +++ b/11/octoflash.hs @@ -0,0 +1,93 @@ +import Data.Char (digitToInt) + +main :: IO () +main = do + input <- getContents + let + octopodes = (map (map digitToInt) . lines) input + (putStrLn . show . solution1) octopodes + (putStrLn . show . solution2) octopodes + +solution1 :: [[Int]] -> Int +solution1 m = snd (iterate flashSimulate (m, 0) !! 100) + +solution2 :: [[Int]] -> Int +solution2 m = countUntil (all (all (==0)) . fst) flashSimulate (m, 0) + +flashSimulate :: ([[Int]], Int) -> ([[Int]], Int) +flashSimulate (octopodes, flashes) = + (refreshOctopodes exhaustedOctopodes, flashes + countExhaustedOctopodes exhaustedOctopodes) + where + exhaustedOctopodes = flashStep octopodes + countExhaustedOctopodes = foldr (\l a -> length l + a) 0 . map (filter (> 9)) + refreshOctopodes = map (map (\o -> if o > 9 then 0 else o)) + +flashStep :: [[Int]] -> [[Int]] +flashStep = propagateFlashes . map (map (+1)) + where + propagateFlashes :: [[Int]] -> [[Int]] + propagateFlashes = until allExhausted flashOctopi + where + allExhausted :: [[Int]] -> Bool + allExhausted = all (all (/= 10)) + flashOctopi :: [[Int]] -> [[Int]] + flashOctopi m = map (map (incrementFlashing m)) + [[(x, y) | y <- [0..length (m !! x) - 1]] | x <- [0..length m - 1]] + where + incrementFlashing ::[[Int]] -> (Int, Int) -> Int + incrementFlashing m' o + | charge < 10 && newCharge > 10 = 10 -- Ensure we don't miss an increment + | otherwise = charge + numFlashingNeighbors o + where + newCharge = charge + numFlashingNeighbors o + charge = m' !!! o + numFlashingNeighbors :: (Int, Int) -> Int + numFlashingNeighbors = length . filter (\o -> (m !!! o) == 10) . (flip adjacent m) + +(!!!) :: [[Int]] -> (Int, Int) -> Int +(!!!) m index = m !! (fst index) !! (snd index) + +countUntil :: (a -> Bool) -> (a -> a) -> a -> Int +countUntil p f = call + where + call x + | p x = 0 + | otherwise = call (f x) + 1 + +adjacent :: (Int, Int) -> [[Int]] -> [(Int, Int)] +adjacent (x, y) m = [(x+i, y+j) | + i <- [-1..1], + j <- [-1..1], + -- (i, j) /= (0, 0), + x+i >= 0, + y+j >= 0, + x+i < length m, + y+j < length (m !! 0)] + +-- Tests + +testInput1 = [ + "5483143223", + "2745854711", + "5264556173", + "6141336146", + "6357385478", + "4167524645", + "2176841721", + "6882881134", + "4846848554", + "5283751526" + ] +parsedTestInput1 = map (map digitToInt) testInput1 + +testInput2 = [ + "11111", + "19991", + "19191", + "19991", + "11111" + ] +parsedTestInput2 = map (map digitToInt) testInput2 + +test1 = solution1 parsedTestInput1 +test2 = solution2 parsedTestInput1 From 2c6611a020b0258c12068e4204003e6aa026db36 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tristan=20Dani=C3=ABl=20Maat?= <tm@tlater.net> Date: Tue, 14 Dec 2021 00:41:16 +0000 Subject: [PATCH 4/7] day12: Complete puzzles --- 12/Parsing.hs | 23 +++++++++ 12/cavesearcher.hs | 122 +++++++++++++++++++++++++++++++++++++++++++++ 12/input.txt | 24 +++++++++ 3 files changed, 169 insertions(+) create mode 100644 12/Parsing.hs create mode 100644 12/cavesearcher.hs create mode 100644 12/input.txt diff --git a/12/Parsing.hs b/12/Parsing.hs new file mode 100644 index 0000000..8ad0f3f --- /dev/null +++ b/12/Parsing.hs @@ -0,0 +1,23 @@ +module Parsing ( + splitByString + ) where + +import Data.List (isPrefixOf) + +splitByString :: String -> String -> [String] +splitByString _ "" = [] +splitByString splitter string = + let (chunk, rest) = spanNextSplit string + in + chunk:(splitByString splitter rest) + where + spanNextSplit :: String -> (String, String) + spanNextSplit [] = ([], []) + spanNextSplit everything@(char:rest) + | splitter `isPrefixOf` rest = + ([char], (drop ((length splitter) + 1) everything)) + | otherwise = + let + (start, end) = spanNextSplit rest + in + (char:start, end) diff --git a/12/cavesearcher.hs b/12/cavesearcher.hs new file mode 100644 index 0000000..45e1091 --- /dev/null +++ b/12/cavesearcher.hs @@ -0,0 +1,122 @@ +import Data.Char (isLower) +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set +import Parsing (splitByString) + +main :: IO () +main = do + input <- getContents + let + caves = parseCaves input + (putStrLn . show . solution1) caves + (putStrLn . show . solution2) caves + +solution1 :: Map.Map String [String] -> Int +solution1 = length . cavePaths + +solution2 :: Map.Map String [String] -> Int +solution2 = length . cavePaths2 + +parseCaves :: String -> Map.Map String [String] +parseCaves = Map.fromListWith (++) . flatmap addReverse . map tupleFromList . map (splitByString "-") . lines + where + addReverse :: (String, [String]) -> [(String, [String])] + addReverse t@(a, b) = [t, (head b, [a])] + tupleFromList :: [String] -> (String, [String]) + tupleFromList [] = undefined + tupleFromList (x:xs) + -- Since the second part is always expected to be a cave label + -- or "end", this should never be > 1 + | length xs > 1 = undefined + | otherwise = (x, xs) + +cavePaths :: Map.Map String [String] -> [[String]] +cavePaths caveMap = followSingle caveMap Set.empty "start" + +cavePaths2 :: Map.Map String [String] -> [[String]] +cavePaths2 caveMap = followOneRepeat caveMap Set.empty "start" + +followSingle :: Map.Map String [String] -> Set.Set String -> String -> [[String]] +followSingle caveMap visited node + | node == "end" = [[node]] + | otherwise = + let + v' = Set.insert node visited + in + map ((:) node) (flatmap (followSingle caveMap v') adjacent) + where + adjacent :: [String] + adjacent = filter (not . visitedSmall) (Map.findWithDefault [] node caveMap) + visitedSmall :: String -> Bool + visitedSmall n = all isLower n && n `elem` visited + +followOneRepeat :: Map.Map String [String] -> Set.Set String -> String -> [[String]] +followOneRepeat caveMap visited node + | node == "end" = [[node]] + | all isLower node && node `elem` visited = + followSingle caveMap visited node + | otherwise = + let + v' = Set.insert node visited + in + map ((:) node) (flatmap (followOneRepeat caveMap v') adjacent) + where + adjacent :: [String] + adjacent = filter (/= "start") (Map.findWithDefault [] node caveMap) + +flatmap :: (t -> [a]) -> [t] -> [a] +flatmap _ [] = [] +flatmap f (x:xs) = f x ++ flatmap f xs + +-- Tests + +testInput1 = unlines [ + "start-A", + "start-b", + "A-c", + "A-b", + "b-d", + "A-end", + "b-end" + ] + +testInput2 = unlines [ + "dc-end", + "HN-start", + "start-kj", + "dc-start", + "dc-HN", + "LN-dc", + "HN-end", + "kj-sa", + "kj-HN", + "kj-dc"] + +testInput3 = unlines [ + "fs-end", + "he-DX", + "fs-he", + "start-DX", + "pj-DX", + "end-zg", + "zg-sl", + "zg-pj", + "pj-he", + "RW-he", + "fs-DX", + "pj-RW", + "zg-RW", + "start-pj", + "he-WI", + "zg-he", + "pj-fs", + "start-RW"] + +parsedTestInput1 = parseCaves testInput1 +test1 = cavePaths parsedTestInput1 +test2 = cavePaths2 parsedTestInput1 +test3 = cavePaths2 (parseCaves testInput2) +test4 = cavePaths2 (parseCaves testInput3) + +printPaths :: [[String]] -> IO () +printPaths = putStr . unlines . (map (foldr1 (\c a -> c++"->"++a))) diff --git a/12/input.txt b/12/input.txt new file mode 100644 index 0000000..4067b56 --- /dev/null +++ b/12/input.txt @@ -0,0 +1,24 @@ +yb-pi +jg-ej +yb-KN +LD-start +end-UF +UF-yb +yb-xd +qx-yb +xd-end +jg-KN +start-qx +start-ej +qx-LD +jg-LD +xd-LD +ej-qx +end-KN +DM-xd +jg-yb +ej-LD +qx-UF +UF-jg +qx-jg +xd-UF From 9abc63b97fb73daa3cb0bc8a874a43e9a1cf2ca7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tristan=20Dani=C3=ABl=20Maat?= <tm@tlater.net> Date: Tue, 14 Dec 2021 22:12:44 +0000 Subject: [PATCH 5/7] day13: Complete puzzles --- 13/Parsing.hs | 32 ++ 13/input.txt | 1035 +++++++++++++++++++++++++++++++++++++++++++++ 13/paperfolder.hs | 86 ++++ 3 files changed, 1153 insertions(+) create mode 100644 13/Parsing.hs create mode 100644 13/input.txt create mode 100644 13/paperfolder.hs diff --git a/13/Parsing.hs b/13/Parsing.hs new file mode 100644 index 0000000..db81f77 --- /dev/null +++ b/13/Parsing.hs @@ -0,0 +1,32 @@ +module Parsing ( + splitByString, + parseCoordinates + ) where + +import Data.List (isPrefixOf) + +splitByString :: String -> String -> [String] +splitByString _ "" = [] +splitByString splitter string = + let (chunk, rest) = spanNextSplit string + in + chunk:(splitByString splitter rest) + where + spanNextSplit :: String -> (String, String) + spanNextSplit [] = ([], []) + spanNextSplit everything@(char:rest) + | splitter `isPrefixOf` rest = + ([char], (drop ((length splitter) + 1) everything)) + | otherwise = + let + (start, end) = spanNextSplit rest + in + (char:start, end) + +parseCoordinates :: String -> [(Int, Int)] +parseCoordinates = + map (tuplify . map read . splitByString ",") . lines + where + tuplify :: [a] -> (a, a) + tuplify [a, b] = (a, b) + tuplify _ = error "Can't parse coordinates from non-2-sized lists" diff --git a/13/input.txt b/13/input.txt new file mode 100644 index 0000000..69e89a4 --- /dev/null +++ b/13/input.txt @@ -0,0 +1,1035 @@ +388,758 +82,197 +689,684 +140,677 +616,14 +206,661 +1110,215 +408,700 +830,773 +808,257 +1221,824 +7,632 +575,208 +792,847 +264,427 +555,443 +12,141 +1153,52 +350,105 +832,200 +1196,133 +371,427 +606,56 +1136,113 +50,803 +110,352 +773,572 +243,103 +213,835 +340,701 +114,761 +1149,831 +1150,873 +1293,42 +288,266 +246,252 +644,781 +75,254 +619,130 +1280,98 +704,254 +291,421 +199,309 +5,528 +95,586 +835,464 +647,822 +131,763 +52,872 +388,337 +387,173 +398,815 +221,25 +1163,240 +1206,448 +60,337 +990,570 +1295,206 +609,36 +224,396 +330,220 +480,513 +1278,856 +82,553 +48,56 +22,889 +1288,889 +534,42 +142,3 +167,801 +10,593 +1104,714 +1006,677 +766,266 +162,4 +1228,197 +765,0 +120,39 +977,528 +1101,808 +1176,514 +960,784 +42,359 +661,891 +1073,294 +798,386 +684,695 +676,310 +324,674 +510,525 +967,686 +1289,880 +586,872 +885,704 +858,487 +803,317 +687,355 +1046,147 +1113,700 +862,320 +3,60 +743,665 +1022,722 +1113,194 +49,112 +1111,197 +38,284 +1257,490 +221,869 +316,469 +15,240 +130,840 +689,418 +470,834 +689,847 +82,777 +592,355 +1,357 +950,89 +1240,805 +701,877 +537,572 +264,747 +735,215 +895,757 +917,654 +1218,714 +1190,437 +758,225 +721,486 +120,478 +373,262 +1034,243 +915,385 +1280,616 +398,761 +388,115 +1058,226 +1019,322 +134,254 +808,637 +276,131 +869,143 +1210,604 +338,301 +1109,691 +132,355 +472,525 +803,179 +562,77 +200,215 +990,324 +1263,642 +1113,343 +110,28 +1128,369 +652,873 +903,446 +462,276 +47,642 +1029,317 +718,355 +224,758 +523,579 +626,806 +305,96 +1049,38 +572,697 +231,756 +1062,817 +167,162 +858,266 +551,397 +576,77 +890,716 +202,855 +798,60 +227,219 +904,77 +606,640 +42,631 +954,619 +199,36 +1141,516 +92,180 +398,481 +639,602 +1242,694 +806,709 +840,219 +462,23 +706,68 +152,749 +1200,423 +554,290 +45,877 +1141,305 +644,749 +304,341 +798,743 +589,38 +162,61 +130,189 +1305,366 +932,378 +776,437 +454,679 +1218,77 +1034,875 +623,275 +360,89 +192,254 +256,514 +1036,135 +380,135 +262,31 +427,219 +304,105 +477,98 +922,337 +490,115 +1006,789 +950,486 +1261,334 +554,604 +743,89 +142,443 +497,141 +216,807 +1166,315 +586,22 +1197,507 +452,822 +534,437 +887,21 +808,325 +1180,189 +760,448 +1300,717 +663,710 +872,632 +1118,393 +758,669 +283,19 +1295,715 +445,506 +579,873 +755,443 +35,714 +557,190 +825,141 +890,357 +181,714 +579,469 +872,362 +1158,738 +1277,684 +206,350 +1241,338 +425,704 +393,486 +69,492 +704,702 +197,194 +1305,528 +375,642 +227,675 +989,753 +157,814 +907,229 +169,516 +427,667 +813,585 +856,215 +920,595 +676,445 +1143,610 +666,849 +142,71 +1190,478 +403,404 +288,432 +261,480 +324,220 +986,674 +1168,584 +773,632 +858,407 +830,369 +858,628 +706,602 +878,89 +661,305 +1241,492 +962,487 +522,539 +1019,473 +493,63 +907,665 +872,490 +70,626 +813,18 +80,700 +616,598 +954,863 +75,192 +912,305 +87,677 +616,180 +117,434 +1260,740 +606,254 +454,7 +199,137 +589,654 +1228,341 +811,38 +398,79 +94,37 +574,529 +1081,190 +79,740 +0,252 +1231,679 +830,781 +933,499 +721,78 +1094,418 +1111,309 +330,21 +45,240 +377,334 +288,682 +373,673 +721,856 +570,408 +602,501 +1228,553 +120,855 +480,121 +15,206 +572,562 +1089,25 +213,59 +738,102 +1064,866 +1108,520 +438,535 +323,529 +129,253 +1158,156 +537,460 +822,194 +192,200 +110,476 +10,85 +1046,299 +109,894 +980,220 +1283,467 +150,185 +329,724 +976,570 +1002,315 +1111,36 +830,121 +102,225 +962,407 +298,619 +182,91 +1017,418 +842,229 +288,880 +790,730 +1094,476 +684,88 +237,602 +825,826 +1014,796 +520,730 +75,425 +42,487 +567,142 +422,760 +1048,863 +209,684 +350,784 +1064,2 +1309,537 +237,826 +1111,757 +510,763 +977,590 +333,690 +202,39 +671,179 +820,844 +870,154 +261,38 +502,637 +869,591 +787,171 +982,179 +972,693 +893,294 +970,701 +579,453 +415,757 +830,829 +1200,418 +1183,445 +169,68 +262,863 +570,800 +462,254 +1153,814 +1062,301 +366,180 +589,856 +684,724 +403,665 +664,686 +798,823 +1228,777 +740,184 +1022,880 +512,732 +1129,602 +565,70 +738,197 +642,417 +298,863 +202,72 +599,816 +1098,814 +209,808 +848,276 +890,292 +972,85 +512,823 +32,632 +1158,290 +1170,677 +1063,446 +560,37 +858,72 +507,577 +1146,844 +982,4 +82,697 +256,305 +862,233 +1268,535 +398,849 +785,894 +1146,50 +234,740 +791,427 +202,520 +441,59 +134,871 +979,305 +1216,857 +78,525 +1126,893 +475,627 +552,3 +626,88 +468,665 +206,768 +1248,539 +1141,640 +1022,628 +1094,87 +825,533 +937,572 +507,403 +475,688 +1076,357 +462,871 +1168,151 +294,581 +671,878 +1181,103 +922,785 +356,479 +994,578 +1094,212 +1129,714 +649,891 +6,548 +944,722 +164,498 +291,572 +259,609 +82,341 +262,656 +214,147 +1216,417 +1298,589 +748,817 +410,556 +792,47 +688,301 +1145,495 +99,78 +209,86 +848,501 +232,477 +80,866 +1136,145 +880,808 +388,86 +330,674 +1101,388 +20,86 +212,894 +1111,137 +294,352 +808,290 +115,383 +668,365 +753,38 +994,757 +688,262 +691,578 +1016,352 +704,646 +1310,642 +1305,814 +903,448 +256,66 +869,255 +261,341 +1241,556 +441,303 +1084,403 +1108,498 +865,506 +65,253 +579,889 +647,374 +837,826 +1231,663 +1160,709 +616,374 +341,98 +288,714 +616,618 +31,171 +457,194 +775,203 +644,593 +1002,579 +830,513 +790,619 +589,266 +493,556 +487,284 +378,378 +623,355 +537,322 +738,117 +602,22 +1288,217 +803,184 +134,514 +622,133 +1262,56 +1059,192 +1208,808 +1029,770 +246,700 +32,128 +1310,252 +1190,39 +654,700 +885,477 +731,565 +1126,227 +678,285 +1153,466 +512,443 +110,184 +314,305 +539,460 +212,313 +666,101 +890,537 +587,138 +512,60 +174,113 +388,785 +756,604 +264,355 +1302,14 +247,441 +544,756 +1268,631 +273,222 +244,33 +951,453 +1141,68 +497,309 +1104,96 +206,96 +644,145 +556,415 +356,514 +1231,602 +510,131 +393,273 +1067,880 +674,333 +1086,808 +62,539 +1113,399 +1153,500 +647,72 +743,581 +1049,592 +129,791 +750,470 +933,334 +987,529 +1245,78 +504,207 +162,833 +589,553 +883,219 +321,141 +1113,495 +902,642 +1288,5 +1310,267 +216,164 +102,274 +1118,276 +92,525 +197,399 +783,893 +1108,479 +1174,159 +1126,360 +1290,808 +360,581 +1083,219 +574,642 +858,863 +1166,561 +1098,894 +398,753 +179,206 +441,751 +1163,715 +520,66 +1101,210 +770,366 +823,610 +721,408 +537,758 +869,751 +209,210 +922,86 +1230,642 +653,226 +1272,284 +1235,665 +346,579 +782,679 +144,315 +735,208 +338,85 +1160,687 +403,814 +622,486 +1078,477 +1216,865 +869,415 +216,642 +1002,333 +903,14 +1250,337 +726,268 +1268,359 +333,304 +825,753 +15,878 +1168,443 +490,844 +1235,254 +448,238 +1193,460 +243,14 +736,642 +1158,705 +97,486 +209,360 +89,742 +448,296 +572,341 +120,416 +1104,855 +765,894 +818,331 +216,58 +311,715 +237,376 +165,495 +677,798 +206,208 +838,707 +261,240 +933,789 +243,343 +535,243 +552,172 +99,667 +1193,322 +853,103 +321,761 +276,875 +604,763 +705,782 +197,551 +621,476 +169,254 +261,592 +1044,360 +494,873 +816,469 +1063,448 +430,136 +1300,289 +1272,724 +734,598 +438,252 +1063,292 +994,469 +1094,164 +676,893 +820,115 +986,220 +169,305 +525,558 +484,168 +1148,509 +304,553 +1268,855 +803,240 +562,714 +808,604 +907,404 +442,56 +69,338 +552,669 +1067,103 +1004,758 +462,393 +388,557 +28,247 +703,831 +1193,710 +348,39 +495,541 +1282,170 +848,871 +1062,632 +1141,204 +935,642 +281,770 +1029,184 +1310,4 +83,880 +1143,801 +1198,358 +109,0 +1067,14 +606,248 +1303,486 +393,592 +1183,449 +112,222 +570,352 +242,800 +338,177 +21,880 +653,21 +826,726 +1176,171 +644,301 +817,63 +119,243 +994,809 +402,220 +770,390 +117,710 +895,137 +646,686 +1200,476 +813,141 +644,849 +502,604 +1298,141 +320,324 +981,537 +644,101 +994,593 +181,826 +402,668 +706,131 +721,273 +291,473 +790,207 +169,640 +157,309 +1096,747 +771,831 +964,561 +53,84 +684,199 +633,798 +8,686 +740,408 +605,334 +490,442 +761,694 +209,460 +1143,732 +475,533 +887,362 +981,170 +817,556 +248,262 +1006,105 +1211,227 +688,593 +825,690 +549,694 +1190,855 +161,831 +706,378 +512,386 +835,516 +179,267 +1165,180 +264,299 +1037,490 +181,68 +206,180 +888,760 +440,740 +552,225 +276,763 +420,537 +232,29 +972,301 +960,609 +1304,548 +21,677 +114,133 +308,333 +15,715 +880,225 +333,133 +1034,763 +94,857 +833,770 +1022,14 +1168,162 +783,130 +1211,78 +1300,301 +32,766 +248,301 +606,838 +1037,222 +545,446 +293,399 +443,12 +1012,754 +912,761 +961,798 +1232,296 +1046,595 +785,641 +682,287 +1245,553 +1096,147 +485,578 +1088,112 +535,203 +62,355 +738,777 +1200,710 +735,740 +304,110 +766,660 +694,714 +735,154 +1180,840 +167,732 +329,805 +209,388 +420,178 +1118,514 +278,374 +1178,91 +1200,471 +555,451 +567,581 +688,133 +1036,140 +330,873 +549,200 +915,61 +1153,585 +557,710 +216,490 +457,103 +706,740 +704,640 +306,136 +1118,694 +340,193 +35,124 +721,553 +800,259 +960,105 +634,893 +157,85 +484,726 +539,63 +900,786 +10,301 +570,497 +1126,534 +706,826 +1278,390 +622,856 +136,47 +604,740 +438,642 +1096,292 +2,642 +1193,584 +1272,276 +1073,68 +1216,134 +279,194 +619,578 +813,813 +1148,833 +222,112 +908,220 +0,890 +769,507 +951,5 +1216,477 +540,504 +900,645 +2,252 +427,3 +487,162 +415,889 +152,829 +1104,544 +858,822 +1083,667 +823,93 +574,252 +68,246 +206,574 +234,357 +527,893 +1048,656 +1153,309 +601,404 +944,14 +869,59 +1062,262 +716,758 +452,844 +1054,33 +356,619 +621,418 +922,115 +1062,77 +1272,732 +251,254 +950,408 +755,451 +113,507 +1126,1 +247,448 +462,501 +406,525 +12,589 +731,192 +1118,619 +954,514 +708,393 +338,501 +420,716 +1223,752 +251,192 +114,528 +10,605 +359,441 +1260,803 +1022,714 +621,847 +1213,408 +1066,504 +644,641 +1131,267 +1231,154 +32,537 +579,329 +766,138 +1017,866 +798,732 + +fold along x=655 +fold along y=447 +fold along x=327 +fold along y=223 +fold along x=163 +fold along y=111 +fold along x=81 +fold along y=55 +fold along x=40 +fold along y=27 +fold along y=13 +fold along y=6 diff --git a/13/paperfolder.hs b/13/paperfolder.hs new file mode 100644 index 0000000..1e8a4e7 --- /dev/null +++ b/13/paperfolder.hs @@ -0,0 +1,86 @@ +import Data.List (foldl', nub) +import Parsing (parseCoordinates, splitByString) + +main :: IO () +main = do + input <- getContents + let + instructions = parseInstructions input + (putStrLn . show . solution1) instructions + (putStr . solution2) instructions + +solution1 :: ([(Int, Int)], [(Int, Int)]) -> Int +solution1 (paper, folds) = (length . nub) (foldPaper paper (folds !! 0)) + +solution2 :: ([(Int, Int)], [(Int, Int)]) -> String +solution2 (paper, folds) = printPaper (foldl' (foldPaper) paper folds) + +foldPaper :: [(Int, Int)] -> (Int, Int) -> [(Int, Int)] +foldPaper paper axis = map (fold axis) paper + where + fold :: (Int, Int) -> (Int, Int) -> (Int, Int) + fold (0, a) (x, y) + | y < a = (x, y) + | y > a = (x, flipCoord y a) + fold (a, 0) (x, y) + | x < a = (x, y) + | x > a = (flipCoord x a, y) + fold _ _ = undefined -- Only axis-folds are defined + flipCoord :: Int -> Int -> Int + flipCoord c a = a - (c - a) + +printPaper :: [(Int, Int)] -> String +printPaper = unlines . coordsToPaper + where + coordsToPaper :: [(Int, Int)] -> [String] + coordsToPaper dots = [[if (x, y) `elem` dots then '█' else ' ' | + x <- [0..maximum (map fst dots)]] | + y <- [0..maximum (map snd dots)]] + +parseInstructions :: String -> ([(Int, Int)], [(Int, Int)]) +parseInstructions input = + (dots, folds) + where + split :: [String] + split = splitByString "\n\n" input + dots :: [(Int, Int)] + dots = (parseCoordinates . head) split + folds :: [(Int, Int)] + folds = (map (tuplify . splitByString "=") . lines . last) split + tuplify :: [String] -> (Int, Int) + tuplify [] = error "Can't turn an empty list into fold instructions" + tuplify (fold:axis) + | last fold == 'x' = (read (head axis), 0) + | last fold == 'y' = (0, read (head axis)) + | otherwise = error "Fold instructions must go across x or y" + +-- Tests + +testInput1 = unlines [ + "6,10", + "0,14", + "9,10", + "0,3", + "10,4", + "4,11", + "6,0", + "6,12", + "4,1", + "0,13", + "10,12", + "3,4", + "3,0", + "8,4", + "1,10", + "2,14", + "8,10", + "9,0", + "", + "fold along y=7", + "fold along x=5"] + +testInput1Parsed = parseInstructions testInput1 +test1 = solution1 testInput1Parsed +test2 = putStr (solution2 testInput1Parsed) + +testPrinted1 = putStr (printPaper (foldPaper (fst testInput1Parsed) (head (snd testInput1Parsed)))) From 99ec5911b74a5e60256c8adde1a263947a03ab09 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tristan=20Dani=C3=ABl=20Maat?= <tm@tlater.net> Date: Sat, 18 Dec 2021 23:38:37 +0000 Subject: [PATCH 6/7] day14: Complete first puzzle --- 14/Parsing.hs | 32 ++++++++++++++ 14/Reducers.hs | 28 ++++++++++++ 14/input.txt | 102 +++++++++++++++++++++++++++++++++++++++++++ 14/polymerization.hs | 64 +++++++++++++++++++++++++++ 4 files changed, 226 insertions(+) create mode 100644 14/Parsing.hs create mode 100644 14/Reducers.hs create mode 100644 14/input.txt create mode 100644 14/polymerization.hs diff --git a/14/Parsing.hs b/14/Parsing.hs new file mode 100644 index 0000000..db81f77 --- /dev/null +++ b/14/Parsing.hs @@ -0,0 +1,32 @@ +module Parsing ( + splitByString, + parseCoordinates + ) where + +import Data.List (isPrefixOf) + +splitByString :: String -> String -> [String] +splitByString _ "" = [] +splitByString splitter string = + let (chunk, rest) = spanNextSplit string + in + chunk:(splitByString splitter rest) + where + spanNextSplit :: String -> (String, String) + spanNextSplit [] = ([], []) + spanNextSplit everything@(char:rest) + | splitter `isPrefixOf` rest = + ([char], (drop ((length splitter) + 1) everything)) + | otherwise = + let + (start, end) = spanNextSplit rest + in + (char:start, end) + +parseCoordinates :: String -> [(Int, Int)] +parseCoordinates = + map (tuplify . map read . splitByString ",") . lines + where + tuplify :: [a] -> (a, a) + tuplify [a, b] = (a, b) + tuplify _ = error "Can't parse coordinates from non-2-sized lists" diff --git a/14/Reducers.hs b/14/Reducers.hs new file mode 100644 index 0000000..8a3f149 --- /dev/null +++ b/14/Reducers.hs @@ -0,0 +1,28 @@ +module Reducers ( + leastMostOcc, + leastMost, + most, + least + ) where + +import Data.List (group, sortBy, sort) +import Data.Ord (comparing) + +groupOccurrences :: (Ord a) => [a] -> [[a]] +groupOccurrences = sortBy (comparing length) . group . sort + +leastMostOcc :: (Ord a) => [a] -> (Int, Int) +leastMostOcc list = ((length . last) occ, (length . head) occ) + where + occ = groupOccurrences list + +leastMost :: (Ord a) => [a] -> (a, a) +leastMost list = ((head . last) occ, (head . head) occ) + where + occ = groupOccurrences list + +least :: (Ord a) => [a] -> a +least = fst . leastMost + +most :: (Ord a) => [a] -> a +most = snd . leastMost diff --git a/14/input.txt b/14/input.txt new file mode 100644 index 0000000..3602070 --- /dev/null +++ b/14/input.txt @@ -0,0 +1,102 @@ +BSONBHNSSCFPSFOPHKPK + +PF -> P +KO -> H +CH -> K +KN -> S +SS -> K +KB -> B +VS -> V +KV -> O +KP -> B +OF -> C +HB -> C +NP -> O +NS -> V +VO -> P +VF -> H +CK -> B +PC -> O +SK -> O +KF -> H +FV -> V +PP -> H +KS -> B +FP -> N +BV -> V +SB -> F +PB -> B +ON -> F +SF -> P +VH -> F +FC -> N +CB -> H +HP -> B +NC -> B +FH -> K +BF -> P +CN -> N +NK -> H +SC -> S +PK -> V +PV -> C +KC -> H +HN -> K +NO -> H +NN -> S +VC -> P +FF -> N +OO -> H +BK -> N +FS -> V +BO -> F +SH -> S +VK -> F +OC -> F +FN -> V +OV -> K +CF -> F +NV -> V +OP -> K +PN -> K +SO -> P +PS -> S +KK -> H +HH -> K +NH -> O +FB -> K +HS -> B +BB -> V +VB -> O +BH -> H +OK -> C +CC -> B +FK -> N +SN -> V +HK -> N +KH -> F +OS -> O +FO -> P +OH -> B +CP -> S +BN -> H +OB -> B +BP -> B +CO -> K +SP -> K +BS -> P +VV -> N +VN -> O +NF -> F +CV -> B +HC -> B +HV -> S +BC -> O +HO -> H +PO -> P +CS -> B +PH -> S +SV -> V +VP -> C +NB -> K +HF -> C diff --git a/14/polymerization.hs b/14/polymerization.hs new file mode 100644 index 0000000..be8ec3c --- /dev/null +++ b/14/polymerization.hs @@ -0,0 +1,64 @@ +import Data.Map.Strict (Map, (!)) +import qualified Data.Map.Strict as Map +import Parsing (splitByString) +import Reducers (leastMostOcc) + +main :: IO () +main = do + input <- getContents + let + polymer = parsePolymer input + (putStrLn . show . solution1) polymer + +parsePolymer :: String -> ([Char], Map [Char] Char) +parsePolymer input = (template input, rules input) + where + template :: String -> String + template = head . splitByString "\n\n" + rules :: String -> Map [Char] Char + rules = Map.fromList . map tupelize . map (splitByString " -> ") . lines . last . splitByString "\n\n" + tupelize :: [String] -> ([Char], Char) + tupelize untupled = (head untupled, (head . last) untupled) + +solution1 :: ([Char], Map [Char] Char) -> Int +solution1 (template, rules) = uncurry (-) (leastMostOcc polymer) + where + polymer :: [Char] + polymer = iterate (polymerize rules) template !! 10 + +solution2 :: ([Char], Map [Char] Char) -> Int +solution2 (template, rules) = undefined + +polymerize :: Map [Char] Char -> [Char] -> [Char] +polymerize rules template = step template + where + step :: [Char] -> [Char] + step [] = [] + step [final] = [final] + step (x:xs) = x:(rules ! [x, head xs]):(step xs) + +-- Tests + +testInput1 = unlines [ + "NNCB", + "", + "CH -> B", + "HH -> N", + "CB -> H", + "NH -> C", + "HB -> C", + "HC -> B", + "HN -> C", + "NN -> C", + "BH -> H", + "NC -> B", + "NB -> B", + "BN -> B", + "BB -> N", + "BC -> B", + "CC -> N", + "CN -> C"] + +testInputParsed1 = parsePolymer testInput1 +test1 = solution1 testInputParsed1 -- 1588 +test2 = solution2 testInputParsed1 -- 2188189693529 From 7de9869d1c6d9a41260de8b35e6d104eafee9df3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tristan=20Dani=C3=ABl=20Maat?= <tm@tlater.net> Date: Sun, 19 Dec 2021 01:32:19 +0000 Subject: [PATCH 7/7] day14: Complete second puzzle --- 14/Itertools.hs | 14 +++++++++ 14/polymerization.hs | 73 +++++++++++++++++++++++++++++++++++++++----- 2 files changed, 79 insertions(+), 8 deletions(-) create mode 100644 14/Itertools.hs diff --git a/14/Itertools.hs b/14/Itertools.hs new file mode 100644 index 0000000..338d017 --- /dev/null +++ b/14/Itertools.hs @@ -0,0 +1,14 @@ +module Itertools ( + flatmap, + windows + ) where + +windows :: Int -> [a] -> [[a]] +windows _ [] = [] +windows i (x:xs) + | length xs < i-1 = [] + | otherwise = (x:take (i-1) xs):windows i xs + +flatmap :: (t -> [a]) -> [t] -> [a] +flatmap _ [] = [] +flatmap f (x:xs) = f x ++ flatmap f xs diff --git a/14/polymerization.hs b/14/polymerization.hs index be8ec3c..5284420 100644 --- a/14/polymerization.hs +++ b/14/polymerization.hs @@ -1,5 +1,8 @@ +import Data.List (maximumBy, minimumBy) import Data.Map.Strict (Map, (!)) import qualified Data.Map.Strict as Map +import Data.Ord (comparing) +import Itertools (flatmap, windows) import Parsing (splitByString) import Reducers (leastMostOcc) @@ -9,6 +12,7 @@ main = do let polymer = parsePolymer input (putStrLn . show . solution1) polymer + (putStrLn . show . solution2) polymer parsePolymer :: String -> ([Char], Map [Char] Char) parsePolymer input = (template input, rules input) @@ -21,13 +25,18 @@ parsePolymer input = (template input, rules input) tupelize untupled = (head untupled, (head . last) untupled) solution1 :: ([Char], Map [Char] Char) -> Int -solution1 (template, rules) = uncurry (-) (leastMostOcc polymer) - where - polymer :: [Char] - polymer = iterate (polymerize rules) template !! 10 +solution1 (template, rules) = uncurry (-) (leastMostOcc (polymerizeN rules template 10)) solution2 :: ([Char], Map [Char] Char) -> Int -solution2 (template, rules) = undefined +solution2 (template, rules) = ((snd . most) polyCounts) - ((snd . least) polyCounts) + where + polyCounts :: Map Char Int + polyCounts = polyCounter rules template 40 + least = minimumBy (comparing snd) . Map.assocs + most = maximumBy (comparing snd) . Map.assocs + +polymerizeN :: Map [Char] Char -> [Char] -> Int -> [Char] +polymerizeN rules template i = iterate (polymerize rules) template !! i polymerize :: Map [Char] Char -> [Char] -> [Char] polymerize rules template = step template @@ -37,6 +46,54 @@ polymerize rules template = step template step [final] = [final] step (x:xs) = x:(rules ! [x, head xs]):(step xs) +-- Since we don't actually need to synthesize the polymer, but only +-- need to know how many of each elements occur, we can get around +-- having to create a ridiculously large list by operating on the rule +-- pairs instead. +-- +-- E.g. NNCB -> NCNBCHB (see testInput1), in this case we turn: +-- +-- - NN -> NC, CN +-- - NC -> NB, BC +-- - CB -> CH, HB +-- +-- All we need to do is keep track of the counts of these +-- sub-sequences, not of the full polymer. +-- +-- To get back to the individual elements, we then just need to +-- de-window it all again. +polyCounter :: Map [Char] Char -> [Char] -> Int -> Map Char Int +polyCounter rules template iterations = elCounts + where + initial :: Map [Char] Int + initial = (Map.fromListWith (+) . map (\e -> (e, 1)) . windows 2) template + step :: Map [Char] Int -> Map [Char] Int + step = Map.fromListWith (+) . flatmap resultingPolies . Map.assocs + resultingPolies :: ([Char], Int) -> [([Char], Int)] + resultingPolies (p, i) = [([head p, c], i), ([c, last p], i)] + where c = rules ! p + polyCounts :: Map [Char] Int + polyCounts = iterate step initial !! iterations + + -- Because the windows are size 2, every element of a sub-binding is + -- counted twice (e.g. NBCBC -> NB, BC, CB, BC), except the first and + -- last element. We know the first and last elements (because we + -- operated on windows, they'll match the first and last of the + -- template), so we can un-window the whole batch by dividing their + -- number of occurrences by two, except for the first and last, where + -- we subtract the number by 1 first and add 1 back later. + elCounts :: Map Char Int + elCounts = Map.mapWithKey deWindow naiveSum + where + els :: ([Char], Int) -> [(Char, Int)] + els (p, i) = [(head p, i), (last p, i)] + naiveSum :: Map Char Int + naiveSum = (Map.fromListWith (+) . flatmap els . Map.assocs) polyCounts + deWindow :: Char -> Int -> Int + deWindow c i + | c == head template || c == last template = (i - 1) `quot` 2 + 1 + | otherwise = i `quot` 2 + -- Tests testInput1 = unlines [ @@ -59,6 +116,6 @@ testInput1 = unlines [ "CC -> N", "CN -> C"] -testInputParsed1 = parsePolymer testInput1 -test1 = solution1 testInputParsed1 -- 1588 -test2 = solution2 testInputParsed1 -- 2188189693529 +parsedTestInput1 = parsePolymer testInput1 +test1 = solution1 parsedTestInput1 -- 1588 +test2 = solution2 parsedTestInput1 -- 2188189693529