タイプと出現を表す：（分かりやすい）コードを書くのが難しい（そう）

Question

例による型と出現の簡単な紹介。

Ex1。 abbacb

a,b,cである。

a occurres 2回; b occurres 3回; cは1回発生します。

これは、より簡潔に[('a',2),('b',3),('c',1)]として表すことができます（実際は、この順序は関係ありません）。

Ex2。 abbacb

ab、bb、ba、ac、cb各シーケンスが1回だけ発生タイプ

の配列です。 Haskellで

('a',2)   -- 'a' occurs 2 times 
    ('b',1)  -- "ab" occurs 1 times 
    ('c',1)  -- "ac" occurs 1 times 
('b',2)   -- 'b' occurs 2 times 
    ('a',1)  -- "ba" occurs 1 times 
    ('b',1)  -- "bb" occurs 1 times 
('c',1)   -- 'c' occurs 1 times 
    ('b',1)  -- "cb" occurs 1 times 

：の配列の出現について[(('a',2),[('b',1),('c',1)]),(('b',2),[('a',1),('b',1)]),(('c',1),[('b',1)])]

これは、以下のグラフィカル構造は、前の二つの同一の有益な内容を有する[("ab",1),("bb",1),("ba",1),("ac",1),("cb",1)]

として表すことができる

3要素：

('a',2)    -- 'a' occurs 2 times 
    ('b',1)   -- "ab" occurs 1 times 
      ('b',1) -- "abb" occurs 1 times 
    ('c',1)   -- "ac" occurs 1 times 
      ('b',1) -- "acb" occurs 1 times 
... 

Haskellで

：タイプ[((Char, Int), [((Char, Int), [(Char, Int)])])]

と

[ 
    (('a',2), [(('b',1),[('b',1)]),(('c',1),[('b',1)])]), 
    (('b',2), [(('a',1),[('c',1)]),(('b',1),[('a',1)])]) 
] 

があっても2つのおよび3つの要素の配列のみを考慮し、グラフィック表現の理解度はハスケルよりもはるかに大きいです。

さらに、リストはあまり効率的ではないので、私はData.Mapライブラリを使用しました。その結果、若干異なる表現になりました。

次の例は、Piの数字に基づいています。興味深い結果は、小説の言葉を使って得ることができます。

私の質問はです：3種類のシーケンスに捧げ

1. 機能は非常に複雑です。 は、を大幅に簡略化することは可能ですか？

2. の機能をどのように一般化することができるか想像もできません。です。誰かがそれをどうやって行うことができるか考えていますか？

3. 実装するのが容易である必要があり、次のデータ型の再帰を使用：しかしData.Mapライブラリ内のすべての機能へのアクセスを失うことはありません。このように

   data TuplesTypesOccurences a = L (M.Map a Int) | B (M.Map a (Int,TuplesTypesOccurences a)) 
   

   ？

   import qualified Data.Map as M 
   import Data.List (sortBy) 
   
   piDigits = "31415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841027019385211055596446229489549303819644288109756659334461284756" 
   
   type TypesOccurrences a = M.Map a Int 
   
   toTypeOccurrences :: Ord k => [k] -> TypesOccurrences k -> TypesOccurrences k 
   toTypeOccurrences [] mp = mp 
   toTypeOccurrences (x:xs) mp = toTypeOccurrences xs $ M.insertWith (+) x 1 mp 
   -- ex. toTypeOccurrences piDigits M.empty 
   
   pprintTO :: Show a => TypesOccurrences a -> IO() 
   pprintTO = mapM_ putStrLn . map (\(xs,n) -> show xs ++ " " ++ (show n)). sortBy (\x y -> compare (snd y) (snd x)) . M.toList 
   -- ex. pprintTO . M.filter (> 22) . toTypeOccurrences piDigits $ M.empty 
   
   type Seq2TypeOccurrences a = M.Map a (Int,TypesOccurrences a) 
   
   toSQ2TO :: Ord a => [a] -> Seq2TypeOccurrences a -> Seq2TypeOccurrences a 
   toSQ2TO []  mp = mp 
   toSQ2TO [x]  mp = mp 
   toSQ2TO (x:y:xs) mp = toSQ2TO (y:xs) $ 
       case M.lookup x mp of 
       Nothing  -> M.insert x (1,M.singleton y 1) mp 
       Just (_,mp2) -> case M.lookup y mp2 of 
        Nothing -> M.update (\(n,mp2) -> Just (n+1,M.insert y 1 mp2)) x mp 
        Just _ -> M.update (\(n,mp2) -> Just (n+1,M.update (\m -> Just (m+1)) y mp2)) x mp 
   -- ex. toSQ2TO piDigits M.empty 
   
   pprintSQ2TO :: Show a => Seq2TypeOccurrences a -> IO() 
   pprintSQ2TO = mapM_ putStrLn . map (\(x,(n,mp)) -> "(" ++ (show x) ++ "," ++ (show n) ++ ")\n\t" ++ (drop 2 . concatMap (("\n\t" ++) . show) . M.toList $ mp)) . M.toList 
   -- ex. pprintSQ2TO (toSQ2TO piDigits M.empty) 
   
   greaterThanSQ2TO :: Ord a => Int -> Seq2TypeOccurrences a -> Seq2TypeOccurrences a 
   greaterThanSQ2TO n = M.filter (\(_,mp2) -> not . M.null $ mp2) . M.map (\(o,mp2) -> (o,M.filter (> n) mp2)) . M.filter (\(m,mp) -> m > n) 
   -- ex. pprintSQ2TO . greaterThanSQ2TO 4 . toSQ2TO piDigits $ M.empty 
   
   descSortSQ2TO :: Ord a => Seq2TypeOccurrences a -> [([a], Int)] 
   descSortSQ2TO = sortBy (\xs ys -> compare (snd ys) (snd xs)) . concatMap (\(x,ys) -> zipWith (\x (y,n) -> ([x,y],n)) (repeat x) ys) . map (\(x,(_,mp2)) -> (x,M.toList mp2)) . M.toList 
   -- mapM_ print . descSortSQ2TO . greaterThanSQ2TO 4 . toSQ2TO piDigits $ M.empty 
   
   unionSQ2TO :: Ord a => Seq2TypeOccurrences a -> Seq2TypeOccurrences a -> Seq2TypeOccurrences a 
   unionSQ2TO = M.unionWith (\(n1,mp1) (n2,mp2) -> (n1+n2, M.unionWith (+) mp1 mp2)) 
   
   type Seq3TypeOccurrences a = M.Map a (Int,Seq2TypeOccurrences a) 
   
   toSQ3TO :: Ord k => [k] -> Seq3TypeOccurrences k -> Seq3TypeOccurrences k 
   toSQ3TO [] mp = mp 
   toSQ3TO [x] mp = mp 
   toSQ3TO [x,y] mp = mp 
   toSQ3TO (x:y:z:xs) mp = toSQ3TO (y:z:xs) $ 
       case M.lookup x mp of 
       Nothing -> M.insert x (1,M.singleton y (1,M.singleton z 1)) mp 
       Just (_,mp2) -> case M.lookup y mp2 of 
        Nothing -> M.update (\(n,mp2) -> Just (n+1,M.insert y (1,M.singleton z 1) mp2)) x mp 
        Just (m,kns3) -> case M.lookup z kns3 of 
         Nothing -> M.update (\(n,_) -> Just (n+1,M.update (\(m,mp3) -> Just (m+1,M.insert z 1 mp3)) y mp2)) x mp 
         Just _ -> M.update (\(n,_) -> Just (n+1,M.update (\(m,mp3) -> Just (m+1,M.update (Just . (+1)) z mp3)) y mp2)) x mp 
   -- ex. toSQ3TO piDigits M.empty 
   
   pprint3 :: Show a => Seq3TypeOccurrences a -> IO() 
   pprint3 = mapM_ putStrLn . map (\(x,(n,mp)) -> "(" ++ (show x) ++ "," ++ (show n) ++ ")" ++ (concatMap (\(x2,(n2,mp2)) -> "\n\t(" ++ (show x2) ++ "," ++ (show n2) ++ ")" ++ (f mp2)) . M.toList $ mp)) . M.toList 
       where 
       f = concatMap (\(x,n) -> "\n\t\t(" ++ (show x) ++ "," ++ (show n) ++ ")") . M.toList 
   -- pprint3 . toSQ3TO piDigits $ M.empty 
   
   pprint3B :: Show a => Seq3TypeOccurrences a -> IO() 
   pprint3B = mapM_ putStrLn . map (\(xs,n) -> show xs ++ " " ++ (show n)) . concatMap (\(xs,mp) -> zipWith (\ys (z,n) -> (ys ++ [z],n)) (repeat xs) mp) . concatMap (\(x,mp) -> zipWith (\y (z,mp2) -> ([y,z],mp2)) (repeat x) mp) . map (\(x,(_,mp)) -> (x, map (\(y,(_,mp2)) -> (y, M.toList mp2)) $ M.toList mp)) . M.toList 
   -- pprint3B . toSQ3TO piDigits $ M.empty 
   
   greaterThan3Q2TO :: Ord a => Int -> Seq3TypeOccurrences a -> Seq3TypeOccurrences a 
   greaterThan3Q2TO n = M.filter (\(_,mp) -> not . M.null $ mp) 
       . M.map (\(m,mp) -> (m,M.filter (\(o,mp2) -> not . M.null $ mp2) mp)) 
       . M.map (\(m,mp) -> (m,M.map (\(o,mp2) -> (o,M.filter (>n) mp2)) mp)) 
       . M.filter (\(_,mp) -> not. M.null $ mp) 
       . M.map (\(m,mp) -> (m,M.filter ((n <) . fst) mp)) 
       . M.filter (\(m,mp) -> m > n) 
   -- ex. pprint3B . greaterThan3Q2TO 2 . toSQ3TO piDigits $ M.empty 
   
   unionSQ3TO :: Ord a => Seq3TypeOccurrences a -> Seq3TypeOccurrences a -> Seq3TypeOccurrences a 
   unionSQ3TO = M.unionWith (\(n,mp2a) (m,mp2b) -> (n+m,unionSQ2TO mp2a mp2b)) 
   

Answer 1

あなたはこのように再帰的なデータ構造を定義する必要があります。

data Trie = Nil | Trie (Map Char (Int, Trie)) 

は、これは再帰的に定義するには、showを可能にし、機能を追加します。

ここに実装があります。どのように動作するかの例を見るにはtest3を実行してください。

import qualified Data.Map as M 
import Text.PrettyPrint 
import Data.List 

data Trie = Nil | Trie (M.Map Char (Int, Trie)) 

showTrie :: String -> Trie -> Doc 
showTrie _ Nil = empty 
showTrie prefix (Trie m) = 
    vcat $ 
    do (k,(count,t)) <- M.assocs m 
     let prefix' = prefix ++ [k] 
     return $ 
     vcat [ lparen <> char '"' <> text prefix' <> char '"' <> comma <> int count <> rparen 
       , nest 4 (showTrie prefix' t) 
       ] 

-- add an element to a Trie 
addTrie :: Trie -> String -> Trie 
addTrie t [] = t 
addTrie Nil xs = addTrie (Trie M.empty) xs 
addTrie (Trie m) (x:xs) = 
    case M.lookup x m of 
    Nothing  -> let t' = addTrie Nil xs 
        in Trie $ M.insert x (1,t') m 
    Just (c,t) -> let t' = addTrie t xs 
        in Trie $ M.insert x (c+1,t') m 

test1 = 
    let t1 = addTrie Nil "abcd" 
     t2 = addTrie t1 "abce" 
    in putStrLn $ render $ showTrie "" t2 

test2 n str = 
    putStrLn $ render $ showTrie "" $ 
     foldr (flip addTrie) Nil (map (take n) (tails str)) 

test3 = test2 4 "31415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841027019385211055596446229489549303819644288109756659334461284756"