2013年12月
日	月	火	水	木	金	土
1	2	3	4	5	6	7
8	9	10	11	12	13	14
15	16	17	18	19	20	21
22	23	24	25	26	27	28
29	30	31

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  //opencv
#include //opencv
#include //opencv
#include 

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 

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 
#include 
#include 

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 >) nopIO (segments_cardioid img)
  fringe_circle img
  putStrLn "enter image save name : "
  savename  (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を押すと終了します．

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

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

draw_cardioid.hs の説明をしておきましょう．今回描こうとしているものは円を基本とした図形なので，キャンバスの座標系に合わせたカスタム版の三角関数
shifted_sin，shifted_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

それでは皆様，良いお年を！

■2018/06/19 追記
FFIによるマーシャリングをこの記事で扱っている．

2件のコメント

投稿者: differentialengine | 投稿日: 2013/12/02 • パーマリンク

カテゴリー: プログラミング、開発メモ、FFI、Haskell

タグ: FFI、Haskell、OpenCV

differentialengineの投稿 (2013/12/02)

https://differentialengine.wordpress.com/2013/12/02/using-opencv-from-haskell-by-ffi/

萌えとかプログラミングとか

最近の投稿

カテゴリー

メタ情報

Blog Stats

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

2件のコメント

コメントを残すコメントをキャンセル

萌えとかプログラミングとか

最近の投稿

カテゴリー

メタ情報

Blog Stats

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

共有:

関連

2件のコメント

コメントを残す コメントをキャンセル

コメントを残すコメントをキャンセル