Group Numbers

group_numbers.hs

import Data.List
import qualified Data.Map.Strict as Map
import qualified Data.Tree as Tree
import qualified Data.Graph as Graph

points :: [[Int]] -> Int -> Int -> [((Int,Int), Int)]
points area width height = zip keys (concat area)
  where
    keys = [(r,c) | r <- [0..(height-1)], c <- [0..(width-1)]]

neighbors :: (Int,Int) -> [[Int]] -> Int -> Int ->  [(Int,Int)]
neighbors key@(r,c) area width height = [k | k <- neighborKeys, Map.lookup k pointMap' == value]
  where
    pointMap' = Map.fromList $ points area width height
    neighborKeys = [(r',c') | (r',c') <- [(r+1,c), (r-1,c), (r,c+1), (r,c-1)], r' >= 0, r' < height, c' >= 0, c' < width]
    value = Map.lookup key pointMap'

edges :: [[Int]] -> Int -> Int -> [(Int, (Int,Int), [(Int,Int)])]
edges area width height = [(v, k, neighbors' k) | (k,v) <- points']
  where
    neighbors' k = neighbors k area width height
    points' = points area width height

graph :: [[Int]] -> Int -> Int -> (Graph.Graph, Graph.Vertex -> (Int, (Int,Int), [(Int,Int)]), (Int,Int) -> Maybe Graph.Vertex)
graph area width height = Graph.graphFromEdges $ edges area width height

solve :: [[Int]] -> Int -> Int -> [(Int,Int)]
solve area width height = sortBy (\(v1,c1) (v2,c2) -> compare v1 v2 `mappend` compare c1 c2) $ map count vertexGroups
  where
    (g, vf, _) = graph area width height
    node (n,_,_) = n
    count vs = (head vs, length vs)
    vertexGroups = [[node $ vf v | v <- vs] | vs <- (map Tree.flatten $ Graph.scc g)]

area :: [[Int]]
area = [
  [0, 0, 0, 2, 2],
  [1, 1, 7, 4, 4],
  [2, 2, 4, 2, 4],
  [2, 1, 4, 4, 4],
  [2, 7, 7, 4, 4],
  [4, 6, 6, 0, 4],
  [4, 4, 6, 4, 4],
  [4, 4, 6, 4, 4]]