问我怎样才能加速这个图形算法？

EN

import Data.List
import Data.Maybe
import qualified Data.IntSet as IS (fromList)

mkgroups :: [[Int]] -> [IntSet]
mkgroups = foldl' add2gc []
  where
    -- if a group is not found, create a new group
    add2gc [] is = [IS.fromList is]
    -- for the current group,
    add2gc (g:gc) ~is@[i1, i2]
      -- if either mates in group, add to group.
      | i1 `IS.member` g = merge2gc i2 g gc
      | i2 `IS.member` g = merge2gc i1 g gc
      -- otherwise try next group
      | otherwise = g : add2gc gc is
    -- merge other inmate to appropriate group
    merge2gc i g gc
      -- in original group, return original group
      | i `IS.member` g = g:gc
      | otherwise = case part (IS.member i) gc of
      -- in any other group, merge that group with this.
        (Just g',gs) -> (IS.union g g') : gs
      -- otherwise add innmate to this group
        _ -> (IS.insert i g):gc

part p as = go as []
  where 
    go []     ps  = (Nothing, ps)
    go (a:as) ps = if p a
      then (Just a, ps ++ as)
      else go as (a:ps)

import Data.Tree as T
import Data.Graph as G

mkgroups :: Int -> [(Int,Int)] -> Forest Vertex
mkgroups n = filter ((>1) . length . T.flatten) . G.components . G.buildG (0,n)