有有效的阵列monad变压器吗？

问题描述

我知道如何实现单链表monad转换器，但无法运行其数组副本。问题在于，存在分组效应，该效应使变压器仅对可交换基本单声道有效。这是一个示例，为简单起见，转换器和基本monad都是数组，并且没有转换器类型包装器：

// 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,1],[0,0],1]]

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

两个计算都应产生相同的结果。现在我的问题是：有没有一种方法可以合法地实现阵列转换器？

解决方法

数组monad转换器与列表monad转换器相同。

// 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中。这样一来，就可以交错其他单调动作，并且如果参数monad不是可交换的，则必须保留单调律。