具有状态的Haskell递归数据类型

我正在努力计算以下各项

给定根值，查找以该值的最后一个字符开头的所有值。显然，如果在路径中已经使用了元素，则不能重复任何元素。查找最大深度（最长路线）

例如，使用seed

“sip”

和单词：

t1 = ["sour","piss","rune","profit","today","rat"]

我们将看到最大路径为5

 siP 1 ---
  |       |
  |       |
  pisS 2  profiT 2
  |       |
  |       |
  |       todaY 3
  | 
  souR 3 ---
  |        |
  |        |
  runE 4   raT 4
           |
           |
           todaY 5

我认为我在以下方面是正确的——但我不知道如何递归地调用它

type Depth = Int
type History = Set.Set String
type AllVals = Set.Set String
type NodeVal = Char

data Tree a h d = Empty | Node a h d [Tree a h d] deriving (Show, Read, Eq, Ord)

singleton :: String -> History -> Depth -> Tree NodeVal History Depth
singleton x parentSet depth = Node (last x) (Set.insert x parentSet) (depth + 1) [Empty]

makePaths :: AllVals -> Tree NodeVal History Depth -> [Tree NodeVal History Depth]
makePaths valSet (Node v histSet depth trees) = newPaths
    where paths = Set.toList $ findPaths valSet v histSet
          newPaths = fmap (\x -> singleton x histSet depth) paths

findPaths :: AllVals -> NodeVal -> History -> History
findPaths valSet v histSet = Set.difference possible histSet
    where possible = Set.filter (\x -> head x == v) valSet

所以

给出：

[Node 's' (fromList ["piss","sip"]) 2 [Empty],Node 't' (fromList ["profit","sip"]) 2 [Empty]]

---

但现在我想不出如何继续下去

您实际上需要递归地继续。在现在的代码中，

makePaths

调用

findPaths

，但

findPaths

和

makePaths

都不会递归调用

makePaths

或

findPaths

。由于两个原因，要了解算法的机制也有点困难：第一，用大量临时状态注释树，第二，不必要地处理

Set

s

让我们把那些东西剥掉

---

让我们从这棵树开始。最终，我们只需要一个在节点上有值的n元树

data Tree a = Empty | Node a [Tree a] deriving (Show, Read, Eq, Ord)

需要说明的是，此

树

相当于您的

树

type OldTree a h d = Tree (a, h, d)

也就是说，由于最终目标树仅在节点处用

String

s修饰，因此我们的目标函数如下：

makeTree :: String -> [String] -> Tree String

这里，第一个字符串是种子值，字符串列表是可能的继续字符串，树是我们完整构建的字符串树。该函数也可以直接编写。它基于这样一个事实递归进行，即给定一个种子，我们立即知道树的根：

makeTree seed vals = Node seed children where
  children = ...

孩子们通过构建自己的子树递归地前进。这是到目前为止我们运行的算法的精确副本，只是我们使用

vals

中的字符串作为新种子。要做到这一点，我们需要一个算法，将一个列表拆分为一个“选定值”列表。差不多

selectEach :: [a] -> [(a, [a])]

这样，对于每个值

（c，extras）

这样

elem（c，extras）（选择每个lst）

列表

c:extras

具有与

lst

相同的值（如果顺序不同）。不过，我将以稍微不同的方式编写此函数，如下所示：

selectEach :: [a] -> [([a], a, [a])]

其中，结果分为三部分，如果

（before，here，after）

是

elem（before，here，after）（选择每个lst）

的值，则

lst==reverse before++[here]++after

。这会变得容易一点

selectEach []     = []
selectEach (a:as) = go ([], a, as) where
  go (before, here, [])    = [(before, here, [])]
  go (before, here, after@(a:as)) = (before, here, after) : go (here:before, a, as)

> selectEach "foo"
[("",'f',"oo"),("f",'o',"o"),("of",'o',"")]

有了这个辅助函数，我们可以很容易地生成树的子元素，但是最终我们会创建太多的子元素

makeTree seed vals = Node seed children where
  children = map (\(before, here, after) -> makeTree here (before ++ after)) 
                 (selectEach vals)

事实上太多了。如果我们要跑

makeTree "sip" ["sour","piss","rune","profit","today","rat"]

我们正在生产一棵1957号的树，而不是我们想要的8号的漂亮的轻便树。这是因为到目前为止，我们已经忽略了一个约束，即种子中的最后一个字母必须是所选值中的第一个字母才能继续。我们将通过过滤掉坏树来解决这个问题

goodTree :: String -> Tree String -> Bool

特别是，如果树遵循此约束，我们将称它为“good”。给定一个种子值，如果树的根节点有一个值，该值的第一个字母与种子的最后一个字母相同，则该值是好的

goodTree []   _              = False
goodTree seed Empty          = False
goodTree seed (Node "" _)    = False
goodTree seed (Node (h:_) _) = last seed == h

我们将根据这个标准简单地过滤孩子们

makeTree seed vals = Node seed children where
  children = 
    filter goodTree
    $ map (\(before, here, after) -> makeTree here (before ++ after)) 
    $ selectEach 
    $ vals

现在我们完成了

> makeTree "sip" ["sour","piss","rune","profit","today","rat"]
Node "sip" 
  [ Node "piss" [ Node "sour" [ Node "rune" []
                              , Node "rat" [ Node "today" [] ]
                              ]
                ]
  , Node "profit" [ Node "today" [] ]
  ]

完整的代码是：

selectEach :: [a] -> [([a], a, [a])]
selectEach []     = []
selectEach (a:as) = go ([], a, as) where
  go (before, here, [])    = [(before, here, [])]
  go (before, here, after@(a:as)) = (before, here, after) : go (here:before, a, as)

data Tree a = Empty | Node a [Tree a] deriving Show

goodTree :: Eq a => [a] -> Tree [a] -> Bool
goodTree []   _              = False
goodTree seed Empty          = False
goodTree seed (Node [] _)    = False
goodTree seed (Node (h:_) _) = last seed == h

makeTree :: Eq a => [a] -> [[a]] -> Tree [a]
makeTree seed vals = Node seed children where
  children =
    filter (goodTree seed)
    $ map (\(before, here, after) -> makeTree here (before ++ after))
    $ selectEach
    $ vals

---

关于

selectEach

如何使用所谓的列表拉链以及

makeTree

如何在

Reader

monad中运行，值得一读。这两个都是中间话题，巩固了我在这里使用的方法。

作为旁白，这是我最初考虑采用的方法。它使用列表作为一个集合，然后映射到

xs

列表，将种子节点设置为每个

x

。然后计算最大值

data Tree a = Node a [Tree a] deriving (Show, Eq, Read, Ord)

follows seed hist count vals = foll where 
    foll = map (\x -> (x, Set.insert x hist, count+1)) next
    next = Set.toList $ Set.filter (\x -> (head x) == (last seed)) 
                           $ Set.difference vals hist

mTree (seed,hist,count) vals = Node (seed,hist,count) children where
    children = map (\x -> mTree x vals) (follows seed hist count vals)

makeTree seed vals = mTree (seed, Set.singleton seed, 1) vals

maxT (Node (_,_,c) []) = c
maxT (Node (_,_,c) xs) = maximum (c : (map maxT xs))

maxTree xs = maximum $ map maxT trees where
    trees = map (\x -> makeTree x vals) xs
    vals  = Set.fromList xs

其结果是：

*Main> maxTree ["sip","sour","piss","rune","profit","today","rat"]
5

---

有趣-完全不同于我想接近它的方式。。。关于使用集合，它不是比过滤列表更有效吗？尽管我想我经常过滤集合；）集合可能更有效，不过在这种情况下，我不需要这样的效率——对于每个种子选择，我遍历剩余候选词的每个列表一次。同样值得注意的是，有多少树木因懒惰而展开。不过，在所有情况下，过早优化可能会掩盖正确性所需的要点。

*Main> maxTree ["sip","sour","piss","rune","profit","today","rat"]
5