algorithm - 优化/改进 Haskell 代码以列出子序列频率

Question

我编写了下面的代码来列出列表列表的子序列频率(结果包括子序列和出现子序列的列表的索引)。有没有人对如何使它更简洁和/或更高效有任何建议？

示例输出:

*主要> combFreq [[1,2,3,5,7,8],[2,3,5,6,7],[3,5,7,9],[1,2,3 ,7,9],[3,5,7,10]]
[([3,5],[0,1,2,4]),([2,3],[0,1,3]),([3,5,7],[0,2,4 ]),([5,7],[0,2,4]),([2,3,5],[0,1]),([1,2],[0,3]),( [1,2,3],[0,3]),([7,9],[2,3])]

import Data.List
import Data.Function (on)

--[[1,2,3,5,7,8],[2,3,5,6,7],[3,5,7,9],[1,2,3,7,9],[3,5,7,10]]

tupleCat x y = (fst x, sort $ nub $ snd x ++ snd y)
isInResult x result = case lookup x result of
                        Just a  -> [a]
                        Nothing -> []

sInt xs = concat $ sInt' (csubs xs) 0 (length xs) where
    csubs = map (filter (not . null) . concatMap inits . tails)
    sInt' []     _     _       = []
    sInt' (x:xs) count origLen = 
        let result = (zip (zip (replicate (length xs) count) [count+1..origLen]) 
                 $ map (\y -> intersect x y) xs)
        in concatMap (\x -> let a = fst x in map (\y -> (y,a)) (snd x))
                 result : sInt' xs (count + 1) origLen

concatResults [] result     = result 
concatResults (x:xs) result = 
    let match = isInResult (fst x) result 
        newX  = (fst x, [fst $ snd x, snd $ snd x])
    in  if not (null match)
        then let match'    = (fst x, head match)
                 newResult = deleteBy (\x -> (==match')) match' result
             in concatResults xs (tupleCat match' newX : newResult)
        else concatResults xs (newX : result)

combFreq xs =
  filter (\x -> length (fst x) > 1)
  $ reverse $ sortBy (compare `on` (length . snd)) $ concatResults (sInt xs) []

Answer 1

下面是我将如何去做。我没有比较它的性能，这当然是天真的。它枚举所有连续的子序列每个列表并将它们收集到一个 Map 中。它应该满足你的要求不过更简洁。

import Data.List as L
import Data.Map (Map)
import qualified Data.Map as M

nonEmptySubs :: [a] -> [[a]]
nonEmptySubs = filter (not . null)
             . concatMap tails
             . inits

makePairs :: (a -> [a]) -> [a] -> [(a, Int)]
makePairs f xs = concat $ zipWith app xs [0 .. ]
    where app y i = zip (f y) (repeat i)

results :: (Ord a) => [[a]] -> Map [a] [Int]
results =
    let ins acc (seq, ind) = M.insertWith (++) seq [ind] acc
        -- Insert the index at the given sequence as a singleton list
    in foldl' ins M.empty . makePairs nonEmptySubs

combFreq :: (Ord a) => [[a]] -> [([a], [Int])]
combFreq = filter (not . null . drop 1 . snd) -- Keep subseqs with more than 1 match
         . filter (not . null . drop 1 . fst) -- keep subseqs longer than 1
         . M.toList
         . results

请注意，此版本将给出相同的定性结果，但它会没有相同的顺序。

我最大的建议是更多地分解事物并利用你可以从一些标准库中完成繁琐的工作。请注意，我们可以将很多工作分解成不同的阶段，然后将它们组合起来获得最终功能的阶段。