具有状态的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- tree树.

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