src/task7/task7.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 import Data.List
   4 import Data.Function (on)
   5
   6 import Data.Text (Text)
   7 import qualified Data.Text.IO as TIO
   8
   9 import Data.Void (Void)
  10
  11 import Text.Megaparsec
  12 import Text.Megaparsec.Char
  13 import qualified Text.Megaparsec.Char.Lexer as L
  14 import qualified Control.Applicative as CA
  15
  16 type Burgers = [Int]
  17 type Flips = [Int]
  18 type Flipper = (Int, Flips)
  19
  20 main :: IO ()
  21 main = do
  22         flipsT <- TIO.readFile "data/07-flips.txt"
  23         let (burgers, flippers) = successfulParse flipsT
  24         print $ part1 burgers flippers
  25         print $ part2 burgers flippers
  26
  27
  28 part1 :: Burgers -> [Flipper] -> Int
  29 part1 burgers = length . filter isSorted . map (enflip burgers) . map snd
  30     where isSorted items = items == unburntSort items
  31
  32 part2 :: Burgers -> [Flipper] -> Int
  33 part2 burgers = fst . head . filter isSorted . map (\(n, fs) -> (n, enflip burgers fs))
  34     where isSorted (_, items) = (null $ filter (<= 0) items) && (items == sort items)
  35
  36
  37 enflip :: Burgers -> Flips -> Burgers
  38 enflip = foldl' oneFlip
  39     where oneFlip items pos = [-1 * i | i <- (reverse $ take pos items)] ++ (drop pos items)
  40
  41 unburntSort :: Burgers -> Burgers
  42 unburntSort = sortBy (compare `on` abs)
  43
  44
  45 -- Parse the input file
  46
  47 type Parser = Parsec Void Text
  48
  49 -- don't treat newlines as automatically-consumed whitespace
  50 sc :: Parser ()
  51 sc = L.space (skipSome (char ' ')) CA.empty CA.empty
  52
  53 lexeme  = L.lexeme sc
  54 integer = lexeme L.decimal
  55 symb = L.symbol sc
  56
  57 flipsFileP = (,) <$> burgersP <* newline <*> (flipperP `endBy` newline)
  58
  59 burgersP = (:) <$> symb "burgers:" *> many integer
  60
  61 flipperP = (,) <$> integer <* symb ":" <*> many integer
  62
  63 successfulParse :: Text -> (Burgers, [Flipper])
  64 successfulParse input =
  65         case parse flipsFileP "input" input of
  66                 Left  _error -> ([], []) -- TIO.putStr $ T.pack $ parseErrorPretty err
  67                 Right flips -> flips