是否有有效的数组单子变压器？

Question

我知道如何实现单链表 monad 转换器，但无法运行其对应的数组。问题是存在分组效应，使得变压器只对可交换的基本单子有效。下面是一个例子，为了简单起见，transformer 和 base monad 都是数组，并且没有transformer 类型的包装器：

// ARRAY

const arrMap = f => xs =>
  xs.map((x, i) => f(x, i));

const arrAp = tf => xs =>
  arrFold(acc => f =>
    arrAppend(acc)
      (arrMap(x => f(x)) (xs)))
        ([])
          (tf);

const arrOf = x => [x];

const arrChain = mx => fm =>
  arrFold(acc => x =>
    arrAppend(acc) (fm(x))) ([]) (mx);

// Transformer

const arrChainT = ({map, ap, of ,chain}) => mmx => fmm =>
  chain(mmx) (mx => {
    const go = ([x, ...xs]) =>
      x === undefined
        ? of([])
        : ap(map(arrCons) (fmm(x))) (go(xs));

    return chain(go(mx)) (ys => of(arrFold(arrAppend) ([]) (ys)));
  });

const arrOfT = of => x => of([x]);

// Transformer stack

const arrArrChain = arrChainT(
  {map: arrMap, ap: arrAp, of: arrOf, chain: arrChain});

const arrArrOf = arrOfT(arrOf);

// auxiliary functions

const arrFold = f => init => xs => {
  let acc = init;
  
  for (let i = 0; i < xs.length; i++)
    acc = f(acc) (xs[i], i);

  return acc;
};

const arrAppend = xs => ys =>
  xs.concat(ys);

const arrCons = x => xs =>
  [x].concat(xs);

// MAIN

foo = x =>
  x === 0
    ? [[0, 1]]
    : [[0], [1]];

console.log(JSON.stringify(
  arrArrChain(arrArrChain(foo(0)) (foo)) (foo)));
    // yields [[0,1,0,0,1],[0,1,1,0,1],[0,1,0,0],[0,1,0,1],[0,1,1,0],[0,1,1,1]]

console.log(JSON.stringify(
  arrArrChain(foo(0)) (x => arrArrChain(foo(x)) (foo))));
    // yields [[0,1,0,0,1],[0,1,0,0],[0,1,0,1],[0,1,1,0,1],[0,1,1,0],[0,1,1,1]]

两种计算都应该产生相同的结果。现在我的问题是：有没有办法以合法的方式实现数组转换器？

Answer 1

数组单子变换器与列表单子变换器相同。

// Step m a = null | { head : a, tail : ListT m a }
// ListT m a = m (Step m a)

// nil : Monad m -> ListT m a
const nil = M => M.pure(null);

// cons : Monad m -> a -> ListT m a -> ListT m a
const cons = M => head => tail => M.pure({ head, tail });

// foldr : Monad m -> (a -> m b -> m b) -> m b -> ListT m a -> m b
const foldr = M => f => a => m => M.bind(m)(step =>
    step ? f(step.head)(foldr(M)(f)(a)(step.tail)) : a);

// append : Monad m -> ListT m a -> ListT m a -> ListT m a
const append = M => m1 => m2 => foldr(M)(cons(M))(m2)(m1);

// pure : Monad m -> a -> ListT m a
const pure = M => x => cons(M)(x)(nil(M));

// bind : Monad m -> ListT m a -> (a -> ListT m b) -> ListT m b
const bind = M => m => f => foldr(M)(x => append(M)(f(x)))(nil(M))(m);

// MonadListT : Monad m -> Monad (ListT m)
const MonadListT = M => ({ pure: pure(M), bind: bind(M) });

// MonadArray : Monad Array
const MonadArray = { pure: x => [x], bind: a => f => a.flatMap(f) };

// MonadListArray : Monad (ListT Array)
const MonadListArray = MonadListT(MonadArray);

// fromArray : Monad m -> Array a -> ListT m a
const fromArray = M => a => a.reduceRight((xs, x) => cons(M)(x)(xs), nil(M));

// lift : Monad m -> m a -> ListT m a
const lift = M => m => M.bind(m)(pure(M));

// foo : Nat -> ListT Array Nat
const foo = x => x === 0
    ? fromArray(MonadArray)([0, 1])
    : lift(MonadArray)([0, 1]);

// associativityLHS : Monad m -> m a -> (a -> m b) -> (b -> m c) -> m c
const associativityLHS = M => m => k => h => M.bind(M.bind(m)(k))(h);

// associativityRHS : Monad m -> m a -> (a -> m b) -> (b -> m c) -> m c
const associativityRHS = M => m => k => h => M.bind(m)(x => M.bind(k(x))(h));

// lhs :: ListT Array Nat
const lhs = associativityLHS(MonadListArray)(foo(0))(foo)(foo);

// rhs :: ListT Array Nat
const rhs = associativityRHS(MonadListArray)(foo(0))(foo)(foo);

console.log(JSON.stringify(lhs) === JSON.stringify(rhs));
console.log(JSON.stringify(lhs));

请注意，列表的每一步都包含在参数 monad 中。这允许其他单子动作交错，如果参数单子不是可交换的，则有必要保留单子定律。