AoC2019/day14.hs

import Data.List.Split
import Data.List
import Data.Char as Char
import Linear.V3
import Debug.Trace as T

main = do
      reactions <- map getReaction <$> lines <$> getContents
      let amout = getConstruction reactions (1,"A")
      let ore = getOre [(1,"FUEL")] []  reactions
      let result = getRestOre ore [] reactions
      let test = part1 [(1,"FUEL")] [] reactions
      putStrLn(show $ head reactions)
      --putStrLn(show ore)
      putStrLn(show result)
      putStrLn(show test)
      --putStrLn(show sumResult1)
data Reaction = Reaction { input :: [(Int, String)],
                           output :: (Int,String)
                         } deriving Show

getReaction :: String -> Reaction
getReaction input =  Reaction left right
        where split = splitOn " => " input
              left = map getElements (splitOn ", " (split!!0))
              right = getElements $ split!!1

getElements :: String -> (Int,String)
getElements input = (amount,element)
        where split = splitOn " " input
              amount = read $ (split!!0)
              element = split!!1
             
getNextStep :: [Reaction] -> Reaction -> [Reaction]
getNextStep xs (Reaction left right) = filter(\(Reaction i o) -> elem (snd  o)  reactElem ) xs  
                      where reactElem = map(\(a,b) -> b) left 
    
getConstruction ::  [Reaction] -> (Int,String) -> (Int,[(Int, String)])
getConstruction reactions (amount,elem) 
  |  elem == "ORE" = (1,[(amount,elem)]) 
  |  length reaction > 0 = (div amount ( fst $ output $ head $ reaction),(input $ head $ reaction))
  |  otherwise = (1,[(amount,elem)])
                   where reaction =  filter(\(Reaction i o) -> ((snd  o) == elem) && (mod amount (fst o) == 0)) reactions
      

getConstructionRest :: [Reaction] -> (Int,String) -> (Int,[(Int, String)])
getConstructionRest reactions (amount, elem) 
         | elem == "ORE" = (1,[(amount,elem)])
         | otherwise = ((div amount ( fst $ output $ head $ reaction)) + 1,(input $ head $ reaction)) 
                where reaction =  filter(\(Reaction i o) -> ((snd  o) == elem) ) reactions
      
part1 :: [(Int,String)] -> [(Int,String)] -> [Reaction] ->  [(Int,String)]  
part1 needs oldNeeds reactions 
         |needs == oldNeeds = needs
         | otherwise = part1 newNeeds needs reactions
         where newNeeds = getRestOre fullNeeds [] reactions
               fullNeeds = getOre needs [] reactions

getOre :: [(Int,String)] -> [(Int,String)] -> [Reaction] ->  [(Int,String)]
getOre needs oldNeeds reactions
         | needs == oldNeeds = newNeeds 
         | otherwise = getOre  (newNeeds) needs reactions  
         where newNeeds =foldl combineNeeds [] ( foldl (++)[] (map(\(amount,xs) -> map(\(a,e) -> ((amount * a),e)) xs) construction))
               construction = map (getConstruction reactions) needs


getRestOre :: [(Int,String)] -> [(Int,String)] -> [Reaction] -> [(Int,String)]
getRestOre needs oldNeeds reactions = sumNeeds
        where  pureNeeds = getPureNeeds needs reactions
               pureRest = foldl (++)[] (map(\(amount,xs) -> map(\(a,e) -> ((amount * a),e)) xs) (map (getConstructionRest reactions) pureNeeds))
               sumNeeds = foldl combineNeeds [] ((needs \\ pureNeeds) ++ pureRest)  

combineNeeds :: [(Int,String)] -> (Int,String) -> [(Int,String)]
combineNeeds xs (amt, elem) 
        | null oldVal = xs ++ [(amt,elem)]
        | otherwise = (xs \\ oldVal) ++ [((amt + (fst (head oldVal))),elem)]
        where oldVal = filter(\(a,e) -> e == elem) xs
      
getPureNeeds :: [(Int,String)] -> [Reaction] -> [(Int,String)]
getPureNeeds needs reactions = filter(\(a,e) ->  notElem e impureElements ) needs 
                  where   impureElements = map(\(a,e) -> e) ( (foldl (++) [] ( map(\(Reaction i o) -> i)reactionList )))
                          reactionList = (filter(\(Reaction i o) -> elem (snd o) elements) reactions)
                          elements = (map(\(a,e) -> e) needs)