带状态的 Haskell 递归数据类型

Question

我正在尝试计算如何计算以下内容。

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

例如使用种子 "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

所以...

setOfAll = Set.fromList xs
tree = singleton "sip" (Set.empty) 0

Node 'p' (fromList ["sip"]) 1 [Empty]


makePaths setOfAll tree

给予：

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

但现在我不知道如何继续。

Answer 1

您实际上需要递归地继续。在你现在的代码中，makePaths 调用findPaths，但findPaths 和makePaths 都不会递归调用makePaths 或findPaths。也有点难以理解算法的机制，原因有两个：首先，您使用大量临时状态注释树，其次，您在处理不必要的 Sets。

让我们去掉一些东西。

---

让我们从树开始。最终，我们只需要一个在节点处具有值的 n-ary 树。

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

需要明确的是，这个Tree 相当于你的Tree

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

也就是说，由于最终目标树是仅在带有Strings 的节点处装饰的树，因此我们将瞄准这样的函数：

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

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

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

孩子们通过建立自己的子树递归地进行。这是到目前为止我们运行的算法的精确副本，除了我们使用vals 中的字符串作为新种子。为此，我们需要一种将列表拆分为“选定值”列表的算法。类似的东西

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

使得对于每个值(c, extras) 使得elem (c, extras) (selectEach lst) 列表c:extras 具有与lst 相同的值，如果顺序不同的话。不过，我打算用不同的方式编写这个函数，因为

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

结果分为三部分，如果(before, here, after) 是elem (before, here, after) (selectEach 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

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

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 中运行。这两个都是中间主题，巩固了我在这里使用的方法。

Answer 2

顺便说一句，这是我最初考虑采用的方法。它使用列表作为一个集合，然后映射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