advent25/src/advent25.hs

   1 -- import Debug.Trace
   2
   3 import Intcode
   4
   5 import qualified Data.Text.IO as TIO
   6 import qualified Data.Text as T
   7 import Data.Char
   8 import Data.List
   9
  10 main :: IO ()
  11 main = do
  12         text <- TIO.readFile "data/advent25.txt"
  13         let mem = parseMachineMemory text
  14         print $ length mem
  15         (machine, instructions, items) <- runPreamble mem
  16         -- runGameM machine instructions
  17         putStrLn $ passSecurity machine instructions items
  18
  19 runPreamble :: [Integer] -> IO (Machine, [String], [String])
  20 runPreamble mem =
  21       do
  22         instr <- TIO.readFile "data/advent25-instructions.txt"
  23         let instructions = lines $ T.unpack instr
  24         -- runGame mem $ lines $ T.unpack instructions
  25         let (machine, _output) = runCommand mem instructions
  26         let (_s, _machine1, output1) = runMachine (encodeCommands (instructions ++ ["inv"])) machine
  27         putStrLn $ decodeOutput output1
  28         let items = extractItems $ decodeOutput output1
  29         -- print items
  30         return (machine, instructions, items)
  31
  32
  33 encodeCommands :: [String] -> [Integer]
  34 encodeCommands cmds = map (fromIntegral . ord) $ concat $ map (++ "\n") cmds
  35
  36 decodeOutput :: [Integer] -> String
  37 decodeOutput = map (chr . fromIntegral)
  38
  39 extractItems :: String -> [String]
  40 extractItems text = items
  41     where candidates = lines text
  42           items = map (drop 2) $ filter (isPrefixOf "- ") candidates
  43
  44
  45 powerList :: [a] -> [[a]]
  46 powerList [] = [[]]
  47 powerList (x:xs) = powerList xs ++ map (x:) (powerList xs)
  48
  49
  50 passSecurity :: Machine -> [String] -> [String] -> String
  51 passSecurity machine instructions items =
  52     "You keep: " ++ (intercalate ", " keeps) ++ "\n\n" ++ (attemptSecurity machine instructions validDropset)
  53     where
  54         dropsets = powerList items
  55         validDropset = head $ filter (passesSecurity machine instructions) dropsets
  56         keeps = items \\ validDropset
  57
  58 passesSecurity :: Machine -> [String] -> [String] -> Bool
  59 passesSecurity machine instructions drops = not ("Alert" `isInfixOf` output)
  60     where output = attemptSecurity machine instructions drops
  61
  62 attemptSecurity :: Machine -> [String] -> [String] -> String
  63 attemptSecurity machine instructions drops = decodeOutput output
  64     where dropCommands = map ("drop " ++ ) drops
  65           (_, _, output) = runMachine (encodeCommands (instructions ++ dropCommands ++ ["north"])) machine
  66
  67 runCommand :: [Integer] -> [String] -> (Machine, String)
  68 runCommand mem inputs = ( machine, decodeOutput output )
  69     where (_state,  machine, output) = runProgram inputCodes mem
  70           inputCodes = encodeCommands inputs
  71
  72 runGame :: [Integer] -> [String] -> IO ()
  73 runGame mem inputs =
  74     do let (_, outputs) = runCommand mem inputs
  75        putStrLn outputs
  76        nextIn <- getLine
  77        runGame mem (inputs ++ [nextIn])
  78
  79 runGameM :: Machine -> [String] -> IO ()
  80 runGameM machine inputs =
  81     do nextIn <- getLine
  82        let (_s, machine1, output1) = runMachine (encodeCommands (inputs ++ [nextIn])) machine
  83        putStrLn $ decodeOutput output1
  84        runGameM machine1 (inputs ++ [nextIn])