reworked modules to allow for multiple executables

This commit is contained in:
IGI-111
2015-04-04 02:15:06 +02:00
parent ee984a685d
commit 24d0dcba96
4 changed files with 56 additions and 41 deletions

8
.gitignore vendored
View File

@@ -1,4 +1,4 @@
*.hi #Ignore anything but haskell source and shell scripts
*.o *
Main !*.hs
*.csv !*.sh

39
DataModel.hs Normal file
View File

@@ -0,0 +1,39 @@
module DataModel where
import Data.Set (Set)
import qualified Data.Set as Set
type Count = Int
type Frequency = Double
type Confidence = Double
class Freq a where
frequency :: [ItemSet] -> a -> Frequency
data Item = Item String deriving (Eq, Ord)
instance Show Item where
show (Item s) = s --"Item " ++ s
data ItemSet = ItemSet (Set Item) deriving (Eq, Ord)
instance Show ItemSet where
show (ItemSet x) = foldr ((\y old -> y ++ " " ++ old).show) "" (Set.toList x)
instance Freq ItemSet where
frequency table (ItemSet set) = setCount / fromIntegral (length table) where
setCount = fromIntegral $ count table (ItemSet set)
count :: [ItemSet] -> ItemSet -> Count
count table (ItemSet set) = length (filter (\(ItemSet row) -> set `Set.isSubsetOf` row) table)
data Rule = Rule ItemSet ItemSet deriving (Eq)
instance Show Rule where
show (Rule a b) = show a ++ "-> " ++ show b
instance Freq Rule where
frequency table (Rule (ItemSet set1) (ItemSet set2)) = frequency table $ ItemSet (set1 `Set.union` set2)
confidence :: [ItemSet] -> Rule -> Confidence
confidence table (Rule x y) = frequency table (Rule x y) / frequency table x

View File

@@ -1,30 +1,10 @@
module Apriori where module FrequentPatterns (
frequentPatterns
import Data.Set (Set) ) where
import DataModel
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.List as List
import Debug.Trace (traceShow) import Debug.Trace (traceShow)
import qualified Data.List as List
data Item = Item String deriving (Eq, Ord)
instance Show Item where
show (Item s) = s --"Item " ++ s
data ItemSet = ItemSet (Set Item) deriving (Eq, Ord)
instance Show ItemSet where
show (ItemSet x) = foldr ((\y old -> y ++ " " ++ old).show) "" (Set.toList x)
data Rule = Rule ItemSet ItemSet deriving (Eq)
instance Show Rule where
show (Rule a b) = show a ++ "-> " ++ show b
type Frequency = Double
type Count = Int
frequency :: [ItemSet] -> ItemSet -> Frequency
frequency table (ItemSet set) = setCount / fromIntegral (length table) where
setCount = fromIntegral $ count table (ItemSet set)
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
@@ -32,10 +12,10 @@ semiUnion (ItemSet set1) (ItemSet set2) = ItemSet (if max1 <= max2 && Set.delete
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]]
generateLevels singles = until (\x -> head x == lastLevel) (\x -> generateNextLevel (head x) : x) [firstLevel] where -- generateLevels singles = until (\x -> head x == lastLevel) (\x -> generateNextLevel (head x) : x) [firstLevel] where
firstLevel = map (\x -> ItemSet $ Set.fromList [x]) singles -- firstLevel = map (\x -> ItemSet $ Set.fromList [x]) singles
lastLevel = [ItemSet $ Set.fromList singles] -- lastLevel = [ItemSet $ Set.fromList singles]
-- generate the next level in a bottom-up route -- generate the next level in a bottom-up route
generateNextLevel :: [ItemSet] -> [ItemSet] generateNextLevel :: [ItemSet] -> [ItemSet]
@@ -44,9 +24,6 @@ generateNextLevel level = traceShow ("Computing level " ++ show (isSize (head le
empty = ItemSet $ Set.fromList [] empty = ItemSet $ Set.fromList []
isSize (ItemSet set) = Set.size set isSize (ItemSet set) = Set.size set
count :: [ItemSet] -> ItemSet -> Count
count table (ItemSet set) = length (filter (\(ItemSet row) -> set `Set.isSubsetOf` row) table)
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

View File

@@ -1,10 +1,9 @@
module Main where
import CSVParser import CSVParser
import Apriori import FrequentPatterns
import DataModel
import qualified Data.Set as Set import qualified Data.Set as Set
import System.Environment(getArgs) import System.Environment(getArgs)
import Control.Monad import Control.Monad(when)
main :: IO() main :: IO()
main = do main = do