takatoh's blog – Learning programming languages.
引数が与えられたらそれをファイル名と見なしてファイルを読み込み，与えられなければ標準入力から読み込む。いわゆるフィルタとしても働くプログラム。こんな感じでいいか？
module Main (main) where
import System
main :: IO ()
main = do args <- getArgs
contents <- if (not.null) args then readFile $ head args else getContents
putStr contents
引数にファイル名を指定
D:\>runghc catFile.hs hello.txt Hello, Haskell.
標準入力から
D:\>runghc catFile.hs < hello.txt Hello, Haskell.
パイプ経由
D:\>type hello.txt | runghc catFile.hs Hello, Haskell.
cf. 今日の一行 – loopの列挙
trail はすでにたどったノードのリスト p と次にたどるノードの候補 q を受け取って，全ての経路を列挙する。「次のノード」がスタートと同じならそこでそのループは終わり。違うなら再帰的にノードをたどる。
各ノードは比較さえできればいいので Eq a にした。入出力の関係で結局は文字列になってるけど。
module Main (main) where
import Data.List (intersperse)
import System (getArgs)
trail :: (Eq a) => [a] -> [a] -> [[a]]
trail p q = concat $ map trail' q
where
trail' q1 | head p == q1 = [ p ++ [q1] ]
| otherwise = trail (p ++ [q1]) $ filter (q1/=) q
trailLoop :: (Eq a) => a -> [a] -> [[a]]
trailLoop s = trail [s]
enumLoops :: (Eq a) => [a] -> [[a]]
enumLoops nodes = concat $ map (flip trailLoop nodes) nodes
showLoop :: [String] -> String
showLoop = concat . intersperse " -> "
main :: IO ()
main = do nodes <- getArgs
mapM_ (putStrLn . showLoop) $ enumLoops nodes
実行例
D:\>runghc enumLoops.hs 1 2 3 1 -> 1 1 -> 2 -> 1 1 -> 2 -> 3 -> 1 1 -> 3 -> 1 1 -> 3 -> 2 -> 1 2 -> 1 -> 2 2 -> 1 -> 3 -> 2 2 -> 2 2 -> 3 -> 1 -> 2 2 -> 3 -> 2 3 -> 1 -> 2 -> 3 3 -> 1 -> 3 3 -> 2 -> 1 -> 3 3 -> 2 -> 3 3 -> 3
ノードが１つ増えるとループはぐっと増える。
D:\>runghc enumLoops.hs 1 2 3 4 1 -> 1 1 -> 2 -> 1 1 -> 2 -> 3 -> 1 1 -> 2 -> 3 -> 4 -> 1 1 -> 2 -> 4 -> 1 1 -> 2 -> 4 -> 3 -> 1 1 -> 3 -> 1 1 -> 3 -> 2 -> 1 1 -> 3 -> 2 -> 4 -> 1 1 -> 3 -> 4 -> 1 1 -> 3 -> 4 -> 2 -> 1 1 -> 4 -> 1 1 -> 4 -> 2 -> 1 1 -> 4 -> 2 -> 3 -> 1 1 -> 4 -> 3 -> 1 1 -> 4 -> 3 -> 2 -> 1 2 -> 1 -> 2 2 -> 1 -> 3 -> 2 2 -> 1 -> 3 -> 4 -> 2 2 -> 1 -> 4 -> 2 2 -> 1 -> 4 -> 3 -> 2 2 -> 2 2 -> 3 -> 1 -> 2 2 -> 3 -> 1 -> 4 -> 2 2 -> 3 -> 2 2 -> 3 -> 4 -> 1 -> 2 2 -> 3 -> 4 -> 2 2 -> 4 -> 1 -> 2 2 -> 4 -> 1 -> 3 -> 2 2 -> 4 -> 2 2 -> 4 -> 3 -> 1 -> 2 2 -> 4 -> 3 -> 2 3 -> 1 -> 2 -> 3 3 -> 1 -> 2 -> 4 -> 3 3 -> 1 -> 3 3 -> 1 -> 4 -> 2 -> 3 3 -> 1 -> 4 -> 3 3 -> 2 -> 1 -> 3 3 -> 2 -> 1 -> 4 -> 3 3 -> 2 -> 3 3 -> 2 -> 4 -> 1 -> 3 3 -> 2 -> 4 -> 3 3 -> 3 3 -> 4 -> 1 -> 2 -> 3 3 -> 4 -> 1 -> 3 3 -> 4 -> 2 -> 1 -> 3 3 -> 4 -> 2 -> 3 3 -> 4 -> 3 4 -> 1 -> 2 -> 3 -> 4 4 -> 1 -> 2 -> 4 4 -> 1 -> 3 -> 2 -> 4 4 -> 1 -> 3 -> 4 4 -> 1 -> 4 4 -> 2 -> 1 -> 3 -> 4 4 -> 2 -> 1 -> 4 4 -> 2 -> 3 -> 1 -> 4 4 -> 2 -> 3 -> 4 4 -> 2 -> 4 4 -> 3 -> 1 -> 2 -> 4 4 -> 3 -> 1 -> 4 4 -> 3 -> 2 -> 1 -> 4 4 -> 3 -> 2 -> 4 4 -> 3 -> 4 4 -> 4
via 毎日Haskell – 2006-12-28 文字列の左詰、右詰
cf. desumasuの日記 – Rubyの文字列操作関数をHaskellで定義する
length を使わずに書けたけど，短いとは言い難い。
ljust（左詰）と rjust（右詰）が定義されてるとして
center :: Int -> String -> String
center 0 [] = ""
center n xs = f (ljust n xs) (rjust n xs)
where
f l r | l == r = l
| otherwise = g l (tail r ++ " ")
g l r | l == r = l
| otherwise = f " " ++ take (n-1) l) r
id:desumasu さんのと引数の順番が違うのは，この方が Haskell っぽいから（気のせい？）。２行目がないと，空文字列を0文字に中央詰めする場合にエラーになる。
実行例。
*Main> center 8 "abc" " abc " *Main> center 8 "abcd" " abcd " *Main> center 3 "abcd" "abcd" *Main> center 3 "" " " *Main> center 0 "" ""
HUnit を使ったテスト（id:desumasuさんのコードを改変）。
import Test.HUnit testCenter = test [ "test1" ~: " hoge " ~=? center 8 "hoge" , "test2" ~: "hoge" ~=? center 1 "hoge" , "test3" ~: " hoge " ~=? center 7 "hoge" , "empty1" ~: "" ~=? center 0 "" , "empty2" ~: " " ~=? center 2 "" ]
*Main> runTestTT testCenter Cases: 5 Tried: 5 Errors: 0 Failures: 0
昨日（id:takatoh:20070111:lighttpd） のつづき。
URL がディレクトリを指して，かつインデックスファイルが見つからない場合に，ディレクトリ内容のリストを表示する機能。mod_dirlisting モジュールは server.modules で指定する必要もなくデフォルトで読み込まれるので，機能を有効にするだけでいい。
dir-listing.activate = "enable"
もし，特定のディレクトリだけリストを表示したいなら次のようにする（これは C:\lighttpd\doc\dirlisting.txt に載っている例）。
$HTTP["url"] =~ "^/download($|/)" {
dir-listing.activate = "enable"
}
mod_alias を読み込んで
"mod_alias",
エイリアスのリストを指定。lighttpd.conf に記述がないので追加する。
alias.url = ( "/cgi-bin/" => "C:/lighttpd/cgi-bin/" )
バーチャルホスト関連のモジュールには mod_evhost というのもあるけど，ここでは mod_simple_vhost を使う（名前ベース）。まずはモジュールの読み込み。
"mod_simple_vhost",
でもって，次のように設定する。これがデフォルトのバーチャルホストになる。
simple-vhost.server-root = "C:/lighttpd/servers/" simple-vhost.default-host = "vhost1" simple-vhost.document-root = "/pages/"
simple-vhost.server-root で指定したディレクトリ以下にバーチャルホストと同名のディレクトリを用意する。ほかの場所に作ってもダメなようだ。
で，この例では vhost1 がバーチャルホスト名，C:/lighttpd/servers/vhost1/pages/ がそのドキュメントルートだ。
複数のバーチャルホストをたてるには
$HTTP["host"] == "vhost2" {
server.document-root = "C:/lighttpd/servers/vhost2/pages/"
}
のように $HTTP[“host”] の値で場合分けする。
元々のホスト－－昨日の例でいえば http://localhost:81/ でアクセスしていたホスト－－は無効になるようだ。
ので，メモ。
cf. http://www.lighttpd.net/ （公式サイト）
cf. ぱるも日記 – Windows で lighttpd を使う
↓ダウンロードはここから。バージョンは 1.4.11。
http://blogs.windowsnetworking.com/wnadmin/2006/09/22/lighttpd-web-server/
公式サイトにはWindows用バイナリ配布サイトへのリンクがあるけど，どういう訳か接続できない。
で，ここの人がミラーしてるってことらしい。最新バージョンではないけど気にしないことにする。
インストールは簡単。ダウンロードしたインストーラを実行するだけ。
インストール先を聞いてこないので，C:\lighttpd に固定のようだ。
設定ファイルは，C:\lighttpd\etc\lighttpd.conf。
ぱるも日記 – Windows で lighttpd を使うを参考に。あと，付属のマニュアル（英語）をちょっとだけ参照。
まずは読み込むモジュール。CGI を使えるように，mod_cgi モジュールを読み込む。コメントをはずせばいい（29行目）。
"mod_cgi",
ドキュメントルート。これはデフォルトのまま。
server.document-root = "C:/lighttpd/htdocs/"
URLにファイル名が省略されたときのインデックスファイルに index.cgi を追加（46行目）。
index-file.names = ( "index.cgi", "index.php", "index.html",
ポート（138行目）。デフォルトは 80 だけど Apache が使ってるので変更。
server.port = 81
CGIスクリプトの拡張子と実行プログラムを指定（219行目～）。
cgi.assign = ( ".pl" => "C:/usr/perl/bin/perl", ".rb" => "C:/usr/ruby/bin/ruby", ".cgi" => "C:/usr/ruby/bin/ruby" )
これで lighttpd を再起動すれば，設定が有効になる。
起動・停止はスタートメニューかアイコンでできる。けど，リスタートが無いのがちょっと不便。
ユーザーディレクトリも使える。まずは mod_userdir を有効化。
"mod_userdir",
パスの設定。lighttpd.conf にデフォルトの記述がないので一番最後に追加した。
userdir.basepath = "D:/www/lighttpd_users/" userdir.path = "htdocs"
これで URL とパスの関係は次のようになる。
Apache の .htaccess に相当するものは無いのかな。
つづき –> id:takatoh:20070112:lighttpd
1月1日からISBN（国際標準図書番号）が変わったという話題。
via ぷわぷわのあかしろ – ISBN
cf. 日本図書コード管理センター – ISBN規格改訂のお知らせ
そういえば昨日買った本のISBNは13桁だった。
そうか，チェックデジットの計算方法も変わってるのか。
で，旧番号から新番号に変換するコードを書いてみた。
入力は，頭の “ISBN” やチェックデジットはあってもなくても良いけど，区切りの “-” は必須。
module Main (main) where
import Data.Char (isAlpha, isDigit)
import System (getArgs)
checkDigit :: [Char] -> String
checkDigit s = show cd
where
cd = if l == 0 then 0 else 10 - l
l = f `mod` 10
f = sum $ zipWith (*) [1,3,1,3,1,3,1,3,1,3,1,3] $ map (\c -> read [c]) s
stripIsbnOld :: String -> String
stripIsbnOld = take 11 . dropWhile isAlpha
isbnConv :: String -> String -> String
isbnConv flg old = "ISBN" ++ flg ++ stripIsbnOld old ++ "-" ++ checkDigit (filter isDigit (flg ++ old))
isbnConv978 :: String -> String
isbnConv978 = isbnConv "978-"
main :: IO ()
main = do cs <- getArgs >>= return . head
putStr $ isbnConv978 cs
実行例。
D:\>runghc isbnconv.hs ISBN4-949999-08-7 ISBN978-4-949999-08-3
お題だけ拝借。
cf. Gaucheクックブック – タブをスペースで展開する
１文字ずつ処理する。正規表現を使ったり日本語を考慮するのはパス。
untabify :: Int -> String -> String
untabify w = f "" 0
where
f r _ [] = r
f r p (c:cs) | '\t' == c = f (r ++ replicate (ts p) ' ') (p + ts p) cs
| otherwise = f (r ++ [c]) (p + 1) cs
ts p = w - p `mod` w
はじめは foldl を使おうと思ったけど f の引数が３つになる（展開後の文字列を位置を蓄積する必要がある）のであきらめた。あと，haskell らしくリストの引数は後ろに。
実行例。
*Main> untabify 8 "012\t012345\t01" "012 012345 01"
タブ幅は２文字がすき。
*Main> untabify 2 "012\t012345\t01" "012 012345 01"
あ，そうか。f の引数をタプル（ペア）にしてやれば foldl が使えるんだ。
untabify2 :: Int -> String -> String
untabify2 w = fst . foldl f ("", 0)
where
f (r, p) c | '\t' == c = ( r ++ replicate (ts p) ' ' , p + ts p )
| otherwise = ( r ++ [c] , p + 1 )
ts p = w - p `mod` w
*Main> untabify2 8 "012\t012345\t01" "012 012345 01" *Main> untabify2 2 "012\t012345\t01" "012 012345 01"
cf. HaHaHa! – ハイフンで区切られた文字をキャピタライズ
cf. 趣味的にっき – ハイフンで区切られた文字をキャピタライズ
↑ここら辺を見て思い出したのが，Ruby on Rails （より正確には ActiveSupport）にある String#underscore。
String#underscore は大文字/小文字/数字からなる文字列を小文字/数字/アンダースコアからなる文字列に変換するメソッドで……つまりこんな感じ。
D:\>irb -rrubygems -ractive_support --simple-prompt >> [ "Railes", ?> "ActiveSupport", ?> "Active1Support", ?> "Active1support", ?> "ToDoList", ?> "XML", ?> "XML2", ?> "XMLData", ?> "XMLdata", ?> "XML2Data", ?> "Iso2022jpMailer" >> ].each do |s| p s.underscore end "railes" "active_support" "active1_support" "active1support" "to_do_list" "xml" "xml2" "xml_data" "xm_ldata" "xml2_data" "iso2022jp_mailer" => ["Railes", "ActiveSupport", "Active1Support", "Active1support", "ToDoList", " XML", "XML2", "XMLData", "XMLdata", "XML2Data", "Iso2022jpMailer"]
これを Haskell でやってみた。
‘_’ は大文字の直前に入るんだけど，前後の文字によって入ったり入らなかったりで，ちょっと複雑。なので State モナドを使ってみた。
import Control.Monad.State
import Data.Char
import System.Environment
data CharCase = UpperB4Upper | UpperB4Lower | UpperB4Number | UpperAtEnd | Lower | Number | None
cState :: Char -> CharCase
cState c | isUpper c = UpperB4Upper
| isLower c = Lower
| otherwise = Number
procChar :: Char -> State CharCase [Char]
procChar c = get >>= p
where
p UpperB4Upper = do put $ cState c
return [toLower c]
p UpperB4Lower = do put $ cState c
return $ "_" ++ [toLower c]
p UpperB4Number = do put $ cState c
if isUpper c then return [toLower c]
else return $ "_" ++ [c]
p UpperAtEnd = do put $ cState c
if isUpper c then return [toLower c]
else return $ "_" ++ [c]
p Lower | isUpper c = do put (UpperB4Lower)
return [toLower c]
| otherwise = do put $ cState c
return [c]
p Number | isUpper c = do put (UpperB4Number)
return [toLower c]
| otherwise = do put $ cState c
return [c]
p None = do put $ if isUpper c then UpperAtEnd else cState c
return [toLower c]
underScoreR :: String -> State CharCase String
underScoreR s = do strs <- mapM procChar $ reverse s return $ reverse $ concat strs underScore :: String -> String
underScore s = evalState (underScoreR s) None
UpperAtEnd は UpperB4Number と扱いが同じだから無くてもいいかも。
チェック用関数。
samples = [ ( "Rails" , "rails" )
, ( "ActiveSupport" , "active_support" )
, ( "Active1Support" , "active1_support" )
, ( "Active1support" , "active1support" )
, ( "ToDoList" , "to_do_list" )
, ( "XML" , "xml" )
, ( "XML2" , "xml2" )
, ( "XMLData" , "xml_data" )
, ( "2XMLdata" , "xm_ldata" )
, ( "XML2Data" , "xml2_data" )
, ( "Iso2022jpMailer" , "iso2022jp_mailer" )
]
checkSamples = mapM_ (putStrLn . check) samples
check s = (show $ underScore org == uds) ++ " " ++ org ++ " => " ++ uds
where
org = fst s
uds = snd s
実際にやってみると
*Main> checkSamples Loading package mtl-1.0 ... linking ... done. True Rails => rails True ActiveSupport => active_support True Active1Support => active1_support True Active1support => active1support True ToDoList => to_do_list True XML => xml True XML2 => xml2 True XMLData => xml_data True XMLdata => xm_ldata True XML2Data => xml2_data True Iso2022jpMailer => iso2022jp_mailer
OKみたい。
Haskell の話題だけでは間が持たないので，Ruby（やその他）についても書くことにします。
だって，ほら，べつに Haskell グループじゃないし。
cf. Ruby/ProgressBar: プログレスバーをテキストで表示する Ruby用のライブラリ
via 趣味的にっき – プログレスバーをテキストで表示する関数
インストールは progressbar.rb をライブラリパスの通ったところにおけばいいだけ。
ProgressBar のインスタンスをつくっておいて ProgressBar#inc か ProgressBar#set で進捗を表示する。
まずは記事にある使用例で試してみよう。
D:\>irb -rprogressbar
irb(main):001:0> pbar = ProgressBar.new("title", 100)
=> #<ProgressBar:0/100> | ETA: --:--:--
irb(main):002:0> (1..100).each{|i| sleep(0.1); pbar.set(i)}; pbar.finish
title: 100% |oooooooooooooooooooooooooooooooooooooooooo| Time: 00:00:35
=> Thu Dec 21 21:29:46 +0000 2006
ProgressBar#file_transfer_mode を使うと，ファイルの転送バイト数と転送速度を表示できる。
こんな感じ。
require 'progressbar'
fname1 = ARGV.shift
fname2 = ARGV.shift
f1 = File.open(fname1, "rb")
f2 = File.open(fname2, "wb")
size = File.size(fname1)
pbar = ProgressBarnew("transfer file", size)
pbar.file_transfer_mode
until f1.eof?
f2.write(f1.read(1000))
pbar.inc(1000)
end
pbar.finish
f1.close
f2.close
ファイルのコピーを低レベルでやらなきゃいけないけど。
実行例。
D:\>copy_pbar.rb projects.xls copy_projects.xls transfer file: 100% |oooooooooooooooooooooooo| 5.0MB 35.5MB/s Time: 00:00:00