source code
{-
The Computer Language Benchmarks Game
http://benchmarksgame.alioth.debian.org/
contributed by Bertram Felgenhauer
-}
import Data.Word
import Data.Array
import Data.Bits
import System.Environment
pieces = [
[(0,0),(0,1),(0,2),(0,3),(1,3)],
[(0,0),(0,2),(0,3),(1,0),(1,1)],
[(0,0),(0,1),(0,2),(1,2),(2,1)],
[(0,0),(0,1),(0,2),(1,1),(2,1)],
[(0,0),(0,2),(1,0),(1,1),(2,1)],
[(0,0),(0,1),(0,2),(1,1),(1,2)],
[(0,0),(0,1),(1,1),(1,2),(2,1)],
[(0,0),(0,1),(0,2),(1,0),(1,2)],
[(0,0),(0,1),(0,2),(1,2),(1,3)],
[(0,0),(0,1),(0,2),(0,3),(1,2)]]
transform p =
[ map (\(y,x) -> (y-dy,x-dx)) p''
| p' <- take 6 (iterate (map (\(y,x) -> (x+y,-y))) p),
p'' <- take 2 (iterate (map (\(y,x) -> (x,y))) p'),
let (dy,dx) = minimum p'']
pieceMasks = listArray (0,9) (map (pieceMasks' . transform) pieces) where
pieceMasks' ps = listArray (0,9) [pieceMasks'' ps (y,x) | y <- [0,1], x <- [0..4]]
pieceMasks'' ps pos = [m | p <- ps, m <- mask 0 pos p]
mask m (dy,dx) [] = [m]
mask m (dy,dx) ((y,x):ps)
| x' < 0 || x' > 4 = []
| True = mask (m .|. shiftL 1 ((dy+y)*5+x')) (dy,dx) ps
where x' = x + dx + div (y+dy) 2
search m 50 p ps = [ps]
search m i p ps | (m .&. shiftL 1 i) > 0 = search m (i+1) p ps
search m i p ps = let (q,r) = divMod i 10 in
[ ps'
| p' <- [0..9], p .&. shiftL 1 p' == 0,
mask <- pieceMasks ! p' ! r,
let mask' = shiftL mask (10*q),
m .&. mask' == 0,
ps' <- search (m .|. mask') (i+1) (p .|. shiftL 1 p') ((p',mask'):ps)]
rows ps = [[i | x <- [0..4], (i,m) <- ps, shiftL 1 (y*5+x) .&. m /= 0] | y <- [0..9]]
main = do
n <- readIO . head =<< getArgs
let sols = map rows (take n (search (-shiftL 1 50 :: Word64) 0 (0 :: Word) []))
putStrLn (show (length sols) ++ " solutions found\n")
mapM (putStrLn . unlines . (zipWith (++) (cycle [""," "]))
. map ((++ " ") . unwords . map show)) [minimum sols,maximum sols]