競プロ AOJ Haskell

オンラインジャッジを使って体で覚えるHaskell入門 パート5

Haskell完全初心者向けにHaskellを理論ではなく実際にAizu Online Judgeの問題を解きながら体で覚えようというHaskell入門シリーズの第5弾です。
Feb. 10, 2020, 3:54 p.m.

この記事の対象読者と目的

この記事は、Haskell完全初心者向けにHaskellを理論ではなく実際にAizu Online Judgeの問題を解きながら体で覚えようというHaskell入門シリーズの第5弾です。

前回までの内容はこちら。

オンラインジャッジを使って体で覚えるHaskell入門 パート4

目次

ITP1_7_A - 成績

問題

試験の成績に応じてランクをつける問題です。

https://onlinejudge.u-aizu.ac.jp/courses/lesson/2/ITP1/all/ITP1_7_A

解答

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
main = interact $ unlines . solve . read' . lines
  where
    solve = map solveRow
    solveRow [a, b, c]
      | a == -1 || b == -1 = "F"
      | a + b >= 80 = "A"
      | a + b >= 65 = "B"
      | a + b >= 50 = "C"
      | a + b >= 30 && c >= 50 = "C"
      | a + b >= 30 = "D"
      | otherwise = "F"
    read' = map (map read . words) . init :: [String] -> [[Int]]

前回出来たフォーマットを使ってかなりシンプルに実装出来ました。
どんどん枝葉末節は裏に隠して重要なロジックに集中出来るようになってきた気がします。
Haskell的に新しい要素はありません。

ITP1_7_B - 組み合わせの数

問題

3つの整数の合計がある整数になる組み合わせの数を求める問題です。

https://onlinejudge.u-aizu.ac.jp/courses/lesson/2/ITP1/all/ITP1_7_B

解答

1
2
3
4
5
6
main = interact $ show' . solve . read' . lines
  where
    solve = map solveRow
    solveRow [n, x] = length [1 | a <- [1..n-2], b <- [a+1..n-1], c <- [b+1..n], a + b + c == x]
    show' = unlines . map show
    read' = map (map read . words) . init :: [String] -> [[Int]]

組み合わせの数と来れば以前にも出てきた、リスト内包表記で全パターンを列挙してフィルタして残った要素を数える、という方法が使えそうです。
リスト内包表記の中身のa b cの決め方はHaskellに限らず重複の無いように列挙するための一般的な書き方です。
こうしないと例えば、1 2 33 2 1を両方ともカウントしてしまいます。
Haskell的に新しい要素なのは、リスト内包表記の最後にフィルタするための条件式が書いてあるところです。
a + b + c == x
こうすることでリスト生成時にすでにフィルタすることが出来ます。

ITP1_7_C - 表計算

問題

スプレッドシートのような行列にに合計値の行・列を追加する問題です。

https://onlinejudge.u-aizu.ac.jp/courses/lesson/2/ITP1/all/ITP1_7_C

解答

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
import Data.List

main = interact $ show' . solve . read' . lines
  where
    solve = addCol . addRow
    addCol xs = map appendSum xs
    addRow = transpose . addCol . transpose
    appendSum row = row ++ [sum row]
    show' = unlines . map (unwords . map show)
    read' = map (map read . words) . tail :: [String] -> [[Int]]

まず1つのリストの末尾に合計を足すのは簡単です。
それをappendSum関数が行っています。
複数のリストの末尾に追加するにはmapを使えば良いですね。
難しいのは表の一番下に合計を足すところです。
各列のn番目の要素を合計する必要があります。
それを書くのは大変そうなので、表の縦横を逆転させる(つまり、行列の転置)関数が無いかと調べたらありました。
transpose関数です。
あとは、transposeで転置して先程すでに使ったaddColを実行してまたtransposeでもとに戻せば完成です。

ITP1_7_D - 行列の積

問題

行列の積を求める問題です。
これは行列の積の計算方法を知らない場合は、大変だと思いますのでスルーで良いと思います。
https://onlinejudge.u-aizu.ac.jp/courses/lesson/2/ITP1/all/ITP1_7_D

解答

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
import Data.List

main = interact $ show' . solve . read' . lines
  where
    solve (matA,matB) = [
                          [sum $ zipWith (*) u v  | v <- (transpose matB)]
                        | u <- matA]
    show' = unlines . map (unwords . map show)
    read' (nml:xs) = (f matA, f matB)
      where
        n = head . map readInt . words $ nml
        f = map (map readInt . words)
        (matA, matB) = splitAt n xs
        readInt = read :: String -> Int

行列の積の結果の行列のサイズは$m \times m$になります。
なので2つの行列を処理するときにどちらもmの長さを持つリストである必要があります。
mになっていない方の行列をtransposeで転置してから後は公式に従ってsum $ zipWip (*) u vと計算するだけです。
u vというのはどちらも各行列から1行とったリストです。

ITP1_8_A - 大文字と小文字の入れ替え

問題

文字列の小文字と大文字を入れ替える問題です。
https://onlinejudge.u-aizu.ac.jp/courses/lesson/2/ITP1/all/ITP1_8_A

解答

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
import Data.Char

main = interact $ solve
  where
    solve [] = []
    solve (x:xs) = (f x):solve xs
    f x | isLower x = toUpper x
        | isUpper x = toLower x
        | otherwise = x
      where
        isLower x = x `elem` ['a'..'z']
        isUpper x = x `elem` ['A'..'Z']

Haskell的に新しい関数が3つあります。
まずは、小文字を大文字に変えるtoUpperと反対に大文字を小文字に変えるtoLowerです。
3つ目は、ある要素がリスト中に存在するかを判定するelemです。
今回はレンジを利用して、文字がそのレンジに入っているかどうかで大文字小文字を判定しています。

ITP1_8_B - 数字の和

問題

与えられた一行ずつ数字の和を求める問題です。
パット見簡単そうでしたが、in3.txtのテストケースで苦労しました。

https://onlinejudge.u-aizu.ac.jp/courses/lesson/2/ITP1/all/ITP1_8_B

解答

1
2
3
4
5
6
7
8
import Data.Char(digitToInt)

main = interact $ show' . solve . read' . lines
  where
    solve = map solveRow
    solveRow = sum . map digitToInt
    show' = unlines . map show
    read' = takeWhile (/= "0")

3つ新しい要素があります。
まずimport Data.Char(digitToInt)ですが、これはライブラリからdigitToInt関数だけをインポートするという意味です。
()を指定すると結局何もインポートしないそうです。
また、カンマ区切りで複数インポート可能です(Data.Char(x, y, (+++)))。

digitToIntは、文字を受け取って整数型に変換する関数です。

takeWhileが今回苦戦した部分です。
これまでは0が必ず一番下の行にあったのでinitで読み飛ばすことが出来ました。
ところが今回のテストケース3にだけ0の次にさらにもう一行空の行があり、0を読み飛ばせていませんでした。
テストケース3のミスっぽいですが、他のテストケースにも対応するために厳密に0をチェックする必要がありました。
takeWhile 条件はリストの前から条件に合致するまでとって新しいリストを生成する関数です。
今回のように可変長の場合に便利ですね。

ITP1_8_C - 文字のカウント

問題

文章中に出現する文字をそれぞれカウントする問題です。
始めてうわさのMaybeモナドを使いました!

https://onlinejudge.u-aizu.ac.jp/courses/lesson/2/ITP1/all/ITP1_8_C

解答

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
import Data.Char(toLower, ord)
import Text.Printf
import Data.List
import Data.Function
import qualified Data.Map as Map

main = interact $ show' . solve
  where
    show' = unlines . map fmt
    solve = addEmpty . count
    fmt (s, d) = printf "%s : %d" s d
    addEmpty xs = [tuple [c] |c <- ['a'..'z']]
      where
        tuple s = case m of
                    Just val -> (s, val)
                    Nothing -> (s, 0)
          where m = Map.lookup s map
        map = Map.fromList xs
    count cs = map length' . group . sort $ [toLower' c| c <- cs, isAlpha c]
    length' str = ([head str], length str)
    toLower' c | isUpper c = toLower c
               | otherwise = c
    isUpper c = a <= o && o <= z
      where o = ord c
    isAlpha c = a <= o && o <= z'
      where o = ord c
    a = ord 'A'
    z = ord 'Z'
    z' = ord 'z'

一気に新しい要素が出ました。
落ち着いて1つずつ見ていきましょう。

qualified ... as

まずはimportのところのqualified ... asについてです。
これはただのimportだと他のパッケージと名前が衝突してしまう場合に完全修飾名(フルネーム)でライブラリをインポートするための文法です。
よく使っているmap関数とMapライブラリ内のmapがかぶってしまうのだそうです。
asはエイリアス(別名)です。完全修飾名にすると大抵は長すぎて不便なので短い別名を付けます。

標準ライブラリ以外の使い方

いつもは手元の環境でまずテストしてからオンラインジャッジに通しています。
今回Data.Mapをインポートしたところコンパイルが通りませんでした。
これは標準に含まれていないので外部依存ライブラリとして追加する必要があるそうです。

package.yamlを以下のように- containersの1行を追加しました。
無関係な部分は省略しています。

1
2
3
dependencies:
- base >= 4.7 && < 5
- containers
Map

Mapはキーと値を組み合わせでもったハッシュマップです。
キーから値を高速($O(\log{N})$)で検索出来ます。

fromListに文字列のキーと値のペアのリストを渡すとリストから作ることが出来ます。

Map.lookup

Map.lookup キー マップの形でキーに対応した値を取得できます。
キーがない場合でもnull-1などを返さずに、キーの有無に関わらず同じMaybeモナドを返します。
値が欲しいのでMaybeモナドからさらにもう一段値を取り出す必要があります。
これは次に解説します。

Maybeモナド

Maybeモナドから値を取り出しているのはこの部分です。
aの出現回数を知りたい場合はMap.loop "a" mapのようにマップに問い合わせます。
aが存在しない場合はNothingというものが返ってくるのでcase ... of文で出現回数0を返しています。
aが存在する場合はJust 10のような値が返ってくるので出現回数10を返しています。

1
2
3
4
tuple s = case m of
            Just val -> (s, val)
            Nothing -> (s, 0)
  where m = Map.lookup s map

case .. ofは他言語のswitch case文と似ているので問題ないと思いますが、パターンマッチとの使い分けがまだ不明です。
それは追々調べていきます。

ITP1_8_D - リング

問題

円状の文字列上にもう一方の文字列が現れるかを判定する問題です。

https://onlinejudge.u-aizu.ac.jp/courses/lesson/2/ITP1/all/ITP1_8_D

解答

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
import Data.List

main = interact $ show' . solve . read'
  where
    show' True = "Yes\n"
    show' False = "No\n"
    solve [xs, ys] = solve' $ xs ++ xs'
      where
        solve' ss | length ss < lys = False
                  | isPrefixOf ys ss = True
                  | otherwise = solve' $ tail ss
        (xs', _) = splitAt lys xs
        lys = length ys
    read' = lines

円状で文字列の始点と終点が分からないとはいえ何周もチェックする必要はありません。
円状の文字列を$A$、その長さを$|A|$、含まれるかチェックする文字列を$B$、その長さを$|B|$とすると、文字列$A$上を$|A| + |B|$の長さだけチェックすれば判定できます。
チェックには$A$の先頭から順に移動して$B$が1文字違わず等しい$A$の部分文字列があるかを確認します。
そのために今回新しく登場したisPrefix 文字列B 文字列Aという関数を使用出来ます。
これは文字列A文字列Bから始まっているかどうかを返す関数です。