QuickCheckで100回以上テストを回す(メモ)

HaskellにはQuickCheckという便利なライブラリがあります。これは、自分で作った関数が特定の性質を満たしているかどうか手早くテストするときに役に立ちます。

たとえば、あなたが(多分自分の勉強のために)2つのリストを結合する関数myconcatを次のように書いたとしましょう:

import Test.QuickCheck
-- $ stack install QuickCheck

myconcat :: (Eq a) => [a] -> [a] -> [a]
myconcat [] ys = ys
myconcat (x:xs) ys = x : (xs `myconcat` ys)

実際これは多くのHaskell教科書に(++)の参照実装として挙げられているものをそのまま真似ただけですから、当然

(xs `myconcat` ys) `myconcat` zs == xs `myconcat` (ys `myconcat` zs)

という性質は「常に」成り立つと期待したいところです。このような事を保証するためには、結局なんらかの証明を与える必要があります。
例えば Richard Bird 著/山下伸夫 訳『関数プログラミング入門 — Haskellで学ぶ原理と技法』では、そのような証明を「手で」つける例が随所で扱われています。あるいは、Coqのような言語を使って、成り立っていることが期待される性質が実際に成り立つことの形式的な証明を与えるという手段もあります。

いずれにせよ、何かのしっかりとした証明をつけるというのはなかなか面倒なことではあります。そこで、乱数で生成した例で手っ取り早くテストしたいという場合があります。特に、「期待される性質」が実際に成り立っていないかもしれないという疑念があるときにはこのような検査は有効です。間違った命題—その命題が本当に間違っているかどうかを事前に知ることができない場合が多いことが厄介なわけですが—を証明しようとあれこれ悩みたくないですからね。

今の場合ならソースコードの末尾にこんな関数を付け加えておけば良いです:

mytest xs ys zs = (xs `myconcat` ys) `myconcat` zs == xs `myconcat` (ys `myconcat` zs)

そしてghciから

*Main> quickCheck mytest
+++ OK, passed 100 tests.

と試せば良いわけです。

ところで、100回以上テストしたい場合はどうすればいいのでしょうか? ここ(stackoverflow)で答を見つけました。答から先に書くと、たとえば5000回テストしたい場合には

*Main>quickCheckWith stdArgs { maxSuccess = 5000 } mytest

とすればいいです。

引用した stackoverflow のあるコメントの後半に「どうやってこの答をみつけたか」の丁寧な解説があったので補足しつつ翻訳します。

1.API documentation を見に行く

API documentation のページはこんなふうなリンクから飛べる

2. quickCheck を見てその次に見たのは maxSuccess フィールドを持つ Args 型だった。

Args型

3. 全部のフィールドを書くのは嫌だったので、Args 型の値を探したら stdArgs が見つかった。(ブラウザの検索機能 Ctrl+F を使いましょう)。または、hoogle を使っても良かったかもしれない。

4. 自分の Args 型変数を使いたいので検索を続行した。次の行に quickCheckWith があった—これだ! または、hoogleを使うという手もあった。

img3

「使ったことがないライブラリをどう使うか」というのは非常に重要です。上に書いてあることはHoogleを使い慣れている人が当たり前にやっていることでしょうが、きちんと段階化し言語化してあるところが素晴らしいと思って訳してしまいました。

更に補足すると、stdArgs { maxSuccess = 5000 }の箇所は、stdArgsが返すArgs型の値の maxSuccessフィールドを 5000 に書き換えた値を生成しているのでした。

広告

ココナツの問題をC++で解く

■前回の記事「Maybeの(>=>)を使って問題を解く」ではHaskellでココナツ問題を解いてみたが、もし使える言語がC++しかなかったらどうするか考えてみた。Haskellでは失敗する可能性のある関数を「合成」することができたが、C++にはそのような機能がないのでif文で分岐することになる。

#include <iostream>
#include <utility>

#define MAX 100000

using namespace std;

pair<bool,int>  g(int n, int r)
{
  pair<bool,int> retval = make_pair(false,0);
  if(0 == (n-r) % 5){
    const int x = 4*((n-r)/5);
    retval = make_pair(true,x);
  }
  return retval;
}

typedef pair<bool,int> mint;

bool check_num(int n)
{
  //1,1,1,1,1,0
  const mint n1 = g(n,1);
  if(n1.first){
    const mint n2 = g(n1.second,1);
    if(n2.first){
      const mint n3 = g(n2.second,1);
      if(n3.first){
        const mint n4 = g(n3.second,1);
        if(n4.first){
          const mint n5 = g(n4.second,1);
          if(n5.first){
            const mint nfin = g(n5.second,0);
            if(nfin.first){
              return true;
            }
          }
        }
      }
    }
  }
  return false;
}

int get_ans(){
  for(int n = 0; n < MAX; ++n){
    if(check_num(n)){
      return n;
    }
  }

  return -1;
}

int main()
{
  const int n = get_ans();
  cout << n << endl;
  return 0;
}

関数check_numをもう少し読みやすく出来ないかと考えてみたが、良い考えを思いつかなかった。

昔の自分なら、マクロを使って

bool check_num(int n)
{
  //1,1,1,1,1,0
  const mint n1 = g(n,1);

  #define MY_MACRO(X,Y,R)   g(X.second,R);if(! Y.first){return false;}

  const mint n2 = MY_MACRO(n1,n2,1);
  const mint n3 = MY_MACRO(n2,n3,1);
  const mint n4 = MY_MACRO(n3,n4,1);
  const mint n5 = MY_MACRO(n4,n5,1);
  const mint nfin = MY_MACRO(n5,nfin,0);

  return true;
}

のように書いたかもしれないが、疲れているときにこのようなコードを書くことの恐ろしさを何度か経験したのであまり乗り気にはなれない。

■結論は特にない。(HaskellがすごいとかC++がダメだと主張したいわけではない)。

Maybeの(>=>)を使って問題を解く

■マーティン・ガードナーのパズル本を見ていたらこんな問題が載っていた:

5人の男と一匹の猿が難破して無人島に漂着した。1日目、彼らは食糧としてたくさんのココナツを集めて回った。そしてその夜、すべてのココナツを積み上げて彼らは眠りについた。
 しかし全員が眠りについたあと、1人の男がふと目を覚ました。朝になってココナツを分けるとき、ひと悶着起きるかもしれないではないか。心配になった彼は自分の取り分を先取りしようと考えた。彼がココナツを5つの山に等分してみると、1つ余ったので、彼はそれを猿にあげてから、自分の取り分を隠して、残りを元通りに積んでおいた。
 しばらくして別の男が目を覚まして、同じことを考えた。やはりココナツは1つ余り、それは猿のものになった。こうして5人の男たちが順番に同じことをした。つまり1人ずつ目を覚ましては、ココナツの山を5つに分けて、残った1つを猿にあげて、自分の取り分を画した。朝になり、残ったココナツ全部を分けると、今度はきれいに5等分された。
(略) さて、最初にココナツはいくつあったのだろうか?

計算機で総当りしてももちろんこの問題は解ける。本には、これを少ない労力で解くためのトリックが紹介されていた。(「ガードナーの数学娯楽」/日本評論社)。そのトリックについてはこの記事では触れない。

この問題を見たとき、HaskellのMaybeモナドを使ったら素直に解けそうだと感じた。(そして実際に解けた)。ココナツの数をNとすると
N = 5A +1 ;  4A個の山を残す # 1人目の男
4A = 5B + 1 ; 4B個の山を残す # 2人目の男
4B = 5C + 1 ; 4C個の山を残す # 3人目の男
4C = 5D + 1 ; 4D個の山を残す # 4人目の男
4D = 5E +1 ; 4E個の山を残す # 5人目の男
4E = 5F ; きれいに5等分された
のようになる。「与えられた数から1を引いておけば5で割り切れる」という状況が続き、そうして得られた商の4倍だけ残すという操作が5回行われている。そこでこんな関数を考えてみよう:

g :: Int -> Int -> Maybe Int
g r n
    |  (n-r) `rem` 5 == 0  = Just( ((n-r) `quot` 5) * 4 )
    |  otherwise           = Nothing

こうすると、それぞれの男が行った操作は g 1 として表現できる:

g 1 :: Int -> Maybe Int

一般に、モナドMに対して X -> M Yの形の関数は、(>=>)で合成できるのだった。
(この記事では説明しないし、知っている必要もないが、この形の関数はこのモナドの与えるKleisli圏の射とみなす事ができ、(>=>)はこのタイプの射の「合成」とみなせるのだった)。

よって、5人の男がココナツに対して行った操作とその結果は

f :: Int -> Maybe Int
f = g 1 {- 1人目の男 -} >=> g 1{- 2人目の男 -} >=> g 1{- 3人目の男 -} >=> g 1{- 4人目の男 -} >=> g 1{- 5人目の男 -} >=> g 0

として表せる。もちろんこれはもっとコンパクトに

f = foldl1 (>=>) [g 1, g 1, g 1, g 1, g 1, g 0]

と書いてもいいし、さらにこれは

f = foldl1 (>=>) $ map g [1,1,1,1,1,0]

と書いてもいい。こうして得られたfInt -> Maybe Int という型シグネチャを持つ。元のクイズの答をNとするとき、 f N Just ...という形をしているはずである。そこで、こんな関数を用意してみよう:

--  f の答がNothing ではない場合の引数を得るように変形する
getJustArg :: (a -> Maybe b) -> (a -> Maybe a)
getJustArg f x
    | isJust (f x)  = Just x
    | otherwise     = Nothing

この関数を使えば、問題のNは map (getJustArg f) [1 ..] の最初の元から得られることがわかる。Data.List の

find :: (a -> Bool) -> [a] -> Maybe a

を使えば最初の元を取ってこられそうだ。findMaybeをかぶせて返してくるおかげで、
find isJust (map (getJustArg f) [1 ..])Maybe(Maybe Int) 値になる。そこで join してMaybe を一段に落としてやると、得られる答は Just n の形をしているので fromJustInt値を引っ張り出せる:

fromJust . join $ find isJust (map (getJustArg f) [1 ..])

以上をまとめると次のようなプログラムが得られる:

import Control.Monad
import Data.List
import Data.Maybe

g :: Int -> Int -> Maybe Int
g r n
    |  (n-r) `rem` 5 == 0  = Just( ((n-r) `quot` 5) * 4 )
    |  otherwise           = Nothing

f = foldl1 (>=>) $ map g [1,1,1,1,1,0]

getJustArg :: (a -> Maybe b) -> (a -> Maybe a)
getJustArg f x
    | isJust (f x)  = Just x
    | otherwise     = Nothing

main = do{
  print $ fromJust . join $ find isJust (map (getJustArg f) [1 ..])
  }

答は3121となる。

■まとめ
Maybeモナドに対するKleisli射の合成演算(>=>)を用いてクイズを解いてみた。

■おまけの問題

5人の男と一匹の猿が難破して無人島に漂着した。1日目、彼らは食糧としてたくさんのココナツを集めて回った。そしてその夜、すべてのココナツを積み上げて彼らは眠りについた。
 しかし全員が眠りについたあと、1人の男がふと目を覚ました。朝になってココナツを分けるとき、ひと悶着起きるかもしれないではないか。心配になった彼は自分の取り分を先取りしようと考えた。彼がココナツを5つの山に等分してみると、4つ余ったので、彼は余ったココナツを猿にあげてから、自分の取り分を隠して、残りを元通りに積んでおいた。
 しばらくして別の男が目を覚まして、同じことを考えた。今度は3つ余ったので、彼はやはり余ったココナツを猿に与え、自分の取り分を隠してから残りを積んでおいた。
三番目の男も同じことを考えたが、彼がココナツを5つの山に分けようとすると今度は2つ余った。やはり彼は余ったココナツを猿に与え、自分の取り分を隠してから残りを積んでおいた。
四番目の男も同じことを考えたが、彼がココナツを5つの山に分けようとすると今度は1つだけ余った。やはり彼は余ったココナツを猿に与え、自分の取り分を隠してから残りを積んでおいた。
五番目の男も同じことを考えたが、彼だけは仲間を裏切ることを恥ずかしく思い、結局何もしなかった。
朝になり、残ったココナツ全部を分けると、きれいに5等分された。
さて、最初にココナツはいくつあったのだろうか?

最小の答は3089個になるはずである。

Makefile で basename や strip を使う(自分用メモ)

こんな Makefile があったとします:

.PHONY : aaa

aaa : bbb.hs   
    ghc  bbb.hs
    ./bbb

Makefile に少し慣れてくると,$< を使って

.PHONY : aaa

aaa : bbb.hs   
    ghc  $<
    ./bbb

のように書くかもしれませんが,今度は ./bbb の箇所が気になります.しかし,コマンド basename を使って

### DOES NOT WORK
.PHONY : aaa

aaa : bbb.hs   
    ghc  $<
    ./$(basename .hs $<)

としてやってもうまくいきません.先頭に空白が残るからです.そこで Make のコマンド strip を使って

aaa : bbb.hs
    ghc $<
    ./$(strip $(basename .hs $<))

としてやると,期待した通りの動作になります.

メモ:Haskellの二項演算子風型構成子

元ネタ:http://stackoverflow.com/questions/19197339/haskell-data-constructor-meaning

(:->)という外国の顔文字みたいな型構成子が気になってHaskell2010を調べたがよくわからず、上のStackoverflowでようやくわかった。

そのまんまの引用だが

data Rose a = a :> [Rose a]
deriving (Eq, Show)

というサンプルが挙げられている。(この例の元ネタは”A rose is a rose is a rose” だろうか)。
最初が:で始まる記号列を型構成子に使えることは知らなかった。忘れそうなのでメモしておく。

Windows に YukiTask を導入する(メモ)

このツイート


を見て便利そうだと思ったので,Windows+MinGWに YukiTask を導入してみた.幾つかハマりそうになったので記念にメモを残す.MinGWを前提とする.Cygwinでもうまくいくと思うが試していない.

■rubyの準備(1)
YukiTaskを動かすために必要なのでインストールした.
Rubyのインストール で調べた上で ruby2.1.6 をインストールした.

■rubyの準備(2)
(1/1): ~/.bashrcに次を追加:

export PATH=$PATH:/c/Ruby21/bin

これにより,MinGWシェルからrubyが見えるようになる.

(2/2): C:\MinGW\msys\1.0\etc\fstab に次を追加:

c:/Ruby21/bin/ruby  /usr/bin/ruby

これにより,シェルスクリプト中に置かれた /usr/bin/ruby が c:/Ruby21/bin/ruby を参照するようになる.

■YukiTask の導入(1)
YukiTask Setup に書いてあることを大体そのままやればよい:

$ mingw-get install msys-wget   #wget を慌ててインストールしている様子
$ mkdir YukiTaskBuild; cd YukiTaskBuild
$ wget --no-check-certificate https://github.com/hyuki0000/yukitask/archive/master.zip
$ mv master master.zip
$ unzip master.zip
$ cd yukitask-master
$ mv yukitask ~

最後のコマンドを実行すると yukitask というディレクトリがホーム直下に移動するが,各自の好みの場所に置けば良い(はず).

■YukiTaskの導入(2)
~/.bashrc の下の方に次を追加する:

export EDITOR=/c/Users/FooBarBaz/AppData/Local/atom/app-0.199.0/atom.exe
PATH=~/yukitask:$PATH
source ~/yukitask/command_aliases
source ~/yukitask/here_aliases

最後の三行ではyukitask というディレクトリがホーム直下にあることを前提としているので,それ以外の場所に置いた人は適宜修正する必要がある.
自分はvimが苦手なので上のサンプルではエディタにatomを指定した.キーボードから手を離したくないならばvimとかそんな感じのエディタを指定すれば良い.

■pbcopy 対策(1)
これで一応動くはずと思って YukiTask TODO のサンプルを実行しようとしたら,YukiTaskの here コマンドで pbcopy にまつわるエラーに遭遇した:「’pbcopy’ は、内部コマンドまたは外部コマンド、操作可能なプログラムまたはバッチ ファイルとして認識されていません。」だそうだ.
調べてみると,pbcopy はMacにしかないコマンドらしい.色々な work-around を調べてみたが,一番カンタンそうなのは go 製のツールで代用するというものだった:Bye Bye Moore/クロスプラットフォームな環境でpbcopy | pbpasteをしたいときはgocopy | gopasteを使う
いままで go を使ったことがなかったが,この機会にインストールした.go を使うためにはパスを通すだけでなく,環境変数GOPATHを設定しないといけないらしい.とにかく動けばいいのでホーム直下に go ディレクトリを作っておくことにした.go へのパスとGOPATHの設定は ~/.bashrc に次のように書いた:

export PATH=$PATH:/c/Go/bin
export GOPATH=~/go

■pbcopy 対策(2)
goのことは全く理解していないが,上で紹介したページに書いてあるとおり

$ go get github.com/atotto/clipboard
$ go get github.com/atotto/clipboard/cmd/gopaste
$ go get github.com/atotto/clipboard/cmd/gocopy
$ exec -l $SHELL

とやれば gocopy.exe が手に入る.$GOPATH/bin にできた gocopy.exe を pbcopy.exe にリネームしておく.$GOPATH/bin にもパスを通しておく:

export PATH=$PATH:$GOPATH/bin

以上の対策で,YukiTaskの here コマンドがpbcopyでコケなくなった.

■YukiTaskを用いた開発の流れ
Haskellの教科書やチュートリアルのサンプルをどんどん書きながら実行するという事を考えてみる.(結城さんの元のツイートがHaskell関連だったのと,私自身の関心からこう書いているが,もちろんどんな言語で使ってもよい.)

1.適当なところにプロジェクトディレクトリを掘る.
たとえば

$ cd
$ mkdir haskell-proj; cd haskell-proj

のようにすればよい.

2.YukiTask の here コマンドでカレントディレクトリにプロジェクト名を割り当てる.

$ here haskell

これによって haskell というコマンドが作られる.YukiTaskを使うつもりでないときも以降は haskell と打っただけでこのコマンドが起動してしまうということでもある.うっかりヤバい名前のコマンドを作ってしまった場合は ~/yukitask/here_aliases をエディタで編集してヤバい名前のコマンド登録を削除すればよい.

3.haskellプロジェクトでの作業を始める

$ cd
$ haskell
/usr/home/FooBarBaz/haskell-proj ~
cat: $HOME/yukitask/TODO: No such file or directory #気にしないことにする
$ pwd
/usr/home/FooBarBaz/haskell-proj

haskell というプロジェクトに対応するディレクトリに移動していることがわかる.

4.適当な名前の.hsファイルを作り,makefileに登録する

$ touch  aaa.hs
$ m

~/.bashrc で定義した環境変数EDITORに対応するエディタが起動して makefile を編集するようになる.たったいま作ったファイルに合わせて e ターゲットに aaa.hs が対応するようにする:

e:
		$(EDITOR) aaa.hs

こうすると,e コマンドで aaa.hs が編集されるようになる.

5.e コマンドと m コマンドを繰り返しながら言語チュートリアルをこなしてゆく
e コマンドで aaa.hs が編集できる.編集が終わったら runghc aaa.hs などして遊ぶ.aaa.hs での遊びが終わったら touch bbb.hs だとか cp aaa.hs ccc.hs のようにして新しいファイルを作り,m コマンドで makefile の編集に入り,eターゲットを書き換えてしまう.

...というような事を繰り返していく.ここでは触れなかったが (YukiTaskの)mk コマンドもうまく使うと良いのかもしれない.

[追記]
本記事のことを結城さんにご紹介したところ,お返事をいただけた:


Makefile変数の定義が複数あると最後の定義で上書きされることを利用するのは思いつかなかった.

bi

※自分用メモです。bison is what とか、どんな原理で動作するかとかの話は書きません(書けません)。

久しぶりにbison(とflex)で遊ぼうと思ったら使い方を色々忘れてしまいました。紙のノートに記録したものがあったのでそれを参考に自分向けのメモを残しておきます。

■bisonファイルの形式
メモ:二箇所に出てくる「%%」が大事。

%{
/*---- C/C++で色々書く ----*/
%}

/*---- Bison宣言部 ----*/
%token ....
%left ....
%right ....
%union ....

%%

/*---- Bison文法部 ----*/

%%

/*---- C/C++で色々書く(その2) ----*/

void helper_func(){ ... }

■OMake関連ファイルの編集

OSTYPE = msys

open build/C
open build/OCaml
open build/LaTeX

DefineCommandVars()

.SUBDIRS: .
.PHONY : all
.DEFAULT : all

TARGET = simple.exe
OBJS = simple.tab.o simple.lexer.o simple_main.o
HEADERS = simple_lexer.h
PREMATURE=premature.
VALUETYPE = double

INCLUDES += -IC:\MinGW\msys\1.0\include -IC:\MinGW\lib\gcc\mingw32\4.8.1\include
LIBPATHS = -LC:\MinGW\lib -LC:\MinGW\lib\gcc\mingw32\4.8.1
LIBS = -lstdc++ -lm

CXX = g++
CXXFLAGS += -Wall -O2 $(INCLUDES)

all : $(TARGET)

%.o: %.cc
	$(CXX) $(CXXFLAGS) -c -o $@ $< 

simple.lexer.cc : simple.l
	flex -o$(PREMATURE)$@ $<
	grep -v "    #define yyFlexLexer yyFlexLexer"  $(PREMATURE)$@ > $@
	$(RM) $(PREMATURE)$@ 

simple.tab.cc  simple.tab.h  : simple.y
	bison -d --verbose $<
	perl -pe 's/typedef int YYSTYPE/typedef $(VALUETYPE) YYSTYPE/;' simple.tab.c > simple.tab.cc
	sed '53c\#define YYSTYPE $(VALUETYPE)' simple.tab.h > $(PREMATURE)simple.tab.h
	mv $(PREMATURE)simple.tab.h  simple.tab.h

$(TARGET) : $(OBJS)
	$(CXX) -o $@ $(LIBPATHS) $(LIBS) $^

■この記事をかくにあたって参考にした記事:
http://d.hatena.ne.jp/fwtmp/20081209

HaskellからFFIでOpenCVを使ってみよう

この記事は Haskell Advent Calendar 2013 の二日目のために慌てて書いたものです.

FFIを使って,画像ライブラリOpenCVを使ってみましょう.OpenCVはBSDライセンスで公開されているフリーの画像処理ライブラリで,物体認識などの比較的高度な機能が実装されてます.今回はそのような高度な機能は使わず,画像の読み込みと書き出しと表示,さらに線を引いたり円を描いたりする初歩的な描画関数だけを使います.

Haskellでは,Foreign Function Interface(FFI,外部関数インタフェース)を通じて,Haskell以外の言語とやりとりが出来ます.FFIには二つの方向があります.

  • 他の言語が持つ機能をHaskellから利用するためのインタフェースを記述する.
  • Haskellで書かれた関数を他の言語から利用する.

本記事では一番目について,とくにC/C++コンパイラで作成されたライブラリの使用方法に限定して解説します.HaskellのFFIの概要は Haskell 2010 Language Reportの Chapter 8 で知ることが出来ますが,FFI と深い関わりのあるライブラリの章(Chapter 25 – Chapter 37)まで含めれば,Haskell 2010 Language Report のページの20%を超える部分がFFIの解説に割かれています.私自身が Chapter 8 をざっと読んだ程度の知識なので,以下の解説でも深いことは触れられません.ご了承ください.

実のところ,一番目の事項,つまりC/C++コンパイラで作成されたライブラリを使う話に限ったとしても,わざわざFFIを学ぶ必要はないかもしれません.というのも,多くの有用なライブラリに対してFFIを用いたHaskellバインディングがすでに作られているからです.しかしながら,自作のライブラリや世間であまり注目されていないライブラリをHaskellから使いたくなる可能性があるならばFFIを学ぶ理由はあるでしょう.もったいぶった前置きをしましたが,本記事で例として取り上げるOpenCVについても,実のところすでにある程度Haskellバインディングが用意されているので,この記事を読まなければHaskellからOpenCVを使えない訳じゃないですよということをかっこよく言いたかっただけです.

さて,ライブラリの実体は,ABIに従うように生成され,そのABIにしたがって解釈したり実行できるバイト列でした.Haskellからライブラリを使うためにはどのようなABIに従うのかを指定する必要があります.現状では ccall, stdcall, cplusplus ぐらいしか選択肢はないようです.以下では ccall を前提とします.

たとえば,Cの標準ライブラリ math.h で宣言されている
double erfc(double x);
をHaskellからFFIで使うコードの例は次のようになります:

import Foreign.C.Types

foreign import ccall "math.h erfc" c_erfc :: CDouble -> CDouble
erfc :: Double -> Double
erfc x = realToFrac $ c_erfc $ realToFrac x
main = putStrLn ("erfc(1.0)= " ++ show (erfc 1.0) )

上のコードはコマンドプロンプトから $ runghc erfc_from_libc.hs としてやれば実行できます.
上のコードの三行目の「ccall "math.h erfc"」の部分は,「C呼び出し規約に従って,math.h で宣言されている erfc を頼む」と読みましょう.さて,その行の残りのc_erfc :: CDouble -> CDouble に出てくる「CDouble」という型は,最初の行のimport Foregn.C.Typesでインポートされています.一般に,Cの double と Haskellの Double は同じ範囲を表せる保証がありません.そこで,Cにおける基本型のほとんどに対して大文字のCで始まる対応物がForegn.C.Typesで定義されています.Doubleの場合は殆どのコンパイラではCのdoubleと同じ範囲を表すんじゃないかと思いますが,とにかく違う型という扱いなので,これをHaskellの関数にラップしたerfc :: Double -> Double の定義では,引数の変形と返り値の変形の合計2回にわたってrealToFracを使っています.

実数や整数の変換については

fromIntegral :: (Integral a, Num b) => a -> b
truncate :: (Integral b, RealFrac a) => a -> b
realToFrac :: (Fractional b, Real a) => a -> b

が便利だったことをこの辺で思い出しましょう.

さて,Cライブラリの関数が副作用を伴わない場合は,話が比較的簡単です.では副作用を持つ関数を考えてみましょう.副作用というのはやや曖昧な言葉ですが,参照透明な関数とは異なった挙動をするもの,例えばI/O関係の関数は副作用を持つと言えます.Haskellでは副作用をアクションとして切り出してモナドとして扱うことによって,参照透明性を保ったままIOを行う処理が(ずばりIOという名前のモナドで)書けるのでした.

ではここでOpenCVを使って副作用を行うC++関数を書いてみましょう.(ちょっと流れが強引ですかね).

extern "C"
{
	void show_madoka();
}

extern "C"を指定しておくことで,生成されたオブジェクトコード中のシンボルがC呼び出し規約で読み込めることが保証されるのでした.)

#include "imshow.h"
#include <highgui.h> //opencv
#include <cv.h>//opencv
#include <cxcore.h>//opencv
#include <iostream>

void show_madoka(){
  using namespace std;
  ::cvNamedWindow("madoka");
  IplImage* pImg = cvLoadImage("madoka.jpg");
  if (!pImg) {
    cerr << "You need madoka.jpg" << endl;
    return;
  }
  cout << "#### 'ESC' to exit" << endl;
  ::cvShowImage("madoka", pImg);
  // ユーザが ESC キーを入力するまで待つ
  enum { Wait_msec = 100, ESC_key = 27,};
  while (true) {
    if (cvWaitKey(Wait_msec) == ESC_key) {break;}
  }
  ::cvDestroyWindow("madoka");
  ::cvReleaseImage(&pImg);
  return;
}

関数void show_madoka() はHaskellからインポートするときにどうなるでしょうか. () -> ()でしょうか?いいえ,()の値などありませんから,型シグネチャが縮退して()になる気がします.ではやってみましょう:

import Foreign.C.Types
foreign import ccall "imshow.h show_madoka" c'show_madoka_bozo :: ()

main = do
  return c'show_madoka_bozo
  putStrLn "madoka"

do式の中で c'show_madoka を置きたかったけれどIOモナドの分だけずれてるのでreturnしてやって型を合わせています.これでばっちり動くはず…なのに何も起きません!これが現実…!

待ってください.画像を表示するためにウィンドウを開いたりするのは副作用だからHaskellの側で受けるときの型シグネチャをIO () にしたら上手くいくのでは? やってみましょう:

import Foreign.C.Types
foreign import ccall "imshow.h show_madoka" c'show_madoka :: IO()

main = do
  c'show_madoka
  putStrLn "madoka"

今度はちゃんと上手く表示されました.(なお,画像にマウスカーソルを合わせてESCを押さないと正常に終了できません.ご了承ください.)

(ちなみに,imshow-bozo.hs や imshow-right.hs を動かすためにはリンクの指定などをする必要がありますが,この辺はいちいちコマンドラインで入力するのが面倒なのでMakefileで処理しています.記事の末尾にMakefileを載せることにします.)

いまとりあげた例は非常に小さいものですが,HaskellのFFIを使う上で気をつけなければならない事の例示となっています.とにかくヤバイということが伝われば幸いです.

さて,もうすこし丁寧に諸々のことを書いておきたい気持ちもありますが,表紙だとかスライドだとか年賀状だとか色々大変なので,今回カージオイド(という曲線)をHaskellからOpenCVの関数をFFI呼び出しして描いたコードをご紹介して記事を終えることにします.

次のヘッダファイルは,今回カージオイドを描くために使った関数をHaskellから import するために,必要に応じてラップしなおした関数の宣言を載せたものです.元々のOpenCVの関数では基本型の直積タイプの構造体を引数とする関数があり,Haskellで import すると扱いが面倒なので「全部基本型に展開して」しまっている箇所があります.

#include <cv.h>

extern "C" {
	IplImage* load_image ( const char* filename);

	IplImage* create_image (
	int width
	, int height
	, const CvScalar color);

	void save_image (const char* filename, IplImage* pImg);

	void make_window (const char* winname);

	void show_image (const char* winname, IplImage* pImg);

	void destroy_window (const char* winname);

	void release_image ( IplImage* pImg );

	//crunched
	IplImage* create_image__crunched (
    int width
	, int height
	, double v0, double v1, double v2);

  //crunched
  void draw_line__crunched (
    IplImage* pImg,
    int pt1x, int pt1y,
    int pt2x, int pt2y,
    double v0, double v1, double v2,
    int thickness);

  void draw_circle__crunched (
  IplImage* pImg,
  int cx, int cy,
  int r,
  double v0, double v1, double v2,
  int thickness);
}

実装側は次のようにしました:

#include "ffi_opencv.h"
#include <highgui.h>
#include <cv.h>
#include <cxcore.h>

IplImage* load_image( const char* filename)
{
  return ::cvLoadImage(filename, CV_LOAD_IMAGE_ANYCOLOR);
}

IplImage* create_image( int width, int height, CvScalar color)
{
  IplImage* pImg = ::cvCreateImage(cvSize(width, height), IPL_DEPTH_8U, 3);
  ::cvSet(pImg, color);
  return pImg;
}

IplImage* create_image__crunched(
    int width,
    int height,
    double v0, double v1, double v2)
{
  return create_image(width, height, cvScalar(v0, v1, v2, 0));
}

void save_image(const char* filename, IplImage* pImg)
{
  ::cvSaveImage(filename, pImg);
  return;
}

void make_window(const char* winname)
{
  ::cvNamedWindow(winname);
  return;
}

void show_image(const char* winname, IplImage* pImg)
{
  ::cvShowImage(winname, pImg);
  enum {  Wait_msec = 100, ESC_key = 27,};
  while(true){ if (::cvWaitKey(Wait_msec) == ESC_key) {break;}}
  return;
}

void destroy_window(const char* winname)
{
  ::cvDestroyWindow(winname);
  return;
}

void release_image(IplImage* pImg)
{
  ::cvReleaseImage(&pImg);
  return;
}

void draw_line__crunched(
    IplImage* pImg,
    int pt1x, int pt1y,
    int pt2x, int pt2y,
    double v0, double v1, double v2,
    int thickness)
{
  ::cvLine(
    pImg
    , ::cvPoint(pt1x, pt1y)
    , ::cvPoint(pt2x, pt2y)
    , ::cvScalar(v0, v1, v2, 0)
    , thickness
    , CV_AA  );
  return;
}

void draw_circle__crunched(
  IplImage* pImg,
  int cx, int cy,
  int r,
  double v0, double v1, double v2,
  int thickness)
{
  ::cvCircle(
    pImg
    , ::cvPoint(cx, cy)
    , r
    , ::cvScalar(v0, v1, v2, 0)
    , thickness
    , CV_AA );
  return;
}

これらのコードを利用してカージオイドを描くHaskellプログラムは次のようになります:

import Foreign.C.Types
import Foreign.C.String
import Foreign.Ptr
import Control.Monad

data Point=Point{x::Double, y::Double}
data Scalar=Scalar{v0::Double, v1::Double, v2::Double}

toCInt :: Int -> CInt
toCInt = fromIntegral

toCDouble :: Double -> CDouble
toCDouble = realToFrac

data Image = Image
type ImagePtr = Ptr Image

type CV_Thickness = Int

foreign import ccall "ffi_opencv.h  load_image"
	c'load_image :: CString -> IO ImagePtr

foreign import ccall "ffi_opencv.h  create_image__crunched"
	c'create_image__crunched :: CInt -> CInt ->
				CDouble -> CDouble -> CDouble -> IO ImagePtr

foreign import ccall "ffi_opencv.h  save_image"
	c'save_image :: CString -> ImagePtr -> IO ()

foreign import ccall "ffi_opencv.h make_window"
	c'make_window :: CString -> IO ()

foreign import ccall "ffi_opencv.h show_image"
	c'show_image :: CString -> ImagePtr -> IO ()

foreign import ccall "ffi_opencv.h destroy_window"
	c'destroy_window :: CString -> IO ()

foreign import ccall "ffi_opencv.h release_image"
	c'release_image :: ImagePtr -> IO ()

foreign import ccall "ffi_opencv.h draw_line__crunched"
	c'draw_line__crunched :: ImagePtr -> CInt -> CInt -> CInt -> CInt -> CDouble -> CDouble -> CDouble -> CInt -> IO ()

foreign import ccall "ffi_opencv.h draw_circle__crunched"
	c'draw_circle__crunched :: ImagePtr -> CInt -> CInt -> CInt -> CDouble -> CDouble -> CDouble -> CInt -> IO ()

load_image :: String -> IO ImagePtr
load_image s = join $ fmap c'load_image $ newCString s

create_image :: Int -> Int -> Scalar -> IO ImagePtr
create_image w h (Scalar d0 d1 d2)
 = c'create_image__crunched (toCInt w) (toCInt h) (toCDouble d0) (toCDouble d1) (toCDouble d2)

save_image :: String -> ImagePtr -> IO ()
save_image s pImg =  join $ (liftM2  c'save_image) (newCString s) (return pImg)

make_window :: String -> IO ()
make_window s = join $ (liftM c'make_window) (newCString s)

show_image :: String -> ImagePtr -> IO ()
show_image s pImg = join $ (liftM2 c'show_image) (newCString s) (return pImg)

destroy_window :: String -> IO ()
destroy_window  s = join $ (liftM c'destroy_window) (newCString s)

release_image :: ImagePtr -> IO ()
release_image = c'release_image

draw_line__crunched :: ImagePtr -> Int -> Int -> Int -> Int -> Double -> Double -> Double -> Int -> IO ()
draw_line__crunched  pImg x1 y1 x2 y2 d0 d1 d2 c
  = c'draw_line__crunched pImg (toCInt x1) (toCInt y1) (toCInt x2) (toCInt y2) (toCDouble d0) (toCDouble d1) (toCDouble d2) (toCInt c)

draw_circle__crunched :: ImagePtr -> Double -> Double -> Double -> Double -> Double -> Double -> Int -> IO ()
draw_circle__crunched pImg cx cy r d0 d1 d2 t
  = c'draw_circle__crunched pImg cx' cy' r' d0' d1' d2' t'
    where
	  cx' = truncate cx
	  cy' = truncate cy
	  r' = truncate r
	  d0' = realToFrac d0
	  d1' = realToFrac d1
	  d2' = realToFrac d2
	  t' = fromIntegral t

draw_line ::  ImagePtr -> Point -> Point -> Scalar -> CV_Thickness -> IO ()
draw_line  pImg  Point{x=p1x,y=p1y}  Point{x=p2x,y=p2y}  Scalar{v0=d0,v1=d1,v2=d2} c = draw_line__crunched pImg p1x' p1y' p2x' p2y' d0 d1 d2  c
  where
    p1x' = truncate p1x
    p1y' = truncate p1y
    p2x' = truncate p2x
    p2y' = truncate p2y

draw_line_from_point_pair :: ImagePtr -> (Point,Point) -> IO ()
draw_line_from_point_pair  pImg  (p1,p2) = draw_line pImg p1 p2 (Scalar 0 0 0) 1

deg_to_rad :: Int -> Double
deg_to_rad t = (fromIntegral t) * pi / 180.0

shifted_sin :: Double -> Double
shifted_sin t =  c + r * sin t

shifted_cos :: Double -> Double
shifted_cos t =  c + r * cos t

main = do
  img <-create_image (truncate (2.0 * c)) (truncate (2.0 * c)) (Scalar 255 255 255)
  foldr (>>) nopIO (segments_cardioid img)
  fringe_circle img
  putStrLn "enter image save name : "
  savename <- getLine
  save_image savename img
  make_window savename
  show_image savename img

nopIO :: IO()
nopIO = return ()

u :: Double
u = 100

c :: Double
c = 4.2 * u

r :: Double
r = 4 * u

deglist :: [Int]
deglist = [0, 3 .. 360-3]

segment_info :: Int -> (Point, Point)
segment_info t = (
  Point{x=shifted_cos $ deg_to_rad t, y=shifted_sin $ deg_to_rad t},
  Point{x=shifted_cos $ deg_to_rad (2*t+180),  y=shifted_sin $ deg_to_rad (2*t+180)}
  )

segments_cardioid :: ImagePtr -> [IO()]
segments_cardioid  pImg = fmap ( (draw_line_from_point_pair pImg) . segment_info) deglist

fringe_circle :: ImagePtr -> IO()
fringe_circle pImg = draw_circle__crunched pImg c c r 128 128 128 1

実行すると保存するファイル名を聞いてくるので cardioid.jpg などと答えると画像を表示してくれます.画像にマウスカーソルを合わせてESCを押すと終了します.

こんな絵が生成されると思います:
cardioid

この絵は,円周上の対蹠する二点P,Qが,Pは角速度ωで,Qが角速度2ωで運動したときの線分PQの軌跡を描いたものです.屈折した三日月のような図形が線の中から浮かび上がっていますが,円から「折れた三日月」を取り除いたずんぐりとした形がなにやら動物の心臓を思わせるので「カージオイド(心臓形, cardioid)」と呼ばれています.円筒形の陶器のカップを日に晒すと円筒の内側で反射した光が屈曲して似たような図形を作りますが,あちらは腎臓形(nephroid)と呼ばれ,Pは角速度ωで,Qが角速度3ωで運動した場合に線分PQが作り出す包絡線です.

draw_cardioid.hs の説明をしておきましょう.今回描こうとしているものは円を基本とした図形なので,キャンバスの座標系に合わせたカスタム版の三角関数
shifted_sinshifted_cos
を用意しました.
deglist = [0, 3 .. 360-3]で3度刻みのリストを作っています.segments_cardioid :: ImagePtr -> [IO()]は定義部でこのdeglistを利用しており,「画像(へのポインタ)を受け取って線分を描くアクションのリストを返す」関数になっています.全部で120個のIO()(>>)でつないでmainを書いても良かったのですが面倒なのでfoldr (>>) nopIO (segments_cardioid img)としてやって合成したアクションを得ています.save_imageのあたりは,プログラムとしては別にイラナイのですが,Cの文字列が関与する関数の扱いを紹介したくてサンプルに入れた記憶があります.

この記事で使ったMinGW+MSYS用のMakefileです.環境に合わせて適宜修正して使ってください.

#####################################################
# Makefile for Haskell Advent Calendar 2013, Dec 2
#####################################################
.PHONY : madoka erfc_from_libc imshow_right imshow_bozo cardioid

GHC = ghc
LD_LIBRARY_PATH = $(PATH)
OPENCV_32_TRUNC = /c/opencv2.4.6.0-MSYS32
OPENCV_VERSION_SUFFIX = 246
OPENCV_HEADERS_INCLUDE32 = -I$(OPENCV_32_TRUNC)/include/opencv  \
-I$(OPENCV_32_TRUNC)/include
OPENCV_LIB_32_LOADPATH = -L$(OPENCV_32_TRUNC)/lib
CXXFLAGS = $(OPENCV_HEADERS_INCLUDE32)

LINK_OPENCV_LIBS = \
-lopencv_highgui$(OPENCV_VERSION_SUFFIX) \
-lopencv_core$(OPENCV_VERSION_SUFFIX) \
#-lopencv_objdetect$(OPENCV_VERSION_SUFFIX)  \
#-lopencv_nonfree$(OPENCV_VERSION_SUFFIX) \
#-lopencv_imgproc$(OPENCV_VERSION_SUFFIX) \
#-lopencv_legacy$(OPENCV_VERSION_SUFFIX)  \
#-lopencv_ml$(OPENCV_VERSION_SUFFIX)  \
#-lopencv_features2d$(OPENCV_VERSION_SUFFIX)  \

LDFLAGS = -lm -lstdc++ $(OPENCV_LIB_32_LOADPATH) $(LINK_OPENCV_LIBS)

madoka : show_madoka.o
	$(LINK.o)  -o madoka.exe  $(filter  %.o,   $^)  $(LDFLAGS)
	./madoka.exe

cardioid : draw_cardioid.hs ffi_opencv.o
	$(GHC) draw_cardioid.hs -o cardioid.exe ffi_opencv.o $(LDFLAGS)
	./cardioid.exe

imshow_bozo : imshow-bozo.hs  imshow.o
	$(GHC) imshow-bozo.hs -o imshow_bozo.exe imshow.o $(LDFLAGS)
	./imshow_bozo.exe

imshow_right : imshow-right.hs  imshow.o
	$(GHC) imshow-right.hs -o imshow-right.exe imshow.o $(LDFLAGS)
	./imshow-right.exe

erfc_from_libc : erfc_from_libc.hs
	$(GHC) erfc_from_libc.hs -o    erfctest.exe
	./erfctest.exe

clean :
	$(RM) ./*.o
	$(RM) ./*.exe

それでは皆様,良いお年を!

ライブラリ

僕はライブラリとか知りたいとあんまし思わないんですが,
なんで皆さんはライブラリとかを珍重するんでしょうか.バイト列じゃん.
わかんない.
nmとかもわかんない.
得るものが少ないとおもいます.
したがって技術系同人誌に載ってるABI(アプリケーションバイナリインタフェース)をテーマにしたラブコメというかライブラリコメディもよくわかりません.ただのバイト列です.
さらにそもそもOSはなぜライブラリを扱うのですか.
あまつさえ動的にリンクしたりするのですか.僕は賛成ですが.いや賛成なのはライブラリが好きだからじゃないです.
動的にリンクすることで実行時まで何かを遅延できるのがなんとなくいいからです.
ぼくはOSとかリンカとかローダみたいなバイナリユーティリティは大好きです.
いや問題なのはOSじゃなくてライブラリです.
ライブラリが見えていてもかまいませんが,ただのバイト列だとおもいます.
いやそうではなく,なぜC呼び出し規約で読めるようなバイト列を大事にするかということです.
僕は賛成ですが.
間違いました.
もういいです.

cabal がアップデートされない問題

自分用覚書.

Windows の場合

C:\Users\Username\AppData\Roaming\cabal\bin;

を PATH に追加しておかないと何度 cabal install cabal-install しても cabal が新しくなってくれない.