Look and Say 数列

ちょっと面白いものを見つけた。

 cf. 「Haskell」で「Look and Say 数列」を生成してみた – Zodiacの黙示録

Look and Say 数列とは次のようなものらしい。

1 11 21 1211 111221 ...

ちょっと規則性が見いだせないが、

  1. 最初の項は「1」
  2. 次の項は直前の項を見る(look)。すると「1」個の「1」。
  3. なので「11」と言う(say)。
  4. さらに次の項は直前の項を見て、「2」個の「1」。
  5. なので「21」と言う。
  6. 以下繰り返し

となっている。

リンク先では Haskell でやっているので、Scheme でやってみた。Haskell と違って無限リストは扱えないので、スクリプトの引数で生成する数列の数を指定するようにした。

(use srfi-1)
(use gauche.sequence)

(define main
  (lambda (args)
    (let ((count (string->number (cadr args))))
      (print (look-and-say count)))))

(define look-and-say
  (lambda (count)
    (unfold (lambda (seed) (zero? (car seed)))
            (lambda (seed) (cadr seed))
            (lambda (seed) (list (- (car seed) 1) (las (cadr seed))))
            (list count "1"))))

(define las
  (lambda (s)
    (let ((ls (group-sequence s)))
      (apply string-append
        (append-map (lambda (e)
          (list (write-to-string (length e)) (string (car e))))
            ls)))))

unfold のために srfi-1 を、group-sequence のために gauche.sequence を読み込んでいる。
group-sequence はリストや文字列といった sequence を、同じ値ごとにグループ化する手続き。こんな感じ:

gosh> (group-sequence "aabccdddee")
((#\a #\a) (#\b) (#\c #\c) (#\d #\d #\d) (#\e #\e))

さて、実行してみよう。

takatoh@apostrophe $ gosh look-and-say.scm 8
(1 11 21 1211 111221 312211 13112221 1113213211)

うまくいったようだ。

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

ふぅ、今日はここまで。