通过在 Haskell 中插入每个后缀来构建后缀树

Question

我正在使用以下数据类型：

data SuffixTree = Leaf Int | Node [(String, SuffixTree)] 
                deriving (Eq, Show)

每棵子树都有对应的标签（字符串）。思路是将每个后缀和它的索引添加到一个累加树中（一开始是Node []），构建对应的后缀树。

这已经定义了

buildTree s
    = foldl (flip insert) (Node []) (zip (suffixes s) [0..length s-1])

其中 suffixes 的定义是正确的。

我已经尝试实现 insert 功能一段时间了，但似乎无法成功。

这是我现在拥有的（名称和样式不是最好的，因为它仍在进行中）：

insert :: (String, Int) -> SuffixTree -> SuffixTree
insert pair tree@(Node content) 
  = insert' pair tree content
  where
    insert' :: (String, Int) -> SuffixTree -> [(String, SuffixTree)] -> SuffixTree
    insert' (s, n) (Node []) subtrees
      = Node ((s, Leaf n) : subtrees)
    insert' (s, n) (Node content@((a, tree) : pairs)) subtrees
      | null p = insert' (s, n) (Node pairs) subtrees
      | p == a = insert' (r, n) tree subtrees
      | p /= a = Node ((p, newNode) : (subtrees \ [(a, tree)]))
      where
        (p, r, r')  = partition s a
        newNode     = Node [(r, (Leaf n)), (r', tree)]

partition 函数接受两个字符串和 return 一个包含以下内容的元组：

公共前缀（如果存在）
没有前缀的第一个字符串
没有前缀的第二个字符串

我想我了解构建树所需的规则。

我们首先将第一个子树的标签与我们要插入的字符串进行比较（例如，str）。如果它们没有共同的前缀，我们尝试插入下一个子树。

如果标签是 str 的前缀，我们继续查看该子树，但我们不使用 str，而是尝试插入没有前缀的 str。

如果str是标签的前缀，那么我们用一个新的Node替换现有的子树，有一个Leaf和旧的子树。我们还调整了标签。

如果我们在 str 和任何标签之间没有匹配项，那么我们将新的 Leaf 添加到子树列表中。

但是，我遇到的最大问题是我需要 return 一个包含更改的新树，所以我必须跟踪树中的所有其他内容（不知道如何做到这一点或如果我对此的想法正确的话）。

代码似乎可以在这个字符串上正常工作："banana":

Node [("a",Node [("",Leaf 5),("na",Node [("",Leaf 3),("na",Leaf 1)])]),
("na",Node [("",Leaf 4),("na",Leaf 2)]),("banana",Leaf 0)]

但是，在这个字符串 "mississippi" 上，我得到一个 Exception: Non-exhaustive patterns in function insert'。

非常感谢任何帮助或想法！

Answer 1

问题是这样发生的。

假设您正在处理 buildTree "nanny"。插入后缀 "nanny"、"anny" 和 "nny" 后，您的树看起来像 t1 给出的：

let t1 = Node t1_content
    t1_content = [("n",t2),("anny",Leaf 1)]
    t2 = Node [("ny",Leaf 2),("anny",Leaf 0)]

接下来，您尝试插入前缀"ny":

insert ("ny", 3) t1
= insert' ("ny", 3) t1 t1_content
-- matches guard p == a with p="n", r="y", r'=""
= insert' ("y", 3) t2 t1_content

您打算接下来要做的是将("y", 3)插入t2以产生：

Node [("y", Leaf 3), ("ny",Leaf 2),("anny",Leaf 0)])

相反，发生的是：

insert' ("y", 3) t2 t1_content
-- have s="y", a="ny", so p="", r="y", r'="ny"
-- which matches guard: null p
= insert' ("y", 3) (Node [("anny", Leaf 0)]) t1_content
-- have s="y", a="anny", so p="", r="y", r'="anny"
-- which matches guard: null p
= insert' ("y", 3) (Node []) t1_content
= Node [("y", Leaf 3), ("n",t2), ("anny",Leaf 1)]

后缀 "y" 已添加到 t1 而不是 t2。

当您下次尝试插入后缀 "y" 时，守卫 p==a 案例会尝试将 ("y",3) 插入 Leaf 3 并且您会遇到模式错误。

它在 banana 上工作的原因是您只在树的顶层插入一个新节点，所以 "adding to t2" 和 "adding to t1" 是一回事。

我怀疑您需要重新考虑递归的结构才能使其正常工作。

Answer 2

您正在使用二次算法；而最佳情况下，可以在线性时间内构建后缀树。也就是说，坚持使用相同的算法，一种可能更好的方法是首先构建（未压缩的）后缀 trie（不是树），然后压缩生成的 trie。

优点是可以使用 Data.Map:

表示后缀特里

data SuffixTrie
  = Leaf' Int
  | Node' (Map (Maybe Char) SuffixTrie)

这使得操作比成对列表更高效、更容易。这样做，你也可以完全绕过常见的前缀计算，因为它自己出来了：

import Data.List (tails)
import Data.Maybe (maybeToList)
import Control.Arrow (first, second)
import Data.Map.Strict (Map, empty, insert, insertWith, assocs)

data SuffixTree
  = Leaf Int
  | Node [(String, SuffixTree)]
  deriving Show

data SuffixTrie
  = Leaf' Int
  | Node' (Map (Maybe Char) SuffixTrie)

buildTrie :: String -> SuffixTrie
buildTrie s = foldl go (flip const) (init $ tails s) (length s) $ Node' empty
  where
  go run xs i (Node' ns) = run (i - 1) $ Node' tr
    where tr = foldr loop (insert Nothing $ Leaf' (i - 1)) xs ns
  loop x run = insertWith (+:) (Just x) . Node' $ run empty
    where _ +: Node' ns = Node' $ run ns

buildTree :: String -> SuffixTree
buildTree = loop . buildTrie
  where
  loop (Leaf' i) = Leaf i
  loop (Node' m) = Node $ con . second loop <$> assocs m
  con (Just x, Node [(xs, tr)]) = (x:xs, tr) -- compress single-child nodes
  con n = maybeToList `first` n

然后：

\> buildTree "banana"
Node [("a",Node [("",Leaf 5),
                 ("na",Node [("",Leaf 3),
                             ("na",Leaf 1)])]),
      ("banana",Leaf 0),
      ("na",Node [("",Leaf 4),
                  ("na",Leaf 2)])]

类似地：

\> buildTree "mississippi"
Node [("i",Node [("",Leaf 10),
                 ("ppi",Leaf 7),
                 ("ssi",Node [("ppi",Leaf 4),
                              ("ssippi",Leaf 1)])]),
      ("mississippi",Leaf 0),
      ("p",Node [("i",Leaf 9),
                 ("pi",Leaf 8)]),
      ("s",Node [("i",Node [("ppi",Leaf 6),
                            ("ssippi",Leaf 3)]),
                 ("si",Node [("ppi",Leaf 5),
                             ("ssippi",Leaf 2)])])]

Answer 3

看起来这段代码可以完成工作，尽管可能仍有待改进。我希望它足够通用以适用于任何字符串。我也尽量避免使用 ++，但总比没有好。

getContent (Node listOfPairs)
  = listOfPairs

insert :: (String, Int) -> SuffixTree -> SuffixTree
insert (s, n) (Node [])
  = Node [(s, Leaf n)]
insert (s, n) (Node (pair@(a, tree) : pairs))
  | p == a   = Node ((a, insert (r, n) tree) : pairs)
  | null p   = Node (pair : (getContent (insert (r, n) (Node pairs))))
  | p /= a   = Node ([(p, Node [(r, Leaf n), (r', tree)])] ++ pairs)
  where
    (p, r, r') = partition s a

通过在 Haskell 中插入每个后缀来构建后缀树

Building a suffix tree by inserting each suffix in Haskell

string

tree

recursion

haskell

suffix-tree