日々の破片
| 著作一覧 |
2010-05-28
_ Haskellは難しいな
Software Designの関数型のやつを書くので、Haskellを復習したわけだ。
Software Design (ソフトウェア デザイン) 2010年 06月号 [雑誌](-)
ある程度のサイズ（20行を越えるようなやつ）を書いてみようかと、とりあえず適当な題材を考えて、プログラム・プロムナードの最大長方形の面積でも作ってみようとした。というか、Haskellでの解答が出ているはずなのでHaskellプログラミングのほうをやってみるつもりで、間違えて先頭にあったのでプログラミング・プロムナードのほうをやってしまったのだが。
最初の難関は升目の内容をプログラムに取り込むところで、ここに全体の時間の半分近くを費やすことになるとは思いもよらなかった。今も、変な入力に対してどうすれば良いのかわかっていない。
次が、Arrayの存在を知らなくて、いかにリストでやるかで一度ストールした。結果的に元の問題のn(O^2)と同じような方法になっているのだが、現在の枡がx、yとすると、x-1,yとx,y-1の枡の内容を合成することになる。これが1つだけならば、直前の枡の内容から現在の枡の内容を返す関数とすれば良いと思うのだが、同時に2つ過去の内容を扱うというのがリストだと（僕には）できなかった。おそらくそういう利用方法が可能なモナドがあるのだろうけど、なんとなくやさしい Haskell 入門だけを眺めて作ろうしたのでそんな感じだ。
で、一応できた。現在の枡をx,yとすると、x-1,yとx,y-1の枡で作れる長方形から、xまたはyが一致しているか、または両方の枡に同一の始点が存在する長方形を抜き出し、現在の枡までの長方形を現在の枡に格納するという方法を取った。Arrayのインデックスにタプルが使えることがわかったので、(x,y)をインデックスとして、枡の始点を(1,1)としている。-1するときに考えなくても良いように、Arrayの始点は(0,0)に置いている。
こんな感じ。
import IO
import Array
rList :: String -> IO [Int]
rList = readIO
rLine :: IO [Int]
rLine = do
lis <- getLine
rList $ "[" ++ lis ++ "]"
data Area = Area Int Int Int Int
deriving (Eq, Show)
showArea :: [Area] -> IO ()
showArea [] = putStrLn ""
showArea (x:xs) = do
putStrLn $ show x
showArea xs
areaX :: Area -> Int
areaX (Area x _ _ _) = x
areaY :: Area -> Int
areaY (Area _ y _ _) = y
areaSize :: Area -> Int
areaSize (Area _ _ w h) = w * h
samePos :: Int -> Int -> Area -> Bool
samePos x y a = x == (areaX a) && y == (areaY a)
checkArea :: Int -> Int -> [Area] -> [Area]
checkArea _ _ [] = []
checkArea x y (a:as) = case a of
(Area sx sy _ _)|sx == x || sy == y -> a:(checkArea x y as)
|otherwise -> (filter (samePos sx sy) as) ++ (checkArea x y as)
calcArea :: Int -> Int -> [Area] -> [Area]
calcArea _ _ [] = []
calcArea x y (a:as) = Area sx sy w h : calcArea x y as
where
sx = areaX a
sy = areaY a
w = x - sx + 1
h = y - sy + 1
accumArea :: Point -> Array (Int, Int) [Area] -> Array (Int, Int) [Area]
accumArea p a = if validPoint p
then
a // [((x, y),
Area x y 1 1 :
calcArea x y (checkArea x y ((a ! (x - 1, y)) ++ (a ! (x, y - 1)))))]
else
a
where
x = pointX p
y = pointY p
accumAreas :: [Point] -> Array (Int, Int) [Area] -> Array (Int, Int) [Area]
accumAreas [] a = a
accumAreas (p:ps) a = accumAreas ps (accumArea p a)
cmpArea :: Area -> [Area] -> Area
cmpArea a0 [] = a0
cmpArea a0 (a:as) = if (areaSize a0) >= (areaSize a)
then cmpArea a0 as
else cmpArea a as
maxArea :: [Area] -> Area
maxArea [] = Area 0 0 0 0
maxArea (a:[]) = a
maxArea (a:as) = cmpArea a as
validArea :: Area -> Bool
validArea (Area _ _ w _) = w > 0
maxAreas :: Array (Int, Int) [Area] -> [Area]
maxAreas a = [maxArea (filter validArea [ maxArea es | es <- (elems a)])]
data Point = Point Int Int Int
deriving (Show)
pointX :: Point -> Int
pointX (Point x _ _) = x
pointY :: Point -> Int
pointY (Point _ y _) = y
validPoint :: Point -> Bool
validPoint (Point _ _ v) = v == 1
mkpnt :: [Int] -> [Int] -> [Int] -> [Point]
mkpnt [] _ _ = []
mkpnt _ [] _ = []
mkpnt _ _ [] = []
mkpnt (x:xs) (y:ys) (v:vs) = Point x y v : (mkpnt xs ys vs)
rsqr :: Int -> Int -> IO [Point]
rsqr n m = if n > m
then return []
else do
putStrLn $ "input line " ++ (show n) ++ "..."
lis <- rLine
llis <- rsqr (succ n) m
return $ (mkpnt [1..] (repeat n) lis) ++ llis
rSquare :: Int -> IO [Point]
rSquare 0 = return []
rSquare n = rsqr 1 n
main :: IO ()
main = do
let size = 5
let a = array ((0, 0), (size,size)) [((x, y), [])| x <- [0..size], y <- [0..size]]
lis <- rSquare size
showArea (maxAreas $ accumAreas lis a)
一応、考えた通りに動作する。同じ大きさの長方形が複数存在するときは、始点が一番小さいものを選ぶようにしている。複数選ぶようにもできるが、とりあえずそういう仕様とした。
*Main> main input line 1... 0,0,1,1,0 input line 2... 0,1,1,1,0 input line 3... 0,1,1,0,1 input line 4... 0,1,1,1,0 input line 5... 0,0,1,1,0 Area 2 2 2 3 ← (2,2)から横2、縦3の6枡が最大 *Main> main input line 1... 0,0,0,1,1 input line 2... 0,1,1,0,1 input line 3... 0,0,1,1,0 input line 4... 0,0,1,1,0 input line 5... 1,1,1,1,1 Area 3 3 2 3 ← (3,3)から横2、縦3の6枡が最大
が、できたプログラムを見ると、いろいろと気に食わない。入力時の情報をPointというデータとし、実際の長方形はAreaというデータにしているが、こんなものは最初からAreaとしておけば良いというのは、完成してすぐに気づいた（長方形をどう残すかの試行錯誤の過程でAreaというデータが生まれたからだ）。
もっと気に食わないのは、現在の升目の位置をほぼすべての関数の第1、第2引数にしているところで、考えてみれば、現在のPointを与えればそこに入っているし、最初の気に食わない点と合わせれば最初から現在の升目に必ずある幅1、高さ1のAreaを与えれば良いはずだ。
で、以下のように修正した。（後、このようにすれば、最初から無効な升目は処理しなくても済むというのも考えた）
import IO
import Array
import Debug.Trace
rList :: String -> IO [Int]
rList = readIO
rLine :: IO [Int]
rLine = do
lis <- getLine
rList $ "[" ++ lis ++ "]"
data Area = Area Int Int Int Int
deriving (Eq, Show)
showArea :: [Area] -> IO ()
showArea [] = putStrLn ""
showArea (x:xs) = do
putStrLn $ show x
showArea xs
areaX :: Area -> Int
areaX (Area x _ _ _) = x
areaY :: Area -> Int
areaY (Area _ y _ _) = y
areaSize :: Area -> Int
areaSize (Area _ _ w h) = w * h
samePos :: Area -> Area -> Bool
samePos (Area x0 y0 _ _) (Area x1 y1 _ _) = x0 == x1 && y0 == y1
checkArea :: Area -> [Area] -> [Area]
checkArea _ [] = []
checkArea a0 (ar:as) = if samePos a0 ar
then ar:(checkArea a0 as)
else (filter (samePos ar) as) ++ (checkArea a0 as)
calcArea :: Area -> [Area] -> [Area]
calcArea _ [] = []
calcArea a0 (ar:as) = Area sx sy w h : calcArea a0 as
where
sx = areaX ar
sy = areaY ar
w = areaX a0 - sx + 1
h = areaY a0 - sy + 1
accumArea :: Area -> Array (Int, Int) [Area] -> Array (Int, Int) [Area]
accumArea ar a = a // [((x, y),
ar :
calcArea ar (checkArea ar ((a ! (x - 1, y)) ++ (a ! (x, y - 1)))))]
where
x = areaX ar
y = areaY ar
accumAreas :: [Area] -> Array (Int, Int) [Area] -> Array (Int, Int) [Area]
accumAreas [] a = a
accumAreas (ar:as) a = accumAreas as (accumArea ar a)
--accumAreas (ar:as) a = accumAreas (trace (show as) as) (accumArea (trace (show ar) ar) a)
compArea :: Area -> [Area] -> Area
compArea a0 [] = a0
compArea a0 (a:as) = if (areaSize a0) >= (areaSize a)
then compArea a0 as
else compArea a as
maxArea :: [Area] -> Area
maxArea [] = Area 0 0 0 0
maxArea (ar:[]) = ar
maxArea (ar:as) = compArea ar as
maxAreas :: Array (Int, Int) [Area] -> [Area]
maxAreas a = [maxArea [ maxArea es | es <- (elems a)]]
makeArea :: [Int] -> [Int] -> [Int] -> [Area]
makeArea [] _ _ = []
makeArea _ [] _ = []
makeArea _ _ [] = []
makeArea (_:xs) (_:ys) (0:vs) = makeArea xs ys vs
makeArea (x:xs) (y:ys) (_:vs) = Area x y 1 1 : makeArea xs ys vs
readSquare :: Int -> IO [Area]
readSquare 0 = return []
readSquare size = rsqr 1 size
where
rsqr :: Int -> Int -> IO [Area]
rsqr n m = if n > m
then return []
else do
putStrLn $ "input line " ++ (show n) ++ "..."
lis <- rLine
llis <- rsqr (succ n) m
return $ (makeArea [1..] (repeat n) lis) ++ llis
setArea :: [Area] -> Array (Int, Int) [Area] -> Array (Int, Int) [Area]
setArea [] a = a
setArea (ar:as) a = setArea as (a // [((areaX ar, areaY ar), [ar])])
main :: IO ()
main = do
let size = 5
let a = array ((0, 0), (size,size)) [((x, y), [])| x <- [0..size], y <- [0..size]]
lis <- readSquare size
showArea (maxAreas $ accumAreas lis (setArea lis a))
自分としては、最初のプログラムの気に食わない点を直しただけで、それ以外を変えたつもりは無いのだが、こちらは期待した通りには動かない。
*Main> main input line 1... 0,0,1,1,1 input line 2... 0,0,1,1,1 input line 3... 0,0,1,1,0 input line 4... 0,0,0,0,0 input line 5... 0,0,0,1,1 Area 3 1 1 1 ← Area 3 1 2 3 となって欲しい
というか、最初にArrayを知らなくてリストで回そうとしたときと同じ状態である。つまり、意図した順番に処理がされていないということだ（と思うけど、もちろんそれ以外に大きな間違いがある可能性は高い）。
いずれにしても、こういうときには何がどうなっているのかprintfしてみたいなぁと困って調べたら、池上さんのHaskell printfデバッグのページが見つかったので、上のリストではコメントアウトしているが、入れてみたら案の定だ。比べてみると同じ箇所で最初のプログラムとは逆順にprintfされている。
ここで気づくのだが、「意図した順番」というのが出てきた時点で、作り方を間違えているのではないかということだ。最初のプログラムが期待通りに動くのは偶然なのではないか（それはそうだと思う。というのは、2番目のプログラムと同じつもりなのだから）？
というわけで、なかなか難しいものであるなぁと思った。それにしても、どこが間違っているんだろう？
ジェズイットを見習え |