packages feed

Parallel-Arrows-BaseSpec (empty) → 0.1.1.0

raw patch · 11 files changed

+457/−0 lines, 11 filesdep +Parallel-Arrows-BaseSpecdep +Parallel-Arrows-Definitiondep +basesetup-changed

Dependencies added: Parallel-Arrows-BaseSpec, Parallel-Arrows-Definition, base, deepseq, hspec, split

Files

+ LICENSE.md view
@@ -0,0 +1,23 @@+[The MIT License (MIT)][]++Copyright (c) 2017 Martin Braun++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.++[The MIT License (MIT)]: https://opensource.org/licenses/MIT
+ Parallel-Arrows-BaseSpec.cabal view
@@ -0,0 +1,62 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 2e1eaee8b7234a112a27864df9c9c2b2880c16f1768a7e233a90748284b60fa3++name:           Parallel-Arrows-BaseSpec+version:        0.1.1.0+synopsis:       BaseSpecs used for @Parallel-Arrows-Definition@ and Co.+description:    BaseSpecs used for @Parallel-Arrows-Definition@ and Co. This package contains tests for basic features and even skeletons. See the tests for the dummy backend (from @Parallel-Arrows-Definition@) in @src/test@ or one of the backends (e.g. @Parallel-Arrows-Multicore@) for actual implementations.+category:       Parallelism,Arrows+homepage:       https://github.com/s4ke/Parrows#readme+bug-reports:    https://github.com/s4ke/Parrows/issues+maintainer:     Martin Braun+license:        MIT+license-file:   LICENSE.md+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    package.yaml+    stack.yaml++source-repository head+  type: git+  location: https://github.com/s4ke/Parrows++library+  hs-source-dirs:+      src/main+  ghc-options: -Wall+  build-depends:+      Parallel-Arrows-Definition ==0.1.1.0+    , base >=4.7 && <5.0+    , deepseq+    , hspec ==2.*+    , split+  exposed-modules:+      BaseSpec.BasicSpecBase+      BaseSpec.CompleteSpecBase+      BaseSpec.SkeletonCheckBase+      BaseSpec.TorusSpecBase+  other-modules:+      Paths_Parallel_Arrows_BaseSpec+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: DefinitionSpec.hs+  hs-source-dirs:+      src/test+  ghc-options: -Wall+  build-depends:+      Parallel-Arrows-BaseSpec+    , Parallel-Arrows-Definition ==0.1.1.0+    , base+    , hspec ==2.*+    , split+  other-modules:+      DummySpec+      Paths_Parallel_Arrows_BaseSpec+  default-language: Haskell2010
+ Setup.hs view
@@ -0,0 +1,7 @@+-- This script is used to build and install your package. Typically you don't+-- need to change it. The Cabal documentation has more information about this+-- file: <https://www.haskell.org/cabal/users-guide/installing-packages.html>.+import qualified Distribution.Simple++main :: IO ()+main = Distribution.Simple.defaultMain
+ package.yaml view
@@ -0,0 +1,38 @@+# This YAML file describes your package. Stack will automatically generate a+# Cabal file when you run `stack build`. See the hpack website for help with+# this file: <https://github.com/sol/hpack>.+category: Parallelism,Arrows+description: BaseSpecs used for @Parallel-Arrows-Definition@ and Co.+  This package contains tests for basic features and even skeletons.+  See the tests for the dummy backend (from @Parallel-Arrows-Definition@) in @src/test@+  or one of the backends (e.g. @Parallel-Arrows-Multicore@) for actual implementations.+extra-source-files:+- package.yaml+- stack.yaml+ghc-options: -Wall+github: s4ke/Parrows+library:+  dependencies:+  - base >= 4.7 && < 5.0+  - hspec == 2.*+  - deepseq+  - split+  - Parallel-Arrows-Definition == 0.1.1.0+  source-dirs: src/main+tests:+  spec:+    source-dirs: src/test+    main: DefinitionSpec.hs+    dependencies:+      - hspec == 2.*+      - base+      - Parallel-Arrows-BaseSpec+      - Parallel-Arrows-Definition == 0.1.1.0+      - split+license: MIT+license-file: LICENSE.md+maintainer: Martin Braun+name: Parallel-Arrows-BaseSpec+synopsis: BaseSpecs used for @Parallel-Arrows-Definition@ and Co.++version: '0.1.1.0'
+ src/main/BaseSpec/BasicSpecBase.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module BaseSpec.BasicSpecBase (basicSpec) where++import Parrows.Definition+import Parrows.Future++import Control.Arrow()++import Test.Hspec+import Test.Hspec.QuickCheck++basicSpec :: (ArrowParallel (->) Int Int (),+  Future fut Int (), ArrowParallel (->) (fut Int) (fut Int) (),+  ArrowParallel (->) (Either Int Int) (Either Int Int) ()) => Spec+basicSpec = describe "Basic Functionality Check" $ do+    prop "Basic parEvalN" $ basicParEvalN+    prop "parEvalNLazy" $ parEvalNLazyInt+    prop "parEvalNFut" $ parEvalNFutInt+    prop "parEval2" $ parEval2Int+     where+        basicParEvalN :: [Int] -> Bool+        basicParEvalN xs = parEvalN () (repeat (+1)) xs == map (+1) xs++        parEvalNLazyInt :: [Int] -> Bool+        parEvalNLazyInt xs = parEvalNLazy () 4 (repeat (+1)) xs == map (+1) xs++        parEvalNFutInt :: [Int] -> Bool+        parEvalNFutInt xs = (map (get ()) (parEvalNFut () (repeat (+1)) (map (put ()) xs))) == map (+1) xs++        parEval2Int :: (Int, Int) -> Bool+        parEval2Int (x, y) = (parEval2 () (+1) (*2) (x, y)) == (x+1,y*2)
+ src/main/BaseSpec/CompleteSpecBase.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module BaseSpec.CompleteSpecBase(specBase) where++import BaseSpec.BasicSpecBase+import BaseSpec.SkeletonCheckBase+import BaseSpec.TorusSpecBase++import Parrows.Definition+import Parrows.Future++import Test.Hspec++specBase :: (+  Future fut Int (),+  Future fut [Matrix] (),+  Future fut (([Int], [Int]), [Int]) (),+  ArrowParallel (->) [Int] [Int] (),+  ArrowParallel (->) (Int, [Int]) Int (),+  ArrowParallel (->) (Either Int Int) (Either Int Int) (),+  ArrowLoopParallel (->) Int Int (),+  ArrowLoopParallel (->) [Matrix] [Matrix] (),+  ArrowLoopParallel (->) (fut Int) (fut Int) (),+  ArrowLoopParallel (->) (Int, fut Int) (Int, fut Int) (),+  ArrowLoopParallel (->) (fut (([Int], [Int]), [Int])) (fut (([Int], [Int]), [Int])) (),+  ArrowLoopParallel (->) ((Matrix, Matrix), fut [Matrix], fut [Matrix]) (Matrix, fut [Matrix], fut [Matrix]) ()) =>+  Spec+specBase = describe "Dummy Parrow Check" $ do+    basicSpec+    pipeSpec+    ringSpec+    mapSpec+    mapReduceSpec+    torusSpec
+ src/main/BaseSpec/SkeletonCheckBase.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module BaseSpec.SkeletonCheckBase where++import Parrows.Definition+import Parrows.Skeletons.Topology+import Parrows.Skeletons.Map++import Parrows.Future++import Control.Arrow++import Test.Hspec+import Test.Hspec.QuickCheck++pipeSpec :: (ArrowLoopParallel (->) Int Int (),+  Future fut Int (),  ArrowLoopParallel (->) (fut Int) (fut Int) (),+  Future fut (([Int], [Int]) ,[Int]) (), ArrowLoopParallel (->) (fut (([Int], [Int]), [Int])) (fut (([Int], [Int]), [Int])) ()) => Spec+pipeSpec = describe "Pipe Test" $ do+    prop "Pipe 4 times (+1)" $ pipeTest+    prop "Pipe (Future) 4 times (+1)" $ pipeSimpleTest+      where+         replicated :: [Int -> Int]+         replicated = map (+) [1..4]++         expectedValue :: Int -> Int+         expectedValue x = foldl (flip ($)) x replicated++         pipeTest :: Int -> Bool+         pipeTest x = pipe () replicated x == expectedValue x++         pipeSimpleTest :: Int -> Bool+         pipeSimpleTest x = pipeSimple () replicated x == expectedValue x++         pipeCombinatorTest :: Int -> Bool+         pipeCombinatorTest x = (((+1) |>>>| (*2)) x) == (((+1) >>> (*2)) x)++ringSpec :: (Future fut Int (), ArrowLoopParallel (->) (Int, fut Int) (Int, fut Int) (),+              ArrowLoopParallel (->) Int Int ()) => Spec+ringSpec = describe "Ring Test" $ do+    prop "" $ ringTest+      where+        values :: Int -> [Int]+        values cnt = take cnt $ [1..]++        ringTest :: Int -> Bool+        ringTest cnt = (ring () (\(x,y) -> (y, x+1)) (values cnt) ) == (rightRotate $ map (+1) (values cnt))++        rightRotate    :: [a] -> [a]+        rightRotate [] =  []+        rightRotate xs =  last xs : init xs++mapSpec :: (ArrowParallel (->) Int Int (), ArrowParallel (->) [Int] [Int] ()) => Spec+mapSpec = describe "mapTest" $ do+    prop "parMap" $ parMapTest $ parMap ()+    prop "parMapStream" $ parMapTest $ parMapStream () 4+    prop "farm" $ parMapTest $ farm () 2+    prop "farmChunk" $ parMapTest $ farmChunk () 2 4+      where+          parMapTest :: ((Int -> Int) -> ([Int] -> [Int])) -> [Int] -> Bool+          parMapTest skel xs = skel (+1) xs == map (+1) xs++mapReduceSpec ::  (ArrowParallel (->) (Int, [Int]) Int ()) => Spec+mapReduceSpec = describe "parMapReduceDirect Test" $+    prop "Basic parMapReduceDirect Test" $ parMapReduceDirectTest+      where+        parMapReduceDirectTest :: [Int] -> Bool+        parMapReduceDirectTest xs = (parMapReduceDirect () 4 (+1) (uncurry (*)) (0, xs)) == (foldl (*) 0 $ map (+1) xs)
+ src/main/BaseSpec/TorusSpecBase.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module BaseSpec.TorusSpecBase (torusSpec, Matrix) where++import Test.Hspec+import Test.Hspec.QuickCheck++import Parrows.Skeletons.Topology as P++import Parrows.Definition+import Parrows.Future++import Data.List+import Data.List.Split++torusSpec :: (Future fut [Matrix] (),+  ArrowLoopParallel (->) [Matrix] [Matrix] (),+  ArrowLoopParallel (->) ((Matrix, Matrix), fut [Matrix], fut [Matrix]) (Matrix, fut [Matrix], fut [Matrix]) ())+  => Spec+torusSpec = describe "torus Test" $ do+    prop "Basic Torus Test" $ torusTest+    prop "Identity Torus Test" $ torusTestIdentity+        where+            vals = [1..256]+            matrixA = toMatrix 256 (cycle vals)+            matrixB = toMatrix 256 (cycle (tail vals))++            torusTest :: Bool+            torusTest = (prMM_torus noPe 256 matrixA matrixB) == (prMM matrixA matrixB)++            torusTestIdentity :: Bool+            torusTestIdentity = (prMM_torus noPe 256 matrixA (identity 256)) == matrixA++noPe :: Int+noPe = 4++type Vector = [Int]+type Matrix = [Vector]++dimX :: Matrix -> Int+dimX = length++dimY :: Matrix -> Int+dimY = length . head++matAdd :: Matrix -> Matrix -> Matrix+matAdd x y+    | dimX x /= dimX y = error "dimX x not equal to dimX y"+    | dimY x /= dimY y = error "dimY x not equal to dimY y"+    | otherwise = chunksOf (dimX x) $ zipWith (+) (concat x) (concat y)++toMatrix :: Int -> [Int] -> Matrix+toMatrix cnt randoms = chunksOf n $ take (matrixIntSize n) randoms+        where n = cnt++identity :: Int -> Matrix+identity size = [((replicate (shift) 0) ++ [1] ++ (replicate (size-1-shift) 0)) | shift <- [0..size-1]]++matrixIntSize :: Int -> Int+matrixIntSize n = n * n++splitMatrix :: Int -> Matrix -> [[Matrix]]+splitMatrix size matrix = (map (transpose . map (chunksOf size)) $ chunksOf size $ matrix)++prMM :: Matrix -> Matrix -> Matrix+prMM m1 m2 = prMMTr m1 (transpose m2)+  where+    prMMTr m1' m2' = [[sum (zipWith (*) row col) | col <- m2' ] | row <- m1']++--  1  2  3  4+--  5  6  7  8+--  9 10 11 12+-- 13 14 15 16++--let x = [[[[1,2],[5,6]],[[3,4],[7,8]]],[[[9,10],[13,14]],[[11,12],[15,16]]]]++numCoreCalc :: Int -> Int+numCoreCalc num+        | num <= 4 = 4+        | num <= 16 = 16+        | num <= 64 = 64+        | num <= 256 = 256+        | num <= 512 = 512+        | otherwise = error "too many cores!"++prMM_torus :: (Future fut [Matrix] (),+  ArrowLoopParallel (->) [Matrix] [Matrix] (),+  ArrowLoopParallel (->) ((Matrix, Matrix), fut [Matrix], fut [Matrix]) (Matrix, fut [Matrix], fut [Matrix]) ())+  => Int -> Int -> Matrix -> Matrix -> Matrix+prMM_torus numCores problemSizeVal m1 m2 = combine $ torus () (mult torusSize) $ zipWith zip (split1 m1) (split2 m2)+    where   torusSize = (floor . sqrt) $ fromIntegral $ numCoreCalc numCores+            combine x = concat (map ((map (concat)) . transpose) x)+            split1 x = staggerHorizontally (splitMatrix (problemSizeVal `div` torusSize) x)+            split2 x = staggerVertically (splitMatrix (problemSizeVal `div` torusSize) x)+++--https://books.google.de/books?id=Hfnj5WmFVNUC&pg=PA499&lpg=PA499&dq=matrix+blockwise+multiplication+torus&source=bl&ots=H_jKeqVBJk&sig=GFIllvD9DKTXJaBMetoJyaLE-4A&hl=de&sa=X&ved=0ahUKEwjorcaTu9LYAhXEtBQKHQCVDSQQ6AEILjAB#v=onepage&q=matrix%20blockwise%20multiplication%20torus&f=false++staggerHorizontally :: [[a]] -> [[a]]+staggerHorizontally matrix = zipWith leftRotate [0..] matrix++staggerVertically :: [[a]] -> [[a]]+staggerVertically matrix = transpose $ zipWith leftRotate [0..] (transpose matrix)++leftRotate :: Int -> [a] -> [a]+leftRotate i xs = xs2 ++ xs1 where+    (xs1,xs2) = splitAt i xs++mult :: Int -> ((Matrix,Matrix),[Matrix],[Matrix]) -> (Matrix,[Matrix],[Matrix])+mult size ((sm1,sm2),sm1s,sm2s) = (result,toRight,toBottom)+    where toRight = take (size-1) (sm1:sm1s)+          toBottom = take (size-1) (sm2:sm2s)+          sms = zipWith prMM (sm1:sm1s) (sm2:sm2s)+          result = foldl1' matAdd sms
+ src/test/DefinitionSpec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ src/test/DummySpec.hs view
@@ -0,0 +1,11 @@+module DummySpec(spec) where++import Parrows.Dummy.Simple()++import BaseSpec.CompleteSpecBase++import Test.Hspec++spec :: Spec+spec = describe "Dummy PArrows Check" $ do+    specBase
+ stack.yaml view
@@ -0,0 +1,67 @@+# This file was automatically generated by 'stack init'+#+# Some commonly used options have been documented as comments in this file.+# For advanced use and comprehensive documentation of the format, please see:+# http://docs.haskellstack.org/en/stable/yaml_configuration/++# Resolver to choose a 'specific' stackage snapshot or a compiler version.+# A snapshot resolver dictates the compiler version and the set of packages+# to be used for project dependencies. For example:+#+# resolver: lts-3.5+# resolver: nightly-2015-09-21+# resolver: ghc-7.10.2+# resolver: ghcjs-0.1.0_ghc-7.10.2+# resolver:+#  name: custom-snapshot+#  location: "./custom-snapshot.yaml"+resolver: lts-7.1++# User packages to be built.+# Various formats can be used as shown in the example below.+#+# packages:+# - some-directory+# - https://example.com/foo/bar/baz-0.0.2.tar.gz+# - location:+#    git: https://github.com/commercialhaskell/stack.git+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a+#   extra-dep: true+#  subdirs:+#  - auto-update+#  - wai+#+# A package marked 'extra-dep: true' will only be built if demanded by a+# non-dependency (i.e. a user package), and its test suites and benchmarks+# will not be run. This is useful for tweaking upstream packages.+packages:+- ../Definition+- '.'+# Dependency packages to be pulled from upstream that are not in the resolver+# (e.g., acme-missiles-0.3)+extra-deps: []++# Override default flag values for local packages and extra-deps+flags: {}++# Extra package databases containing global packages+extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true+#+# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: ">=1.1"+#+# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64+#+# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]+#+# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor