Question

我试图编写一个自动在列表上分配二进制操作的Haskell函数，类似于算术运算在J language中的工作方式。您可以将其视为＆＃34;深zipWith＆＃34;适用于任何深度的嵌套列表，包括非列表和不同深度的列表。例如：

distr (+) 1 10 === 11  -- Non-list values are added together
distr (+) [1,2] 10 === [11,12]  -- Non-list values distribute over lists
distr (+) [1,2] [10,20] === [11,22]  -- Two lists get zipped
distr (+) [[1,2],[3,4]] [[10,20],[30,40]] === [[11,22],[33,44]]  -- Nested lists get zipped

不同长度的列表会被截断，就像zipWith一样，但这并不重要。

现在，我已经写过：

{-# LANGUAGE
    MultiParamTypeClasses,
    FunctionalDependencies,
    UndecidableInstances,
    FlexibleInstances
#-}

class Distr a b c x y z | a b c x y -> z
  where distr :: (a -> b -> c) -> (x -> y -> z)

instance Distr a b c a b c where distr = id
instance {-# OVERLAPPING #-}
         (Distr a b c x y z) => Distr a b c [x] [y] [z]
  where distr = zipWith . distr
instance (Distr a b c x y z) => Distr a b c [x]  y  [z]
  where distr f xs y = map (\x -> distr f x y) xs
instance (Distr a b c x y z) => Distr a b c  x  [y] [z]
  where distr f x ys = map (\y -> distr f x y) ys

这定义了一个带有函数Distr的6参数类型类distr :: (Distr a b c x y z) => (a -> b -> c) -> (x -> y -> z)，以及嵌套列表中的Distr的一些实例。它适用于上面的示例，但它在不相等的嵌套深度列表上的行为并不是我想要的。它执行此操作（如果您向(+)和两个列表添加类型注释，它都有效）：

distr (+) [[1,2],[3,4]] [10,20] === [[11,12],[23,24]]  -- Zip and distribute

Try it here. 我想要的是这个：

distr (+) [[1,2],[3,4]] [10,20] === [[11,22],[13,24]]  -- Distribute and zip

当前实现应用zipWith，直到其中一个参数为非列表值，然后将其分布在另一个列表中。我希望它将一个参数（具有较少列表层的参数）分配给另一个参数，直到达到相等的嵌套深度，然后使用zipWith将它们减少为非列表值。

我的问题是：我可以实现第二种行为吗？ 我对一个解决方案很满意，这个解决方案要求我明确告诉Haskell运算符和每个参数的类型，正如我目前的解决方案所做的那样。我不会在将列表作为输入的运算符上调用distr，因此无需处理该情况。但是，我不想为distr提供额外的参数作为类型提示，或者为不同的用例提供几个不同版本的distr。我知道我的问题可以通过这种方式解决，但我更喜欢不需要的解决方案。

Answer 1

（As a gist in Literate Haskell）

{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances,
    TypeFamilies, MultiParamTypeClasses, UndecidableInstances,
    RankNTypes, ScopedTypeVariables, FunctionalDependencies, TypeOperators #-}

module Zip where

import Data.Proxy
import GHC.TypeLits

让我们首先假设两个嵌套列表具有相同的深度。例如，深度2：

zipDeep0 ((+) :: Int -> Int -> Int) [[1,2],[3,4,5]] [[10,20],[30,40]] :: [[Int]]
[[11,22],[33,44]]

实现：

zipDeep0
  :: forall n a b c x y z
  .  (ZipDeep0 n a b c x y z, n ~ Levels a x, n ~ Levels b y, n ~ Levels c z)
  => (a -> b -> c) -> (x -> y -> z)
zipDeep0 = zipDeep0_ (Proxy :: Proxy n)

Levels a x计算嵌套列表类型x中a的深度。封闭类型族允许我们进行一些非线性类型级模式匹配（其中a在子句中出现两次）。

type family Levels a x :: Nat where
  Levels a a = 0
  Levels a [x] = 1 + Levels a x

我们使用该深度来选择实现zip的ZipDeep0实例，这种方式比仅依赖其他六种普通类型参数更整洁，因为当一些列表为空时它避免了类型推断和重叠实例的问题（所以我们无法从自身推断其实际类型，或者当a，b，c也是列表类型。

class ZipDeep0 (n :: Nat) a b c x y z where
  zipDeep0_ :: proxy n -> (a -> b -> c) -> x -> y -> z

-- Moving the equality constraints into the context helps type inference.
instance {-# OVERLAPPING #-} (a ~ x, b ~ y, c ~ z) => ZipDeep0 0 a b c x y z where
  zipDeep0_ _ = id

instance (ZipDeep0 (n - 1) a b c x y z, xs ~ [x], ys ~ [y], zs ~ [z])
  => ZipDeep0 n a b c xs ys zs where
  zipDeep0_ _ f = zipWith (zipDeep0_ (Proxy :: Proxy (n - 1)) f)

当两个列表的深度不同时，让我们先假设第二个列表更深，所以我们必须分配它。我们开始失去一些类型推断，我们必须至少知道Levels a x（和因此a和x）以及此函数之前的Levels b y或Levels c z 可以适用。

示例：

zipDeep1 (+) [10,20 :: Int] [[1,2],[3,4]] :: [[Int]]
[[11,22],[13,24]]

实现：

zipDeep1
 :: forall n m a b c x y z
 .  (n ~ Levels a x, m ~ Levels b y, m ~ Levels c z, ZipDeep1 (m - n) a b c x y z)
 => (a -> b -> c) -> x -> y -> z
zipDeep1 = zipDeep1_ (Proxy :: Proxy (m - n))

级别(m - n)之间的差异告诉我们必须分配多少层＆＃34;分发＆＃34; 之后再回到zipDeep0。

class ZipDeep1 (n :: Nat) a b c x y z where
  zipDeep1_ :: proxy n -> (a -> b -> c) -> x -> y -> z

instance {-# OVERLAPPING #-} ZipDeep0 (Levels a x) a b c x y z => ZipDeep1 0 a b c x y z where
  zipDeep1_ _ = zipDeep0_ (Proxy :: Proxy (Levels a x))

instance (ZipDeep1 (n - 1) a b c x y z, ys ~ [y], zs ~ [z]) => ZipDeep1 n a b c x ys zs where
  zipDeep1_ proxy f xs = fmap (zipDeep1_ (Proxy :: Proxy (n - 1)) f xs)

最后，当任何一个列表可能更深时，我们可以进行类型级比较一。我们失去了所有的类型推断。

示例：

zipDeep ((+) :: Int -> Int -> Int) [[1,2 :: Int],[3,4]] [10 :: Int,20] :: [[Int]]
[[11,22],[13,24]]

通过改为指定预期的深度来恢复某些类型推断每个列表都有TypeApplications。

zipDeep @2 @1 ((+) :: Int -> Int -> Int) [[1,2],[3,4]] [10,20]
[[11,22],[13,24]]

实现：

zipDeep
  :: forall n m a b c x y z
  .  (ZipDeep2 (CmpNat n m) n m a b c x y z, n ~ Levels a x, m ~ Levels b y)
  => (a -> b -> c) -> x -> y -> z
zipDeep = zipDeep2_ (Proxy :: Proxy '(CmpNat n m, n, m))

class ZipDeep2 (cmp :: Ordering) (n :: Nat) (m :: Nat) a b c x y z where
  zipDeep2_ :: proxy '(cmp, n, m) -> (a -> b -> c) -> x -> y -> z

instance {-# OVERLAPPING #-} (n ~ Levels a x, m ~ Levels b y, m ~ Levels c z, ZipDeep1 (m - n) a b c x y z)
  => ZipDeep2 'LT n m a b c x y z where
  zipDeep2_ _ = zipDeep1

instance (n ~ Levels a x, m ~ Levels b y, n ~ Levels c z, ZipDeep1 (n - m) b a c y x z)
  => ZipDeep2 cmp n m a b c x y z where
  zipDeep2_ _ = flip . zipDeep1 . flip

重载＆＃34; zipWith＆＃34;支持嵌套列表

1 个答案: