import Data.List
import Data.Map (Map, (!))
import Data.Set (Set)
import qualified Data.Set as S
import qualified Data.Map as M

type Elf = (Int,Int)
type Elves = Set Elf
type Proposal = Maybe (Int,Int)
type Proposals = Map Elf Proposal
type PMech = Elves -> Elf -> Proposal

readData :: IO Elves
readData = do
    xs <- lines <$> readFile "puzzle.txt"
    let ys = zipWith (\n x -> zipWith (\m y -> (y,(m,-n))) [0..] x) [0..] xs
    return $ S.fromList [c | (x,c) <- concat ys, x == '#']

pMechPart :: Int -> PMech
pMechPart n es (x,y) = if any (flip S.member es) checkList then Nothing else Just (checkList !! 1)
    where checkList = case n of 0 -> [(x-1,y+1),(x,y+1),(x+1,y+1)]
                                1 -> [(x-1,y-1),(x,y-1),(x+1,y-1)]
                                2 -> [(x-1,y+1),(x-1,y),(x-1,y-1)]
                                3 -> [(x+1,y+1),(x+1,y),(x+1,y-1)]

pSched :: Int -> PMech
pSched n es e = resolve $ mapMaybe (\m -> pMechPart m es e) $ take 4 $ drop n [0,1,2,3,0,1,2,3]
    where resolve xs = if length xs `elem` [0,4] then Nothing else Just $ head xs

proposals :: PMech -> Elves -> Proposals
proposals pmech es = M.fromList [(e,pmech es e) | e <- S.toList es]

countVals :: (Ord a) => Map k a -> Map a Int
countVals m = let vals = M.elems m in M.fromList [(v,length $ filter (==v) vals) | v <- vals]

update :: PMech -> Elves -> Elves
update pm es = S.map updateElf es
    where props = proposals pm es
          propCounts = countVals props
          updateElf e = case props ! e of Nothing -> e
                                          Just e' -> if propCounts ! (Just e') > 1 then e else e'

stabElves :: Elves -> (Elves,Int)
stabElves es = let xs = scanl' (\e n -> update (pSched n) e) es (cycle [0..3])
               in head [(y,n) | ((y,y'),n) <- zip (zip xs (tail xs)) [0..], y == y']

main = do
    es <- readData rf
    let (_,n) = stabElves es
    print (n+1)