fork download
copy 
  1. module Main where
  2.  
  3. import Data.Array.Repa hiding (map)
  4. import Criterion.Main
  5. import Criterion.Types
  6. import System.IO.Unsafe
  7.  
  8.  
  9. type DIM1_U_D = Array U DIM1 Double
  10. type DIM1_D_D = Array D DIM1 Double
  11. type DIM2_D_D = Array D DIM2 Double
  12.  
  13. calc :: DIM1_U_D -> DIM1_U_D -> DIM1_D_D
  14. calc k b = let sizeB = size (extent b)
  15.                sizeK = size (extent k)
  16.                p kp bp (Z:.ic) = sum $ map
  17.                                  (\i -> kp (Z:.i) * bp (Z:.ic+i))
  18.                                  [0..sizeK-1]
  19.            in traverse2 k b (\_ _ -> Z:.sizeB-sizeK+1) p
  20.  
  21. calc0, calc1, calc2 :: DIM1_U_D -> DIM1_U_D -> DIM1_U_D
  22. calc0 k b = unsafePerformIO $ computeP $ calc k b 
  23.  
  24. calc1 k b = let
  25.     Z :. ks = extent k
  26.     Z :. bs = extent b
  27.     sh = Z :. bs - ks + 1 :. ks
  28.     k', b' :: DIM2_D_D
  29.     k' = traverse k (const sh) (\f (Z :. _ :. j) -> f (Z :. j))
  30.     b' = traverse b (const sh) (\f (Z :. i :. j) -> f (Z :. (i+j)))
  31.   in unsafePerformIO $ sumP $ k' *^ b'
  32.  
  33. calc2 k b = let
  34.     s (Z :. ks) (Z :. bs) = Z :. bs - ks + 1 :. ks
  35.     f kf bf (Z :. i :. j) = kf (Z :. j) * bf (Z :. (i+j))
  36.   in unsafePerformIO $ sumP $ traverse2 k b s f
  37.  
  38. kernel, base :: [Double]
  39. -- (kernel, base) = ([6, 3, 5], [3, 5, 2, 9, 4])
  40. -- (kernel, base) = ([1..10], [1..100])
  41. (kernel, base) = ([1..200], [1..40000])
  42.  
  43.  
  44.  
  45. main = do
  46.   k <- return $! fromListUnboxed (Z :. length kernel) kernel
  47.   b <- return $! fromListUnboxed (Z :. length base) base
  48. --  test1 k b
  49.   test2 k b
  50.  
  51. test1 k b = do
  52.   print $ calc0 k b
  53.   print $ calc1 k b
  54.   print $ calc2 k b
  55.  
  56. test2 k b =
  57.   defaultMain [bench "calc0" $ whnf (calc0 k) b,
  58.                bench "calc1" $ whnf (calc1 k) b,
  59.                bench "calc2" $ whnf (calc2 k) b]
  60.  
  61. {- COMMAND
  62. ghc -O2 -rtsopts -threaded --make 265.hs
  63. sleep 100
  64. ./265 +RTS -N
  65. -}
  66.  
  67. {- RESULT
  68. -}
Not running #stdin #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/hdl0v
language:
Haskell (ghc 8.4.4)
created:
12 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!