test1从字符串" abcdef"中正确生成以下结构:
(a,(1,[0])) -- type 'a' occur 1 time in position 0
(b,(1,[1])) -- type 'b' occur 1 time in position 1
(c,(1,[2]))
(d,(1,[3]))
(e,(1,[4]))
(f*,(1,[5])) -- type 'f' is the last of the list
但是这个结果取决于数字6 ,这是一个非常特殊的字符串类的长度,对于一般情况无效。
因此,如果test1中的字符串是" abc"结果是错误的:
(a,(1,[0]))
(b,(1,[7]))
(c*,(1,[8]))
如果test1中的字符串是" abcdefgh"结果也是错误的:
(a,(1,[0]))
(b,(1,[2])) -- Should be [1]
(c,(1,[3])) -- Should be [2]
(d,(1,[4])) -- ...
(e,(1,[5]))
(f,(1,[6]))
(g,(1,[7]))
(h*,(1,[8]))
在addTrieWithCounter中,我无法用parameterized function on the length of the word
替换此常量(6)。
此函数的上下文。 addTrieWithCounter将被放置在一个特殊的"循环"这样的" al alts" becames:addTrieWithCounter ..." al" 0 - > "放弃空间" - > addTrieWithCounter ..." alts" 3.因此,事件将与初始字符串对齐。
-- analyzing "all alts" should be obtained this result.
(a,(2,[4,0])) -- type 'a' occur 2 times in positions 3 and 0 (reversed order)
(l,(2,[5,1])) -- type 'l' (of seq "al") occur 2 times in positions 4 and 1 (reversed order)
(l*,(1,[2])) -- type 'l' (of seq "all") occur 1 time in positions 2
(t,(1,[6])) -- type 't' (of seq "alt") occur 1 time in positions 6
(s*,(1,[7])) -- type 's' (of seq "alts") occur 1 time in positions 7
这将是一件微不足道的事情,但我不知道。
提前感谢您的建议。
import qualified Data.Map as M
import Text.PrettyPrint as TP
import Data.Either (either)
data Trie a b = Nil | Trie (M.Map (Either a a) (b, Trie a b)) deriving Show
-- (Just a note: Trie will be a Monoid's instance. So with "Either" it is possible to distinguish the following cases: "all" and "alliance")
-- add an element to a Trie
addTrieWithCounter
:: Ord a =>
(Trie a (Int, [t1]), Int)
-> ((Int, [t1]) -> Int -> (Int, [t1]))
-> [a]
-> (Trie a (Int, [t1]), Int)
addTrieWithCounter (t,st) f [] = (t,st)
addTrieWithCounter (Nil,st) f xs = addTrieWithCounter (Trie M.empty, st) f xs
addTrieWithCounter (Trie m,st) f [x] =
(Trie $ M.insertWith (\(c,_) _ -> (f c st,Nil)) (Left x) (f (0,[]) st,Nil) m,st + 1)
addTrieWithCounter (Trie m, st) f (x:xs) =
case M.lookup (Right x) m of -- !!!!! PROBLEM IN THE FOLLOWING LINE !!!!!
Nothing -> let (t',st') = addTrieWithCounter (Nil, 6 - length xs ) f xs
in (Trie $ M.insert (Right x) (f (0,[]) st,t') m,st + 1)
Just (c,t) -> let (t',st') = addTrieWithCounter (t,st) f xs -- TO CHANGE
in (Trie $ M.insert (Right x) (f c st',t') m,st')
showTrieS f (t,_) = showTrie f t
showTrie :: Show a => (Either t t -> String) -> Trie t a -> Doc
showTrie _ Nil = empty
showTrie f (Trie m)
| M.null m = empty
| otherwise =
vcat $
do (k,(count,t)) <- M.assocs m
return $
vcat [ lparen TP.<> text (f k) TP.<> comma TP.<> (text . show $ count) TP.<> rparen
, nest 4 (showTrie f t)
]
test1 = showTrieS f1 t
where
f1 = (either (:"*") (:""))
t = addTrieWithCounter (Trie M.empty,0) f2 "abcdef"
f2 (cr,poss) st = ((cr + 1),(st : poss))
答案 0 :(得分:1)
这将帮助你完成大部分工作。它并没有解决你的问题 确切的问题,但显示了如何删除硬编码的长度值。
import qualified Data.Map.Strict as M
import qualified Data.IntSet as S
import Data.Monoid
import Text.PrettyPrint hiding ((<>))
data GenTrie a b = Trie (M.Map a (b, GenTrie a b))
deriving (Show)
emptyTrie = Trie M.empty
data Info = Info { _count :: Int, _positions :: S.IntSet }
deriving (Show)
type Trie = GenTrie Char Info
addString :: Int -> String -> Trie -> Trie
addString i cs t = go t i cs
where
go :: Trie -> Int -> String -> Trie
go t i [] = t
go t i (c:cs) =
let Trie m = t
pair =
case M.lookup c m of
Nothing ->
let t2 = go emptyTrie (i+1) cs
val = Info 1 (S.singleton i)
in (val, t2)
Just (info,t1) ->
let t2 = go t1 (i+1) cs
val = info { _count = _count info+1
, _positions = S.insert i (_positions info)
}
in (val, t2)
in Trie (M.insert c pair m)
printTrie = putStrLn . showTrie
showTrie = render . trieToDoc
trieToDoc :: Trie -> Doc
trieToDoc (Trie m)
| M.null m = empty
| otherwise =
vcat $
do (ch, (info,t)) <- M.assocs m
let count = show (_count info)
pos = show (S.toList (_positions info))
return $
vcat [ text [ch] <> space <> text count <> space <> text pos
, nest 4 (trieToDoc t)
]
test1 = printTrie $ addString 0 "abc" emptyTrie
test2 = printTrie $ addString 4 "alts" $ addString 0 "all" emptyTrie
答案 1 :(得分:0)
addTrieWithCounter (Trie m,st) f (x:xs) =
case M.lookup (Right x) m of
Nothing -> let (t',st') = addTrieWithCounter (Nil, st + 1 ) f xs
in (Trie $ M.insert (Right x) (f (0,[]) st,t') m, st')
Just (c,t) -> let (t',st') = addTrieWithCounter (t,st + 1) f xs
in (Trie $ M.insert (Right x) (f c st,t') m,st')