Data.Array.Accelerate and Katy Perry

So what if you want to take the lovely Katy Perry, and use your graphics card to melt her lovely face? Well you could write some crazy C/CUDA code to mash memory around, or some PyCUDA which is just Python with the C code as strings.

But you don't want to do that. You'd rather fight Haskell's typechecker and end up with some magic EDSL code that does what you want in a lovely functional way.

Without further ado:

(Compile with $ghc -threaded -main-is Katy)

	module Katy where
	import Prelude hiding (map)
	import Data.Array.Accelerate hiding ((++),round,fromIntegral,tail)
	import Data.Array.Accelerate.IO
	import Data.Array.Accelerate.CUDA
	import Control.Monad
	type RGBA = Word32
	type Image a = Array DIM2 a
	frames = 100 :: Int
	ts :: Int -> [Exp Double]
	ts f = [constant ((fromInteger $ round $ x * (10^n)) / k)|x<-[0,1/k..1]]
	where
	k = (10.0^^n)
	n = round . logBase 10 $ fromIntegral f
	main = do
	initial_condition <- liftM make_init $ readImageFromBMP "katy.bmp"
	mapM (process initial_condition) (ts frames)
	print "All done!"
	make_init (Right x) = x
	process init t = do
	final_state <- return $ (run.advance t.use) init
	writeImageToBMP ("lol" ++ label ++ ".bmp") $ final_state
	where label = tail (show
	(fromIntegral frames + (t*fromIntegral frames)))
	advance :: Exp Double -> Acc (Image RGBA) -> Acc (Image RGBA)
	advance t = map $ magic t
	magic :: Exp Double -> Exp RGBA32 -> Exp RGBA32
	magic t a = rgba32OfLuminance .
	(\x-> x >* t ? (x,constant (0::Double))) $
	(luminanceOfRGBA32 a :: Exp Double)

view raw katy.hs hosted with ❤ by GitHub

(Make the image with $ convert -loop 0 lol* katy.gif)