JavaScript の Array をモナドにしてみるテスト

listmonad.js

var A = Array;

// (++) :: [a] -> [a] -> [a]
// | 既存の連結メソッド
A.prototype.concat;

// ------------------------------------
// Monad

// return    :: Monad m => a -> m a
// rerurn x  = [x]
// | 便宜上、クラスとオブジェクトの両方に実装
A.mreturn = function (x) { return [x]; };
A.prototype.mreturn = function (x) { return [x]; };

// (>>=)       :: Monad m => m a -> (a -> m b) -> m b
// this >>= f  =  foldr ((++) . f) [] this
A.prototype.mbind = function(f) {
  return this.reduceRight(
    function(acc, x) { return f(x).concat(acc); },
    []
  );
};

// ------------------------------------
// MonadPlus

// mzero :: MonadPlus m => m a
// mzero = []
A.mzero = [];

// mplus :: MonadPlus m => m a -> m a -> m a
// mplus = (++)
A.prototype.mplus = A.prototype.concat;


// ------------------------------------
// モナド則のテスト
// ------------------------------------
// ほんとうは机上で論証するものらしい
// あとで調べてみる

// 配列の同値判定
function arrayEq(a, b) { return !(a < b || a > b); }

// (a -> m b) な関数
function f(x) { return [x, x*x, x*x*x]; }
function g(x) { return [x*10, x*100, x*1000]; }

// 1. (return x) >>= f == f x
//    return が >>= について左単位元
console.log(arrayEq( A.mreturn(5).mbind(f), f(5) ));
console.log(arrayEq( A.mreturn(5).mbind(g), g(5) ));

// 2. m >>= return == m
//    return が >>= について右単位元
console.log(arrayEq( [1,2,3].mbind(A.mreturn), [1,2,3] ));
console.log(arrayEq( [[1,2],[3,4]].mbind(A.mreturn), [[1,2],[3,4]] ));

// 3. (m >>= f) >>= g == m >>= (\x -> f x >>= g)
//    結合法則
console.log(arrayEq(
  ([1,2,3].mbind(f)).mbind(g),
   [1,2,3].mbind(function(x) { return f(x).mbind(g); })
));

// ------------------------------------
// その他あれこれ

// guard :: MonadPlus m => Bool -> m ()
// guard True  = return ()
// guard False = mzero
// | 引数にMonadPlusを１つも取らないのでOOPの多態を頼れない
// | 型注釈代わりにクラスを与える苦肉の策
function guard(M, b) {
  if (b) {
    return M.mreturn(null);
  } else {
    return M.mzero;
  }
}

// id    :: a -> a
// id x  = x
function id(x) { return x; }

// join    :: m (m a) -> m a
// join x  = x >>= id
function join(x) { return x.mbind(id); } 

// (>=>)      :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c
// f (>=>) g  = \x -> f x >>= g
function mcompose(f, g) {
  return function(x) {
    return f(x).mbind(g);
  };
}

// liftM       :: (a1 -> r) -> m a1 -> m r
// liftM f m1  = m1 >>= \x1 -> return (f x1)
function liftM(f) {
  return function(m1) {
    return m1.mbind(function(x1) {
      return m1.mreturn(f(x1));
    });
    // 型推論の代わりにオブジェクトメソッドのreturnを使う
  };
}

// liftM2        :: (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
// liftM2 f m1 m2  = m1 >>= \x -> m2 >>= \y -> return (f x1 x2)
function liftM2(f) {
  return function(m1, m2) {
    return m1.mbind(function(x1) {
      return m2.mbind( function(x2) {
        return m1.mreturn(f(x1, x2));
        // 型推論の代わりにオブジェクトメソッドのreturnを使う
      });
    });
  };
}

// ------------------------------------
// いろいろためす

// join をためす
console.log(arrayEq(
  join([[1,2], [3,4], [5,6]]),
  [1,2,3,4,5,6]
));

// (>=>) をためす
console.log(arrayEq(
  [1,2,3].mbind(f).mbind(g),
  [1,2,3].mbind(mcompose(f, g))
));

// lift* を使ってみる
function succ(x) { return x + 1; }
console.log(arrayEq(
  liftM(succ)([1,2,3]),
  [2,3,4]
));

function mult(x, y) { return x * y; }
console.log(arrayEq(
  liftM2(mult)([1,2,3], [10, 100]),
  [10,100,20,200,30,300]
));

// [(x, y) | x <- [1,2,3], y <- [1,2,3], x /= y ]
// のつもり
console.log(
  [1,2,3].mbind(function(x) {
    return [1,2,3].mbind(function(y) {
      return guard(A, x != y).mbind(function() {
        return A.mreturn([x, y]);
      });
    });
  })
);