Help us understand the problem. What is going on with this article?

# 第13回オフラインリアルタイムどう書くの問題をFregeで解く

More than 5 years have passed since last update.

shortest.fr
```-- http://nabetani.sakura.ne.jp/hena/ord13blocktup/

data Cell = Wall | Empty | Water
derive Eq Cell -- Haskellのdata Cell = ... deriving(Eq)

-- セルを表示する
instance Show Cell where
show Wall = "*"
show Empty = " "
show Water = "+"

-- 盤面を表示する
data Matrix = Matrix [ [ Cell ] ] Int Int
derive Eq Matrix
instance Show Matrix where
show (Matrix xs w h) = "w="++show w++",h="++show h++"\n"++ unlines (map showLine xs)
where
showLine :: [Cell] -> String
showLine line = "[" ++ foldl (++) "" (map show line) ++ "]"

-- 盤面を生成する
toMatrix :: String -> Matrix
toMatrix str =
let maxx = length str
maxy = maximum \$ map (\ch -> ord ch - ord '0') (unpacked str)
makeLine n maxn = replicate n Wall ++ replicate (maxn-n) Empty
in Matrix (map (\ch -> makeLine (ord ch - ord '0') maxy) (unpacked str)) maxx maxy

-- 指定した座標(xPos,yPos)のセル内容を取得する
getCell :: Matrix -> Int -> Int -> Cell
getCell (Matrix mat w h) xPos yPos
| (0 <= xPos) && ( xPos < w ) && (0 <= yPos) && (yPos < h) = mat !! xPos !! yPos
| otherwise = Empty

-- Matrix型の盤面の指定した座標(xPos,yPos)にセル内容cを設定する
setCell:: Matrix -> Int -> Int -> Cell -> Matrix
setCell (Matrix mat w h) xPos yPos c
| ( xPos < w ) && (yPos < h) = Matrix (setCell' mat xPos yPos c) w h

-- [[Cell]]型の盤面の指定した座標(xPos,yPos)にセル内容cを設定する
setCell' :: [[Cell]] -> Int -> Int -> Cell -> [[Cell]]
setCell' (x:xs) xPos yPos c
| xPos == 0 = setCellY x yPos c : xs
| otherwise = x:setCell' xs (xPos-1) yPos c

-- Cellの列の指定した座標(yPos)にセル内容cを設定する
setCellY :: [Cell] -> Int -> Cell -> [Cell]
setCellY (x:xs) yPos c
| yPos == 0 = c:xs
| otherwise = x:setCellY xs (yPos-1) c

-- 以下のtmpは、以下が通らなかったための苦肉の策。fregeのバグ?
-- fillWater m0 = foldl (\mat (x,y)-> fillWaterCell mat x y) m0 (cells m0)
tmp:: Matrix -> (Int, Int) -> Matrix
tmp mat (x,y) = fillWaterCell mat x y

-- 盤面に水を満たす
fillWater :: Matrix -> Matrix
fillWater m0 = foldl tmp m0 (cells m0)
where
cells (Matrix _ width height) = do
y <- [0.. height-1]
x <- [0.. width-1]
return (x, y)

fillWaterCell mat x y
| isKeepWater mat x y && getCell mat x y == Empty = setCell mat x y Water
| otherwise = mat

-- 指定した座標x,yは水を保持できるか？
isKeepWater :: Matrix -> Int -> Int -> Bool
isKeepWater mat x y
| hereOK mat x y = true
| leftOK mat x y && bottomOK mat x y && rightThroughOK mat x y = true
| otherwise = false
where
ok x = (x == Wall) || (x == Water)
hereOK mat x y = ok \$ getCell mat x y
leftOK mat x y = ok \$ getCell mat (x-1) y
bottomOK mat x y = ok \$ getCell mat x (y-1)
rightOK mat x y = ok \$ getCell mat (x+1) y
rightThroughOK mat x y
| bottomOK mat x y && rightOK mat x y = true
| bottomOK mat x y && rightThroughOK mat (x+1) y = true
| otherwise = false

-- 水の個数を返す
countAllWater :: Matrix -> Int
countAllWater (Matrix m _ _) = foldr ((+) . countAllWaterY) 0 m
where
countAllWaterY [] = 0
countAllWaterY (Water:xs) = 1 + countAllWaterY xs
countAllWaterY (x:xs) = 0 + countAllWaterY xs

test :: String -> String -> Bool
test dat expected = expected.atoi == (countAllWater \$ fillWater (toMatrix dat))

main :: [String] -> IO ()
main _ = do
println \$ test "83141310145169154671122" "24" {-0-}
println \$ test "923111128" "45" {-1-}
println \$ test "923101128" "1" {-2-}
println \$ test "903111128" "9" {-3-}
println \$ test "3" "0" {-4-}
println \$ test "31" "0" {-5-}
println \$ test "412" "1" {-6-}
println \$ test "3124" "3" {-7-}
println \$ test "11111" "0" {-8-}
println \$ test "222111" "0" {-9-}
println \$ test "335544" "0" {-10-}
println \$ test "1223455321" "0" {-11-}
println \$ test "000" "0" {-12-}
println \$ test "000100020003121" "1" {-13-}
println \$ test "1213141516171819181716151413121" "56" {-14-}
println \$ test "712131415161718191817161514131216" "117" {-15-}
println \$ test "712131405161718191817161514031216" "64" {-16-}
println \$ test "03205301204342100" "1" {-17-}
println \$ test "0912830485711120342" "18" {-18-}
println \$ test "1113241120998943327631001" "20" {-19-}
println \$ test "7688167781598943035023813337019904732" "41" {-20-}
println \$ test "2032075902729233234129146823006063388" "79" {-21-}
println \$ test "8323636570846582397534533" "44" {-22-}
println \$ test "2142555257761672319599209190604843" "41" {-23-}
println \$ test "06424633785085474133925235" "51" {-24-}
println \$ test "503144400846933212134" "21" {-25-}
println \$ test "1204706243676306476295999864" "21" {-26-}
println \$ test "050527640248767717738306306596466224" "29" {-27-}
println \$ test "5926294098216193922825" "65" {-28-}
println \$ test "655589141599534035" "29" {-29-}
println \$ test "7411279689677738" "34" {-30-}
println \$ test "268131111165754619136819109839402" "102" {-31-}
```