[commit: dph] master: Add Rank and Indices examples (5e7d2b2)
Ben Lippmeier
benl at ouroborus.net
Thu Jun 2 09:15:15 CEST 2011
Repository : ssh://darcs.haskell.org//srv/darcs/packages/dph
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/5e7d2b208bfa25120df38fb0e3478d831c16d099
>---------------------------------------------------------------
commit 5e7d2b208bfa25120df38fb0e3478d831c16d099
Author: Ben Lippmeier <benl at ouroborus.net>
Date: Thu Jun 2 11:59:37 2011 +1000
Add Rank and Indices examples
>---------------------------------------------------------------
.../imaginary/Indices/dph/IndicesVectorised.hs | 50 ++++++++++++++++++++
dph-examples/imaginary/Indices/dph/Main.hs | 39 +++++++++++++++
dph-examples/imaginary/Rank/dph/Main.hs | 38 +++++++++++++++
dph-examples/imaginary/Rank/dph/RankVectorised.hs | 19 +++++++
4 files changed, 146 insertions(+), 0 deletions(-)
diff --git a/dph-examples/imaginary/Indices/dph/IndicesVectorised.hs b/dph-examples/imaginary/Indices/dph/IndicesVectorised.hs
new file mode 100644
index 0000000..1652411
--- /dev/null
+++ b/dph-examples/imaginary/Indices/dph/IndicesVectorised.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE ParallelArrays #-}
+{-# OPTIONS -fvectorise #-}
+module IndicesVectorised
+ (indicesPA, indices)
+where
+import Data.Array.Parallel.Prelude
+import Data.Array.Parallel.Prelude.Int
+import qualified Prelude as P
+
+
+indicesPA :: PArray Int -> PArray Int -> PArray Int
+{-# NOINLINE indicesPA #-}
+indicesPA arr ixs
+ = toPArrayP (indices (fromPArrayP arr) (fromPArrayP ixs))
+
+
+indices :: [:Int:] -> [:Int:] -> [:Int:]
+indices arr ixs
+ = treeLookup arr ixs
+
+{-
+ = mapP (thing arr) ixs
+
+thing :: [:Int:] -> Int -> Int
+thing arr i
+ = (sliceP i 1 arr) !: 0
+
+
+
+-- arr !: i
+
+thingo :: [:Int:] -> [:Int:] -> [:Int:]
+thingo table is
+ = go is
+ where go is'
+ =
+-}
+
+treeLookup :: [:Int:] -> [:Int:] -> [:Int:]
+{-# NOINLINE treeLookup #-}
+treeLookup table xx
+ | lengthP xx == 1
+ = [: table !: (xx !: 0) :]
+
+ | otherwise
+ = let len = lengthP xx
+ half = len `div` 2
+ s1 = sliceP 0 half xx
+ s2 = sliceP half half xx
+ in concatP (mapP (treeLookup table) [: s1, s2 :])
diff --git a/dph-examples/imaginary/Indices/dph/Main.hs b/dph-examples/imaginary/Indices/dph/Main.hs
new file mode 100644
index 0000000..3a41360
--- /dev/null
+++ b/dph-examples/imaginary/Indices/dph/Main.hs
@@ -0,0 +1,39 @@
+
+import Util
+import Timing
+import Randomish
+import System.Environment
+import Control.Exception
+import qualified IndicesVectorised as ID
+import qualified Data.Array.Parallel.PArray as P
+import qualified Data.Vector.Unboxed as V
+
+
+main
+ = do args <- getArgs
+
+ case args of
+ [alg, count] -> run alg (read count)
+ _ -> usage
+
+
+run "vectorised" count
+ = do let arr = P.fromList [0 .. count - 1]
+ arr `seq` return ()
+
+ (arrResult, tElapsed)
+ <- time
+ $ let arr' = ID.indicesPA arr arr
+ in P.nf arr' `seq` return arr'
+
+ print $ P.length arrResult
+ putStr $ prettyTime tElapsed
+
+run _ _
+ = usage
+
+
+usage = putStr $ unlines
+ [ "usage: indices <algorithm> <count>\n"
+ , " algorithm one of " ++ show ["vectorised"]
+ , ""]
diff --git a/dph-examples/imaginary/Rank/dph/Main.hs b/dph-examples/imaginary/Rank/dph/Main.hs
new file mode 100644
index 0000000..f4f6f82
--- /dev/null
+++ b/dph-examples/imaginary/Rank/dph/Main.hs
@@ -0,0 +1,38 @@
+import Util
+import Timing
+import Randomish
+import System.Environment
+import Control.Exception
+import qualified RankVectorised as RD
+import qualified Data.Array.Parallel.PArray as P
+import qualified Data.Vector.Unboxed as V
+
+
+main
+ = do args <- getArgs
+
+ case args of
+ [alg, count] -> run alg (read count)
+ _ -> usage
+
+
+run "vectorised" count
+ = do let arr = P.fromList [0 .. count - 1]
+ arr `seq` return ()
+
+ (arrRanks, tElapsed)
+ <- time
+ $ let arr' = RD.ranksPA arr
+ in P.nf arr' `seq` return arr'
+
+ print $ P.length arrRanks
+ putStr $ prettyTime tElapsed
+
+run _ _
+ = usage
+
+
+usage = putStr $ unlines
+ [ "usage: rank <algorithm> <count>\n"
+ , " algorithm one of " ++ show ["vectorised"]
+ , ""]
diff --git a/dph-examples/imaginary/Rank/dph/RankVectorised.hs b/dph-examples/imaginary/Rank/dph/RankVectorised.hs
new file mode 100644
index 0000000..f052fa6
--- /dev/null
+++ b/dph-examples/imaginary/Rank/dph/RankVectorised.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE ParallelArrays #-}
+{-# OPTIONS -fvectorise #-}
+module RankVectorised
+ (ranksPA)
+where
+import Data.Array.Parallel.Prelude
+import Data.Array.Parallel.Prelude.Int
+import qualified Prelude as P
+
+
+ranksPA :: PArray Int -> PArray Int
+{-# NOINLINE ranksPA #-}
+ranksPA ps
+ = toPArrayP (ranks (fromPArrayP ps))
+
+ranks :: [:Int:] -> [:Int:]
+{-# NOINLINE ranks #-}
+ranks arr = [: lengthP [: a | a <- arr, a < b :] | b <- arr :]
+
More information about the Cvs-libraries
mailing list