日々の破片

_ 5/28の続き

良く良く見たら、改版のほうは単純なバグ（同列、同行の比較をすべきなのに間違えて同一始点か見てた）なので直して、それから意味無く冗長だった箇所を修正。

・readIOの呼び出しに2回クッションがあったけど、なぜそうしたのか今となってはわからないので直接呼び出すように修正。

・最大のやつを求める関数のmaximumByを見つけたので置き換え。

・重複したコードを1つにするとか。

・長すぎる気がしたところを変数に束縛したり。

・concatの使い方を覚えた気がする。

・>>=を使ってみたり。

import IO
import Array
import Data.List(maximumBy)
import Debug.Trace
 
rLine :: IO [Int]
rLine = do
          lis <- getLine
          readIO $ "[" ++ 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
 
samePos :: Area -> Area -> Bool
samePos (Area x0 y0 _ _) (Area x1 y1 _ _) = x0 == x1 && y0 == y1
 
sameLine :: Area -> Area -> Bool
sameLine (Area x0 y0 _ _) (Area x1 y1 _ _) = x0 == x1 || y0 == y1
 
checkArea :: Area -> [Area] -> [Area]
checkArea _ [] = []
checkArea a0 (ar:as) = if sameLine a0 ar
                       then ar:checkA0 as
                       else filter (samePos ar) as ++ checkA0 as
             where checkA0 = checkArea a0                            
 
calcArea :: Area -> [Area] -> [Area]
calcArea _ [] = []
calcArea a0 ((Area sx sy _ _):as) = Area sx sy w h : calcArea a0 as
  where   
    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 list)]
  where   
    x = areaX ar
    y = areaY ar
    list = checkArea ar (a ! (x - 1, y) ++ a ! (x, y - 1))
 
accumAreas :: [Area] -> Array (Int, Int) [Area] -> Array (Int, Int) [Area]
accumAreas [] a = a
accumAreas (ar:as) a = accumAreas as $ accumArea ar a
 
compArea :: Area -> Area -> Ordering
(Area _ _ w0 h0) `compArea` (Area _ _ w1 h1) = (w0 * h0) `compare` (w1 * h1)
 
maxAreas :: Array (Int, Int) [Area] -> [Area]
maxAreas a = [maximumBy compArea $ concat [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 nn =  mapM (rsqr [1..nn]) [1..nn] >>= return . concat
    where
      rsqr :: [Int] -> Int -> IO [Area]
      rsqr sq n = do
        putStrLn $ "input line " ++ (show n) ++ "..."
        rLine >>= return . makeArea sq (repeat n)
        
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

以下の箇所は気に食わない。

makeArea _ _ [] = []
makeArea _ [] _ = []
makeArea [] _ _ = []

makeArea _ _ [] = []はあり得るが、下の2つはあり得ない。しかし省略すると-Wallだと文句を垂れてくる。コンパイラの警告を止めるためだけの無意味なキャストとか嫌いなのだが（だからがちがちのCコンパイラを使うときは警告はわりと気にしない。戻り値を使わない関数呼び出しにいちいち(void)とか書くのは愚の骨頂だろ）、Haskellの場合はどうするんだろう？ やっぱり警告が出ないように書くのかな。

あと、>>=の使い方がやっとわかった。

*Main> :t (>>=)
(>>=) :: (Monad m) => m a -> (a -> m b) -> m b

だから、→の先はm bを返す関数でなければならないので、上のリストだとconcatを与えることができず、return . concatを与える必要があるということなのか。

手元の向井さんの本の

関数の返り値型はモナドですから、その結果はやはりIOとしてしか受け取れず、いつまでたってもIOの「印」を取り除けずに、しかしどんどん計算を進めることができるというわけです。

の意味が腑に落ちた。

入門Haskell―はじめて学ぶ関数型言語(向井 淳)

なんか、アマゾン評はやたらと低いし、すでにカタログには無いが、おれにはこの語り口は妙に読みやすいんだよね。でも索引がずれているからリファレンスとしては使えない（正誤表はあるのだが、これが印刷すると変な順序になるので今3つくらい使えない）のが残念な点。