dph-lifted-vseg: fix edge case in concatl when the last segment is empty
authorBen Lippmeier <benl@ouroborus.net>
Thu, 3 Nov 2011 05:23:24 +0000 (16:23 +1100)
committerBen Lippmeier <benl@ouroborus.net>
Thu, 3 Nov 2011 05:26:54 +0000 (16:26 +1100)
dph-lifted-vseg/Data/Array/Parallel/PArray/PData/Nested.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/UPSSegd.hs
dph-prim-par/Data/Array/Parallel/Unlifted/Parallel/UPSegd.hs
dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/USSegd.hs
dph-test/test/PData/PRFuns.hs

index 51a1561..b92ac69 100644 (file)
@@ -543,14 +543,43 @@ concatPR' (PNested vsegd pdatas)
 
 
 -- | Lifted concat.
---   Both arrays must contain the same number of elements.
 concatlPR :: PR a => PData (PArray (PArray a)) -> PData (PArray a)
 concatlPR arr
  = let  (segd1, darr1)  = unsafeFlattenPR arr
         (segd2, darr2)  = unsafeFlattenPR darr1
+
+
+        -- Generate indices for the result array
+        --  There is a tedious edge case when the last segment in the nested
+        --  array has length 0. For example:
+        --
+        --    concatl [ [[1, 2, 3] [4, 5, 6]] [] ]
+        --  
+        --  After the calls to unsafeFlattenPR we get:
+        --   segd1: lengths1 = [ 2 0 ]
+        --          indices1 = [ 0 2 ]
         
+        --   segd2: lengths2 = [ 3 3 ]
+        --          indices2 = [ 0 3 ]
+        -- 
+        --  The problem is that the last element of 'indices1' points off the end
+        --  of 'indices2' so we can't use use 'backpermute' as we'd like to:
+        --    ixs' = (U.bpermute (U.indicesSegd segd2) (U.indicesSegd segd1))        
+        --  Instead, we have to explicitly check for the out-of-bounds condition.
+        --  TODO: We want a faster way of doing this, that doesn't require the 
+        --        test for every element.
+        -- 
+        ixs1            = U.indicesSegd segd1
+        ixs2            = U.indicesSegd segd2
+        len2            = U.length ixs2
+
+        ixs'            = U.map (\ix -> if ix >= len2
+                                                then 0
+                                                else ixs2 U.!: ix)
+                        $ ixs1
+
         segd'           = U.mkSegd (U.sum_s segd1 (U.lengthsSegd segd2))
-                                   (U.bpermute (U.indicesSegd segd2) (U.indicesSegd segd1))
+                                   ixs'
                                    (U.elementsSegd segd2)
 
    in   PNested (U.promoteSegdToVSegd segd') 
index 4ae24df..f25eb3a 100644 (file)
@@ -68,6 +68,7 @@ data UPSSegd
         }
         deriving Show
 
+
 instance PprPhysical UPSSegd where
  pprp (UPSSegd ussegd dssegd)
   =  text "UPSSegd"
index aa29de6..33dcf53 100644 (file)
@@ -37,15 +37,16 @@ import qualified Data.Array.Parallel.Unlifted.Sequential.Basics         as Seq
 import qualified Data.Array.Parallel.Unlifted.Sequential.Combinators    as Seq
 import qualified Data.Array.Parallel.Unlifted.Sequential.Vector         as Seq
 import qualified Data.Array.Parallel.Unlifted.Sequential.USegd          as USegd
+import Data.Array.Parallel.Pretty                                       hiding (empty)
 import Data.Array.Parallel.Unlifted.Sequential.Vector                   (Vector, MVector, Unbox)
 
 import Control.Monad.ST
 import Prelude  hiding (length)
 
 
--- | A parallel segment descriptor holds a global (undistributed) segment desciptor, 
---   as well as a distributed version. The distributed version describes how to split
---   work on the segmented array over the gang. 
+-- | A parallel segment descriptor holds a global (undistributed) segment
+--   desciptor, as well as a distributed version. The distributed version
+--   describes how to split work on the segmented array over the gang. 
 data UPSegd 
         = UPSegd 
         { upsegd_usegd :: !USegd
@@ -59,6 +60,15 @@ data UPSegd
         }
 
 
+-- Pretty ---------------------------------------------------------------------
+instance PprPhysical UPSegd where
+ pprp (UPSegd usegd dsegd)
+  =  text "UPSegd"
+  $$ (nest 7 $ vcat
+        [ text "usegd:  "  <+> pprp usegd
+        , text "dsegd:  "  <+> pprp dsegd])
+
+
 -- Valid ----------------------------------------------------------------------
 -- | O(1).
 --   Check the internal consistency of a parallel segment descriptor.
index 5ab5457..25f001c 100644 (file)
@@ -87,12 +87,12 @@ data USSegd
 
 -- | Pretty print the physical representation of a `UVSegd`
 instance PprPhysical USSegd where
- pprp (USSegd _ starts srcids ssegd)
+ pprp (USSegd _ starts sources ssegd)
   = vcat
   [ text "USSegd" 
         $$ (nest 7 $ vcat
                 [ text "starts:  " <+> (text $ show $ U.toList starts)
-                , text "srcids:  " <+> (text $ show $ U.toList srcids) ])
+                , text "sources: " <+> (text $ show $ U.toList sources) ])
   , pprp ssegd ]
 
 
index 01fef75..bd69665 100644 (file)
@@ -12,9 +12,10 @@ import Data.Array.Parallel.PArray.PData.Base    ()
 import Data.Array.Parallel.PArray.PData.Nested
         ( concatPR,  concatlPR
         , unconcatPR
-        , appendlPR)
+        , appendlPR
+        , unsafeFlattenPR)
 
-import Text.PrettyPrint
+import Text.PrettyPrint                         as T
 import GHC.Exts
 import Control.Monad
 import Data.Vector                              (Vector)
@@ -316,11 +317,16 @@ $(testcases [ ""        <@ [t|  PArray Int |]
         :: (PR b, PA b, Eq b)
         => VVector b -> VVector b -> Bool
   prop_appendl (VVector vec1) (VVector vec2)
-   = let  len   = min (V.length vec1) (V.length vec2)
+   = let  -- Ensure both input vectors have the same length, 
+          --   which will be the lifting context.
+          len   = min (V.length vec1) (V.length vec2)
           vec1' = V.take len vec1
           vec2' = V.take len vec2
           
+          -- Lifted append directly on the vectors.
           vec'   = V.map PA.fromVector $ V.zipWith (V.++) vec1' vec2'
+
+          -- Lifted append via a nested array.
           pdata1 = fromVectorPR (V.map PA.fromVector vec1')
           pdata2 = fromVectorPR (V.map PA.fromVector vec2')
           pdata' = appendlPR pdata1 pdata2
@@ -336,6 +342,16 @@ $(testcases [ ""        <@ [t|  PArray Int |]
   
   |])
 
+
+-- TODO: shift this to D.A.P.BasePretty
+instance (PprPhysical a, PprPhysical b)
+        => PprPhysical (a, b) where
+ pprp (x, y)
+  = vcat
+        [ text "Tuple2"
+        , T.nest 4 $ pprp x
+        , T.nest 4 $ pprp y]
+
 -- Arbitrary PArrays ----------------------------------------------------------
 instance (PprPhysical (PArray a), Arbitrary a, PR a) 
        => Arbitrary (PArray a) where