通过在 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 函数接受两个字符串并返回一个包含以下内容的元组：

1. 通用前缀（如果存在）
2. 第一个不带前缀的字符串
3. 不带前缀的第二个字符串

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

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

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

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

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

但是，我遇到的最大问题是我需要返回包含更改的新树，因此我必须跟踪树中的其他所有内容（不知道如何执行此操作，或者我的想法是否正确关于这个）。

代码似乎在此字符串上正常工作："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

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

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

Answer 2

这是问题的发生方式。

假设您正在处理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 的原因是您只在树的顶层插入一个新节点，因此“添加到 t2”和“添加到 t1”是一回事。

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

Answer 3

您正在使用 二次 算法；而最佳情况下，后缀树可以在线性时间内构建。也就是说，坚持使用相同的算法，可能更好的方法是首先构建（未压缩的）suffix 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)])])]