Haskellにも喋ってもらおう(2)
数日前にTVを見ていたら、鉄分を含んだ「鉄子さん」の紹介をしていた。サプリメントで 取る、CaやFeの話ではなくて、鉄道大好きな女性の事だ。男の領分に進出し、親父 ぽくなったのかな？ そう言えば、「歴女」もブームだなあ。
いままででは考えられないような趣味に、女性が進出してきているが、物を集めたり する趣味はどうなんだろう？ ひたすら、デッシュ（パラボラアンテナ）や「こま犬」 の写真を撮り続けている、あの人の領域は侵されるのだろうか？
飛行機の写真をひたすら撮り続ける人が、今度は、変電所にはまって、写真に収め 始めたようだ。見せてもらったけど、にょきにょきと突き出た碍子が、うにの棘に 見えてしまう私は、そういう世界とは縁遠いのだろうか？
暇にまかせて、近くにある大送電線や変電所の写真でも撮りに行ってみようか。但し、 こっそり取らないと、テロリストに間違えられて、通報される恐れがありそうなので 要注意。
ひらがなへの変換
さて、いよいよ漢字混じりの文章を、ひらがなに変換する関数を書いていく。これって 結局、ルビを振る事だよね。関数名は、ruby としよう。だって、htmlのタグに ruby ってのがあるんだもの。（えっ、趣味悪いって？ まあ、こういう事でもないと、haskell に、rubyの名前を登場させられませんから）
ruby :: String -> IO String
ruby s = do
(input, output, _, _) <- runInteractiveProcess
"mecab" ["--eos-format="
,"--unk-format=\\s%m"
,"--node-format=\\s%pS%f[7]"]
Nothing Nothing
hPutStr input s
hClose input
hGetContents output
書けたら、その場でチェックですね。
*Main> ruby "hellow world 123times" " hellow world 123 times"
どうやら、大丈夫そうですんで、speakに組み込んで実験します。旨く行くかな？
期待したんですが、jsayが、酷いエラーを吐いてしまいました。どのくらい酷いかと言うと M$に言いつけてやると言う程、酷いエラー。今までちゃんと動いていた、データでも だめなんで、どんなデータが jsay に渡っているかプローブしました。
jsay :: String -> IO ExitCode
jsay s = do { putStrLn s; rawSystem "jsay" [s] }
Haskellでも、progn みたいな事が出来るんですね。こうしておいてから
c:\sakae\gsay>ghc --make speak.hs [1 of 1] Compiling Main ( speak.hs, speak.o ) Linking speak.exe ...
コンパイルしました。そして実行してみると、やはり、酷いエラー。但し、jsayに 渡ったデータが見れます。それによると、必ず、行頭に１個のスペースが入っていました。 後は、問題なく、ルビを振ってくれています。しょうがないので、 AquesTalkのサポートページを見たら、先頭に半角スペース が有ると、落ちると報告が出ていました。折を見て直すそうです。
そっか、それじゃ、何とかせねば。。。 取り合えずの逃げとして
speak :: String -> IO ExitCode
speak s = do r <- ruby s
utf <- s2u r
sjis <- u2s $ unwords $ words utf
jsay sjis
のように、wordsの特性を利用して、先頭スペースをカットしました。どうせ、この 部分は、変更しますんで。
Prelude> let s = " abc 123 def " Prelude> words s ["abc","123","def"] Prelude> unwords $ words s "abc 123 def"
これで、ようやく漢字混じり文を、読み上げるようになりました。
次はアルファベットや数字混じり文も喋らせる
これが出来れば、外交にも財政にも強い事を国民のみなさんに強くアッピール出来る ので、選挙には必須のアイテムになります。上記を、早速改造しました。 (ソースは、巻末参照)
joinが思い出せなくて、カンニングしちゃいました。なかなか特殊なモジュールに 入っていて、探すのに苦労しちゃいました。joinとかsplitぐらいは、標準に入れて おいて欲しいぞ。また、ascpの中で、head s を何回も評価してて、ちょっと無駄っぽい。 綺麗な書き方って、ないものだろうか？
今日は980円の靴を買いに、ABC靴店へ行きました。 売り切れで、残念無念です。
旨く、喋るかな？
c:\sakae\gsay>ghci speak.hs GHCi, version 6.10.3: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer ... linking ... done. Loading package base ... linking ... done. [1 of 1] Compiling Main ( speak.hs, interpreted ) Ok, modules loaded: Main. *Main> :main smpl.txt Loading package syb ... linking ... done. Loading package base-3.0.3.1 ... linking ... done. Loading package bytestring-0.9.1.4 ... linking ... done. Loading package old-locale-1.0.0.1 ... linking ... done. Loading package old-time-1.0.0.2 ... linking ... done. Loading package filepath-1.1.0.2 ... linking ... done. Loading package Win32-2.2.0.0 ... linking ... done. Loading package directory-1.0.0.3 ... linking ... done. Loading package process-1.0.1.1 ... linking ... done. Loading package array-0.2.0.0 ... linking ... done. Loading package random-1.0.0.1 ... linking ... done. Loading package haskell98 ... linking ... done. Loading package utf8-string-0.3.5 ... linking ... done. キョウ,ハ,<NUMK VAL=980>,エン,ノ,クツ,ヲ,カイ,ニ,、,H ウリキレ,デ,、,ザンネン, *Main>
ザンネン、１行目は喋ってくれませんでした。どうも、ABCの所がまずいようです。 何故なんだ。ちょっとemacs上で実験してみます。
*Main> tr "123 ABC" "<NUMK VAL=123>,\12360\12540,\12403\12540,\12375\12540" *Main> U.putStrLn $ tr "123 ABC" <NUMK VAL=123>,えー,びー,しー
これは、大丈夫そう。utf-8の日本語領域って、文字列表現では、数字？になるのね。 知らなかった。それじゃ、こっちは？
*Main> tr "abc くつ" "\12360\12540,\12403\12540,\12375\12540,\32314\19978\9661" *Main> U.putStrLn $ tr "abc くつ" えー,びー,しー,縺上懿｡
文字化けしてるよ。何故？ GHCのバグでしょうか？外から来たものと、リテラルは 混ぜるな危険とかいう制約があるのでしょうか？ よう分かりませんです。 秋に出ると言う、新版に期待しますか。一応、全リストを載せておきます。
-- -*- utf-8 -*-
-- speak japanese (use external application iconv,mecab,jsay)
-- Usage: speak.exe shift-jis-file
import System
import System.IO
import System.Process
import System.Cmd
import List
import Data.Char
import qualified System.IO.UTF8 as U
type Table = [(Char,String)]
tblAsc :: Table
tblAsc = [('a',"えー"), ('b', "びー"), ('c', "しー"), ('d', "でー")]
tblPunct :: Table
tblPunct = [('(',"かっこ"), (')',"こっか"), ('-', "だっつしゅ")
,('<',"しょうなり"), ('>',"だいなり"), (':',"ころん")]
a2p :: Char -> Table -> String
a2p c t = case lookup c t of
Just p -> p
Nothing -> "しらないもじ"
join :: [a] -> [[a]] -> [a]
join delim l = concat (intersperse delim l)
iconv :: String -> String -> String -> IO String
iconv from to s = do
(input, output, _, _) <- runInteractiveProcess
"iconv" ["-f", from, "-t", to]
Nothing Nothing
hSetBinaryMode input False
hSetBinaryMode output False
hPutStr input s
hClose input
hGetContents output
s2u :: String -> IO String
s2u s = iconv "SHIFT_JIS" "UTF-8" s
u2s :: String -> IO String
u2s s = iconv "UTF-8" "SHIFT_JIS" s
jsay :: String -> IO ExitCode
jsay s = do { putStrLn s; rawSystem "jsay" [s] }
ruby :: String -> IO String
ruby s = do
(input, output, _, _) <- runInteractiveProcess
"mecab" ["--eos-format="
,"--unk-format=\\s%m"
,"--node-format=\\s%pS%f[7]"]
Nothing Nothing
hPutStr input s
hClose input
hGetContents output
speak :: String -> IO ExitCode
speak s = do r <- ruby s
utf <- s2u r
sjis <- u2s $ tr utf
jsay sjis
tr :: String -> String
tr s = join "," $ map ascp $ words s
ascp :: String -> String
ascp s
| (ord $ head s) > 127 = s
| isDigit $ head s = "<NUMK VAL=" ++ s ++ ">"
| isAlpha $ head s = join "," $ map (\c -> a2p (toLower c) tblAsc) s
| isPunctuation $ head s = join "," $ map (\c -> a2p c tblPunct) s
| isSymbol $ head s = join "," $ map (\c -> a2p c tblPunct) s
| isControl $ head s = "どくもじ"
| otherwise = "おかしいぞ"
main :: IO ()
main = do args <- getArgs
cs <- readFile $ head args
mapM_ speak $ lines cs