sudoku-solver

あいだが空いてしまった。ちょうど1週間だ。5月の連休中から Scala のエントリを1月以上も連続で更新してたのに。まぁ、別にいいんだけど。

で、今日から再開ということで Scala をやろうと思ったんだけど、事情があって Haskell だ。

数独っていうパズルがある。ナンプレともいう、マス目に 1 から 9 の数字を入れていくアレだ。暇つぶしにやってたんだけど、入門編の問題くらいはともかく、それ以上になると途端に難しくなる。向いてないのかもしれない。

ともかく、こんなのやってられねーってわけで、問題を解くプログラムを作ってみた。Haskell で。

作ったものは GitHub にあげたので見てほしい。

 cf. takatoh / sudoku-solver

使い方はこんな感じ。

^o^ > type example2.txt
     87
928    15
     1
14    8
   485
  6    43
   5
51    924
  92

^o^ > sudoku example2.txt
431658792
928734615
675921438
147362859
392485167
856197243
284519376
513876924
769243581

問題は 9 × 9 マスに入っている数字を 9 文字 × 9 行のテキストファイルにして、sudoku プログラムにファイル名を渡してやるだけ。

「数独 難問」でググって出てきた問題でもあっという間に解ける。ああ、気持ちいい。

リスト(配列)の中で隣り合う同じ値をグループ化する(2)

こないだのやつを Scheme と Haskell でやってみた。

まずは Scheme 版。

(define adjacent-group
  (lambda (lis)
    (let loop ((l (cdr lis)) (c (car lis)) (r (cons (list (car lis)) '())))
      (if (null? l)
          (reverse (map reverse r))
          (if (= (car l) c)
              (loop (cdr l) c (cons (cons (car l) (car r)) (cdr r)))
              (loop (cdr l) (car l) (cons (list (car l)) r)))))))

(print (adjacent-group '(1 1 2 2 3 1 1)))
^o^ >gosh adjacent-group.scm
((1 1) (2 2) (3) (1 1))

基本的な考え方は、Ruby や Python のと同じ。ちょっと工夫したのは、先頭の要素を最初から結果のリストに入れたこと。これで分岐条件が1つ減った。
……のはいいんだけど、これって引数に空リストが来た時のことが考えられてないじゃないか。まあ、グループ化しようというんだから空リストは考えなくてもいいか……ホントか?

さて、Haskell 版。こっちはちゃんと空リストが来ても大丈夫(実行例は示さないけど)。

adjacentGroup :: [Int] -> [[Int]]
adjacentGroup [] = []
adjacentGroup (x:xs) = reverse $ map reverse $ foldl f [[x]] xs
  where
    f (y:ys) z = if head y == z
                 then (z:y):ys
                 else (z:[]):y:ys

main :: IO()
main = print $ adjacentGroup [1, 1, 2, 2, 3, 1, 1]
^o^ >runhaskell adjacentGroup.hs
[[1,1],[2,2],[3],[1,1]]

[追記](9/27)

Scheme 版を空リスト対応にした。分岐条件が1つ増えた。

(define adjacent-group
  (lambda (lis)
    (let loop ((l lis) (c (undefined)) (r '()))
      (if (null? l)
          (reverse (map reverse r))
          (cond
            ((undefined? c) (loop (cdr l) (car l) (cons (list (car l)) r)))
            ((= (car l) c) (loop (cdr l) c (cons (cons (car l) (car r)) (cdr r))))
            (else (loop (cdr l) (car l) (cons (list (car l)) r))))))))

(print (adjacent-group '(1 1 2 2 3 1 1)))
(print (adjacent-group '()))
^o^ >gosh adjacent-group2.scm
((1 1) (2 2) (3) (1 1))
()

[さらに追記](9/28)

分岐条件を工夫して2つに減らせた。cond じゃなく if になった。

(define adjacent-group
  (lambda (lis)
    (let loop ((l lis) (c (undefined)) (r '()))
      (if (null? l)
          (reverse (map reverse r))
          (if (and (not (undefined? c)) (= (car l) c))
              (loop (cdr l) c (cons (cons (car l) (car r)) (cdr r)))
              (loop (cdr l) (car l) (cons (list (car l)) r)))))))

(print (adjacent-group '(1 1 2 2 3 1 1)))
(print (adjacent-group '()))
^o^ > gosh adjacent-group3.scm
((1 1) (2 2) (3) (1 1))
()

文字列間のレーベンシュタイン距離を求める(3)Haskell版ふたたび

去年の12月に2つの文字列のレーベンシュタイン距離を求めるっていうのを、JavaScriptHaskell でやった。もともとは Python での実装を参考に2次元配列を使ってやってみたもので、JavaScript版はともかく Haskell版は2次元配列の更新に苦労した。
それが、今日ふと1次元配列でやってみたらどうだろうと思いついた。
つまりこうだ。(m + 1)行×(n + 1)列(m、n は比較する文字列2つの長さ)の各行をつなげた1次元配列を考えて、2次元配列の時の座標を表すタプル (i, j) で初期化しておく。0 < i, 0 < j のとき、(i, j) の値はひとつ左(i-1, j)、ひとつ上(i, j-1)、左上(i-1, j-1)から決まるから、これを1次元配列のインデックスに直すと次のようになる:

  • ひとつ左: i * (n + 1) + j – 1
  • ひとつ上: (i – 1) * (n + 1) + j
  • 左上: (i – 1) * (n + 1) + j – 1

これをコードに落としこんでやるとこうなった:

module Main where

import System.Environment (getArgs)

levenshteinDistance :: String -> String -> Int
levenshteinDistance s1 s2 = last ld
  where
    ld = map f [(x, y) | x <- [0..m], y <- [0..n]]
    m = length s1
    n = length s2
    f (0, 0) = 0
    f (i, 0) = i
    f (0, j) = j
    f (i, j) = minimum [a, b, c]
      where
        a = ld !! (i * (n + 1) + j - 1) + 1
        b = ld !! ((i - 1) * (n + 1) + j) + 1
        c = ld !! ((i - 1) * (n + 1) + j - 1) + c'
        c' = if s1 !! (i - 1) == s2 !! (j - 1) then
          0
        else
          1

main :: IO ()
main = do
  args <- getArgs
  let s1 = args !! 0
  let s2 = args !! 1
  print $ levenshteinDistance s1 s2

結果はこうだ。

takatoh@apostrophe $ runhaskell ld2.hs apple play
4
takatoh@apostrophe $ runhaskell ld2.hs perl pearl
1

OK、うまくいった。

だけど、上のコードはまだ2次元配列の意識を引きずっている。もっと単純にできるはずだ。1次元配列のインデックスを x とすると:

  • ひとつ左: x – 1
  • ひとつ上: x – (n + 1)
  • 左上: x – (n + 1) – 1

となる。これで一般部については2次元配列を気にしなくて良くなった。ただし問題がある。いちばん上の行(第0行)といちばん左の列(第0列)だ。少し考えて、x を (n + 1) で割った商と余りを使えばいいと気がついた。コードにするとこう:

module Main where

import System.Environment (getArgs)

levenshteinDistance :: String -> String -> Int
levenshteinDistance s1 s2 = last ld
  where
    ld = map f [0..((m + 1) * (n + 1) -1)]
    m = length s1
    n = length s2
    f x | x < n + 1                       = x
        | x `rem` (n + 1) == 0 = x `div` (n + 1)
        | otherwise                       = minimum [a, b, c]
    where
      a = ld !! (x - 1) + 1
      b = ld !! (x - (n + 1)) + 1
      c = ld !! (x - (n + 1) - 1) + c'
      c' = if s1 !! i == s2 !! j then
        0
      else
        1
      i = x `div` (n + 1) - 1
      j = x `rem` (n + 1) - 1

main :: IO ()
main = do
  args <- getArgs
  let s1 = args !! 0
  let s2 = args !! 1
  print $ levenshteinDistance s1 s2

1行だけだけど長くなってしまった。だけど考え方はシンプルのように思う。実行してみよう。

takatoh@apostrophe $ runhaskell ld3.hs apple play
4
takatoh@apostrophe $ runhaskell ld3.hs perl pearl
1

OK。

2次元のリストの指定した座標を含むブロックの座標を列挙する

タイトルがわかりにくいな。
ホントは図を描けばいいのかもしれないけど、まず、2次元のリストを考える。で、そのリストの中に3×3のブロックが並んでいると考えてほしい。今日やりたいのは、ある座標(インデックス、0始まり、2次元なので当然2つの整数)を与えたときに、その座標を含むブロックの全座標を列挙したいってこと。
最初、どうやったらいいか悩んだけど、出来てみれば案外簡単だった。

module Main where

import System.Environment (getArgs)

block :: Int -> Int -> [(Int, Int)]
block i j = [(x,y)| x <- section i, y <- section j]

section :: Int -> [Int]
section n = [s..e]
  where
    s = n `div` 3 * 3
    e = s + 2

main :: IO ()
main = do
  args <- getArgs
  let i = read (args !! 0) :: Int
  let j = read (args !! 1) :: Int
  print $ block i j

実行例:

takatoh@apostrophe $ runhaskell block.hs 4 2
[(3,0),(3,1),(3,2),(4,0),(4,1),(4,2),(5,0),(5,1),(5,2)]
takatoh@apostrophe $ runhaskell block.hs 1 5
[(0,3),(0,4),(0,5),(1,3),(1,4),(1,5),(2,3),(2,4),(2,5)]

こんな感じ。

リストから要素を削除する

Haskell での話。リストから特定の要素を削除したくて、ググってみたけどそれらしい関数が見当たらない。需要がないはずがないと思いながらしばし考えて、filter を使えばいいということに思い当たった。
というわけでメモ。

Prelude> let delete x xs = filter (/= x) xs
Prelude> delete 3 [1..9]
[1,2,4,5,6,7,8,9]

[追記]

Data.List モジュールに delete という関数があった。探し方が悪いな。
でも、この関数は上のと違って、最初にマッチした要素しか削除してくれない。

Prelude> import Data.List
Prelude Data.List> delete 3 [1,3,2,3]
[1,2,3]

文字列を長さ1の文字列のリストに分割したい(Haskell編)

以前、Scheme では書いた。

 cf. 文字列を長さ1の文字列のリストに分割したい – blog.PanicBlanket.com

今日は Haskell でやってみよう。

Prelude> map (\ c -> [c]) "abcdefg"
["a","b","c","d","e","f","g"]

というわけで、とりあえず出来たわけだけどなんだか冗長できれいじゃない。
こんなふうじゃダメなんだろうか。

Prelude> map ([]) "abcdefg"

<interactive>:3:6:
    Couldn't match expected type `Char -> b0' with actual type `[a0]'
    In the first argument of `map', namely `([])'
    In the expression: map ([]) "abcdefg"
    In an equation for `it': it = map ([]) "abcdefg"

ダメだった。
いや、空リストに cons すればいいのか。

Prelude> map (:[]) "abcdefg"
["a","b","c","d","e","f","g"]

出来た。

Text.Parsecで固定長データをパースする(2)

一昨日の記事で、パーサの型も(一応)解った。なので、今度は Text.Parsecで固定長データをパースする で省いていたヘッダのパースをすることにする。さらに、パースしたデータをCSV形式のデータに変換する。

まずは、対象の地震動波形のファイルを再掲しておこう。

Example wave 1
NUMBER OF DATA=12001, DT=0.010, MAX.=-779.834268(TIME= 22.520), FORMAT=10F8.2
   -0.05   -0.05   -0.05   -0.05   -0.06   -0.06   -0.06   -0.06   -0.06   -0.07
   -0.07   -0.07   -0.07   -0.07   -0.08   -0.08   -0.08   -0.09   -0.09   -0.09
   -0.10   -0.10   -0.10   -0.11   -0.11   -0.12   -0.13   -0.13   -0.14   -0.15
   -0.16   -0.17   -0.18   -0.20   -0.22   -0.24   -0.27   -0.29   -0.33   -0.37
   -0.41   -0.45   -0.50   -0.56   -0.61   -0.68   -0.74   -0.82   -0.89   -0.97
   -1.06   -1.15   -1.25   -1.35   -1.45   -1.56   -1.68   -1.79   -1.92   -2.05
   -2.18   -2.32   -2.46   -2.61   -2.76   -2.91   -3.07   -3.23   -3.39   -3.55
   -3.72   -3.89   -4.06   -4.24   -4.42   -4.60   -4.78   -4.96   -5.14   -5.31
(以下略)

ヘッダは2行。1行目は地震動の名前、2行目はいくつかのパラメータで、ここで重要なのは「DT=0.010」の部分。DT は時刻刻み―つまりサンプリングレートで、0.01秒ごとにデータを記録していることを意味している。ほかのパラメータは今回は無視。

で、手始めに地震動を表すデータ型 Wave を作った。

data Wave = Wave { wvName :: String
                 , wvDT :: Double
                 , wvData :: [Double]
                 } deriving Show

それから、ヘッダを含む地震動ファイル全体をパースする関数 waveFile

waveFile :: Parser Wave
waveFile = do
  n <- waveName
  dt <- waveDT
  w <- wave
  eof
  return Wave { wvName = n, wvDT = dt, wvData = w }

waveFileWave を返すので、型は Parser Wave だ。

あとは、コード全体を示そう。

module Main where

import System.Environment ( getArgs )
import Text.Parsec
import Text.Parsec.String
import Data.List
import Text.Printf

--------------------------------------------------------------------------------

data Wave = Wave { wvName :: String
                 , wvDT :: Double
                 , wvData :: [Double]
                 } deriving Show

--------------------------------------------------------------------------------

main :: IO ()
main = do
  args <- getArgs
  cs <- readFile (head args)
  let wv = parseWave cs
  either (\ e -> print e) (\ w -> putStr $ formatWave w) wv

--------------------------------------------------------------------------------

formatWave :: Wave -> String
formatWave w = unlines $ header : wv
  where
    header = "," ++ (wvName w)
    wv = map (\ (t, d) -> printf "%.2f,%.2f" t d) $ zip tm (wvData w)
    tm = 0.0 : unfoldr (\ x -> Just (x + dt, x + dt)) 0.0
    dt = wvDT w

--------------------------------------------------------------------------------

-- Parsers

waveFile :: Parser Wave
waveFile = do
  n <- waveName
  dt <- waveDT
  w <- wave
  eof
  return Wave { wvName = n, wvDT = dt, wvData = w }

line :: Parser String
line = do
  l <- many1 (noneOf "\n")
  newline
  return l

waveName :: Parser String
waveName = line

waveDT :: Parser Double
waveDT = do
  string "NUMBER OF DATA="
  many1 digit
  string ", DT="
  dt <- many1 dataChar
  many1 (noneOf "\n")
  newline
  return $ read dt

wave :: Parser [Double]
wave = do
  ls <- many1
  waveLine
  return $ concat ls

waveLine :: Parser [Double]
waveLine = do
  ws <- many1
  waveData
  newline
  return ws

waveData :: Parser Double
waveData = do
  d <- count 8 dataChar
  return $ read d

dataChar :: Parser Char
dataChar = digit <|> oneOf "-. "

--------------------------------------------------------------------------------

parseWave :: String -> Either ParseError Wave
parseWave input = parse waveFile "(unknown)" input

--------------------------------------------------------------------------------

これで出来たはずだ。

実行例:

takatoh@apostrophe $ runhaskell parsewave4.hs data1.dat > result.csv
takatoh@apostrophe $ head result.csv
,Example wave 1
0.00,-0.05
0.01,-0.05
0.02,-0.05
0.03,-0.05
0.04,-0.06
0.05,-0.06
0.06,-0.06
0.07,-0.06
0.08,-0.06

OK。うまくいった。

Text.Parsecのパーサの型

前回 Text.Parsec の記事を書いてから、ひと月以上あいてしまった。なんか途中で書くモチベーションが下がったりもしたんだけど、今日は時間がとれたので書く。前回良くわからなかった、パーサの型についてだ。
ここ↓が参考になった。

 cf. Parsec3 におけるパーサーの型 – k16’s note

このページによると、

  • パーサの厳密な型シグネチャは ParsecT s u m a
    • s は抽象化された入力の型。この抽象化された入力をストリームという
    • u はパース時に好きな状態を格納しておく容器の型
    • m はモナド変換子にとって基盤となるモナド
    • a は出力の型

モナド変換子というのは、ここでは ParsecT のことで、正直なんだかよくわからない。
前回書いたコードにある wave パーサの場合、入力は文字列(String)、出力は少数点数のリスト([Double])で、m がモナドである必要があるから、次のようになる。

wave :: Monad m => ParsecT String u m [Double]

コード全体を載せると:

module Main where

import System.Environment ( getArgs )
import Text.Parsec

--------------------------------------------------------------------------------

main :: IO ()
main = do
  args <- getArgs
  cs <- readFile (head args)
  let wv = parseWave cs
  either (\ e -> print e) (\ w -> putStr $ unlines $ map show w) wv

--------------------------------------------------------------------------------

-- Parsers

wave :: Monad m => ParsecT String u m [Double]
wave = do
  ls <- many1
  waveLine
  eof
  return $ concat ls

waveLine :: Monad m => ParsecT String u m [Double]
waveLine = do
  ws <- many1
  waveData
  newline
  return ws

waveData :: Monad m => ParsecT String u m Double
waveData = do
  d <- count 8 dataChar
  return $ read d

dataChar :: Monad m => ParsecT String u m Char
dataChar = digit <|> oneOf "-. "

--------------------------------------------------------------------------------

parseWave :: String -> Either ParseError [Double]
parseWave input = parse wave "(unknown)" input

--------------------------------------------------------------------------------

実行例:

takatoh@apostrophe $ runhaskell parsewave0.hs data0.dat > result0.txt
takatoh@apostrophe $ head result0.txt
-5.0e-2
-5.0e-2
-5.0e-2
-5.0e-2
-6.0e-2
-6.0e-2
-6.0e-2
-6.0e-2
-6.0e-2
-7.0e-2

話はさらに続く。
Text.Parsec.String には、次のような定義がある。

type Parsec s u = ParsecT s u Identity
type Parser = Parsec String ()

上は ParsecT のモナドに Identity を使ったもの、下はその Parsec の入力に String、容器に () を使ったものだ。これを使うと、前述の wave パーサの型は次のように簡潔に書ける。

wave :: Parser [Double]

コード全体を載せよう。

module Main where

import System.Environment ( getArgs )
import Text.Parsec
import Text.Parsec.String

--------------------------------------------------------------------------------

main :: IO ()
main = do
  args <- getArgs
  cs <- readFile (head args)
  let wv = parseWave cs
  either (\ e -> print e) (\ w -> putStr $ unlines $ map show w) wv

--------------------------------------------------------------------------------

-- Parsers

wave :: Parser [Double]
wave = do
  ls <- many1
  waveLine
  eof
  return $ concat ls

waveLine :: Parser [Double]
waveLine = do
  ws <- many1
  waveData
  newline
  return ws

waveData :: Parser Double
waveData = do
  d <- count 8 dataChar
  return $ read d

dataChar :: Parser Char
dataChar = digit <|> oneOf "-. "

--------------------------------------------------------------------------------

parseWave :: String -> Either ParseError [Double]
parseWave input = parse wave "(unknown)" input

--------------------------------------------------------------------------------

実行例:

takatoh@apostrophe $ runhaskell parsewave0a.hs data0.dat > result0a.txt
takatoh@apostrophe $ head result0a.txt
-5.0e-2
-5.0e-2
-5.0e-2
-5.0e-2
-6.0e-2
-6.0e-2
-6.0e-2
-6.0e-2
-6.0e-2
-7.0e-2

ふぅ、今日はここまで。

Text.Parsecで固定長データをパースする

仕事で地震動波形のファイルを扱うことがある。地震動波形ってのは、地震の加速度を数値化したもので、こんなふうなファイルになっている。

Example wave 1
NUMBER OF DATA=12001, DT=0.010, MAX.=-779.834268(TIME= 22.520), FORMAT=10F8.2
   -0.05   -0.05   -0.05   -0.05   -0.06   -0.06   -0.06   -0.06   -0.06   -0.07
   -0.07   -0.07   -0.07   -0.07   -0.08   -0.08   -0.08   -0.09   -0.09   -0.09
   -0.10   -0.10   -0.10   -0.11   -0.11   -0.12   -0.13   -0.13   -0.14   -0.15
   -0.16   -0.17   -0.18   -0.20   -0.22   -0.24   -0.27   -0.29   -0.33   -0.37
   -0.41   -0.45   -0.50   -0.56   -0.61   -0.68   -0.74   -0.82   -0.89   -0.97
   -1.06   -1.15   -1.25   -1.35   -1.45   -1.56   -1.68   -1.79   -1.92   -2.05
   -2.18   -2.32   -2.46   -2.61   -2.76   -2.91   -3.07   -3.23   -3.39   -3.55
   -3.72   -3.89   -4.06   -4.24   -4.42   -4.60   -4.78   -4.96   -5.14   -5.31
(以下略)

見てのとおりヘッダが2行あって、3行目以降に8桁の固定長データが続いている。
今回はこれを Text.Parsec を使ってパースしてみようってわけ。といっても最初はことを単純にするため、ヘッダを省略してデータの部分だけでやってみる。

   -0.05   -0.05   -0.05   -0.05   -0.06   -0.06   -0.06   -0.06   -0.06   -0.07
   -0.07   -0.07   -0.07   -0.07   -0.08   -0.08   -0.08   -0.09   -0.09   -0.09
   -0.10   -0.10   -0.10   -0.11   -0.11   -0.12   -0.13   -0.13   -0.14   -0.15
   -0.16   -0.17   -0.18   -0.20   -0.22   -0.24   -0.27   -0.29   -0.33   -0.37
   -0.41   -0.45   -0.50   -0.56   -0.61   -0.68   -0.74   -0.82   -0.89   -0.97
   -1.06   -1.15   -1.25   -1.35   -1.45   -1.56   -1.68   -1.79   -1.92   -2.05
   -2.18   -2.32   -2.46   -2.61   -2.76   -2.91   -3.07   -3.23   -3.39   -3.55
   -3.72   -3.89   -4.06   -4.24   -4.42   -4.60   -4.78   -4.96   -5.14   -5.31
(以下略)

Haskell のパーサコンビネータ Parsec には Parsec 2 相当の Text.ParserCombinators.Parsec と Parsec 3 相当の Text.Parsec がある。最近では Parsec 2 ではなく Parsec 3 (つまり Text.Parsec)を使え、ということのようなんだけど、Web で検索しても Text.ParserCombinators.Parsec ばかりで、結構苦労した。特にパーサの型がわからなかった。結局、各パーサの型を書くのをやめて、パースを実行する関数にだけ型を書いたら動いてくれた。書いたコードがこれ。

module Main where

import System.Environment ( getArgs )
import Text.Parsec

--------------------------------------------------------------------------------

main :: IO ()
main = do
  args <- getArgs
  cs <- readFile (head args)
  let wv = parseWave cs
  either (\ e -> print e) (\ w -> putStr $ unlines $ map show w) wv

--------------------------------------------------------------------------------

-- Parsers

wave = do
  ls <- many1
  waveLine
  eof
  return $ concat ls

waveLine = do
  ws <- many1
  waveData
  newline
  return ws

waveData = do
  d <- count 8 dataChar
  return $ read d

dataChar = digit <|> oneOf "-. "

--------------------------------------------------------------------------------

parseWave :: String -> Either ParseError [Double]
parseWave input = parse wave "(unknown)" input

--------------------------------------------------------------------------------

実行例:

takatoh@apostrophe $ runhaskell parsewave.hs data0.dat > result.txt
takatoh@apostrophe $ head result.txt
-5.0e-2
-5.0e-2
-5.0e-2
-5.0e-2
-6.0e-2
-6.0e-2
-6.0e-2
-6.0e-2
-6.0e-2
-7.0e-2

なんとか、うまく動いてくれた。

ちなみに、ヘッダのついた data1.dat を食わせるとこんなエラーになる。

takatoh@apostrophe $ runhaskell parsewave.hs data1.dat
"(unknown)" (line 1, column 1):
unexpected "E"
expecting digit