我正在使用以下数据类型:
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
函数接受两个字符串并返回一个由以下内容组成的元组:
我想我理解构建树所需的规则。
我们首先将第一个子树的标签与我们想要插入的字符串(例如str
)进行比较。如果他们没有共同的前缀,我们会尝试插入下一个子树。
如果标签是str
的前缀,我们会继续查看该子树,但不是使用str
,而是尝试插入不带前缀的str
。
如果str
是标签的前缀,那么我们将现有的子树替换为新的Node
,具有Leaf
和旧的子树。我们还调整标签。
如果我们在str
和任何标签之间没有匹配,那么我们会在子树列表中添加新的Leaf
。
然而,我遇到的最大问题是我需要返回一个包含更改的新树,所以我必须跟踪树中的其他所有内容(不确定如何执行此操作或者如果我' m正确思考这个问题。)
代码似乎在此字符串上正常运行:"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'
。
非常感谢任何帮助或想法!
答案 0 :(得分:4)
您正在使用二次算法;最佳地,后缀树可以在线性时间内构造。也就是说,坚持使用相同的算法,可能更好的方法是首先构建(未压缩的)后缀trie (不是树),然后压缩生成的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)])])]
答案 1 :(得分: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”是一回事。
我怀疑你需要重新考虑你的递归结构才能让它发挥作用。
答案 2 :(得分:2)
看起来这段代码完成了这项工作,尽管仍有待改进。我希望它能够处理任何字符串。我也试图避免使用++
,但它仍然比没有好。
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