import Data.Array.IO
import Data.Array.IArray
import System
ini ::Int->Int->Int->IO (IOArray (Int,Int) Flea)
ini s x y= do
a <- newArray ((1,1),(s,s)) 
writeArray a (x,y) 1
return a
type Flea = Double
addArray ::IOArray (Int,Int) Flea -> (Int,Int) -> Flea -> IO()
addArray m i e = do
v <- readArray m i
writeArray m i (e+v)
jump ::Int->IOArray (Int,Int) Flea -> IO (IOArray (Int,Int) Flea)
jump s b = do
b' <- newArray ((1,1),(s,s)) ::IO (IOArray (Int,Int) Flea)
getAssocs b >>= foldl1 (>>) .map (uncurry $ addArray b') .concatMap j
return b'
where
move (i,j) =filter (inRange ((1,1),(s,s))) [(i+1,j),(i,j+1),(i-1,j),(i,j-1)]
area =  fromIntegral.length.move
j (_,) =[]
j (ix,f) = [((i',j'),f/(area ix))|(i',j')<-move ix]
jumpFlea s n (i,j) =getElems=<<(foldl (>>=) (ini s i j) .take n .repeat$jump s)
p213 s n= do
fs <- mapM (jumpFlea s n)[(i,j)|i<-[1..s],j<-[1..s]]
print.sum.foldl (zipWith (*)) [1,1..] . map (map (1-)) $ fs
main = do
(s:n:_)<-getArgs
p213 (read s) (read n)

普通に作ったらメモリが足りなくて死んだ。

ちょっと変えたらよく分からないが、動くようになった。これだから関数型言語は。