通過在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的前綴，那么我們用一個具有Leaf和舊子樹的新Node替換現有子樹。 我們還調整標簽。

如果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

您正在使用二次算法; 最佳地，后綴樹可以在線性時間內構建。 也就是說，堅持使用相同的算法，一種可能更好的方法是首先構建（未壓縮的） 后綴trie （不是樹），然后壓縮生成的trie。

優點是可以使用Data.Map表示后綴trie：

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 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

你打算接下來要做的是在t2插入("y", 3)以產生：

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

看起來這個代碼完成了這項工作，盡管可能仍有待改進。 我希望它能夠處理任何字符串。 我也試圖避免使用++ ，但它總比沒有好。

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