更改 Haskell 树中的索引

Question

（很抱歉上下文描述太长，但我找不到更简单的方法来解释我的问题）考虑以下类型：

import Data.Array

data UnitDir = Xp | Xm | Yp | Ym | Zp | Zm
    deriving (Show, Eq, Ord, Enum, Bounded, Ix)

type Neighborhood a = Array UnitDir (Tree a)

data Tree a = Empty | Leaf a | Internal a (Neighborhood a)
    deriving (Eq, Show)

显然，Tree 可以定义为 Functor 的实例，如下所示：

instance Functor Tree where
    fmap _ Empty           = Empty
    fmap f (Leaf x)        = Leaf (f x)
    fmap f (Internal x ts) = Internal (f x) $ fmap (fmap f) ts

我想定义一个函数，它通过排列 Array UnitDir (Tree a) 的索引来遍历 Tree 的实例（因此它是 UnitDir 的 6 个可能值的排列） .

一种可能的实现方式是：

type Permutation = Array UnitDir UnitDir

applyPermutation :: Permutation -> Tree a -> Tree a
applyPermutation _ Empty = Empty
applyPermutation _ (Leaf x) = Leaf x
applyPermutation f (Internal x ts) = Internal x (applyPermutation' ts)
    where applyPermutation' ts = ixmap (Xp, Zm) (f !) (applyPermutation f <$> ts)

我的问题如下：在重新索引子项时，"traverse" 树是否有自然的 Haskell 构造？

Functor 不起作用，因为我用它来更改树的内容，而不是它的索引方案。看来我需要 Functor 的两个实例，一个用于更改内容，另一个用于更改数组索引。

我认为 Traversable 是正确的选择，但所提供函数的签名中 none 与 applyPermutation 相匹配。

在此先感谢您的帮助。

Answer 1

Functor does not work, since I use it to change the content of the tree, not its indexing scheme. It seems I would need two instances of Functor, one to change the content and the other to change the array indices.

您的直觉是正确的：作用于 Neighborhood a 字段的仿函数会满足您的需求，调用这样的东西 "functor" 是正确的。这是 applyPermutation 的一种可能重构：

{-# LANGUAGE LambdaCase #-}

-- I prefer case syntax for this sort of definition; with it, there is less stuff
-- that needs to be repeated. LambdaCase is the icing on the cake: it frees me
-- me from naming the Tree a argument -- without it I would be forced to write
-- mapOverNeighborhoods f t = case t of {- etc. -}
mapOverNeighborhoods :: (Neighborhood a -> Neighborhood a) -> Tree a -> Tree a
mapOverNeighborhoods f = \case 
    Empty -> Empty
    Leaf x -> Leaf x
    Internal x ts -> Internal x (f (mapOverNeighborhoods f <$> ts))

applyPermutation :: Permutation -> Tree a -> Tree a
applyPermutation perm = mapOverNeighborhoods applyPermutation'
    where applyPermutation' = ixmap (Xp, Zm) (perm !)

（您可能更愿意走得更远，使用直接采用 UnitDirection -> UnitDirection 而不是 Neighborhood a -> Neighborhood a 的映射。我这样做主要不是为了让它反映这个答案的其余部分更紧密，但也因为它可以说是一个更诚实的界面——在 Array 中重新排列索引并不像对索引应用任意函数那么简单。）

这种定义另一个函子的尝试有两个限制：

正如您所指出的，我们已经有一个 Functor 实例。仅仅为这个用例替换是不明智的，并且为它定义一个 newtype 太烦人了。
即使不是这种情况，mapOverNeighborhoods 也不能成为 Functor 实例，因为 fmap 可以随意使用 a -> b 函数，更改社区类型不是一个选项。

这两个问题由光学库解决，例如 lens (if you end up using optics for just this one thing in your code base, though, you might prefer microlens 以减少依赖足迹）。

{-# LANGUAGE TemplateHaskell #-} -- makeLenses needs this.
{-# LANGUAGE DeriveFunctor #-} -- For the sake of convenience.
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}

-- Record fields on sum types are nasty; these, however, are only here for the
-- sake of automatically generating optics with makeLenses, so it's okay.
data Tree a
    = Empty 
    | Leaf { _value :: a } 
    | Internal { _value :: a, _neighborhood :: Neighborhood a }
    deriving (Eq, Show, Functor, Foldable, Traversable)
makeLenses ''Tree

applyPermutation :: Permutation -> Tree a -> Tree a
applyPermutation perm = over neighborhood applyPermutation'
    where applyPermutation' = ixmap (Xp, Zm) (perm !)

over（中缀拼写：%~）实际上是一个 fmap，它允许选择目标。我们通过给它传递一个合适的光学器件来做到这一点（在本例中，neighborhood，这是一个 Traversal，它针对树中的所有邻域——over neighborhood 可以读作 "map over all neighborhoods").请注意，我们无法更改邻域类型这一事实不是问题（而且，在其他情况下，可能会有 type-changing 光学器件）。

最后一点，neighborhoods 的类型是 Traversal' (Tree a) (Neighborhood a)。如果我们展开 Traversal' 类型的同义词，我们得到：

GHCi> :t neighborhood
neighborhood
  :: Applicative f =>
     (Neighborhood a -> f (Neighborhood a)) -> Tree a -> f (Tree a)

虽然深入探讨为什么会这样会使这个答案太长，但值得注意的是，这很像 traverse 对 Tree 的签名...

GHCi> :set -XTypeApplications
GHCi> :t traverse @Tree
traverse @Tree
  :: Applicative f => (a -> f b) -> Tree a -> f (Tree b)

... 除了它作用于邻域而不是值（参见 fmap 和 mapOverNeighborhoods 之间的平行线）。事实上，如果您要使用该类型充分实现 traverse 类似物，您将能够使用它来代替 makeLenses.

自动生成的那个

Answer 2

为了完整性，我编写了一个基于变形的小变体，利用 recursion-schemes。

{-# LANGUAGE LambdaCase, DeriveFunctor, KindSignatures, TypeFamilies, 
    DeriveFoldable, DeriveTraversable, TemplateHaskell #-}

import Data.Functor.Foldable
import Data.Functor.Foldable.TH

import Data.Array
data UnitDir = Xp | Xm | Yp | Ym | Zp | Zm
    deriving (Show, Eq, Ord, Enum, Bounded, Ix)

type Neighborhood a = Array UnitDir (Tree a)

data Tree a = Empty | Leaf a | Internal a (Neighborhood a)
    deriving (Eq, Show, Functor)

-- Use TH to automatically define a base functor for Tree,
-- enabling recursion-schemes
makeBaseFunctor ''Tree

那么想要的映射函数是：

mapOverNeighborhoods :: (Neighborhood a -> Neighborhood a) -> Tree a -> Tree a
mapOverNeighborhoods f = cata $ \case
   EmptyF -> Empty
   LeafF x -> Leaf x
   InternalF x nb -> Internal x (f nb)

粗略地说，cata 为我们做了所有的递归。它为其函数参数（\case ...，上文）提供了一个 TreeF a (Tree a) 类型的值，它与普通的 Tree a 本质上相同，除了第一个 "layer" 使用不同的构造函数，以额外的 F 结尾。 cata：所有这些构造函数的内部树已经 pre-processed：在上面，我们可以假设 nb 数组中的所有树都已经递归应用了 f。我们需要做的是处理第一个 "layer"，将 F 构造函数转换为常规构造函数，并将 f 应用于第一个 "layer"。

更改 Haskell 树中的索引

Changing indices within a Haskell tree

haskell

functor

traversable

foldable