```
import Data.List (span)
main = mapM_ (putStrLn . draw) . take 20 . iterate step . initialize $ dat
where draw = map (\n -> if n == 0 then ' ' else '■')
dat = [1,2,3,7,8,12,13,18]
initialize :: [Int] -> [Int]
initialize = ini [] (-1)
where ini acc _ [] = reverse acc
ini acc prev (x:xs) = ini (make (x-prev)++acc) x xs
make n = (1:) . take (n-1) . repeat $ 0
step ns = step' [] ns
where step' acc [] = reverse acc
step' acc (x:xs) = case x of
0 -> step' (0:acc) xs
2 -> step' (1:acc) xs
1 -> step' (0:acc) $ balls ++ (2:drop 1 boxes)
where (balls,boxes) = span (/= 0) xs
```

実行結果

```
■■■ ■■ ■■ ■
■■■ ■■ ■■ ■
■■ ■■■ ■■ ■
■■ ■■ ■■ ■■
■■ ■■ ■ ■■■
■■ ■■ ■ ■■■
■■ ■ ■■ ■■■
■■ ■ ■■ ■■■
■■ ■ ■■ ■■■
■ ■■ ■■ ■■■
■ ■■ ■■ ■■■
■ ■■ ■■ ■■■
■ ■■ ■■ ■■■
■ ■■ ■■ ■■■
■ ■■ ■■ ■■■
■ ■■ ■■ ■■■
■ ■■ ■■ ■■■
■ ■■ ■■ ■■■
■ ■■ ■■ ■■■
■ ■■ ■■ ■■■
```