Day twelve part one

day-12-haskell/src/Lib.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE TupleSections #-}
+
+module Lib (task1) where
+
+import Control.Monad (join)
+import Data.List (partition, (!?))
+import qualified Data.Set as Set
+import Flow
+
+type World = [[Char]]
+type Point = (Int, Int)
+type Cluster = Set.Set Point
+
+task1 :: String -> IO Int
+task1 input = let allClusters = readWorld input |> clusters
+              in do
+                 return $ sum $ map price allClusters
+
+readWorld :: String -> World
+readWorld = lines
+
+clusters :: World -> [Cluster]
+clusters world = points |> addToClusters []
+  where
+    points :: [Point]
+    points = zip [0..] world |> map (\(y, line) -> take (length line) [0..] |> map (\x -> (x,y))) |> join
+
+    addToClusters :: [Cluster] -> [Point] -> [Cluster]
+    addToClusters existingClusters [] = existingClusters
+    addToClusters existingClusters (point:restPoints) =
+      case partition (\c -> belongingToCluster c point) existingClusters of
+        ([], other) -> addToClusters (Set.singleton point : other) restPoints
+        (matching, other) -> addToClusters ((map Set.toList matching |> join |> Set.fromList |> Set.insert point) : other) restPoints
+
+    belongingToCluster :: Cluster -> Point -> Bool
+    belongingToCluster cluster point =
+      let char = inWorld world point
+      in adjacentPoints point |> filter (\p -> char == inWorld world p) |> any (\x -> Set.member x cluster)
+
+price :: Cluster -> Int
+price cluster = length cluster * perimiter cluster
+
+perimiter :: Cluster -> Int
+perimiter cluster = Set.toList cluster |> map perimiterOnSquare |> sum
+  where
+    perimiterOnSquare :: Point -> Int
+    perimiterOnSquare position = adjacentPoints position |> filter (\pos -> Set.notMember pos cluster) |> length
+
+inWorld :: World -> Point -> Maybe Char
+inWorld world (x,y) = do
+  line <- world !? y
+  line !? x
+
+adjacentPoints :: Point -> [Point]
+adjacentPoints point = [(-1, 0), (0, -1), (1, 0), (0, 1)] |> map (offset point)
+
+offset :: Num a => (a, a) -> (a, a) -> (a, a)
+offset (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)