A quick experiment using union-find to determine which pieces of 'land' in a grid are connected. Could ostensibly be used with any equivalence/grouping predicate.

FindIslands.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Lib where

import Data.UnionFind.IO
import Control.Monad
import Control.Applicative
import Data.Foldable
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Traversable
import Data.Tuple
import Control.Arrow

-- .#.#.
-- ...#.
-- #....
-- .#..#
-- .#...


land :: M.Map (Int, Int) (Int, Int)
land = M.fromList . fmap (id &&& id) $ [(0, 1), (0, 3), (1, 3), (2, 0), (3, 1), (3, 4), (4, 1)]

findIslands :: IO [[ (Int, Int) ]]
findIslands = do
    pointMap <- traverse fresh land -- O(n)
    void . flip M.traverseWithKey pointMap $ \(x, y) point -> do -- O(n)
        for_ (catMaybes (flip M.lookup pointMap <$> [(x + 1, y), (x, y + 1)])) -- O(log(n))
            $ \neighbourPoint -> do
                union point neighbourPoint -- O(1)
    withUnionKey :: (M.Map (Int, Int) (Int, Int)) <- for pointMap (repr >=> descriptor) -- O(n)
    let unionKeyToCoord :: [((Int, Int), (Int, Int))] = (swap <$> M.toList withUnionKey) -- O(n)
    let results = M.fromListWith (<>) $ (fmap (:[]) <$> unionKeyToCoord) -- O(nlogn)
    return (M.elems results)

-- >>> findIslands
-- [ [(0, 1)]
-- , [(1, 3), (0, 3)]
-- , [(2, 0)]
-- , [(3, 4)]
-- , [(4, 1), (3, 1)]
-- ]