如何参数化常量(在这个特定的递归函数中)?

时间:2016-08-02 18:53:56

标签: haskell

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

2 个答案:

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