{-# OPTIONS_GHC -Wall #-}
import Data.Array
import Data.List
import Data.Tree
import Data.Maybe
 
input :: [String]
input =
  [ "  GYRR"
  , "RYYGYG"
  , "GYGYRR"
  , "RYGYRG"
  , "YGYRYG"
  , "GYRYRG"
  , "YGYRYR"
  , "YGYRYR"
  , "YRRGRG"
  , "RYGYGG"
  , "GRYGYR"
  , "GRYGYR"
  , "GRYGYR"
  ]
 
height :: Int
height = length input
 
width :: Int
width = length $ head input
 
type Board = Array Pos Mark
type Mark = Char
type Pos = (Int,Int)            -- (y,x)
 
main :: IO ()
main = mapM_ printBoard $ puyopuyo $ toBoard input
 
printBoard :: Board -> IO ()
printBoard b = do
  mapM_ print $ fromBoard b
  putStrLn ""
 
toBoard :: [String] -> Board
toBoard [] = error "invalid parameter"
toBoard ss = listArray ((0,0), (height-1,width-1)) $ concat ss
 
fromBoard :: Board -> [String]
fromBoard = groupn width . map snd . assocs
 
positions :: Board -> [Pos]
positions = (map fst) . assocs
 
-- | 次の状態を返す
puyo :: Board -> Board
puyo b = fall $ deleteMark b $ concat $ deletable b []
 
-- | (初期状態から平衡状態までの連続的な)状態のリストを返す
puyopuyo :: Board -> [Board]
puyopuyo b = if b == puyo b
  then []
  else (b : puyopuyo (puyo b))
 
-- | 4つ以上同色で連なっているものの座標を返す
deletable :: Board -> [Pos] -> [[Pos]]
deletable b passed = filter ((>=4).length) $ map flatten $ catMaybes $ deletable' b passed  $ positions b
  where
    deletable' :: Board -> [Pos] -> [Pos] -> [Maybe (Tree Pos)]
    deletable' _ _ [] = []
    deletable' b' passed' (p':ps') = (connectTree b' passed' p') : (deletable' b' (p':passed') ps')
 
deleteMark :: Board -> [Pos] -> Board
deleteMark board ps = board // [(p,' ')|p<-ps]
 
-- | 落下(' 'を下に詰める)した状態を返す
fall :: Board -> Board
fall = toBoard . transpose . paddingFront width "      " . map (paddingFrontSpace height . deleteSpace) . transpose . fromBoard
  where
    deleteSpace = filter (/=' ')
 
-- | リストを定数個ごとに分割する
groupn :: Int -> [a] -> [[a]]
groupn _ [] = []
groupn n xs =
  let (xs1, xs2) = splitAt n xs
  in xs1 : groupn n xs2
 
-- | 文字列の先頭に" "を詰めて指定文字数のの文字列を返す
paddingFrontSpace :: Int -> String -> String
paddingFrontSpace n = paddingFront n ' '
 
-- | リストの先頭に指定した要素を詰めて、指定の数の要素数のリストを返す
paddingFront :: Int -> a ->[a] -> [a]
paddingFront n pad = reverse . take n . (++ (cycle [pad])) . reverse
 
-- | となり合った座標を返す
neigbors :: Pos -> [Pos]
neigbors (y,x) = [(y',x')|(x',y') <- [(x+1,y),(x-1,y),(x,y+1),(x,y-1)], 0 <= x', x' < width, 0 <= y', y' < height]
 
-- | 指定した座標のとなりで同色の座標リストを返す
connects :: Board -> Pos -> [Pos]
connects b p = (sameColors b p) `intersect` (neigbors p)
 
sameColors :: Board -> Pos -> [Pos]
sameColors b p = map fst $ filter (\(_,m) -> (m /= ' ') && (m == (b!p))) $ assocs b
 
-- | 繋がったマークのPosリストをツリーにして返す(一度通ったところは除外する)
-- >>> connectTree a [] (1,1)
-- Just (Node {rootLabel = (1,1), subForest = [Node {rootLabel = (1,2), subForest = []},Node {rootLabel = (2,1), subForest = [Node {rootLabel = (3,1), subForest = []}]}]})
connectTree :: Board -> [Pos] -> Pos -> Maybe (Tree Pos)
connectTree b passed p = if p `elem` passed
  then Nothing
  else Just $ Node p $ subTs $ connects b p
  where
    subTs :: [Pos] -> [Tree Pos]
    subTs = catMaybes . map (connectTree b (p:passed))
 

ey0jIE9QVElPTlNfR0hDIC1XYWxsICMtfQppbXBvcnQgRGF0YS5BcnJheQppbXBvcnQgRGF0YS5MaXN0CmltcG9ydCBEYXRhLlRyZWUKaW1wb3J0IERhdGEuTWF5YmUKCmlucHV0IDo6IFtTdHJpbmddCmlucHV0ID0KICBbICIgIEdZUlIiCiAgLCAiUllZR1lHIgogICwgIkdZR1lSUiIKICAsICJSWUdZUkciCiAgLCAiWUdZUllHIgogICwgIkdZUllSRyIKICAsICJZR1lSWVIiCiAgLCAiWUdZUllSIgogICwgIllSUkdSRyIKICAsICJSWUdZR0ciCiAgLCAiR1JZR1lSIgogICwgIkdSWUdZUiIKICAsICJHUllHWVIiCiAgXQoKaGVpZ2h0IDo6IEludApoZWlnaHQgPSBsZW5ndGggaW5wdXQKCndpZHRoIDo6IEludAp3aWR0aCA9IGxlbmd0aCAkIGhlYWQgaW5wdXQKCnR5cGUgQm9hcmQgPSBBcnJheSBQb3MgTWFyawp0eXBlIE1hcmsgPSBDaGFyCnR5cGUgUG9zID0gKEludCxJbnQpICAgICAgICAgICAgLS0gKHkseCkKCm1haW4gOjogSU8gKCkKbWFpbiA9IG1hcE1fIHByaW50Qm9hcmQgJCBwdXlvcHV5byAkIHRvQm9hcmQgaW5wdXQKCnByaW50Qm9hcmQgOjogQm9hcmQgLT4gSU8gKCkKcHJpbnRCb2FyZCBiID0gZG8KICBtYXBNXyBwcmludCAkIGZyb21Cb2FyZCBiCiAgcHV0U3RyTG4gIiIKCnRvQm9hcmQgOjogW1N0cmluZ10gLT4gQm9hcmQKdG9Cb2FyZCBbXSA9IGVycm9yICJpbnZhbGlkIHBhcmFtZXRlciIKdG9Cb2FyZCBzcyA9IGxpc3RBcnJheSAoKDAsMCksIChoZWlnaHQtMSx3aWR0aC0xKSkgJCBjb25jYXQgc3MKCmZyb21Cb2FyZCA6OiBCb2FyZCAtPiBbU3RyaW5nXQpmcm9tQm9hcmQgPSBncm91cG4gd2lkdGggLiBtYXAgc25kIC4gYXNzb2NzCgpwb3NpdGlvbnMgOjogQm9hcmQgLT4gW1Bvc10KcG9zaXRpb25zID0gKG1hcCBmc3QpIC4gYXNzb2NzCgotLSB8IOasoeOBrueKtuaFi+OCkui/lOOBmQpwdXlvIDo6IEJvYXJkIC0+IEJvYXJkCnB1eW8gYiA9IGZhbGwgJCBkZWxldGVNYXJrIGIgJCBjb25jYXQgJCBkZWxldGFibGUgYiBbXQoKLS0gfCAo5Yid5pyf54q25oWL44GL44KJ5bmz6KGh54q25oWL44G+44Gn44Gu6YCj57aa55qE44GqKeeKtuaFi+OBruODquOCueODiOOCkui/lOOBmQpwdXlvcHV5byA6OiBCb2FyZCAtPiBbQm9hcmRdCnB1eW9wdXlvIGIgPSBpZiBiID09IHB1eW8gYgogIHRoZW4gW10KICBlbHNlIChiIDogcHV5b3B1eW8gKHB1eW8gYikpCgotLSB8IDTjgaTku6XkuIrlkIzoibLjgafpgKPjgarjgaPjgabjgYTjgovjgoLjga7jga7luqfmqJnjgpLov5TjgZkKZGVsZXRhYmxlIDo6IEJvYXJkIC0+IFtQb3NdIC0+IFtbUG9zXV0KZGVsZXRhYmxlIGIgcGFzc2VkID0gZmlsdGVyICgoPj00KS5sZW5ndGgpICQgbWFwIGZsYXR0ZW4gJCBjYXRNYXliZXMgJCBkZWxldGFibGUnIGIgcGFzc2VkICAkIHBvc2l0aW9ucyBiCiAgd2hlcmUKICAgIGRlbGV0YWJsZScgOjogQm9hcmQgLT4gW1Bvc10gLT4gW1Bvc10gLT4gW01heWJlIChUcmVlIFBvcyldCiAgICBkZWxldGFibGUnIF8gXyBbXSA9IFtdCiAgICBkZWxldGFibGUnIGInIHBhc3NlZCcgKHAnOnBzJykgPSAoY29ubmVjdFRyZWUgYicgcGFzc2VkJyBwJykgOiAoZGVsZXRhYmxlJyBiJyAocCc6cGFzc2VkJykgcHMnKQoKZGVsZXRlTWFyayA6OiBCb2FyZCAtPiBbUG9zXSAtPiBCb2FyZApkZWxldGVNYXJrIGJvYXJkIHBzID0gYm9hcmQgLy8gWyhwLCcgJyl8cDwtcHNdCgotLSB8IOiQveS4iygnICfjgpLkuIvjgavoqbDjgoHjgosp44GX44Gf54q25oWL44KS6L+U44GZCmZhbGwgOjogQm9hcmQgLT4gQm9hcmQKZmFsbCA9IHRvQm9hcmQgLiB0cmFuc3Bvc2UgLiBwYWRkaW5nRnJvbnQgd2lkdGggIiAgICAgICIgLiBtYXAgKHBhZGRpbmdGcm9udFNwYWNlIGhlaWdodCAuIGRlbGV0ZVNwYWNlKSAuIHRyYW5zcG9zZSAuIGZyb21Cb2FyZAogIHdoZXJlCiAgICBkZWxldGVTcGFjZSA9IGZpbHRlciAoLz0nICcpCgotLSB8IOODquOCueODiOOCkuWumuaVsOWAi+OBlOOBqOOBq+WIhuWJsuOBmeOCiwpncm91cG4gOjogSW50IC0+IFthXSAtPiBbW2FdXQpncm91cG4gXyBbXSA9IFtdCmdyb3VwbiBuIHhzID0KICBsZXQgKHhzMSwgeHMyKSA9IHNwbGl0QXQgbiB4cwogIGluIHhzMSA6IGdyb3VwbiBuIHhzMgoKLS0gfCDmloflrZfliJfjga7lhYjpoK3jgasiICLjgpLoqbDjgoHjgabmjIflrprmloflrZfmlbDjga7jga7mloflrZfliJfjgpLov5TjgZkKcGFkZGluZ0Zyb250U3BhY2UgOjogSW50IC0+IFN0cmluZyAtPiBTdHJpbmcKcGFkZGluZ0Zyb250U3BhY2UgbiA9IHBhZGRpbmdGcm9udCBuICcgJwoKLS0gfCDjg6rjgrnjg4jjga7lhYjpoK3jgavmjIflrprjgZfjgZ/opoHntKDjgpLoqbDjgoHjgabjgIHmjIflrprjga7mlbDjga7opoHntKDmlbDjga7jg6rjgrnjg4jjgpLov5TjgZkKcGFkZGluZ0Zyb250IDo6IEludCAtPiBhIC0+W2FdIC0+IFthXQpwYWRkaW5nRnJvbnQgbiBwYWQgPSByZXZlcnNlIC4gdGFrZSBuIC4gKCsrIChjeWNsZSBbcGFkXSkpIC4gcmV2ZXJzZQoKLS0gfCDjgajjgarjgorlkIjjgaPjgZ/luqfmqJnjgpLov5TjgZkKbmVpZ2JvcnMgOjogUG9zIC0+IFtQb3NdCm5laWdib3JzICh5LHgpID0gWyh5Jyx4Jyl8KHgnLHknKSA8LSBbKHgrMSx5KSwoeC0xLHkpLCh4LHkrMSksKHgseS0xKV0sIDAgPD0geCcsIHgnIDwgd2lkdGgsIDAgPD0geScsIHknIDwgaGVpZ2h0XQoKLS0gfCDmjIflrprjgZfjgZ/luqfmqJnjga7jgajjgarjgorjgaflkIzoibLjga7luqfmqJnjg6rjgrnjg4jjgpLov5TjgZkKY29ubmVjdHMgOjogQm9hcmQgLT4gUG9zIC0+IFtQb3NdCmNvbm5lY3RzIGIgcCA9IChzYW1lQ29sb3JzIGIgcCkgYGludGVyc2VjdGAgKG5laWdib3JzIHApCgpzYW1lQ29sb3JzIDo6IEJvYXJkIC0+IFBvcyAtPiBbUG9zXQpzYW1lQ29sb3JzIGIgcCA9IG1hcCBmc3QgJCBmaWx0ZXIgKFwoXyxtKSAtPiAobSAvPSAnICcpICYmIChtID09IChiIXApKSkgJCBhc3NvY3MgYgoKLS0gfCDnuYvjgYzjgaPjgZ/jg57jg7zjgq/jga5Qb3Pjg6rjgrnjg4jjgpLjg4Tjg6rjg7zjgavjgZfjgabov5TjgZko5LiA5bqm6YCa44Gj44Gf44Go44GT44KN44Gv6Zmk5aSW44GZ44KLKQotLSA+Pj4gY29ubmVjdFRyZWUgYSBbXSAoMSwxKQotLSBKdXN0IChOb2RlIHtyb290TGFiZWwgPSAoMSwxKSwgc3ViRm9yZXN0ID0gW05vZGUge3Jvb3RMYWJlbCA9ICgxLDIpLCBzdWJGb3Jlc3QgPSBbXX0sTm9kZSB7cm9vdExhYmVsID0gKDIsMSksIHN1YkZvcmVzdCA9IFtOb2RlIHtyb290TGFiZWwgPSAoMywxKSwgc3ViRm9yZXN0ID0gW119XX1dfSkKY29ubmVjdFRyZWUgOjogQm9hcmQgLT4gW1Bvc10gLT4gUG9zIC0+IE1heWJlIChUcmVlIFBvcykKY29ubmVjdFRyZWUgYiBwYXNzZWQgcCA9IGlmIHAgYGVsZW1gIHBhc3NlZAogIHRoZW4gTm90aGluZwogIGVsc2UgSnVzdCAkIE5vZGUgcCAkIHN1YlRzICQgY29ubmVjdHMgYiBwCiAgd2hlcmUKICAgIHN1YlRzIDo6IFtQb3NdIC0+IFtUcmVlIFBvc10KICAgIHN1YlRzID0gY2F0TWF5YmVzIC4gbWFwIChjb25uZWN0VHJlZSBiIChwOnBhc3NlZCkpCg==