takatoh – ページ 44 – blog.PanicBlanket.com

九九表のすべてのマスの和

前回から時間が開いてしまった。本当は Text.Parsec の話題を書こうと思ってるんだけど、今日も時間がないので小ネタ、しかも他人のネタ。

詳しくはリンク先を見て。いくつかの言語でやってるんだけど、Ruby と Scheme がなかったのでやってみた。

まずは Ruby。

# encoding: utf-8

def sum_of_kuku
  a = (1..9).to_a
  a.product(a).map{|x,y| x * y}.inject(:+)
end

puts sum_of_kuku

takatoh@apostrophe $ ruby sum_of_kuku.rb
2025

１〜９までの配列の直積をとって、それぞれを掛けあわせて、最後に全部足してるだけ。

Scheme でも同じ考え方。でもリストの直積を取る手続きが見当たらなかったので direct-product を自作した。

(use srfi-1)

(define direct-product
  (lambda (lis1 lis2)
    (append-map
      (lambda (x) (map (lambda (y) (list x y)) lis2))
      lis1)))

(define sum-of-kuku
  (lambda ()
    (let ((l1 '(1 2 3 4 5 6 7 8 9))
          (l2 '(1 2 3 4 5 6 7 8 9)))
      (apply + (map (lambda (x) (apply * x)) (direct-product l1 l2))))))

(print (sum-of-kuku))

takatoh@apostrophe $ gosh sum-of-kuku.scm
2025

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
（以下略）

見てのとおりヘッダが２行あって、３行目以降に８桁の固定長データが続いている。
今回はこれを 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

Haskellでリフル・シャッフル

こないだのリフル・シャッフルを Haskell でやってみた。

Prelude> concat $ zip [0,2,4,6,8] [1,3,5,7,9]

:2:10:
    Couldn't match type `(a1, b0)' with `[a0]'
    Expected type: [[a0]]
      Actual type: [(a1, b0)]
    In the return type of a call of `zip'
    In the second argument of `($)', namely
      `zip [0, 2, 4, 6, ....] [1, 3, 5, 7, ....]'
    In the expression:
      concat $ zip [0, 2, 4, 6, ....] [1, 3, 5, 7, ....]

あれ。そうか、zip はタプルのリストを返すんだっけ。

Prelude> zip [0,2,4,6,8] [1,3,5,7,9]
[(0,1),(2,3),(4,5),(6,7),(8,9)]

じゃあ、foldr を使ってみようか。

Prelude> foldr (\(x,y) acc -> x:y:acc) [] $ zip [0,2,4,6,8] [1,3,5,7,9]
[0,1,2,3,4,5,6,7,8,9]

うまくいった。
いや、zipWith のほうがいいか？

Prelude> concat $ zipWith (\x y -> x:y:[]) [0,2,4,6,8] [1,3,5,7,9]
[0,1,2,3,4,5,6,7,8,9]

riffle-shuffle

「リフル・シャッフルとは、カードの山札を半分ずつに分けて、パラパラと交互に重ねていくトランプ札の切り方を言う」んだそうで。

　cf. riffle-shuffle (2つのリスト(の要素)を交互に混ぜる) – 分室の分室

詳しくはリンク先を見てもらうとして、要は２つのリストの要素を交互に混ぜようってことだ（て、リンクのタイトルに書いてあるじゃん）。

まあ、ベタに書こうと思うとリンク先のようなコードになるんだろうけど、ここは用意されている便利な手続きを使って：

gosh> (use srfi-1)
#<undef>
gosh> (concatenate (zip '(0 2 4 6 8) '(1 3 5 7 9)))
(0 1 2 3 4 5 6 7 8 9)

てなかんじで、どうっスか。

string-join

intersperse があれば string-join は簡単だ。デリミタを差し込んだ文字列のリストに string-append を適用してやればいい。

gosh> (apply string-append (intersperse "-" '("foo" "bar" "baz")))
"foo-bar-baz"

と、思ったら string-join には省略可能な引数 delim と grammer があった。

　cf. 6.12 文字列 – Gauche ユーザリファレンス

delim はデリミタで、省略すると空白文字１文字が使われる。

(define my-string-join
  (case-lambda
    ((slist) (my-string-join slist " "))
    ((slist delim)
    (apply string-append (intersperse delim slist)))))

(print (my-string-join '("foo" "bar" "baz")))
(print (my-string-join '("foo" "bar" "baz") "-"))

takatoh@apostrophe $ gosh my-string-join.scm
foo bar baz
foo-bar-baz

grammer は手続きの挙動を決めるためのシンボルで、infix、strict-infix、prefix、suffix のいずれか。
今回、strict-infix は面倒そうだったのでそれ以外を実装してみた。

(define my-string-join
  (case-lambda
    ((slist) (my-string-join slist " " 'infix))
    ((slist delim) (my-string-join slist delim 'infix))
    ((slist delim grammer)
      (let ((l (intersperse delim slist)))
        (cond ((eq? grammer 'infix) (apply string-append l))
              ((eq? grammer 'prefix) (apply string-append (cons delim l)))
              ((eq? grammer 'suffix) (apply string-append (append l (list delim))))
              (else (error "Illegal grammer.")))))))

(print (my-string-join '("foo" "bar" "baz")))
(print (my-string-join '("foo" "bar" "baz") "-"))
(print (my-string-join '("foo" "bar" "baz") "/" 'prefix))
(print (my-string-join '("foo" "bar" "baz") ";" 'suffix))
(print (my-string-join '("foo" "bar" "baz") ";" 'surfix)) ;; misspell

takatoh@apostrophe $ gosh my-string-join3.scm
foo bar baz
foo-bar-baz
/foo/bar/baz
foo;bar;baz;
gosh: "error": Illegal grammer.

intersperse

Haskell の Data.List モジュールに intersperse という関数がある。リストの要素の間に値を挿入する関数だ。

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

これを自前で実装するとこうなる。

module Main where

intersperse :: a -> [a] -> [a]
intersperse _ (x:[]) = x : []
intersperse y (x:xs) = x : y : intersperse y xs

main :: IO ()
main = print $ intersperse 0 [1..3]

takatoh@apostrophe $ runhaskell intersperse.hs
[1,0,2,0,3]

素直な再帰関数だ。

Scheme ではどうだろうか。実は Gauche には intersperse が用意されているんだけど、自前で実装してみたらこうなった。

(define my-intersperse
  (lambda (delim lis)
    (let loop ((l (cdr lis)) (r (list (car lis))))
      (if (null? l)
        (reverse r)
        (loop (cdr l) (cons (car l) (cons delim r)))))))

(print (my-intersperse 0 '(1 2 3)))

takatoh@apostrophe $ gosh my-intersperse.scm
(1 0 2 0 3)

Haskell のと違って末尾再帰になっているのは、まあ、それが身についていると言ってもいいのかな。

さて、ここまで書いてみて畳み込みが使えそうだと気がついた。

(define my-intersperse
  (lambda (delim lis)
    (reverse (fold (lambda (x acc) (cons x (cons delim acc)))
      (list (car lis))
        (cdr lis)))))

(print (my-intersperse 0 '(1 2 3)))

takatoh@apostrophe $ gosh my-intersperse2.scm
(1 0 2 0 3)

同様に Haskell で。

module Main where

intersperse :: a -> [a] -> [a]
intersperse y xs = reverse $ foldl f [head xs] (tail xs)
  where
    f acc a = a : y : acc

main :: IO ()
main = print $ intersperse 0 [1..3]

takatoh@apostrophe $ runhaskell intersperse2.hs
[1,0,2,0,3]

Haskell の場合は foldl を使うよりも、単純な再帰のほうが見やすい気がする。それに Haskell は非正格だから、リスト全体をたどる必要（それも２回も）のある前者よりも後者のほうが効率がいいのかも。

投稿者: takatoh

Look and Say 数列

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

Text.Parsecのパーサの型

増減を繰り返す整数のリストを作る