diff --git a/3/diagnosticReader.hs b/3/diagnosticReader.hs
index 897c374..d819b8c 100644
--- a/3/diagnosticReader.hs
+++ b/3/diagnosticReader.hs
@@ -1,23 +1,33 @@
 import           Control.Exception (assert)
 import           Data.Bits         (bit)
 import           Data.Char         (digitToInt)
-import           Data.List         (group, maximumBy, minimumBy, sort,
-                                    transpose)
+import           Data.List         (group, intersect, maximumBy, minimumBy,
+                                    sort, transpose)
 import           Data.Ord          (comparing)
 
 main :: IO ()
 main = do
   diagnostics <- getContents
   putStrLn (solution1 diagnostics)
+  putStrLn (solution2 diagnostics)
 
 solution1 :: String -> String
 solution1 diagnostics = show (calcGamma * calcEpsilon)
   where
-    calcGamma = listToBit (map most (parseDiagnostics diagnostics))
-    calcEpsilon = listToBit (map least (parseDiagnostics diagnostics))
+    calcGamma = listToBit (map most (transpose (parseDiagnostics diagnostics)))
+    calcEpsilon = listToBit (map least (transpose (parseDiagnostics diagnostics)))
+
+solution2 :: String -> String
+solution2 diagnostics = show (calcOxygen * calcCO2)
+  where
+    calcOxygen = listToBit (head (filterForLife most (parseDiagnostics diagnostics)))
+    calcCO2 = listToBit (head (filterForLife least (parseDiagnostics diagnostics)))
 
 parseDiagnostics :: String -> [[Int]]
-parseDiagnostics diagnostics = map (map digitToInt) (transpose (lines diagnostics))
+parseDiagnostics diagnostics = map (map digitToInt) (lines diagnostics)
+
+enumerate :: [a] -> [(Int, a)]
+enumerate = zip [0..]
 
 most :: [Int] -> Int
 most = head . (maximumBy (comparing length)) . group . sort
@@ -34,8 +44,18 @@ listToBit list = foldr (\b acc -> (acc + toBit b)) 0 (enumerate (reverse list))
     toBit (i, b) = if b == 1
                    then bit i
                    else 0
-    enumerate :: [a] -> [(Int, a)]
-    enumerate = zip [0..]
+
+filterForLife :: ([Int] -> Int) -> [[Int]] -> [[Int]]
+filterForLife targetFilter list = foldl (filterNext) list [0..length(head list)-1]
+  where
+    filterNext :: [[Int]] -> Int-> [[Int]]
+    filterNext acc i = acc `intersect` filterIndex targetFilter acc i
+
+filterIndex :: ([Int] -> Int) -> [[Int]] -> Int -> [[Int]]
+filterIndex targetFilter list index = filter ((==filterTarget) . (!! index)) list
+  where
+    filterTarget :: Int
+    filterTarget = targetFilter ((transpose list) !! index)
 
 -- Tests
 
@@ -57,3 +77,6 @@ testInput1 = unlines [
 
 test1 :: String
 test1 = assert ((solution1 testInput1) == "198") "success"
+
+test2 :: String
+test2 = assert ((solution2 testInput1) == "230") "success"