changed indent method according to ghc standard

This commit is contained in:
IGI-111
2015-04-05 15:45:51 +02:00
parent 24d0dcba96
commit 32309510a8
4 changed files with 43 additions and 39 deletions

View File

@@ -1,31 +1,31 @@
module CSVParser ( module CSVParser (
parseCSV parseCSV
)where )where
import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec
csvFile :: GenParser Char st [[String]] csvFile :: GenParser Char st [[String]]
csvFile = do csvFile = do
result <- many line result <- many line
eof eof
return result return result
line :: GenParser Char st [String] line :: GenParser Char st [String]
line = do line = do
result <- cells result <- cells
_ <- eol _ <- eol
return result return result
cells :: GenParser Char st [String] cells :: GenParser Char st [String]
cells = do cells = do
first <- cellContent first <- cellContent
next <- remainingCells next <- remainingCells
return (first : next) return (first : next)
remainingCells :: GenParser Char st [String] remainingCells :: GenParser Char st [String]
remainingCells = remainingCells =
(char ',' >> cells) -- Found comma? More cells coming (char ',' >> cells) -- Found comma? More cells coming
<|> return [] -- No comma? Return [], no more cells <|> return [] -- No comma? Return [], no more cells
cellContent :: GenParser Char st String cellContent :: GenParser Char st String
cellContent = many (noneOf ",\n") cellContent = many (noneOf ",\n")

View File

@@ -8,31 +8,35 @@ type Frequency = Double
type Confidence = Double type Confidence = Double
class Freq a where class Freq a where
frequency :: [ItemSet] -> a -> Frequency frequency :: [ItemSet] -> a -> Frequency
data Item = Item String deriving (Eq, Ord) data Item = Item String deriving (Eq, Ord)
instance Show Item where instance Show Item where
show (Item s) = s --"Item " ++ s show (Item s) = s --"Item " ++ s
data ItemSet = ItemSet (Set Item) deriving (Eq, Ord) data ItemSet = ItemSet (Set Item) deriving (Eq, Ord)
instance Show ItemSet where instance Show ItemSet where
show (ItemSet x) = foldr ((\y old -> y ++ " " ++ old).show) "" (Set.toList x) show (ItemSet x) =
foldr ((\y old -> y ++ " " ++ old).show) "" (Set.toList x)
instance Freq ItemSet where instance Freq ItemSet where
frequency table (ItemSet set) = setCount / fromIntegral (length table) where frequency table (ItemSet set) =
setCount = fromIntegral $ count table (ItemSet set) setCount / fromIntegral (length table) where
setCount = fromIntegral $ count table (ItemSet set)
count :: [ItemSet] -> ItemSet -> Count count :: [ItemSet] -> ItemSet -> Count
count table (ItemSet set) = length (filter (\(ItemSet row) -> set `Set.isSubsetOf` row) table) count table (ItemSet set) =
length (filter isSuperSet table) where
isSuperset (ItemSet row) = set `Set.isSubsetOf` row
data Rule = Rule ItemSet ItemSet deriving (Eq) data Rule = Rule ItemSet ItemSet deriving (Eq)
instance Show Rule where instance Show Rule where
show (Rule a b) = show a ++ "-> " ++ show b show (Rule a b) = show a ++ "-> " ++ show b
instance Freq Rule where instance Freq Rule where
frequency table (Rule (ItemSet set1) (ItemSet set2)) = frequency table $ ItemSet (set1 `Set.union` set2) frequency table (Rule (ItemSet set1) (ItemSet set2)) = frequency table $ ItemSet (set1 `Set.union` set2)
confidence :: [ItemSet] -> Rule -> Confidence confidence :: [ItemSet] -> Rule -> Confidence
confidence table (Rule x y) = frequency table (Rule x y) / frequency table x confidence table (Rule x y) = frequency table (Rule x y) / frequency table x

View File

@@ -1,6 +1,6 @@
module FrequentPatterns ( module FrequentPatterns (
frequentPatterns frequentPatterns
) where ) where
import DataModel import DataModel
import qualified Data.Set as Set import qualified Data.Set as Set
import Debug.Trace (traceShow) import Debug.Trace (traceShow)
@@ -8,8 +8,8 @@ import qualified Data.List as List
semiUnion :: ItemSet -> ItemSet -> ItemSet semiUnion :: ItemSet -> ItemSet -> ItemSet
semiUnion (ItemSet set1) (ItemSet set2) = ItemSet (if max1 <= max2 && Set.delete max1 set1 == Set.delete max2 set2 then set1 `Set.union` set2 else Set.empty) where semiUnion (ItemSet set1) (ItemSet set2) = ItemSet (if max1 <= max2 && Set.delete max1 set1 == Set.delete max2 set2 then set1 `Set.union` set2 else Set.empty) where
max1 = Set.findMax set1 max1 = Set.findMax set1
max2 = Set.findMax set2 max2 = Set.findMax set2
-- generate all possible combinations from a set of singletons -- generate all possible combinations from a set of singletons
-- generateLevels :: [Item] -> [[ItemSet]] -- generateLevels :: [Item] -> [[ItemSet]]
@@ -20,14 +20,14 @@ semiUnion (ItemSet set1) (ItemSet set2) = ItemSet (if max1 <= max2 && Set.delete
-- generate the next level in a bottom-up route -- generate the next level in a bottom-up route
generateNextLevel :: [ItemSet] -> [ItemSet] generateNextLevel :: [ItemSet] -> [ItemSet]
generateNextLevel level = traceShow ("Computing level " ++ show (isSize (head level))) $ foldr (\value old -> generate value ++ old) [] level where generateNextLevel level = traceShow ("Computing level " ++ show (isSize (head level))) $ foldr (\value old -> generate value ++ old) [] level where
generate value = takeWhile (/= empty) (foldr (\x old -> semiUnion value x : old) [] (tail $ List.dropWhile (/= value) level)) generate value = takeWhile (/= empty) (foldr (\x old -> semiUnion value x : old) [] (tail $ List.dropWhile (/= value) level))
empty = ItemSet $ Set.fromList [] empty = ItemSet $ Set.fromList []
isSize (ItemSet set) = Set.size set isSize (ItemSet set) = Set.size set
singletons :: [ItemSet] -> [Item] singletons :: [ItemSet] -> [Item]
singletons table = Set.toList $ foldr (\(ItemSet row) old -> old `Set.union` row) (Set.fromList []) table where singletons table = Set.toList $ foldr (\(ItemSet row) old -> old `Set.union` row) (Set.fromList []) table where
frequentPatterns :: Frequency -> [ItemSet] -> [[ItemSet]] frequentPatterns :: Frequency -> [ItemSet] -> [[ItemSet]]
frequentPatterns thresh table = until (\x -> [] == head x) (\x -> filterByFrequency (generateNextLevel (head x)) : x) [firstLevel] where frequentPatterns thresh table = until (\x -> [] == head x) (\x -> filterByFrequency (generateNextLevel (head x)) : x) [firstLevel] where
firstLevel = filterByFrequency $ map (\x -> ItemSet $ Set.fromList [x]) (singletons table) firstLevel = filterByFrequency $ map (\x -> ItemSet $ Set.fromList [x]) (singletons table)
filterByFrequency = filter (\x -> frequency table x >= thresh) filterByFrequency = filter (\x -> frequency table x >= thresh)

View File

@@ -7,12 +7,12 @@ import Control.Monad(when)
main :: IO() main :: IO()
main = do main = do
args <- getArgs args <- getArgs
when (2 /= length args) (error "Usage: Main <file.csv> <threshold>") when (2 /= length args) (error "Usage: Main <file.csv> <threshold>")
let filename = head args let filename = head args
let threshold = read $ last args let threshold = read $ last args
file <- readFile filename file <- readFile filename
case parseCSV file of case parseCSV file of
Left _ -> error "Could not parse out.csv" Left _ -> error "Could not parse out.csv"
Right val -> mapM_ (\x -> putStrLn (show x ++ "(" ++ show (count table x) ++ ")")) (concat (frequentPatterns threshold table)) where Right val -> mapM_ (\x -> putStrLn (show x ++ "(" ++ show (count table x) ++ ")")) (concat (frequentPatterns threshold table)) where
table = map (ItemSet. Set.fromList .map Item) val table = map (ItemSet. Set.fromList .map Item) val