about summary refs log tree commit diff
path: root/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/HybCC.hs
blob: 876d08f75b627212e54cb9b89f6d11dc4b0e611d (plain) (blame)
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')