{-# Language ImportQualifiedPost, BlockArguments, LambdaCase, QuasiQuotes, TemplateHaskell #-}
{-|
Module      : Main
Description : Day 3 solution
Copyright   : (c) Eric Mertens, 2021
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2021/day/3>

Select binary numbers using the most and least common bit
in each position.

-}
module Main (main) where

import Advent (count, format, fromDigits)
import Data.List (transpose)

-- | A bit
data B = B0 | B1 deriving (ReadPrec [B]
ReadPrec B
Int -> ReadS B
ReadS [B]
(Int -> ReadS B)
-> ReadS [B] -> ReadPrec B -> ReadPrec [B] -> Read B
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS B
readsPrec :: Int -> ReadS B
$creadList :: ReadS [B]
readList :: ReadS [B]
$creadPrec :: ReadPrec B
readPrec :: ReadPrec B
$creadListPrec :: ReadPrec [B]
readListPrec :: ReadPrec [B]
Read, Int -> B -> ShowS
[B] -> ShowS
B -> String
(Int -> B -> ShowS) -> (B -> String) -> ([B] -> ShowS) -> Show B
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> B -> ShowS
showsPrec :: Int -> B -> ShowS
$cshow :: B -> String
show :: B -> String
$cshowList :: [B] -> ShowS
showList :: [B] -> ShowS
Show, B -> B -> Bool
(B -> B -> Bool) -> (B -> B -> Bool) -> Eq B
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: B -> B -> Bool
== :: B -> B -> Bool
$c/= :: B -> B -> Bool
/= :: B -> B -> Bool
Eq, Eq B
Eq B =>
(B -> B -> Ordering)
-> (B -> B -> Bool)
-> (B -> B -> Bool)
-> (B -> B -> Bool)
-> (B -> B -> Bool)
-> (B -> B -> B)
-> (B -> B -> B)
-> Ord B
B -> B -> Bool
B -> B -> Ordering
B -> B -> B
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: B -> B -> Ordering
compare :: B -> B -> Ordering
$c< :: B -> B -> Bool
< :: B -> B -> Bool
$c<= :: B -> B -> Bool
<= :: B -> B -> Bool
$c> :: B -> B -> Bool
> :: B -> B -> Bool
$c>= :: B -> B -> Bool
>= :: B -> B -> Bool
$cmax :: B -> B -> B
max :: B -> B -> B
$cmin :: B -> B -> B
min :: B -> B -> B
Ord)

-- | Bit complement
cmpl :: B -> B
cmpl :: B -> B
cmpl B
B0 = B
B1
cmpl B
B1 = B
B0

-- | Interpret list of bits as a big-endian binary number
--
-- >>> fromBits [B1, B1, B0, B1]
-- 13
fromBits :: [B] -> Integer
fromBits :: [B] -> Integer
fromBits = Integer -> [Integer] -> Integer
forall a. (HasCallStack, Integral a) => a -> [a] -> a
fromDigits Integer
2 ([Integer] -> Integer) -> ([B] -> [Integer]) -> [B] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (B -> Integer) -> [B] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map \case B
B0->Integer
0; B
B1->Integer
1

mempty -- make B available for reify in format

-- | >>> :main
-- 749376
-- 2372923
main :: IO ()
IO ()
main =
 do [[B]]
inp <- [format|2021 3 (@B*%n)*|]
    Integer -> IO ()
forall a. Show a => a -> IO ()
print ((([B] -> B) -> [[B]] -> [B]) -> [[B]] -> Integer
harness ([B] -> B) -> [[B]] -> [B]
pick1 [[B]]
inp)
    Integer -> IO ()
forall a. Show a => a -> IO ()
print ((([B] -> B) -> [[B]] -> [B]) -> [[B]] -> Integer
harness ([B] -> B) -> [[B]] -> [B]
pick2 [[B]]
inp)

-- | Use selection function to pick output bit by column
pick1 :: ([B] -> B) -> [[B]] -> [B]
pick1 :: ([B] -> B) -> [[B]] -> [B]
pick1 [B] -> B
sel [[B]]
xs = ([B] -> B) -> [[B]] -> [B]
forall a b. (a -> b) -> [a] -> [b]
map [B] -> B
sel ([[B]] -> [[B]]
forall a. [[a]] -> [[a]]
transpose [[B]]
xs)

-- | Use selection function to filter entries by each bit column
pick2 :: ([B] -> B) -> [[B]] -> [B]
pick2 :: ([B] -> B) -> [[B]] -> [B]
pick2 [B] -> B
_ [[B]
x] = [B]
x
pick2 [B] -> B
sel [[B]]
xs = B
b B -> [B] -> [B]
forall a. a -> [a] -> [a]
: ([B] -> B) -> [[B]] -> [B]
pick2 [B] -> B
sel [[B]
ys | B
y:[B]
ys <- [[B]]
xs, B
b B -> B -> Bool
forall a. Eq a => a -> a -> Bool
== B
y]
  where
    b :: B
b = [B] -> B
sel [B
y | B
y:[B]
_ <- [[B]]
xs]

-- | Given a function that requires a selection function run
-- it on the selection function picking the most and least frequent
-- values and then multiply those results together
harness :: (([B] -> B) -> [[B]] -> [B]) -> [[B]] -> Integer
harness :: (([B] -> B) -> [[B]] -> [B]) -> [[B]] -> Integer
harness ([B] -> B) -> [[B]] -> [B]
k [[B]]
xs = [B] -> Integer
fromBits (([B] -> B) -> [[B]] -> [B]
k [B] -> B
rule [[B]]
xs) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* [B] -> Integer
fromBits (([B] -> B) -> [[B]] -> [B]
k (B -> B
cmpl (B -> B) -> ([B] -> B) -> [B] -> B
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [B] -> B
rule) [[B]]
xs)

-- | Pick 1 when there are at least as many 1s as 0s
rule :: [B] -> B
rule :: [B] -> B
rule [B]
xs
  | B -> [B] -> Int
forall (f :: * -> *) a. (Foldable f, Eq a) => a -> f a -> Int
count B
B0 [B]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= B -> [B] -> Int
forall (f :: * -> *) a. (Foldable f, Eq a) => a -> f a -> Int
count B
B1 [B]
xs = B
B1
  | Bool
otherwise                  = B
B0