diff options
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo')
8 files changed, 201 insertions, 0 deletions
diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/AwShCC.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/AwShCC.hs new file mode 100644 index 0000000000..404e289fae --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/AwShCC.hs @@ -0,0 +1,38 @@ +{-# OPTIONS -fno-spec-constr-count #-} +module Algo.AwShCC (awshcc) where + +import Data.Vector.Unboxed as V + +awshcc :: (Int, Vector Int, Vector Int) -> Vector Int +{-# NOINLINE awshcc #-} +awshcc (n, es1, es2) = concomp ds es1' es2' + where + ds = V.enumFromTo 0 (n-1) V.++ V.enumFromTo 0 (n-1) + es1' = es1 V.++ es2 + es2' = es2 V.++ es1 + + starCheck ds = V.backpermute st' gs + where + gs = V.backpermute ds ds + st = V.zipWith (==) ds gs + st' = V.update st . V.filter (not . snd) + $ V.zip gs st + + concomp ds es1 es2 + | V.and (starCheck ds'') = ds'' + | otherwise = concomp (V.backpermute ds'' ds'') es1 es2 + where + ds' = V.update ds + . V.map (\(di, dj, gi) -> (di, dj)) + . V.filter (\(di, dj, gi) -> gi == di && di > dj) + $ V.zip3 (V.backpermute ds es1) + (V.backpermute ds es2) + (V.backpermute ds (V.backpermute ds es1)) + + ds'' = V.update ds' + . V.map (\(di, dj, st) -> (di, dj)) + . V.filter (\(di, dj, st) -> st && di /= dj) + $ V.zip3 (V.backpermute ds' es1) + (V.backpermute ds' es2) + (V.backpermute (starCheck ds') es1) + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/HybCC.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/HybCC.hs new file mode 100644 index 0000000000..876d08f75b --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/HybCC.hs @@ -0,0 +1,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') diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Leaffix.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Leaffix.hs new file mode 100644 index 0000000000..40ec517556 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Leaffix.hs @@ -0,0 +1,16 @@ +module Algo.Leaffix where + +import Data.Vector.Unboxed as V + +leaffix :: (Vector Int, Vector Int) -> Vector Int +{-# NOINLINE leaffix #-} +leaffix (ls,rs) + = leaffix (V.replicate (V.length ls) 1) ls rs + where + leaffix xs ls rs + = let zs = V.replicate (V.length ls * 2) 0 + vs = V.update_ zs ls xs + sums = V.prescanl' (+) 0 vs + in + V.zipWith (-) (V.backpermute sums ls) (V.backpermute sums rs) + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/ListRank.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/ListRank.hs new file mode 100644 index 0000000000..933bd8eb2e --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/ListRank.hs @@ -0,0 +1,21 @@ +module Algo.ListRank +where + +import Data.Vector.Unboxed as V + +listRank :: Int -> Vector Int +{-# NOINLINE listRank #-} +listRank n = pointer_jump xs val + where + xs = 0 `V.cons` V.enumFromTo 0 (n-2) + + val = V.zipWith (\i j -> if i == j then 0 else 1) + xs (V.enumFromTo 0 (n-1)) + + pointer_jump pt val + | npt == pt = val + | otherwise = pointer_jump npt nval + where + npt = V.backpermute pt pt + nval = V.zipWith (+) val (V.backpermute val pt) + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Quickhull.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Quickhull.hs new file mode 100644 index 0000000000..694bea3097 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Quickhull.hs @@ -0,0 +1,32 @@ +module Algo.Quickhull (quickhull) where + +import Data.Vector.Unboxed as V + +quickhull :: (Vector Double, Vector Double) -> (Vector Double, Vector Double) +{-# NOINLINE quickhull #-} +quickhull (xs, ys) = xs' `seq` ys' `seq` (xs',ys') + where + (xs',ys') = V.unzip + $ hsplit points pmin pmax V.++ hsplit points pmax pmin + + imin = V.minIndex xs + imax = V.maxIndex xs + + points = V.zip xs ys + pmin = points V.! imin + pmax = points V.! imax + + + hsplit points p1 p2 + | V.length packed < 2 = p1 `V.cons` packed + | otherwise = hsplit packed p1 pm V.++ hsplit packed pm p2 + where + cs = V.map (\p -> cross p p1 p2) points + packed = V.map fst + $ V.filter (\t -> snd t > 0) + $ V.zip points cs + + pm = points V.! V.maxIndex cs + + cross (x,y) (x1,y1) (x2,y2) = (x1-x)*(y2-y) - (y1-y)*(x2-x) + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Rootfix.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Rootfix.hs new file mode 100644 index 0000000000..1b112a801a --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Rootfix.hs @@ -0,0 +1,15 @@ +module Algo.Rootfix where + +import Data.Vector.Unboxed as V + +rootfix :: (V.Vector Int, V.Vector Int) -> V.Vector Int +{-# NOINLINE rootfix #-} +rootfix (ls, rs) = rootfix (V.replicate (V.length ls) 1) ls rs + where + rootfix xs ls rs + = let zs = V.replicate (V.length ls * 2) 0 + vs = V.update_ (V.update_ zs ls xs) rs (V.map negate xs) + sums = V.prescanl' (+) 0 vs + in + V.backpermute sums ls + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Spectral.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Spectral.hs new file mode 100644 index 0000000000..811c58269e --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Spectral.hs @@ -0,0 +1,21 @@ +module Algo.Spectral ( spectral ) where + +import Data.Vector.Unboxed as V + +import Data.Bits + +spectral :: Vector Double -> Vector Double +{-# NOINLINE spectral #-} +spectral us = us `seq` V.map row (V.enumFromTo 0 (n-1)) + where + n = V.length us + + row i = i `seq` V.sum (V.imap (\j u -> eval_A i j * u) us) + + eval_A i j = 1 / fromIntegral r + where + r = u + (i+1) + u = t `shiftR` 1 + t = n * (n+1) + n = i+j + diff --git a/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Tridiag.hs b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Tridiag.hs new file mode 100644 index 0000000000..7668deace1 --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/vector/benchmarks/Algo/Tridiag.hs @@ -0,0 +1,16 @@ +module Algo.Tridiag ( tridiag ) where + +import Data.Vector.Unboxed as V + +tridiag :: (Vector Double, Vector Double, Vector Double, Vector Double) + -> Vector Double +{-# NOINLINE tridiag #-} +tridiag (as,bs,cs,ds) = V.prescanr' (\(c,d) x' -> d - c*x') 0 + $ V.prescanl' modify (0,0) + $ V.zip (V.zip as bs) (V.zip cs ds) + where + modify (c',d') ((a,b),(c,d)) = + let id = 1 / (b - c'*a) + in + id `seq` (c*id, (d-d'*a)*id) + |