quick resize algorithm for use with juicypixels -- made for auto-thumbnailing for web pages, so caches results. should generalize to affine transforms, it's pretty close...

thumb.hs

import Prelude
import Codec.Picture -- http://hackage.haskell.org/package/JuicyPixels
import Data.Ratio
import Control.Arrow
import Control.Monad
import Control.Applicative
import System.FilePath
import System.Directory

tn :: Int -> FilePath -> IO FilePath
tn h inF = (flip unless (createDirectoryIfMissing True d >> go inF outF h) =<< doesFileExist outF) >> return outF
    where (base,ext) = splitExtension fn
          (dir, fn) = splitFileName inF
          outF = d </> base <.> (show h) ++ "tn" <.> ext
          d = dir </> "tn"

go :: FilePath -> FilePath -> Int -> IO ()
go inF outF h = either error f =<< readImage inF
    where f (ImageRGB8 i) = if fact < 1 
                                then do putStrLn $ "making " ++ outF
                                        savePngImage outF . ImageRGB8 $ resize fact i   
                                else error "only shrinks"
                            where fact = h % (imageHeight i)
          f _             = error "only does ImageRGB8"          

--i hate that this is png/PixelRGB8 specific, but see https://github.com/Twinside/Juicy.Pixels/issues/1
--resize :: (RealFrac a, Pixel b) => a -> Image b -> Image b
resize :: (RealFrac a) => a -> Image PixelRGB8 -> Image PixelRGB8
resize fact i = uncurry (generateImage f) new
    where f = curry $ (pixelAt' old (round $ 1/fact) i) . (uncurry (***) $ (join (***) tmp) (fst,snd))
          old = (imageWidth &&& imageHeight) i
          new = (join (***) $ scale fact) old
          scale r = round . (* (toRational r)) . toRational
          tmp s = scale (s old) . (% (s new))

-- pretty slow, should use repa or something
pixelAt' :: (Int, Int) -> Int -> Image PixelRGB8 -> (Int, Int) -> PixelRGB8
pixelAt' (dw,dh) s i (x,y) = avg pix
    where inds n d = [a | a <- (+ n) <$> [0..s], all id ([(>= 0), (< d)] <*> [a])]
          pix = (uncurry $ pixelAt i) <$> [(x',y') | x' <- inds x dw, y' <- inds y dh]
          avg p = (foldl pp (0,0,0) p) `pd` (length p)
          pp (r, g, b) (PixelRGB8 r' g' b') = (pf r r', pf g g', pf b b')
          pf a = (+ a) . fromIntegral
          pd (r, g, b) d = PixelRGB8 (pr r d) (pr g d) (pr b d)
          pr a b = round (a % b)

{-
-- inspired by mzero
resize' fact (x,y) (npx,npy) = ((nx, ny), (px, py))
    where (nx, px) = r x npx
          (ny, py) = r y npy
          r d p = (join (***) round) (fact*d, p/fact)
-}

Hello,
I am relatively new to haskell and try to fully understand your code from above. Could you be so kind and write a few comments for further explanation?
Thanks in advance!
Greetings from Munich.

er, which part :) the currying and arrow crap is just trying to be pointfree and trying to DRY the fact that you're doing the same thing along the two dimensions of the tuple (would really like a way to similarly DRY the fact that you're doing the same thing in each RGB channel). pixelAt' uses those comprehensions to just slide a window all over the place calculating average value per channel within the window. it's so slow cuz that's a lot of redundant calculation (think of the window one pixel over -- almost all the values are the same) -- i'm sure there's some way to do this in fourier space or something that would eliminate that redundancy... if that doesn't address your question, please further specify... ;)