Day 3, unpretty

advent-of-code.cabal

@@ -33,7 +33,6 @@ executable aoc-02b
 executable aoc-03a
   import              : aoc-common
   main-is             : AOC-03a.hs
-  build-depends       : containers
 
 executable aoc-03b
   import              : aoc-common

src/AOC-03a.hs

 module Main where
 
-import qualified Data.Foldable as F ( Foldable(..) )
-import qualified Data.Map as M
+import Data.List (transpose)
 
-rates :: String -> (Integer,Integer)
-rates s = (fromBinary bepsilon, fromBinary bgamma) where
-  bitdiffs :: [Integer]
-  bitdiffs =  F.toList . M.unionsWith (+) . concatMap (zipWith M.singleton [1::Int ..] . map bitvalue) . lines $ s
-  bitvalue '0' = -1
-  bitvalue '1' = 1
-  bitvalue _ = error "unexpected bit"
-  bepsilon = map resolveBit bitdiffs
-  bgamma = map ((1 -) . resolveBit) bitdiffs
-  resolveBit :: Integer -> Integer
-  resolveBit b = case compare b 0 of
-    LT -> 0
-    EQ -> error "equal rates!"
-    GT -> 1
+bitf :: a -> a -> Char -> a
+bitf tv fv b = case b of
+  '1' -> tv
+  '0' -> fv
+  _ -> error "bitf: not a bit"
+
+signf :: a -> a -> a -> Int -> a
+signf pv zv nv n = case compare n 0 of { GT -> pv; EQ -> zv; LT -> nv }
+
+powerRates :: String -> (Integer,Integer)
+powerRates s = (fromBinary bepsilon, fromBinary bgamma) where
+  t = transpose (lines s)
+  majorityf a b = map (signf a (error "impossible") b . sum . map (bitf 1 (-1)))
+  bepsilon = majorityf 1 0 t
+  bgamma   = majorityf 0 1 t
 
 fromBinary :: [Integer] -> Integer
 fromBinary bits = sum (zipWith (*) powers (reverse bits)) where
   powers = iterate (*2) 1
+
 main :: IO ()
 main = do
-  (gamma,epsilon) <- rates <$> readFile "data/diagnostics.txt"
+  (gamma,epsilon) <- powerRates <$> readFile "data/diagnostics.txt"
   print $ gamma * epsilon
\ No newline at end of file

src/AOC-03b.hs

 module Main where
 
+bitf :: a -> a -> Char -> a
+bitf tv fv b = case b of
+  '1' -> tv
+  '0' -> fv
+  _ -> error "bitf: not a bit"
+
+signf :: a -> a -> a -> Int -> a
+signf pv zv nv n = case compare n 0 of { GT -> pv; EQ -> zv; LT -> nv }
+
+lifeRates :: [String] -> (Integer,Integer)
+lifeRates ss = (fromBinary oxygenBits, fromBinary scrubberBits) where
+  search _ [a] = a
+  search f as  = b : (search f . map tail . filter ((==b) . head)) as where
+    b = f (map head as)
+  keepMost  = signf '1' '1' '0' . sum . map (bitf 1 (-1))
+  keepLeast = signf '0' '0' '1' . sum . map (bitf 1 (-1))
+  oxygenBits   = map (bitf 1 0) $ search keepMost ss
+  scrubberBits = map (bitf 1 0) $ search keepLeast ss
+
+fromBinary :: [Integer] -> Integer
+fromBinary bits = sum (zipWith (*) powers (reverse bits)) where
+  powers = iterate (*2) 1
+
 main :: IO ()
-main = pure ()
+main = do
+  (oxygenRate,scrubberRate) <- lifeRates . lines <$> readFile "data/diagnostics.txt"
+  print $ oxygenRate * scrubberRate
\ No newline at end of file