{-|
Module:         Day3
Description:    <https://adventofcode.com/2021/day/3 Day 3: Binary Diagnostic>
-}
module Day3 (day3a, day3b) where

import Data.Bits (xor)
import Data.Char (chr, ord)
import Data.List (group, maximumBy, minimumBy, sort, transpose)
import Data.Ord (comparing)
import Data.Text (Text)
import qualified Data.Text as T (lines, unpack)
import Data.Void (Void)
import Text.Megaparsec (ParseErrorBundle, eof, parse)
import Text.Megaparsec.Char.Lexer (binary)

common, uncommon :: (Ord a) => [a] -> a
common :: [a] -> a
common [a]
xs = [a] -> a
forall a. [a] -> a
head ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ ([a] -> [a] -> Ordering) -> [[a]] -> [a]
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (([a] -> Int) -> [a] -> [a] -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [[a]]) -> [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
xs
uncommon :: [a] -> a
uncommon [a]
xs = [a] -> a
forall a. [a] -> a
head ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ ([a] -> [a] -> Ordering) -> [[a]] -> [a]
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (([a] -> Int) -> [a] -> [a] -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [[a]]) -> [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
xs

day3a :: Text -> Either (ParseErrorBundle String Void) Int
day3a :: Text -> Either (ParseErrorBundle String Void) Int
day3a Text
input = Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) (Int -> Int -> Int)
-> Either (ParseErrorBundle String Void) Int
-> Either (ParseErrorBundle String Void) (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void String Int
-> String -> String -> Either (ParseErrorBundle String Void) Int
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void String Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
binary Parsec Void String Int
-> ParsecT Void String Identity () -> Parsec Void String Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" String
gamma Either (ParseErrorBundle String Void) (Int -> Int)
-> Either (ParseErrorBundle String Void) Int
-> Either (ParseErrorBundle String Void) Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec Void String Int
-> String -> String -> Either (ParseErrorBundle String Void) Int
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void String Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
binary Parsec Void String Int
-> ParsecT Void String Identity () -> Parsec Void String Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" String
epsilon where
    nums :: [String]
nums = Text -> String
T.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.lines Text
input
    gamma :: String
gamma = String -> Char
forall a. Ord a => [a] -> a
common (String -> Char) -> [String] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> [String]
forall a. [[a]] -> [[a]]
transpose [String]
nums
    epsilon :: String
epsilon = Int -> Char
chr (Int -> Char) -> (Char -> Int) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor Int
1 (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
gamma

day3b :: Text -> Either (ParseErrorBundle String Void) Int
day3b :: Text -> Either (ParseErrorBundle String Void) Int
day3b Text
input = Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) (Int -> Int -> Int)
-> Either (ParseErrorBundle String Void) Int
-> Either (ParseErrorBundle String Void) (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void String Int
-> String -> String -> Either (ParseErrorBundle String Void) Int
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void String Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
binary Parsec Void String Int
-> ParsecT Void String Identity () -> Parsec Void String Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" String
o2 Either (ParseErrorBundle String Void) (Int -> Int)
-> Either (ParseErrorBundle String Void) Int
-> Either (ParseErrorBundle String Void) Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec Void String Int
-> String -> String -> Either (ParseErrorBundle String Void) Int
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec Void String Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
binary Parsec Void String Int
-> ParsecT Void String Identity () -> Parsec Void String Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"" String
co2 where
    nums :: [String]
nums = Text -> String
T.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
T.lines Text
input
    scrub :: ([a] -> a) -> [[a]] -> [a]
scrub [a] -> a
_ [[a]]
xs | [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
xs Bool -> Bool -> Bool
|| ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
xs = []
    scrub [a] -> a
f [[a]]
xs = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ([a] -> a) -> [[a]] -> [a]
scrub [a] -> a
f [[a]
ys | a
y:[a]
ys <- [[a]]
xs, a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x] where x :: a
x = [a] -> a
f ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. [a] -> a
head ([a] -> a) -> [[a]] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[a]]
xs
    o2 :: String
o2 = (String -> Char) -> [String] -> String
forall a. Eq a => ([a] -> a) -> [[a]] -> [a]
scrub String -> Char
forall a. Ord a => [a] -> a
common [String]
nums
    co2 :: String
co2 = (String -> Char) -> [String] -> String
forall a. Eq a => ([a] -> a) -> [[a]] -> [a]
scrub String -> Char
forall a. Ord a => [a] -> a
uncommon [String]
nums