hlcm (empty) → 0.2.1
raw patch · 8 files changed
+1046/−0 lines, 8 filesdep +arraydep +basedep +bytestringsetup-changedbinary-added
Dependencies added: array, base, bytestring, bytestring-csv, containers, haskell98, parallel
Files
- Bench.hs +75/−0
- Data/datasets.tgz binary
- HLCM.hs +661/−0
- LICENSE +9/−0
- Main.hs +161/−0
- README +85/−0
- Setup.lhs +3/−0
- hlcm.cabal +52/−0
+ Bench.hs view
@@ -0,0 +1,75 @@+-- HLCM, parallel execution benchmarking version.+-- (c) Alexandre Termier, 2009-2010+-- Original LCM algorithm from Takaki Uno and Hiroki Arimura.+-- +--+-- See the README file for installation, usage, and details.+-- See the LICENSE file for licensing.++{-|+Main program to invoke the LCM algorithm and+compute closed frequent itemsets, with benchmarking options. +These benchmarking options allow to test various ways of using semi-implicit parallelism of Haskell.++Usage : ++@benchHLCM /input_data support_threshold strategy_id value_for_parBuffer depth/@++See the page for the main of @hlcm@ for details about what the program do.++Parameters are :++ * input_data : input file, must be in the numeric format described in hlcm main executable.++ * support_threshold : minimal frequency of a pattern. Less means more computations and longer execution times.++ * strategy_id : 1 = myParBuffer from Simon Marlow (see file HLCM.hs, no memory leak), 2 = parBuffer from Control.Parallel.Strategies (can have a memory leak), 3 = parMap++ * value_for_buffer : if strategy is myParBuffer or parBuffer, value to use for buffering (you can start with 8)++ * depth : during depth first exploration, below the depth given no more sparks are created++A typical execution:++@time benchHLCM Data\/mushroom.dat 1000 1 8 2 >\/dev\/null +RTS -N2@++This runs benchHLCM on the mushroom dataset, with a support of 1000, strategy=myParBuffer with n=8 and a spark cutoff depth of 2.+The outputs are not interesting for benchmarking, they are thus dumped in /dev/null.+Two cores are requested.++Note that there is a known bug in GHC 6.10.4/6.12.1: on a machine with N cores, it is better to use <= N-1 cores.+See <http://hackage.haskell.org/trac/ghc/ticket/3553#comment:5>.++-}+module Main(main) where++import HLCM+import System( getArgs )++import qualified Data.ByteString.Char8 as L++{-|+Main program, parses command line, calls LCM and dumps raw output.+-}+main :: IO ()+main = do+ args <- getArgs+ (dataFile, _thres, _strat, _n, _d) <- return (args !! 0, args !! 1, args !! 2, args !! 3, args !! 4)+ stringMatrix <- L.readFile dataFile+ let + thres = read _thres::Frequency+ strat = read _strat::Int+ n = read _n::Int+ d = read _d::Int+ cfis = runBench stringMatrix thres strat n d in+ do+ putStrLn (show cfis)+ + +runBench :: L.ByteString -> Frequency -> Int -> Int -> Int -> [[Item]]+runBench db frq strat n d+ | strat == 1 = benchLCM_parBuffer db frq n d+ | strat == 2 = benchLCM_parMap db frq d+ | otherwise = []+ +
+ Data/datasets.tgz view
binary file changed (absent → 446996 bytes)
+ HLCM.hs view
@@ -0,0 +1,661 @@+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}++{-|++Library for using the LCM algorithm in order to compute closed frequent pattern.+Input must be a transaction database, either in text format (as a ByteString)+or in @[[Item]]@ format, where @Item = Int@.++Several bencharking functions allowing to tune parallel strategy used and depth+cutoff are also provided.++-}+++-- HLCM+-- (c) Alexandre Termier, 2009-2010+-- Original LCM algorithm from Takaki Uno and Hiroki Arimura.+-- Many performance improvements thanks to Simon Marlow and Satnam Singh.+-- +-- Module implementing the LCM algorithm.+-- +--+-- See the README file for installation, usage, and details.+-- See the LICENSE file for licensing.++++module HLCM+ ( Frequency, Item+ , runLCMstring+ , runLCMmatrix+ , benchLCM_parBuffer+ , benchLCM_parMap+ ) where++-----------------------------------------------------------------+-- Imports+-----------------------------------------------------------------++import Data.List+import Data.Array.Unboxed+import Control.Monad.ST+import Data.Array.ST+import Control.Parallel+import Control.Parallel.Strategies+import Control.Exception( evaluate )+import Data.Array.Base+import Control.Monad+import GHC.Exts+import GHC.ST++import qualified Data.List as List++import qualified Data.ByteString.Char8 as L++-----------------------------------------------------------------+-- Type definitions+-----------------------------------------------------------------++type Item = Int+type Frequency = Int+type Tid = Int+type Weight = Int++-----------------------------------------------------------------+-- LCM functions+-----------------------------------------------------------------++{-|+ Get the data as a long bytestring, parses it and+ and executes LCM to discover closed frequent itemsets.+-}+runLCMstring :: L.ByteString -- ^ The transaction database as a big string. Transactions are separated by newlines, items are separated by spaces+ -> Frequency -- ^ Minimum frequency threshold for the frequent itemsets+ -> [[Item]] -- ^ Output: list of closed frequent itemsets+runLCMstring stringMatrix freq =+ let -- Load the file and convert it in the transaction database format (lexicographic tree)+ (transactionsLT, maxItem, antiPerm) = loadTransactionsString stringMatrix freq + -- Compute occurrences for 1-itemsets+ occs = occurrenceDeliverLT transactionsLT maxItem + in+ reversePerm antiPerm $ concat (parBuffer 8 rdeepseq $ (map (\x -> lcmIter 1 transactionsLT [] x (-1) occs maxItem freq) [0..maxItem]) )+ + +{-|+ Get the data as a matrix of Items, parses it and+ and executes LCM to discover closed frequent itemsets.+-}+runLCMmatrix :: [[Item]] -- ^ The transaction database as matrix of items (List of List)+ -> Frequency -- ^ Minimum frequency threshold for the frequent itemsets+ -> [[Item]] -- ^ Output: list of closed frequent itemsets+runLCMmatrix transMatrix freq =+ let -- Convert the matrix in the transaction database format (lexicographic tree)+ (transactionsLT, maxItem, antiPerm) = loadTransactionsMatrix transMatrix freq + -- Compute occurrences for 1-itemsets+ occs = occurrenceDeliverLT transactionsLT maxItem + in+ reversePerm antiPerm $ concat (parBuffer 8 rdeepseq $ (map (\x -> lcmIter 1 transactionsLT [] x (-1) occs maxItem freq) [0..maxItem]) )+ ++{-|+ Use for benchmarking, parallel strategy = parBuffer by Simon Marlow. + This strategy does not have space leak. ++ /Warning: outputs are unusable as is, because items are renamed internally, and in this function the reverse + renaming is not performed. It is trivial to have it back by copying the code from runLCMstring./+-}+benchLCM_parBuffer :: L.ByteString -- ^ The transaction database as a big string. Transactions are separated by newlines, items are separated by spaces+ -> Frequency -- ^ Minimum frequency threshold for the frequent itemsets+ -> Int -- ^ value for parBuffer+ -> Int -- ^ depth for cutting parallelism+ -> [[Item]] -- ^ Output: list of closed frequent itemsets+benchLCM_parBuffer stringMatrix freq n d =+ let -- Load the file and convert it in the transaction database format (lexicographic tree)+ (transactionsLT, maxItem, antiPerm) = loadTransactionsString stringMatrix freq + -- Compute occurrences for 1-itemsets+ occs = occurrenceDeliverLT transactionsLT maxItem + in+ concat (parBuffer n rdeepseq $ (map (\x -> lcmIterParBuffer 1 transactionsLT [] x (-1) occs maxItem freq n d) [0..maxItem]) )+ +++{-|+ Use for benchmarking, parallel strategy = parMap from Control.Parallel.Strategies. ++ /Warning: outputs are unusable as is, because items are renamed internally, and in this function the reverse + renaming is not performed. It is trivial to have it back by copying the code from runLCMstring./+-}+benchLCM_parMap :: L.ByteString -- ^ The transaction database as a big string. Transactions are separated by newlines, items are separated by spaces+ -> Frequency -- ^ Minimum frequency threshold for the frequent itemsets+ -> Int -- ^ depth for cutting parallelism+ -> [[Item]] -- ^ Output: list of closed frequent itemsets+benchLCM_parMap stringMatrix freq d =+ let -- Load the file and convert it in the transaction database format (lexicographic tree)+ (transactionsLT, maxItem, antiPerm) = loadTransactionsString stringMatrix freq + -- Compute occurrences for 1-itemsets+ occs = occurrenceDeliverLT transactionsLT maxItem + in+ concat ( ((parMap rdeepseq) (\x -> lcmIterParMap 1 transactionsLT [] x (-1) occs maxItem freq d) [0..maxItem]))+ +++++{-|+ Takes a list of itemsets and a permutation of items, an apply this permutation to the itemsets.+-}+reversePerm :: UArray Item Item -- ^ A permutation of items+ -> [[Item]] -- ^ Input list of itemsets. An itemset is a list of items, starting with its frequency.+ -> [[Item]] -- ^ Permuted list of itemsets. Frequency at the head of the itemset is untouched.+reversePerm _ [] = []+reversePerm antiPerm (t:ts) = ((head t):(sort $ map (\it -> unsafeAt antiPerm it) (tail t))):(reversePerm antiPerm ts)++{-|+ Loads input datase as string into a database of transactions in lexicographic tree format.+ Also reorders/renames the item by their frequency.+ The permutation between old item values and new item values is also returned.+-}+loadTransactionsString :: L.ByteString -- ^ Data as a long bytestring+ -> Frequency -- ^ Minimum support threshold+ -> (LexicoTreeItem, Item, UArray Item Item) -- ^ Return value : (Database, maximum item value after reduction, permutation of items)+loadTransactionsString s thres = + case stringToTransDB (L.lines s) of+ Nothing -> (Nil, -1, array (1,0) []) + Just intMatrix -> let itmFrq = histogram (0, maxItem) intMatrix+ maxItem = maximum (concat intMatrix)+ (perm, antiPerm) = permut itmFrq+ reorderedMat = reorderMat intMatrix perm itmFrq thres+ maxItem' = maximum (concat reorderedMat)+ lexicoTree = foldr (\t lt -> insertLT t (-1) 1 lt) Nil reorderedMat+ in (lexicoTree, maxItem', antiPerm)+ + +{-|+ Loads input datase as a matrix of Items into a database of transactions in lexicographic tree format.+ Also reorders/renames the item by their frequency.+ The permutation between old item values and new item values is also returned.+-}+loadTransactionsMatrix :: [[Item]] -- ^ Data as a matrix of Items+ -> Frequency -- ^ Minimum support threshold+ -> (LexicoTreeItem, Item, UArray Item Item) -- ^ Return value : (Database, maximum item value after reduction, permutation of items)+loadTransactionsMatrix intMatrix thres = + let itmFrq = histogram (0, maxItem) intMatrix+ maxItem = maximum (concat intMatrix)+ (perm, antiPerm) = permut itmFrq+ reorderedMat = reorderMat intMatrix perm itmFrq thres+ maxItem' = maximum (concat reorderedMat)+ lexicoTree = foldr (\t lt -> insertLT t (-1) 1 lt) Nil reorderedMat+ in (lexicoTree, maxItem', antiPerm)+++{-|+ Converts the contents of a data string to + a transaction database and computes maxItem.+-}+stringToTransDB :: [L.ByteString] -- ^ List of transactions+ -> Maybe [[Item]] -- ^ Return value : transactions as lists of items, and maxItem+stringToTransDB [] = return []+stringToTransDB (t:ts) = do+ ts' <- stringToTransDB ts+ return (convertOneTrans t:ts')++{-|+ Converts one transaction from string format to item format [Item].+-}+convertOneTrans :: L.ByteString -- ^ Transaction as extracted from file+ -> [Item] -- ^ Result : list of items+convertOneTrans s = + case L.readInt s of+ Nothing -> []+ Just (itm, rest) -> if (not $ L.null rest) + then itm:(convertOneTrans (L.tail rest))+ else [itm]+++{-|+ For a transaction database of type [[Item]], compute the frequency+ of each item and return an array (item, frequency). +-}+histogram :: (Item,Item) -- ^ Bounds for resulting array, must be (0, maxItem)+ -> [[Item]] -- ^ Transaction database + -> UArray Item Frequency -- ^ Result : Array associating each item with its frequency+histogram bnds lst = accumArray (+) 0 bnds [(i, 1) | j <- lst, i <- {-nub-} j{-, inRange bnds i-}]+++{-|+ Sorts a list of (Item, frequency of this item) in+ decreasing ordrer of frequency.++ XXX PERF : seems unefficient. +-} +sortFrq :: [(Item,Frequency)] -- ^ Each item is associated with its frequency+ -> [(Item,Frequency)] -- ^ Same list as input, but sorted in decreasing frequency order+sortFrq [] = []+sortFrq ((x,y):rest) = (sortFrq [(x',y') | (x',y') <- rest, y' >= y])+ ++ [(x,y)]+ ++ (sortFrq [(x'',y'') | (x'',y'') <- rest, y'' < y])+-- XXX PERF: lots of copies here...maybe not a pb for small lists ?++{-|+ From an array of (item, frequency of this item),+ computes an associative array X where X[i] is+ the ith most frequent item.++ XXX PERF : performance issue with conversions to and from list inside function.+-}+permut :: UArray Item Frequency -- ^ Array associating to each item its frequency+ -> (UArray Item Item, UArray Item Item) -- ^ Result : new array where items are ranked by frequency, and the reverse+permut arr = let (lo,hi) = bounds arr+ lstVal = [(i,(arr!i)) | i <- [lo..hi]]+ lst2 = sortFrq lstVal+ -- in array (lo,hi) [(k, (fst (lst2 !! (k)))) | k <- [lo..hi]]+ in (array (lo,hi) [(k, (head $ findIndices ((==k).fst) lst2)) | k <- [lo..hi]],+ array (lo,hi) [(k, (fst (lst2 !! (k)))) | k <- [lo..hi]])+-- XXX PERF: must be bad : the array is converted to list (one copy),+-- then this list is sorted (more copies of small lists), and at+-- last a new array is created...+-- Try to improve this with a mutable array and more "in place" spirit...+++{-|+ Rewrites an input transaction database by removing infrequent items and + using reordered items (i.e. each item is replaced by its rank in decreasing frequency order).+-}+reorderMat :: [[Item]] -- ^ Original transaction database+ -> UArray Item Item -- ^ Array of items sorted by decreasing frequency order (item, rank)+ -> UArray Item Frequency -- ^ Array associating each item with its frequency (item, frequency)+ -> Frequency -- ^ Minimum frequency threshold+ -> [[Item]] -- ^ Result : rewritten transaction database+reorderMat ts perm itmFrq thres = + map (\t -> + sort $ (map (\i -> (unsafeAt perm i)) -- permutates items+ (filter (\x -> (unsafeAt itmFrq x) >= thres) -- eliminate unfrequent items+ t))) ts+++{-| + Compute for each item of the transaction database its frequency.+-}+occurrenceDeliverLT :: LexicoTreeItem -- ^ Transaction database (in lexicographic tree format)+ -> Item -- ^ Maximal item in transaction database+ -> UArray Item Frequency -- ^ Result : array associating each item to its frequency.+occurrenceDeliverLT cdb maxItem = + runST (do+ arr <- newArray_ (0,maxItem)+ -- Creates an empty array : each item starts with frequency 0+ forM_ [0..maxItem] $ \i -> unsafeWrite arr i 0 -- workaround for http://hackage.haskell.org/trac/ghc/ticket/3586+ -- Compute frequencies for each item by efficient tree traversal+ _ <- traverse cdb arr+ unsafeFreeze arr+ )+ + ++{-|+ Efficient traversal of the transaction database as a lexicographic tree.+ Items frequencies are updated on the fly.+-}+traverse :: LexicoTreeItem -- ^ Transaction database+ -> STUArray s Item Frequency -- ^ Array associating each item with its frequency. UPDATED by this function !+ -> ST s ()+traverse tree arr = ST $ \s -> + case traverse' tree arr s of (# s', _ #) -> (# s', () #)++traverse' :: LexicoTreeItem -> STUArray s Item Frequency -> State# s -> (# State# s, Int# #)+traverse' Nil !arr s = (# s, 0# #)+traverse' (Node item child alt w@(I# w#)) !arr s0 =+ case traverse' child arr s0 of { (# s1, childw #) ->+ case traverse' alt arr s1 of { (# s2, altw #) ->+ case unsafeRead arr item of { ST f -> case f s2 of { (# s3, I# itemw #) ->+ case unsafeWrite arr item (I# itemw + I# childw + w) of { ST f -> case f s2 of { (# s4, _ #) ->+ (# s4, childw +# w# +# altw #)+ }}}}}}+++{-|+ For a transaction database, a closed frequent itemset, and a candidate item+ for extension of this closed frequent itemset, recursively computes all+ the successor closed frequent itemsets by PPC-extension.+-}+lcmIter :: Int -- ^ Current depth in the search tree (for parallel optimisation purposes)+ -> LexicoTreeItem -- ^ Transaction database. + -> [Item] -- ^ Input closed frequent itemset.+ -> Item -- ^ Candidate to extend the closed frequent itemset above.+ -> Item -- ^ CoreI item relative to the closed frequent itemset+ -> UArray Item Frequency -- ^ Array associating each item with its frequency+ -> Item -- ^ Maximal item+ -> Frequency -- ^ Minimum suppport threshold+ -> [[Item]] -- ^ Result : list of closed frequent itemsets. Each result is a list of items, the head of the list being the frequency of the item.+lcmIter prof cdb itemset candidate coreI occs maxItem thres = + let + -- Reduce database+ rdb = projectAndReduce cdb candidate occs+ -- Compute items occurrences in reduced database + newOccs = occurrenceDeliverLT rdb maxItem + -- Check which items actually appear in reduced database+ presentItems = filter (\i -> newOccs!i > 0) [0..maxItem] + candidateFreq = occs!candidate+ -- Compute 100% frequent items, unfrequent items, and future candidates+ (closedFrqItems, candidates, unfrqItems) = computeCandidates thres candidateFreq presentItems newOccs + -- Update items occurrences table by suppressing 100% frequent and unfrequent items+ newOccs' = suppressItems newOccs closedFrqItems unfrqItems + -- Result closed frequent itemset = input closed frequent itemset + 100% frequent items+ closedItemset = sort (itemset ++ closedFrqItems) + -- Only candidates with value lower than input candidate can be used for further extension on this branch+ smallCandidates = takeWhile (<candidate) candidates in+ if (closedFrqItems /= []) -- if there is a result ...+ then if ((last closedFrqItems) <= candidate)-- ...and if it is OK to extend it+ then if ((length smallCandidates) > 0) -- ... and if we have at least 1 possible extension+ then -- recursiverly extend the candidates+ if (prof < 3) -- create parallel sparks only for low search space depth + then ((candidateFreq:closedItemset):(concat (parBuffer 2 rdeepseq $ (map (\x -> lcmIter (prof+1) rdb closedItemset x candidate newOccs' maxItem thres) smallCandidates))))+ else ((candidateFreq:closedItemset):(concat (map (\x -> lcmIter (prof+1) rdb closedItemset x candidate newOccs' maxItem thres) smallCandidates)))+ else [candidateFreq:closedItemset] + else [] + else [] + + + +------------------------------- BENCHMARKING ------------------------------+++{-|+ +-}+lcmIterParBuffer :: Int -- ^ Current depth in the search tree (for parallel optimisation purposes)+ -> LexicoTreeItem -- ^ Transaction database. + -> [Item] -- ^ Input closed frequent itemset.+ -> Item -- ^ Candidate to extend the closed frequent itemset above.+ -> Item -- ^ CoreI item relative to the closed frequent itemset+ -> UArray Item Frequency -- ^ Array associating each item with its frequency+ -> Item -- ^ Maximal item+ -> Frequency -- ^ Minimum suppport threshold+ -> Int -- ^ Value for parBuffer+ -> Int -- ^ Depth for cutting parallelism+ -> [[Item]] -- ^ Result : list of closed frequent itemsets. Each result is a list of items, the head of the list being the frequency of the item.+lcmIterParBuffer prof cdb itemset candidate coreI occs maxItem thres n d = + let + -- Reduce database+ rdb = projectAndReduce cdb candidate occs+ -- Compute items occurrences in reduced database + newOccs = occurrenceDeliverLT rdb maxItem + -- Check which items actually appear in reduced database+ presentItems = filter (\i -> newOccs!i > 0) [0..maxItem] + candidateFreq = occs!candidate+ -- Compute 100% frequent items, unfrequent items, and future candidates+ (closedFrqItems, candidates, unfrqItems) = computeCandidates thres candidateFreq presentItems newOccs + -- Update items occurrences table by suppressing 100% frequent and unfrequent items+ newOccs' = suppressItems newOccs closedFrqItems unfrqItems + -- Result closed frequent itemset = input closed frequent itemset + 100% frequent items+ closedItemset = sort (itemset ++ closedFrqItems) + -- Only candidates with value lower than input candidate can be used for further extension on this branch+ smallCandidates = takeWhile (<candidate) candidates in+ if (closedFrqItems /= []) -- if there is a result ...+ then if ((last closedFrqItems) <= candidate)-- ...and if it is OK to extend it+ then if ((length smallCandidates) > 0) -- ... and if we have at least 1 possible extension+ then -- recursiverly extend the candidates+ if (prof < d) -- create parallel sparks only for low search space depth + then ((candidateFreq:closedItemset):(concat (parBuffer n rdeepseq $ (map (\x -> lcmIterParBuffer (prof+1) rdb closedItemset x candidate newOccs' maxItem thres n d) smallCandidates))))+ else ((candidateFreq:closedItemset):(concat (map (\x -> lcmIterParBuffer (prof+1) rdb closedItemset x candidate newOccs' maxItem thres n d) smallCandidates)))+ else [candidateFreq:closedItemset] + else [] + else [] ++---++{-|+ +-}+lcmIterParMap :: Int -- ^ Current depth in the search tree (for parallel optimisation purposes)+ -> LexicoTreeItem -- ^ Transaction database. + -> [Item] -- ^ Input closed frequent itemset.+ -> Item -- ^ Candidate to extend the closed frequent itemset above.+ -> Item -- ^ CoreI item relative to the closed frequent itemset+ -> UArray Item Frequency -- ^ Array associating each item with its frequency+ -> Item -- ^ Maximal item+ -> Frequency -- ^ Minimum suppport threshold+ -> Int -- ^ Depth for cutting parallelism+ -> [[Item]] -- ^ Result : list of closed frequent itemsets. Each result is a list of items, the head of the list being the frequency of the item.+lcmIterParMap prof cdb itemset candidate coreI occs maxItem thres d = + let + -- Reduce database+ rdb = projectAndReduce cdb candidate occs+ -- Compute items occurrences in reduced database + newOccs = occurrenceDeliverLT rdb maxItem + -- Check which items actually appear in reduced database+ presentItems = filter (\i -> newOccs!i > 0) [0..maxItem] + candidateFreq = occs!candidate+ -- Compute 100% frequent items, unfrequent items, and future candidates+ (closedFrqItems, candidates, unfrqItems) = computeCandidates thres candidateFreq presentItems newOccs + -- Update items occurrences table by suppressing 100% frequent and unfrequent items+ newOccs' = suppressItems newOccs closedFrqItems unfrqItems + -- Result closed frequent itemset = input closed frequent itemset + 100% frequent items+ closedItemset = sort (itemset ++ closedFrqItems) + -- Only candidates with value lower than input candidate can be used for further extension on this branch+ smallCandidates = takeWhile (<candidate) candidates in+ if (closedFrqItems /= []) -- if there is a result ...+ then if ((last closedFrqItems) <= candidate)-- ...and if it is OK to extend it+ then if ((length smallCandidates) > 0) -- ... and if we have at least 1 possible extension+ then -- recursiverly extend the candidates+ if (prof < d) -- create parallel sparks only for low search space depth + then ((candidateFreq:closedItemset):(concat ((parMap rdeepseq) (\x -> lcmIterParMap (prof+1) rdb closedItemset x candidate newOccs' maxItem thres d) smallCandidates)))+ else ((candidateFreq:closedItemset):(concat (map (\x -> lcmIterParMap (prof+1) rdb closedItemset x candidate newOccs' maxItem thres d) smallCandidates)))+ else [candidateFreq:closedItemset] + else [] + else [] ++++------------------- END OF BENMARKING FUNCTIONS -------------------------------++++{-|+ For a given itemset being extended by a given candidate,+ compute the closure of this itemset and compute the candidates for further extension.+-}+computeCandidates :: Frequency -- ^ Minimum support thresold+ -> Frequency -- ^ Frequency of item selected for extension (@candidate@)+ -> [Item] -- ^ List of items in the transaction database+ -> UArray Item Frequency -- ^ Array associating to each item its frequency+ -> ([Item], [Item], [Item]) -- ^ Result : (100% frequent items = closure, + -- candidates for further extension, unfrequent items)+computeCandidates thres candidateFreq presentItems occs =+ let (frequentItems, unfrqItems) = partition(\i -> occs!i >= thres) presentItems+ closedFrqItems = filter (\i -> occs!i == candidateFreq) frequentItems+ candidates = frequentItems \\ closedFrqItems + in (closedFrqItems, candidates, unfrqItems)++++{-|+ Modifies an array associating items with their frequency, in order to + give a frequency of 0 to a given list of items.++ NB : for performance reasons, this is REALLY a modification, made with unsafe operations.+-}+suppressItems :: UArray Item Frequency -- ^ Array associating an item with its frequency+ -> [Item] -- ^ List of 100% frequent items+ -> [Item] -- ^ List of unfrequent items+ -> UArray Item Frequency -- ^ Initial array, with frequencies of 100% frequent items+ -- and unfrequent items set to 0.+suppressItems occs closedItems unfreqItems =+ runST $ do occsST <- unsafeThaw occs :: ST s (STUArray s Item Frequency) -- Can be used in multithread because no concurrent write+ sequence_ (map (\i -> writeArray occsST i 0) closedItems)+ sequence_ (map (\i -> writeArray occsST i 0) unfreqItems)+ newOccs <- unsafeFreeze occsST -- Can be used in multithread because no concurrent write+ return newOccs++++{-|+ Creates a new, reduced transaction database by eliminating all items+ greater than @candidate@ item, and all infrequent items.+-}+projectAndReduce :: LexicoTreeItem -- ^ Original transaction database+ -> Item -- ^ Candidate item, on which the projection is made+ -> UArray Item Frequency -- ^ Array associating each item with its frequency in + -- original transaction database.+ -> LexicoTreeItem -- ^ Result : Reduced transaction database+projectAndReduce Nil _ _ = Nil+projectAndReduce (Node e suiv alt w) !candidate occs + | e > candidate = Nil+ | e == candidate = let !(TreeWeight suiv' addWeight) = filterInfrequent suiv occs+ in (Node e suiv' Nil (w+addWeight))+ | e < candidate = let !alt' = projectAndReduce alt candidate occs+ !suiv' = projectAndReduce suiv candidate occs+ in if (occs!e > 0)+ then if notNil suiv' && notNil alt'+ then (Node e suiv' alt' 0)+ else if notNil suiv'+ then (Node e suiv' Nil 0)+ else alt'+ else if notNil suiv' && notNil alt'+ then mergeAlts suiv' alt'+ else if notNil suiv'+ then suiv'+ else alt'++{-|+ Suppress all infrequent items from a transaction database expressed as + lexicographic tree, and returns a new lexicographic tree.+-}+filterInfrequent :: LexicoTreeItem -- ^ Original transaction database+ -> UArray Item Frequency -- ^ Array associating each item with its frequency in + -- original transaction database. In this setting, + -- an infrequent item as a frequency of 0 (because of preprocessing by + -- 'suppressItems').+ -> TreeWeight -- ^ Result : (transaction database without infrequent items, weight to report in parent nodes)+filterInfrequent Nil _ = TreeWeight Nil 0+filterInfrequent (Node e suiv alt w) occs+ | occs!e > 0 = TreeWeight (Node e suiv' alt' (w+ws)) wa+ | notNil suiv' && notNil alt' = TreeWeight (mergeAlts suiv' alt') w'+ | notNil alt' = TreeWeight alt' w'+ | notNil suiv' = TreeWeight suiv' w'+ | otherwise = TreeWeight Nil w'+ where+ w' = w+ws+wa+ !(TreeWeight suiv' ws) = filterInfrequent suiv occs+ !(TreeWeight alt' wa) = filterInfrequent alt occs++{-# INLINE notNil #-}+notNil Nil = False+notNil _ = True++data TreeWeight = TreeWeight !LexicoTreeItem {-#UNPACK#-}!Weight++-----------------------------------------------------------------+-- LEXICOGRAPHIC TREE MANIPULATION+-----------------------------------------------------------------++{-|+ Type for a lexicographic tree, implementating a n-ary tree over a binary tree.+-}+data LexicoTreeItem = Nil -- ^ Void node+ | Node {-#UNPACK#-} !Item+ !LexicoTreeItem -- NB. experimental strictness annotation+ !LexicoTreeItem -- NB. experimental strictness annotation+ {-#UNPACK#-} !Int -- ^ A node : item, next node (next in transaction), alternative node (other branch), weight+ deriving (Eq, Show)++{-|+ Returns the maximal item of a lexicographic tree+-}+treeMax :: LexicoTreeItem -> Item+treeMax Nil = -1+treeMax (Node e Nil Nil _) = e +treeMax (Node _ suiv Nil _) = treeMax suiv+treeMax (Node _ Nil alt _) = treeMax alt+treeMax (Node _ suiv alt _) = max (treeMax suiv) (treeMax alt)+++{-|+ Inserts a transaction in list format into the lexicographic tree.+ Automatically merges identical transactions.+ Performs suffix intersection.+-}+insertLT :: [Item] -- ^ Transaction to insert into lexicographic tree+ -> Item -- ^ "coreI" item, for suffix intersection.+ -> Int -- ^ Weight of the transaction to inserct+ -> LexicoTreeItem -- ^ Input lexicographic tree+ -> LexicoTreeItem -- ^ Result : a new lexicographic tree with the transaction inserted+insertLT [] _ _ lt = lt+insertLT lst _ w Nil = createPath lst w+insertLT [x] i w (Node e suiv alt weight) + | x < e = Node x Nil (Node e suiv alt weight) w+ | x == e = Node e suiv alt (weight + w)+ | x > e = Node e suiv (insertLT [x] i w alt) weight+insertLT (x:xs) i w (Node e suiv alt weight) + | x < e = Node x (createPath xs w) (Node e suiv alt weight) 0+ | x == e = if (e /= i)+ then Node e (insertLT xs i w suiv) alt weight+ else suffixIntersectionLT xs w (Node e suiv alt weight)+ | x > e = Node e suiv (insertLT (x:xs) i w alt) weight++{-|+ From a transaction and its weight, directly creates a path-shaped lexicographic tree.+-}+createPath :: [Item] -- ^ Transaction+ -> Int -- ^ Weight of the transaction+ -> LexicoTreeItem -- ^ Result : a path-shaped lexicographic tree encoding the transaction+createPath [] _ = Nil+createPath [x] w = Node x Nil Nil w+createPath (x:xs) w = Node x (createPath xs w) Nil 0++{-|+ Perform the "suffix intersection" operation with the suffix of a transaction+ and the corresponding part of a lexicographic tree.++ For more details, see "prefixIntersection" in Takeaki Uno's papers about LCM.+-}+suffixIntersectionLT :: [Item] -- ^ Suffix of the transaction to insert.+ -> Int -- ^ Weight of the transaction to insert+ -> LexicoTreeItem -- ^ (Sub-)lexicographic tree where the transaction must be inserted. The @next@ part (see data type comments)+ -- should be a simple path, it will be the target of intersection with the suffix.+ -> LexicoTreeItem -- ^ Result : lexicographic tree where the suffix has been added, with correct intersections performed.+suffixIntersectionLT _ w (Node e Nil alt weight) = Node e Nil alt (weight+w)+suffixIntersectionLT lst w (Node e suiv alt weight) = + let (newSuiv, addWeight) = suffInterSuiv lst w suiv + in Node e newSuiv alt (weight+addWeight)++{-|+ Intersects a list-shaped transaction and a path-shaped lexicographic tree.+ The result is a path shaped lexicographic tree with weights correctly updated.+-}+suffInterSuiv :: [Item] -- ^ Transaction as list+ -> Int -- ^ Weight of the above transaction+ -> LexicoTreeItem -- ^ Path-shaped lexicographic tree+ -> (LexicoTreeItem, Int) -- ^ Result : (path-shaped lexicographic tree representing the intersection + -- of transaction and input path , 0 if intersection not [] / sum of weights else)+suffInterSuiv lst w suiv =+ let (lstSuiv, weightSuiv) = getLstSuiv suiv+ inter = List.intersect lstSuiv lst+ in if (inter /= [])+ then (createPath inter (weightSuiv+w), 0)+ else (Nil, weightSuiv+w)+ +{-|+ Collects all the nodes of lexicographic tree in a list of elements.+-}+getLstSuiv :: LexicoTreeItem -- ^ Path shaped lexicographic tree.+ -> ([Item], Int) -- ^ Result : (list of elements in the path, sum of weights of nodes in the path)+getLstSuiv Nil = ([], 0)+getLstSuiv (Node e suiv Nil weight) =+ let (lst, w) = getLstSuiv suiv+ in (e:lst, w + weight)++{-|+ Merge two lexicographic trees.+-}+mergeAlts :: LexicoTreeItem -- ^ Tree 1+ -> LexicoTreeItem -- ^ Tree 2+ -> LexicoTreeItem -- ^ Return : Tree 1 merged with Tree 2+mergeAlts Nil lt = lt+mergeAlts lt Nil = lt+mergeAlts (Node e1 suiv1 alt1 w1) (Node e2 suiv2 alt2 w2)+ | e1 < e2 = (Node e1 suiv1 (mergeAlts alt1 (Node e2 suiv2 alt2 w2)) w1)+ | e1 > e2 = (Node e2 suiv2 (mergeAlts (Node e1 suiv1 alt1 w1) alt2) w2)+ | e1 == e2 = (Node e1 (mergeAlts suiv1 suiv2) (mergeAlts alt1 alt2) (w1+w2))++------------------------------------------------------------------
+ LICENSE view
@@ -0,0 +1,9 @@+Copyright (c) 2010, Alexandre Termier+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:+Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.+Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.+Neither the name of the <ORGANIZATION> nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Main.hs view
@@ -0,0 +1,161 @@+-- HLCM+-- (c) Alexandre Termier, 2009-2010+-- Original LCM algorithm from Takaki Uno and Hiroki Arimura.+-- +-- +--+-- See the README file for installation, usage, and details.+-- See the LICENSE file for licensing.++{-|+Main program to invoke the LCM algorithm and+compute closed frequent itemsets.++Usage :++@hlcm /input_data type_of_input_file support_threshold/@++Type of input file can be @csv@ or @num@.++Support threshold correspond to the minimum number of times that the frequent pattern must appear in data to be reported (i.e., the minimum number of transactions in which it is included).++Results are dumped on stdout.++For both input types, input data must be a file with one line per transaction.+++/ * CSV data/++In case of @csv@ data : items in transactions are strings separated by commas.++Example: the file @Data\/simple.csv@ contains:++> bread,butter+> butter,chocolate,bread+> chocolate++To know the itemsets that appear at least 2 times, invoke hlcm with : ++@hlcm Data\/simple.csv csv 2@++Result : ++> HLCM, (c) Alexandre Termier 2010, from original Takeaki Uno and Hiroki Arimura LCM algorithm.+> Input file was a CSV file.+>+> frequency: 2 cfis: ["chocolate"]+> frequency: 2 cfis: ["bread","butter"]+> +> There are 2 closed frequent itemsets.++As expected, @[chocolate]@ appears two times but is not frequently appearing with other items. +On the other hand, the itemset @[bread,butter]@ appears twice.++/ * Numerical data/++In case of @num@ data : items in the transactions are integers separated by spaces.++Example: the file @Data\/simple.num@ contains:++> 1 2+> 2 3 1+> 3++As you can see, it is a simple transformation of @simple.csv@ replacing text items by integers.++To know the itemsets that appear at least 2 times, invoke hlcm with : ++@hlcm Data\/simple.num num 2@++WARNING : do not feed HLCM with numerical datasets where an item is repeated several times in a transaction.+The results would be wrong.++Result: ++> HLCM, (c) Alexandre Termier 2010, from original Takeaki Uno and Hiroki Arimura LCM algorithm.+> Input file was a NUMERIC file.+> +> frequency: 2 cfis: [3]+> frequency: 2 cfis: [1,2]+> +> There are 2 closed frequent itemsets.++++-}+module Main(main) where++++import HLCM+import System( getArgs )++import Text.CSV.ByteString -- get with cabal install bytestring-csv+++import qualified Data.Set as Set+import qualified Data.Map as Map+import qualified Data.List as Lst++import qualified Data.ByteString.Char8 as L++++{-|+Main program, parses command line, calls LCM and dumps output nicely.+-}+main :: IO ()+main = do+ args <- getArgs+ (dataFile, fileType, _thres) <- return (args !! 0, args !! 1, args !! 2)+ stringMatrix <- L.readFile dataFile+ let thres = read _thres::Frequency+ (transMatrix, labelToItem) = if (fileType == "csv")+ then readCSVFile stringMatrix+ else ([[]],Map.empty) -- never evaluated + cfis = if (fileType == "csv")+ then runLCMmatrix transMatrix thres+ else runLCMstring stringMatrix thres in+ do+ putStrLn "HLCM, (c) Alexandre Termier 2010, from original Takeaki Uno and Hiroki Arimura LCM algorithm."+ if (fileType == "csv")+ then putStrLn "Input file was a CSV file.\n"+ else putStrLn "Input file was a NUMERIC file.\n"+ showNiceCFIS cfis labelToItem+ + +{-|+ Read input given in a CSV file.+-}+readCSVFile :: L.ByteString -> ([[Item]],Map.Map Item L.ByteString)+readCSVFile dataFile = + case (parseCSV dataFile) of + Nothing -> ([[]],Map.empty)+ Just csvData -> let labelsSet = Set.fromList $ (concat csvData)+ itmWithLabelLst = zip (Set.toList labelsSet) [1..]+ mapLabel2itm = Map.fromList itmWithLabelLst+ mapItm2Label = Map.fromList $ zip [1..] (Set.toList labelsSet)+ in (map (\t -> Lst.nub $ map (\it -> Map.findWithDefault (-1) it mapLabel2itm) t) csvData, mapItm2Label)++ +{-|+ Pretty printing of the results.+-}+showNiceCFIS :: [[Item]] -> Map.Map Item L.ByteString -> IO ()+showNiceCFIS l m + | Map.null m = showNiceCFIS' l 0+ | otherwise = showNiceCFIS'' l m 0++showNiceCFIS' :: [[Item]] -> Int -> IO ()+showNiceCFIS' [] counter = putStrLn ("\nThere are "++(show counter)++" closed frequent itemsets.")+showNiceCFIS' (t:ts) counter =+ do+ putStrLn ("frequency: "++(show (head t))++" cfis: "++(show (tail t)))+ showNiceCFIS' ts (counter+1)++showNiceCFIS'' :: [[Item]] -> Map.Map Item L.ByteString -> Int -> IO ()+showNiceCFIS'' [] _ counter = putStrLn ("\nThere are "++(show counter)++" closed frequent itemsets.")+showNiceCFIS'' (t:ts) m counter =+ do+ putStrLn ("frequency: "++(show (head t))++" cfis: "++(show (map (\it -> Map.findWithDefault L.empty it m) (tail t))))+ showNiceCFIS'' ts m (counter+1)
+ README view
@@ -0,0 +1,85 @@+HLCM, the parallel closed frequent itemset miner in Haskell.+(c) 2010, Alexandre Termier++Introduction+------------++Discovering frequent itemsets consists in finding patterns that are +often repeated in data. +The data is a list of transactions, and each transaction is composed of items.+It is easier to see with the "supermarket" analogy : + - an item is a product that a customer buys+ - a transaction is the list of products bought by a customer. ++A transaction database will then be the list of purchases at a supermarket.+The frequent itemsets will then be the products that are often bought together by customers.+Finding those can lead to important insights about the data. +In the supermarket case, the goal is to better understand the buying habits of customers. ++Closed frequent itemsets is a subset of frequent itemsets, without information loss.+I.e., knowing the closed frequent itemsets is sufficient to recompute all the frequent itemsets. +Basically, there are lots of redundancies in frequent itemsets, and these redundancies are +eliminated in closed frequent itemsets.+Algorithms for computing closed frequent itemsets are orders of magnitude faster than traditional+algorithms to discover frequent itemsets such as Apriori, and are thus heavily recommanded.++LCM is the fastest of those algorithms. It has been proposed in 2004 by Takeaki Uno and Hiroki Arimura.+HLCM allows Haskell users to benefit from this excellent algorithm, either as a library+or as a standalone program.++Installation : +--------------++runhaskell Setup configure --user+runhaskell Setup build++Recommanded but not mandatory: runhaskell Setup haddock --executable+(builds the HTML documentation)++runhaskell Setup install+++You can also use cabal with : cabal install hlcm (XXX VERIFY THIS)++Sample datasets :+-----------------++Several datasets are given in the Data directory.+You first have to decompress them :++cd Data+tar xvzf datasets.tgz++The toy datasets are : ++ * simple.csv : a csv file with 3 transactions that could come from a grocery store+ * simple.num : same as simple.csv, but items are represented by integers+ * mushroom_expanded.csv : a dataset about mushrooms, where the items are long strings.+ More infos here : http://archive.ics.uci.edu/ml/datasets/Mushroom++See the haddock documentation of hlcm for examples on how to mine these datasets.+++Benchmarking parallel runtime :+-------------------------------++One of the purposes of HLCM is to be a real-world benchmark for the Haskell RTS when using only semi-implicit parallelism.++The benchmark datasets provided are :+ * mushroom.dat : a small size dataset, with around 8000 transactions. + A support threshold of 6000 gives very few items, whereas a support + thresold of 100 should give more work to the processors.+ * connect.dat : a complex dataset, with around 60000 transactions.+ A support threshold of 15000 will run in a few minutes and allow + to have a good estimate of speedup. +++More datasets can be found here : http://fimi.cs.helsinki.fi/data/+These dataset can be directly used by HLCM with any preprocessing.++Be warned that currently, HLCM is not very efficient at loading data files, and does so sequentially (no parallelism here).+Huge datasets such as kosarak can be handled, but loading time only will take several minutes.++You can tinker with parallel strategy and parameters by using benchHLCM. +See the haddock documentation for explanations on parameters.+
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ hlcm.cabal view
@@ -0,0 +1,52 @@+name: hlcm+version: 0.2.1+synopsis: Fast algorithm for mining closed frequent itemsets+description: Closed frequent itemsets are patterns that occur more + than a defined threshold in a transactional database. + This program is a Haskell implementation of the LCM2+ algorithm by Takeaki Uno and Hiroki Arimura, which+ is the fastest algorithm for this task. + This implementation can make use of several threads. +category: Algorithms, Data Mining +license: BSD3+license-file: LICENSE+author: Alexandre Termier+maintainer: Alexandre.Termier@imag.fr+homepage: http://membres-liglab.imag.fr/termier/HLCM/hlcm.html+build-depends: base >=3 && < 4,+ bytestring,+ haskell98,+ array >= 0.2,+ parallel >= 1.1,+ containers >= 0.3,+ bytestring-csv+build-type: Simple+cabal-version: >= 1.2+data-files: README,+ Data/datasets.tgz++library+ exposed-modules: HLCM+ build-depends: base,+ bytestring,+ haskell98,+ array >= 0.2,+ parallel >= 2.2+ ghc-options: -O2 -threaded+++executable hlcm+ main-is: Main.hs+ ghc-options: -O2 -threaded+ build-depends: base >=3 && < 4,+ bytestring,+ haskell98,+ array >= 0.2,+ parallel >= 2.2,+ containers >= 0.3,+ bytestring-csv++executable benchHLCM+ main-is: Bench.hs+ ghc-options: -O2 -threaded+