2

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

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

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

一个可能的实现是这个：

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)

我的问题如下：是否有一个自然的 Haskell 构造来“遍历”树，同时重新索引孩子？

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

我认为这Traversable将是正确的选择，但所提供函数的签名都不匹配applyPermutation.

提前感谢您的帮助。

4

2 回答 2

5

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

您的直觉是正确的：作用于该Neighborhood a领域的函子会做您需要的事情，将这样的东西称为“函子”是正确的。这是一种可能的重构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. - 在 an 中重新排列索引Array并不像将任意函数应用于索引那样简单。）

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

  • Functor正如您所指出的，我们已经有一个实例。仅仅为这个用例替换是不明智的，并且newtype为它定义 a 太烦人了。

  • 即使不是这种情况，也不能像使用任意函数那样将mapOverNeighborhoods其制成Functor实例，并且不能选择更改邻域的类型。fmapa -> b

这两个问题由诸如lens之类的光学库解决（但是，如果您最终在代码库中仅将光学用于这件事，那么您可能更喜欢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允许选择目标。我们通过传递一个适当的 optic 来做到这一点（在这种情况下，neighborhood，它是Traversal针对树中所有邻域的 ——over neighborhood可以读作“所有邻域的地图”）。请注意，我们无法更改邻域类型的事实不是问题（而且，在其他情况下，可能会有类型更改的光学器件）。

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

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

虽然进入原因会使这个答案太长，但值得注意的是，这很像traversefor Tree...

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

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

于 2018-02-17T05:35:06.707 回答
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只是第一个“层”使用不同的构造函数，以额外的 . 结尾F。所有这些构造函数的内部树都已经通过 : 进行了预处理cata，我们可以假设nb数组中的所有树都已经f递归应用了。我们需要做的是处理第一个“层”，将F构造函数转换为常规构造函数，并将其应用于f第一个“层”。

于 2018-02-17T09:49:11.597 回答