Day 12

adventofcode.cabal

@@ -1,6 +1,8 @@
--- This file has been generated from package.yaml by hpack version 0.17.1.
+-- This file has been generated from package.yaml by hpack version 0.20.0.
 --
 -- see: https://github.com/sol/hpack
+--
+-- hash: 3f3cbe111f1f469760a75a30c1b54e4cf67cf5ca5a968c511d1e0fe4bac65a32
 
 name:                adventofcode
 version:             0.1.0.0
@@ -39,16 +41,17 @@ library
       Day09
       Day10
       Day11
+      Day12
   other-modules:
       Paths_adventofcode
   build-depends:
-      base >=4.7 && <5
-    , protolude
+      array
+    , base >=4.7 && <5
     , containers
     , foldl
-    , text
-    , array
     , parsec
+    , protolude
+    , text
   default-language: Haskell2010
 
 executable adventofcode-exe
@@ -57,11 +60,13 @@ executable adventofcode-exe
   main-is: Main.hs
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base
-    , adventofcode
-    , protolude
-    , pretty
+      adventofcode
+    , base
     , containers
+    , pretty
+    , protolude
+  other-modules:
+      Paths_adventofcode
   default-language: Haskell2010
 
 test-suite adventofcode-test
@@ -70,10 +75,12 @@ test-suite adventofcode-test
       test
   main-is: Spec.hs
   build-depends:
-      base
+      HUnit
     , adventofcode
+    , base
     , tasty
     , tasty-hunit
-    , HUnit
+  other-modules:
+      Paths_adventofcode
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   default-language: Haskell2010

app/Main.hs

@@ -17,6 +17,7 @@ import qualified Day08
 import qualified Day09
 import qualified Day10
 import qualified Day11
+import qualified Day12
 
 showSol :: [Char] -> Doc -> IO ()
 showSol txt d = putText . toS . render $
@@ -39,6 +40,7 @@ solutions = Map.fromList [(["01"], day01)
                          ,(["09"], day09)
                          ,(["10"], day10)
                          ,(["11"], day11)
+                         ,(["12"], day12)
                          ]
 
 day01 :: IO ()
@@ -114,3 +116,12 @@ day11 = do
   input <- Day11.parseInput
   let sol1 = Day11.solution1 input
   showSol "Solution 1" (int sol1)
+
+day12 :: IO ()
+day12 = do
+  putText "Day 12:"
+  input <- Day12.parseInput
+  let sol1 = fmap Day12.solution1 input
+  showSol "Solution 1" (int (fromMaybe 0 sol1))
+  let sol2 = fmap Day12.solution2 input
+  showSol "Solution 2" (int (fromMaybe 0 sol2))

package.yaml

@@ -24,6 +24,7 @@ library:
   - Day09
   - Day10
   - Day11
+  - Day12
   dependencies:
   - base >=4.7 && <5
   - protolude

src/Day12.hs

@@ -0,0 +1,117 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+description:
+
+Walking along the memory banks of the stream, you find a small village that is
+experiencing a little confusion: some programs can't communicate with each
+other.
+
+Programs in this village communicate using a fixed system of pipes. Messages are
+passed between programs using these pipes, but most programs aren't connected to
+each other directly. Instead, programs pass messages between each other until
+the message reaches the intended recipient.
+
+For some reason, though, some of these messages aren't ever reaching their
+intended recipient, and the programs suspect that some pipes are missing. They
+would like you to investigate.
+
+You walk through the village and record the ID of each program and the IDs with
+which it can communicate directly (your puzzle input). Each program has one or
+more programs with which it can communicate, and these pipes are bidirectional;
+if 8 says it can communicate with 11, then 11 will say it can communicate with
+8.
+
+You need to figure out how many programs are in the group that contains program
+ID 0.
+
+For example, suppose you go door-to-door like a travelling salesman and record
+the following list:
+
+0 <-> 2
+1 <-> 1
+2 <-> 0, 3, 4
+3 <-> 2, 4
+4 <-> 2, 3, 6
+5 <-> 6
+6 <-> 4, 5
+
+In this example, the following programs are in the group that contains program ID 0:
+
+- Program 0 by definition.
+- Program 2, directly connected to program 0.
+- Program 3 via program 2.
+- Program 4 via program 2.
+- Program 5 via programs 6, then 4, then 2.
+- Program 6 via programs 4, then 2.
+
+Therefore, a total of 6 programs are in this group; all but program 1, which has
+a pipe that connects it to itself.
+
+How many programs are in the group that contains program ID 0?
+
+--- Part Two ---
+
+There are more programs than just the ones in the group containing program ID 0.
+The rest of them have no way of reaching that group, and still might have no way
+of reaching each other.
+
+A group is a collection of programs that can all communicate via pipes either
+directly or indirectly. The programs you identified just a moment ago are all
+part of the same group. Now, they would like you to determine the total number
+of groups.
+
+In the example above, there were 2 groups: one consisting of programs
+0,2,3,4,5,6, and the other consisting solely of program 1.
+
+How many groups are there in total?
+
+|-}
+module Day12 where
+
+import Protolude
+
+import           Data.Graph    (Graph,Vertex)
+import qualified Data.Graph as Graph
+import qualified Data.Text as T
+
+data NodeMeta = NodeMeta { relatedTo :: [Int]
+                         , visited :: Bool
+                         } deriving (Show)
+
+parseInput :: IO (Maybe Graph)
+parseInput = parseTxt <$> readFile "inputs/day12.txt"
+
+parseTxt :: Text -> Maybe Graph
+parseTxt txt =
+  txt
+  & T.lines
+  & map T.words
+  & toGraph
+  & fmap (\(x,_,_) -> x)
+  where toGraph :: [[Text]] -> Maybe (Graph,Vertex -> (Int,Int,[Int]), Int -> Maybe Vertex)
+        toGraph lines = Graph.graphFromEdges <$> (traverse toNode lines)
+        toNode :: [Text] -> Maybe (Int,Int,[Int])
+        toNode (nodeVal:"<->":sons) = do
+          val <- txtToInt nodeVal
+          sonsIds <- traverse txtToInt sons
+          return (val,val,sonsIds)
+        toNode _ = Nothing
+
+txtToInt :: Text -> Maybe Int
+txtToInt = fmap fst . head . reads . toS
+
+testTxt :: Text
+testTxt = "0 <-> 2\n\
+          \1 <-> 1\n\
+          \2 <-> 0, 3, 4\n\
+          \3 <-> 2, 4\n\
+          \4 <-> 2, 3, 6\n\
+          \5 <-> 6\n\
+          \6 <-> 4, 5\n"
+
+solution1 :: Graph -> Int
+solution1 = length . flip Graph.reachable 0
+
+solution2 :: Graph -> Int
+solution2 = length . Graph.components

test/Spec.hs

@@ -12,7 +12,7 @@ import qualified Day07
 import qualified Day08
 import qualified Day10
 import qualified Day11
-
+import qualified Day12
 
 main :: IO ()
 main = defaultMain $
@@ -106,4 +106,14 @@ main = defaultMain $
          Day11.solution1 (Day11.parseTxt "se,sw,se,sw,sw") @?= 3
       ]
     ]
+  , testGroup "Day 12"
+    [ testGroup "Solution 1"
+      [ testCase "Example" $
+          fmap Day12.solution1 (Day12.parseTxt Day12.testTxt) @?= Just 6
+      ]
+    , testGroup "Solution 2"
+      [ testCase "Example" $
+          fmap Day12.solution2 (Day12.parseTxt Day12.testTxt) @?= Just 2
+      ]
+    ]
   ]