如何参数化一个常量（在这个特定的递归函数中）？

Question

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”成为：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)) 

Answer 1

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

Answer 2

这会让你大部分的方式。它不能解决您的确切问题，但会显示如何删除硬编码的长度值。

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