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

时间:2014-05-17 14:12:29

标签: haskell recursion custom-data-type

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

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

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

但现在我无法解决如何继续。

2 个答案:

答案 0 :(得分:6)

您需要实际递归递归。在您的代码中,makePaths调用findPaths,但findPathsmakePaths都不会递归调用makePathsfindPaths。由于两个原因,有点难以看到算法的机制:第一,你用大量临时状态注释树,第二,你不必要地处理{ {1}}秒。

让我们剥掉一些东西。


让我们从树开始。最终,我们只需要一个 n -ary树,它在节点上有值。

Set

要明确,此data Tree a = Empty | Node a [Tree a] deriving (Show, Read, Eq, Ord) 相当于您的Tree

Tree

也就是说,由于最终目标树是仅在type OldTree a h d = Tree (a, h, d) s节点上装饰的目标树,我们将瞄准这样的函数:

String

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

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)

我们生产了一棵1957年的树,而不是我们喜欢的8号方便的树。这是因为我们到目前为止已经省略了种子中的最后一个字母必须是选择继续的值中的第一个字母的约束。我们通过过滤掉坏树来解决这个问题。

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

特别是,我们会打电话给一棵树" good"如果它遵循这个约束。给定一个种子值,如果树的根节点有一个值,其第一个字母与种子的最后一个字母相同,那么它就是好的。

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 如何使用名为拉链的列表以及selectEachmakeTree monad中的运作方式。这两个都是中间主题,巩固了我在这里使用的方法。

答案 1 :(得分:1)

顺便说一句,这是我原本想要采取的方法。它使用列表作为集合,然后映射到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