packages feed

comfort-array-0.5.4: test/DocTest/Data/Array/Comfort/Storable.hs

-- Do not edit! Automatically created with doctest-extract from src/Data/Array/Comfort/Storable.hs
{-# LINE 98 "src/Data/Array/Comfort/Storable.hs" #-}

module DocTest.Data.Array.Comfort.Storable where

import Test.DocTest.Base
import qualified Test.DocTest.Driver as DocTest

{-# LINE 99 "src/Data/Array/Comfort/Storable.hs" #-}
import     qualified DocTest.Data.Array.Comfort.Boxed.Unchecked
                                                 as TestBoxedArray
import     qualified Data.Array.Comfort.Boxed as BoxedArray
import     qualified Data.Array.Comfort.Storable as Array
import     qualified Data.Array.Comfort.Shape as Shape
import     Data.Array.Comfort.Storable (Array, (!))

import     qualified Test.QuickCheck as QC
import     Test.ChasingBottoms.IsBottom (isBottom)

import     Control.Monad (replicateM)
import     Control.Applicative ((<$>), (<*>))

import     qualified Data.Map as Map
import     qualified Data.Set as Set
import     Data.Map (Map)
import     Data.Function.HT (Id)
import     Data.Complex (Complex((:+)))
import     Data.Tuple.HT (swap)
import     Data.Word (Word16)

import     Foreign.Storable (Storable)

type     ShapeInt = Shape.ZeroBased Int
type     X = Shape.Element

shapeInt     :: Int -> ShapeInt
shapeInt     = Shape.ZeroBased

genArray     :: QC.Gen (Array ShapeInt Word16)
genArray     = Array.vectorFromList <$> QC.arbitrary

genArray2     :: QC.Gen (Array (ShapeInt,ShapeInt) Word16)
genArray2     = do
       xs <- QC.arbitrary
       let n = length xs
       (k,m) <-
          if n == 0
             then QC.elements [(,) 0, flip (,) 0] <*> QC.choose (1,20)
             else fmap (\m -> (div n m, m)) $ QC.choose (1,n)
       return $ Array.fromList (Shape.ZeroBased k, Shape.ZeroBased m) xs

genArrayForShape     :: (Shape.C shape) => shape -> QC.Gen (Array shape Word16)
genArrayForShape     sh =
       Array.fromList sh <$> replicateM (Shape.size sh) QC.arbitrary

genNonEmptyArray2     :: QC.Gen (Array (ShapeInt,ShapeInt) Word16)
genNonEmptyArray2     = do
       xs <- QC.getNonEmpty <$> QC.arbitrary
       let n = length xs
       m <- QC.choose (1,n)
       return $ Array.fromList (Shape.ZeroBased (div n m), Shape.ZeroBased m) xs

infix     4 ==?
(==?)     :: a -> a -> (a,a)
(==?)     = (,)

forAllNonEmpty     :: (Eq b) => (Array ShapeInt Word16 -> (b,b)) -> QC.Property
forAllNonEmpty     f =
       QC.forAll genArray $ \xs ->
       case f xs of
          (resultArray,resultList) ->
             if Array.shape xs == Shape.ZeroBased 0
                then isBottom resultArray
                else resultArray == resultList


transpose     ::
       (Shape.Indexed sh0, Shape.Indexed sh1, Storable a) =>
       Array (sh0,sh1) a -> Array (sh1,sh0) a
transpose     a = Array.sample (swap $ Array.shape a) (\(i,j) -> a!(j,i))

test :: DocTest.T ()
test = do
 DocTest.printPrefix "Data.Array.Comfort.Storable:185: "
{-# LINE 185 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.example(
{-# LINE 185 "src/Data/Array/Comfort/Storable.hs" #-}
    Array.fromList (shapeInt 5) ['a'..]
  )
  [ExpectedLine [LineChunk "StorableArray.fromList (ZeroBased {zeroBasedSize = 5}) \"abcde\""]]
 DocTest.printPrefix "Data.Array.Comfort.Storable:204: "
{-# LINE 204 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.example(
{-# LINE 204 "src/Data/Array/Comfort/Storable.hs" #-}
    Array.fromTuple ('a',('b','c')) :: Array (Shape.NestedTuple Shape.TupleIndex (X,(X,X))) Char
  )
  [ExpectedLine [LineChunk "StorableArray.fromList (NestedTuple {getNestedTuple = (Element 0,(Element 1,Element 2))}) \"abc\""]]
 DocTest.printPrefix "Data.Array.Comfort.Storable:207: "
{-# LINE 207 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.example(
{-# LINE 207 "src/Data/Array/Comfort/Storable.hs" #-}
      
   let arr :: Array (Shape.NestedTuple Shape.TupleAccessor (X,(X,X))) Char
       arr = Array.fromTuple ('a',('b','c'))
   in (arr ! fst, arr ! (fst.snd))
  )
  [ExpectedLine [LineChunk "('a','b')"]]
 DocTest.printPrefix "Data.Array.Comfort.Storable:230: "
{-# LINE 230 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.example(
{-# LINE 230 "src/Data/Array/Comfort/Storable.hs" #-}
      
   let arr = Array.fromRecord ('a' :+ 'b') in
   let (real:+imag) = Shape.indexRecordFromShape $ Array.shape arr in
   (arr ! real, arr ! imag)
  )
  [ExpectedLine [LineChunk "('a','b')"]]
 DocTest.printPrefix "Data.Array.Comfort.Storable:295: "
{-# LINE 295 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.example(
{-# LINE 295 "src/Data/Array/Comfort/Storable.hs" #-}
      
   Array.fromBlockArray1 $ BoxedArray.fromList Set.empty [] :: Array (Map Char ShapeInt) Word16
  )
  [ExpectedLine [LineChunk "StorableArray.fromList (fromList []) []"]]
 DocTest.printPrefix "Data.Array.Comfort.Storable:300: "
{-# LINE 300 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.example(
{-# LINE 300 "src/Data/Array/Comfort/Storable.hs" #-}
      
   let block n a = Array.replicate (shapeInt n) (a::Word16) in
   Array.fromBlockArray1 $
   BoxedArray.fromList (Set.fromList "ABC") [block 2 0, block 3 1, block 5 2]
  )
  [ExpectedLine [LineChunk "StorableArray.fromList (fromList [('A',ZeroBased {",WildCardChunk,LineChunk " 2}),('B',ZeroBased {",WildCardChunk,LineChunk " 3}),('C',ZeroBased {",WildCardChunk,LineChunk " 5})]) [0,0,1,1,1,2,2,2,2,2]"]]
 DocTest.printPrefix "Data.Array.Comfort.Storable:318: "
{-# LINE 318 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.example(
{-# LINE 318 "src/Data/Array/Comfort/Storable.hs" #-}
      
   let shapeR0 = shapeInt 2; shapeR1 = shapeInt 3 in
   let shapeC0 = shapeInt 3; shapeC1 = shapeInt 2 in
   let block sh a = Array.replicate sh (a::Word16) in
   Array.fromBlockArray2
      (Map.singleton 'A' shapeR0 <> Map.singleton 'B' shapeR1)
      (Map.singleton '1' shapeC0 <> Map.singleton '2' shapeC1) $
   BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")
      [block (shapeR0,shapeC0) 0, block (shapeR0,shapeC1) 1,
       block (shapeR1,shapeC0) 2, block (shapeR1,shapeC1) 3]
  )
  [ExpectedLine [LineChunk "StorableArray.fromList (fromList [('A',ZeroBased {",WildCardChunk,LineChunk " 2}),('B',ZeroBased {",WildCardChunk,LineChunk " 3})],fromList [('1',ZeroBased {",WildCardChunk,LineChunk " 3}),('2',ZeroBased {",WildCardChunk,LineChunk " 2})]) [0,0,0,1,1,0,0,0,1,1,2,2,2,3,3,2,2,2,3,3,2,2,2,3,3]"]]
 DocTest.printPrefix "Data.Array.Comfort.Storable:331: "
{-# LINE 331 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.property(
{-# LINE 331 "src/Data/Array/Comfort/Storable.hs" #-}
        
   QC.forAll genArray2 $ \blockA1 ->
   QC.forAll genArray2 $ \blockB2 ->
   let shapeR0 = fst $ Array.shape blockA1 in
   let shapeC0 = snd $ Array.shape blockA1 in
   let shapeR1 = fst $ Array.shape blockB2 in
   let shapeC1 = snd $ Array.shape blockB2 in
   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->
   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->
   let blocked =
         BoxedArray.fromList (Set.fromList "AB", Set.fromList "12")
            [blockA1, blockA2, blockB1, blockB2] in

   transpose (Array.fromNonEmptyBlockArray2 blocked)
   QC.===
   Array.fromNonEmptyBlockArray2
      (TestBoxedArray.transpose (fmap transpose blocked))
  )
 DocTest.printPrefix "Data.Array.Comfort.Storable:350: "
{-# LINE 350 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.property(
{-# LINE 350 "src/Data/Array/Comfort/Storable.hs" #-}
        
   QC.forAll genArray2 $ \blockA1 ->
   QC.forAll genArray2 $ \blockB2 ->
   QC.forAll genArray2 $ \blockC3 ->
   let shapeR0 = fst $ Array.shape blockA1 in
   let shapeC0 = snd $ Array.shape blockA1 in
   let shapeR1 = fst $ Array.shape blockB2 in
   let shapeC1 = snd $ Array.shape blockB2 in
   let shapeR2 = fst $ Array.shape blockC3 in
   let shapeC2 = snd $ Array.shape blockC3 in
   QC.forAll (genArrayForShape (shapeR0, shapeC1)) $ \blockA2 ->
   QC.forAll (genArrayForShape (shapeR0, shapeC2)) $ \blockA3 ->
   QC.forAll (genArrayForShape (shapeR1, shapeC0)) $ \blockB1 ->
   QC.forAll (genArrayForShape (shapeR1, shapeC2)) $ \blockB3 ->
   QC.forAll (genArrayForShape (shapeR2, shapeC0)) $ \blockC1 ->
   QC.forAll (genArrayForShape (shapeR2, shapeC1)) $ \blockC2 ->
   let blocked =
         BoxedArray.fromList (Set.fromList "ABC", Set.fromList "123")
            [blockA1, blockA2, blockA3,
             blockB1, blockB2, blockB3,
             blockC1, blockC2, blockC3] in

   transpose (Array.fromNonEmptyBlockArray2 blocked)
   QC.===
   Array.fromNonEmptyBlockArray2
      (TestBoxedArray.transpose (fmap transpose blocked))
  )
 DocTest.printPrefix "Data.Array.Comfort.Storable:401: "
{-# LINE 401 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.example(
{-# LINE 401 "src/Data/Array/Comfort/Storable.hs" #-}
      
   (id :: Id (array (height, Map Char ShapeInt) Word16)) $
   Array.fromBlockArray2
      (Map.singleton 'A' (shapeInt 2) <> Map.singleton 'B' (shapeInt 3))
      Map.empty $
   BoxedArray.fromList (Set.fromList "AB", Set.empty) []
  )
  [ExpectedLine [LineChunk "StorableArray.fromList (fromList [('A',ZeroBased {",WildCardChunk,LineChunk " 2}),('B',ZeroBased {",WildCardChunk,LineChunk " 3})],fromList []) []"]]
 DocTest.printPrefix "Data.Array.Comfort.Storable:410: "
{-# LINE 410 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.property(
{-# LINE 410 "src/Data/Array/Comfort/Storable.hs" #-}
        
   QC.forAll genArray2 $ \block ->
   let height = Map.singleton 'A' $ fst $ Array.shape block in
   let width  = Map.singleton '1' $ snd $ Array.shape block in

   Array.reshape (height,width) block
   QC.===
   Array.fromBlockArray2 height width
      (BoxedArray.replicate (Set.singleton 'A', Set.singleton '1') block)
  )
 DocTest.printPrefix "Data.Array.Comfort.Storable:516: "
{-# LINE 516 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.property(
{-# LINE 516 "src/Data/Array/Comfort/Storable.hs" #-}
      QC.forAll genNonEmptyArray2 $ \xs -> QC.forAll (QC.elements $ Shape.indices $ Array.shape xs) $ \(ix0,ix1) -> Array.pick xs ix0 ! ix1 == xs!(ix0,ix1)
  )
 DocTest.printPrefix "Data.Array.Comfort.Storable:534: "
{-# LINE 534 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.property(
{-# LINE 534 "src/Data/Array/Comfort/Storable.hs" #-}
      QC.forAll genArray2 $ \xs -> xs == Array.fromRowArray (snd $ Array.shape xs) (Array.toRowArray xs)
  )
 DocTest.printPrefix "Data.Array.Comfort.Storable:551: "
{-# LINE 551 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.property(
{-# LINE 551 "src/Data/Array/Comfort/Storable.hs" #-}
      forAllNonEmpty $ \xs -> Array.minimum xs ==? minimum (Array.toList xs)
  )
 DocTest.printPrefix "Data.Array.Comfort.Storable:559: "
{-# LINE 559 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.property(
{-# LINE 559 "src/Data/Array/Comfort/Storable.hs" #-}
      forAllNonEmpty $ \xs -> Array.maximum xs ==? maximum (Array.toList xs)
  )
 DocTest.printPrefix "Data.Array.Comfort.Storable:571: "
{-# LINE 571 "src/Data/Array/Comfort/Storable.hs" #-}
 DocTest.property(
{-# LINE 571 "src/Data/Array/Comfort/Storable.hs" #-}
      forAllNonEmpty $ \xs -> Array.limits xs ==? (Array.minimum xs, Array.maximum xs)
  )