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 <[email protected]>
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 :]
+



_______________________________________________
Cvs-libraries mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-libraries

Reply via email to