Twitter で竹内関数が話題に登っていたので Haskell で関数適用回数を数えてみた

Haskell C++ C++0x

内容はタイトル通り． 折角なので正格評価と遅延評価の両方でカウント．

import Data.IORef
import System.IO.Unsafe

-- グローバル変数
-- 本題ではないので詳細は省略
resetCount :: IO ()
incCount   :: IO ()
readCount  :: IO Int

( resetCount, incCount, readCount ) = 
  ( writeIORef  count 0,
    modifyIORef count (+ 1),
    readIORef   count )
  where
    count = unsafePerformIO $ newIORef ( 0 :: Int )

-- 正格評価版竹内関数
-- 見たまんまで分かりやすい
taraiStrict :: Int -> Int -> Int -> IO Int
taraiStrict x y z = do
  incCount
  if x <= y then
    return y
   else do
    x' <- taraiStrict (x-1) y z
    y' <- taraiStrict (y-1) z x
    z' <- taraiStrict (z-1) x y
    taraiStrict x' y' z'

-- 遅延評価版竹内関数
-- 本来は Int -> Int -> Int -> Int で書くべきだが
-- 関数呼び出し回数を測定する為，ややこしい事をしている
-- unsafePerformIO は邪道
taraiLazy :: Int -> Int -> Int -> IO Int
taraiLazy x y z = taraiLazy' (return x) (return y) (return z) where
  taraiLazy' mx my mz = do
    incCount
    x <- mx
    y <- my
    if x <= y then
      return y
     else do
      -- 本当は z は更に（ z' で z-1 を使うまで）遅延評価させるべき
      -- 今回はたまたま x' と y' の第１／第２引数で z が評価されているので
      -- 遅延評価しなくても同じになる
      -- （遅延評価する場合は taraiLazy' を使う）
      z <- mz
      let x' = taraiLazy (x-1) y z
          y' = taraiLazy (y-1) z x
          z' = taraiLazy (z-1) x y
      taraiLazy' x' y' z'

main = do
  resetCount
  taraiStrict 10 5 0
  print =<< readCount -- 343073
  
  resetCount
  taraiLazy 10 5 0
  print =<< readCount -- 76


詳しい解説は面倒なので省略．


とりあえず，

  • 正格評価版が手続き型言語で書いた場合と同じ関数呼び出し回数となっている点
  • 副作用込みの遅延評価を， IO a を引数に持ち込むことで可能にしている点 ((参考： 引数として IO () を取る関数 Control.Monad.when は，条件によって その引数を評価したり評価しなかったりする))

に注目すれば，何が起きているかは自ずと分かるんじゃないかと．

追記

遅延評価版，よく考えたら x と y に関しては正格なので， IO モナドで遅延評価させる意味は無いですね．

taraiLazy :: Int -> Int -> Int -> IO Int
taraiLazy x y z = taraiLazy' x y (return z) where
  taraiLazy' :: Int -> Int -> IO Int -> IO Int
  -- x と y に関しては正格なので IO なし
  -- z は評価しなくていい場合があるので IO a にする
  taraiLazy' x y mz = do
    incCount
    if x <= y then
      return y
     else do
      -- ここで初めて mz を評価（ y' を求めるために必要）
      z <- mz
      x'     <- taraiLazy (x-1) y z
      y'     <- taraiLazy (y-1) z x
      let mz' = taraiLazy (z-1) x y
      taraiLazy' x' y' mz'

こう書いても同じです．

さらに追記

折角なので遅延評価版を C++11 で書いてみた．

#include <functional>

int count = 0;

int taraiLazy( int, int, int );

int taraiLazy_( int x, int y, std::function<int()> fz )
{
  count += 1;
  if( x <= y ) {
    return y;
  }
  else {
    int const z = fz();
    
    int const x_ = taraiLazy( x-1, y, z );
    int const y_ = taraiLazy( y-1, z, x );
    
    auto const fz_ = [=]() {
      return taraiLazy( z-1, x, y );
    };
    
    return taraiLazy_( x_, y_, fz_ );
    
  }
}

int taraiLazy( int x, int y, int z ) {
  return taraiLazy_( x, y, [=](){ return z; } );
}

#include <iostream>

int main()
{
  count = 0;
  taraiLazy( 10, 5, 0 );
  std::cout << count << std::endl;
}

引数の std::function はテンプレートにしても良いが，
その場合には taraiLazy_ 内のラムダ式を std::bind 等で書き換えないと
延々と taraiLazy_ のインスタンス化が続いてコンパイルエラーになる((各 taraiLazy_ 内部のラムダ式は，それぞれ固有の型となる為))．


一応，テンプレート版も記しておく．

#include <functional>

int count = 0;

int taraiLazy( int, int, int );

auto bindTaraiLazy = [] ( int x, int y, int z ) {
  return std::bind(
    []( int x, int y, int z ){ return taraiLazy( x, y, z ); },
    z-1, x, y
  );
};

template< class Fz >
int taraiLazy_( int x, int y, Fz fz )
{
  count += 1;
  if( x <= y ) {
    return y;
  }
  else {
    int const z = fz();
    
    int const x_ = taraiLazy( x-1, y, z );
    int const y_ = taraiLazy( y-1, z, x );
    auto const fz_ = bindTaraiLazy( z-1, x, y );
    
    return taraiLazy_( x_, y_, fz_ );
    
  }
}

int taraiLazy( int x, int y, int z ) {
  return taraiLazy_( x, y, [=](){ return z; } );
}

bindTaraiLazy は別の関数にする必要はないと思うかもしれないが，
taraiLazy_ 内でラムダを作ると結局 意味が無いため，別の関数にせざるを得ない．
一応， std::bind に渡す引数をラムダではなく関数ポインタにすれば問題ないのだが，
関数ポインタは多重定義に弱かったり効率が悪かったりと問題点が多いので，可能ならラムダを使うべきです．

// ってか C++ にも where 欲しい…．