aoc/app/12.hs

{-# LANGUAGE LambdaCase #-}
module Main where

import Data.Functor
import Data.Matrix hiding (trace)
import Data.List
import Debug.Trace
import Data.Maybe

type Pos = (Int,Int)

parse :: String -> Matrix Char
parse = fromLists . lines

getGroup :: Pos -> Matrix Char -> [Pos]
getGroup (i,j) s =
  let e = getElem i j s in
    go e [(i,j)] []
    where go :: Char -> [Pos] -> [Pos] -> [Pos]
          go _ [] v = v
          go c (x@(i,j):xs) v
            | x `elem` v = go c xs v
            | uncurry safeGet x s /= Just c = go c xs v
            | otherwise = go c (filter (isJust . flip (uncurry safeGet) s) [(i+1,j),(i-1,j),(i,j+1),(i,j-1)] ++ xs) (x:v)

groups :: Matrix Char -> [[Pos]]
groups s = go [(i,j) | i <- [1 .. nrows s], j <- [1 .. ncols s]] []
  where go :: [Pos] -> [[Pos]] -> [[Pos]]
        go [] v = v
        go (x:xs) v
          | any (x `elem`) v = go xs v
          | otherwise = go xs (nub (getGroup x s):v)

perimeter :: [Pos] -> Int
perimeter s = length $ s >>= \(i,j) -> [(i,j+1),(i,j-1),(i+1,j),(i-1,j)] \\ s

solve1 :: Matrix Char -> Int
solve1 s = let g = groups s; p = perimeter <$> g in sum $ zipWith (*) (length <$> g) p

sides :: [Pos] -> Int
sides s = length $ go s []
  where go :: [Pos] -> [(Pos,Pos)] -> [(Pos,Pos)]
        go [] v = v
        go ((y,x):xs) v
          | any (\((y1,x1),(y2,x2)) -> (x == x1 && y1 <= y && y <= y2) || (y == y1 && x1 <= x && x <= x2)) v = go xs v
          | otherwise = undefined

solve2 :: Matrix Char -> Int
solve2 = undefined

main :: IO ()
main = readFile "inputs/12" <&> parse >>= \i ->
       print (solve1 i) >>
       print (solve2 i)