string - 通过在 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 是 label 的前缀，那么我们用一个新的 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

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