Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

add fwdense and rotateimage

  • Loading branch information...
commit 8545f3c56574e44ffab2346dee83c8e5f123baf8 1 parent 4e0bd10
@simonmar authored
Showing with 200 additions and 44 deletions.
  1. +48 −44 fwdense.hs
  2. +74 −0 fwdense1.hs
  3. +33 −0 parconc-examples.cabal
  4. +45 −0 rotateimage.hs
View
92 fwdense.hs
@@ -1,11 +1,10 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, BangPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}
-module Main ( main, test ) where
+module Main ( main, test, maxDistances ) where
import System.Environment
import Data.Array.Repa
-import Data.Maybe
-- <<Graph
type Weight = Int
@@ -15,62 +14,67 @@ type Graph r = Array r DIM2 Weight
-- -----------------------------------------------------------------------------
-- shortestPaths
+-- <<shortestPaths
shortestPaths :: Graph U -> Graph U
-shortestPaths g = go 0 g
+shortestPaths g0 = go g0 0 -- <2>
where
- Z :. k0 :. _ = extent g
-
- go k g | k == k0 = g
- | otherwise = go (k+1) $! g'
- where
-#if 1
- g' = fromJust (computeP (fromFunction (Z:.k0:.k0) sp))
- sp (Z:.i:.j) = min (g ! (Z:.i:.j)) (g ! (Z:.i:.k) + g ! (Z:.k:.j))
-#elif 0
- g' = computeS (fromFunction (Z:.k0:.k0) sp)
- sp (Z:.i:.j) = min (g ! (Z:.i:.j)) (g ! (Z:.i:.k) + g ! (Z:.k:.j))
-#else
- g' = computeS $ traverse g id $ \prev (Z:.i:.j) ->
- min (prev (Z:.i:.j)) (prev (Z:.i:.k) + prev (Z:.k:.j))
-#endif
+ Z :. _ :. n = extent g0 -- <1>
+
+ go !g !k | k == n = g -- <3>
+ | otherwise =
+ let g' = computeS (fromFunction (Z:.n:.n) sp) -- <4>
+ in go g' (k+1) -- <5>
+ where
+ sp (Z:.i:.j) = min (g ! (Z:.i:.j)) (g ! (Z:.i:.k) + g ! (Z:.k:.j)) -- <6>
+-- >>
+
+-- -----------------------------------------------------------------------------
+
+-- <<maxDistance
+maxDistance :: Weight -> Weight -> Weight
+maxDistance x y
+ | x == inf = y
+ | y == inf = x
+ | otherwise = max x y
+-- >>
+
+maxDistances :: Graph U -> Array U DIM1 Weight
+maxDistances = foldS maxDistance inf
-- -----------------------------------------------------------------------------
-- Testing
-input :: [[Int]]
-input = [[ 0, 999, 999, 13, 999, 999],
- [999, 0, 999, 999, 4, 9],
- [ 11, 999, 0, 999, 999, 999],
- [999, 3, 999, 0, 999, 7],
- [ 15, 5, 999, 1, 0, 999],
- [ 11, 999, 999, 14, 999, 0]]
+-- <<inf
+inf :: Weight
+inf = 999
+-- >>
+
+testGraph :: Graph U
+testGraph = toAdjMatrix $
+ [[ 0, inf, inf, 13, inf, inf],
+ [inf, 0, inf, inf, 4, 9],
+ [ 11, inf, 0, inf, inf, inf],
+ [inf, 3, inf, 0, inf, 7],
+ [ 15, 5, inf, 1, 0, inf],
+ [ 11, inf, inf, 14, inf, 0]]
-- correct result:
-result :: [[Int]]
-result = [[0, 16, 999, 13, 20, 20],
- [19, 0, 999, 5, 4, 9],
+expectedResult :: Graph U
+expectedResult = toAdjMatrix $
+ [[0, 16, inf, 13, 20, 20],
+ [19, 0, inf, 5, 4, 9],
[11, 27, 0, 24, 31, 31],
- [18, 3, 999, 0, 7, 7],
- [15, 4, 999, 1, 0, 8],
- [11, 17, 999, 14, 21, 0] ]
+ [18, 3, inf, 0, 7, 7],
+ [15, 4, inf, 1, 0, 8],
+ [11, 17, inf, 14, 21, 0] ]
test :: Bool
-test = fromAdjMatrix (shortestPaths (toAdjMatrix input)) == result
+test = shortestPaths testGraph == expectedResult
-toAdjMatrix :: [[Int]] -> Graph U
+toAdjMatrix :: [[Weight]] -> Graph U
toAdjMatrix xs = fromListUnboxed (Z :. k :. k) (concat xs)
where k = length xs
-fromAdjMatrix :: Graph U -> [[Int]]
-fromAdjMatrix m = chunk k (toList m)
- where
- (Z :. _ :. k) = extent m
-
-chunk :: Int -> [a] -> [[a]]
-chunk _ [] = []
-chunk n xs = as : chunk n bs
- where (as,bs) = splitAt n xs
-
main :: IO ()
main = do
[n] <- fmap (fmap read) getArgs
View
74 fwdense1.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE CPP, BangPatterns #-}
+{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}
+
+module Main ( main, test ) where
+
+import System.Environment
+import Data.Array.Repa
+import Data.Functor.Identity
+
+-- <<Graph
+type Weight = Int
+type Graph r = Array r DIM2 Weight
+-- >>
+
+-- -----------------------------------------------------------------------------
+-- shortestPaths
+
+-- <<shortestPaths
+shortestPaths :: Graph U -> Graph U
+shortestPaths g0 = runIdentity $ go g0 0 -- <1>
+ where
+ Z :. _ :. n = extent g0
+
+ go !g !k | k == n = return g -- <2>
+ | otherwise = do
+ g' <- computeP (fromFunction (Z:.n:.n) sp) -- <3>
+ go g' (k+1)
+ where
+ sp (Z:.i:.j) = min (g ! (Z:.i:.j)) (g ! (Z:.i:.k) + g ! (Z:.k:.j))
+-- >>
+
+-- -----------------------------------------------------------------------------
+-- Testing
+
+input :: [[Int]]
+input = [[ 0, 999, 999, 13, 999, 999],
+ [999, 0, 999, 999, 4, 9],
+ [ 11, 999, 0, 999, 999, 999],
+ [999, 3, 999, 0, 999, 7],
+ [ 15, 5, 999, 1, 0, 999],
+ [ 11, 999, 999, 14, 999, 0]]
+
+-- correct result:
+result :: [[Int]]
+result = [[0, 16, 999, 13, 20, 20],
+ [19, 0, 999, 5, 4, 9],
+ [11, 27, 0, 24, 31, 31],
+ [18, 3, 999, 0, 7, 7],
+ [15, 4, 999, 1, 0, 8],
+ [11, 17, 999, 14, 21, 0] ]
+
+test :: Bool
+test = fromAdjMatrix (shortestPaths (toAdjMatrix input)) == result
+
+toAdjMatrix :: [[Int]] -> Graph U
+toAdjMatrix xs = fromListUnboxed (Z :. k :. k) (concat xs)
+ where k = length xs
+
+fromAdjMatrix :: Graph U -> [[Int]]
+fromAdjMatrix m = chunk k (toList m)
+ where
+ (Z :. _ :. k) = extent m
+
+chunk :: Int -> [a] -> [[a]]
+chunk _ [] = []
+chunk n xs = as : chunk n bs
+ where (as,bs) = splitAt n xs
+
+main :: IO ()
+main = do
+ [n] <- fmap (fmap read) getArgs
+ let g = fromListUnboxed (Z:.n:.n) [1..n^(2::Int)] :: Graph U
+ print (sumAllS (shortestPaths g))
+
View
33 parconc-examples.cabal
@@ -201,6 +201,39 @@ executable timetable3
default-language: Haskell2010
-- -----------------------------------------------------------------------------
+-- par-repa
+
+executable fwdense
+ main-is: fwdense.hs
+ build-depends: base >= 4.5 && < 4.7
+ , repa == 3.2.*
+ ghc-options: -O2 -fllvm
+ default-language: Haskell2010
+
+executable fwdense1
+ main-is: fwdense1.hs
+ build-depends: base >= 4.5 && < 4.7
+ , repa == 3.2.*
+ , transformers ==0.3.*
+ ghc-options: -O2 -fllvm
+ default-language: Haskell2010
+
+-- Disable the image-maniputation programs by default, because they
+-- require the devil library which needs to be installed separately.
+flag devil
+ default: False
+
+executable rotateimage
+ main-is: rotateimage.hs
+ build-depends: base >= 4.5 && < 4.7
+ , repa == 3.2.*
+ , repa-devil == 0.3.*
+ ghc-options: -O2 -fllvm
+ if !flag(devil)
+ buildable: False
+ default-language: Haskell2010
+
+-- -----------------------------------------------------------------------------
-- conc-fork
executable fork
View
45 rotateimage.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE FlexibleContexts, BangPatterns #-}
+
+import Data.Array.Repa
+import Data.Array.Repa.IO.DevIL
+import System.Environment
+import Data.Array.Repa.Repr.ForeignPtr
+import Data.Word
+
+-- <<main
+main :: IO ()
+main = do
+ [n, f1,f2] <- getArgs
+ runIL $ do
+ (RGB v) <- readImage f1
+ rotated <- computeP $ rotate (read n) v :: IL (Array F DIM3 Word8)
+ writeImage f2 (RGB rotated)
+-- >>
+
+-- <<rotate
+rotate :: Double -> Array F DIM3 Word8 -> Array D DIM3 Word8
+rotate deg g = fromFunction (Z :. y :. x :. k) f
+ where
+ sh@(Z :. y :. x :. k) = extent g
+
+ !theta = pi/180 * deg
+
+ !st = sin theta
+ !ct = cos theta
+
+ !fy2 = fromIntegral y / 2 :: Double
+ !fx2 = fromIntegral x / 2 :: Double
+
+ f (Z :. i :. j :. k)
+ | inShape sh new = g ! new
+ | otherwise = 0 -- black
+ where
+ new = Z :. i' :. j' :. k
+
+ fi = fromIntegral i - fy2
+ fj = fromIntegral j - fx2
+
+ i' = round (st * fj + ct * fi + fy2)
+ j' = round (ct * fj - st * fi + fx2)
+-- >>
+
Please sign in to comment.
Something went wrong with that request. Please try again.