1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
|
module Algo.HybCC (hybcc) where
import Data.Vector.Unboxed as V
hybcc :: (Int, Vector Int, Vector Int) -> Vector Int
{-# NOINLINE hybcc #-}
hybcc (n, e1, e2) = concomp (V.zip e1 e2) n
where
concomp es n
| V.null es = V.enumFromTo 0 (n-1)
| otherwise = V.backpermute ins ins
where
p = shortcut_all
$ V.update (V.enumFromTo 0 (n-1)) es
(es',i) = compress p es
r = concomp es' (V.length i)
ins = V.update_ p i
$ V.backpermute i r
enumerate bs = V.prescanl' (+) 0 $ V.map (\b -> if b then 1 else 0) bs
pack_index bs = V.map fst
. V.filter snd
$ V.zip (V.enumFromTo 0 (V.length bs - 1)) bs
shortcut_all p | p == pp = pp
| otherwise = shortcut_all pp
where
pp = V.backpermute p p
compress p es = (new_es, pack_index roots)
where
(e1,e2) = V.unzip es
es' = V.map (\(x,y) -> if x > y then (y,x) else (x,y))
. V.filter (\(x,y) -> x /= y)
$ V.zip (V.backpermute p e1) (V.backpermute p e2)
roots = V.zipWith (==) p (V.enumFromTo 0 (V.length p - 1))
labels = enumerate roots
(e1',e2') = V.unzip es'
new_es = V.zip (V.backpermute labels e1') (V.backpermute labels e2')
|
