--Emping is a utility that derives heuristic rules from nominal data. Nominal data are qualitative and unordered, as in: -
--Class is actually an ordinal attribute, but when the order is disregarded, it is nominal. -
--Heuristic rules consist of attribute values (predicates) that together imply another attribute value. For example: -
--Heuristic rules are purely empirical, with no foundation in a theory or model. The input of Emping is just a table of nominal facts. The user has to select which attribute is to be the consequent. Then Emping derives all shortest rules which, in the table, imply the values of the selected consequent. Each reduced rule is a generalization of one or more original rules, and therefore reduced rules may imply or be equivalant to others. If this is the case, these logical dependencies are also derived. -
--Emping reads a file in a comma seperated format (.csv) as produced by the Open Office Calc spreadsheet, and returns the results as .csv files that can be read by OO Calc. -
--You start the utility from a terminal and provide the file name as a command line parameter. For example: -
-
-$ ./emping QuinLanFacts.csv
-
-Emping then asks you to supply the name of the attribute that is to be the consequent of the rules. The reduced normal form is saved in a file with prefix "RNF_" and the name of the attribute. If there are logical dependencies, these will be stored in a file with prefix "DPT_". Finally, original rules may be ambiguous, that is, the same antecedent may imply two or more different values. The reduction algorithm also works if ambiguous rules are present, but Emping informs you which rules are ambiguous in a third file with prefix "AMB_". -
--The reduced normal form file and, if present, the others, can then be loaded into OO Calc. -
--More about the principles on which emping is based can be found in the white paper, Deriving Heuristic Rules from Facts , which is included in the distribution (pdf). -
--Enter the data in Open Office Calc as shown: -
-
-
-
-As you can see, the table can have empty lines and does not have to start in the first column. But: -
--Save the table in Text CSV format. Choose double quotes as the text delimiter (default). Whole numbers will be stored without delimiters, and emping will use them after checking if they are all digits (no negatives, no fractions). -
-
-Open the terminal and type emping, followed by the filename of the table (including the path). You may have to precede the command with the directory, which contains the emping executable. For example, if it is in your working directory:
-
-$ ./emping (followed by the file name) -
--The program will now ask for the attribute which is to be predicted. This can be any one of the names in the table header. -
-
-
-
-There are no ambiguous rules for Fishing but the reduced normal form has dependency trees as well as unconnected rules. -
--View the reduced normal form in file RNF_Fishing.csv in OO Calc. -
-
-
-
-and all branches of the dependency trees, together with the singletons, in DPT_Fishing.csv -
-
-
-
-Note: For an example with ambiguities and equals (implications both ways) choose Windy as the consequent attribute. -
--The emping utility is written in Haskell, and has been developed and tested on the Fedora Core 6 Linux platform, using the Haskell tools which are available as FC6 packages. To use it you must compile the package with the Haskell compiler on your platform or build it with Cabal. See the README file for details. -
--(Potential) users will probably be somewhat wary, in particular if their data is critical. Keep in mind that emping derives the rules, which is the hard part. Checking the results for correctness is easy. -
--Emping stands for empirical reasoning or the Indonesian snack with that name. -
- - - - diff --git a/docs/EmpingWP.pdf b/docs/EmpingWP.pdf deleted file mode 100644 Binary files a/docs/EmpingWP.pdf and /dev/null differ diff --git a/docs/Quinlan.png b/docs/Quinlan.png deleted file mode 100644 Binary files a/docs/Quinlan.png and /dev/null differ diff --git a/docs/RNF_Fishing.png b/docs/RNF_Fishing.png deleted file mode 100644 Binary files a/docs/RNF_Fishing.png and /dev/null differ diff --git a/docs/session_ex.png b/docs/session_ex.png deleted file mode 100644 Binary files a/docs/session_ex.png and /dev/null differ diff --git a/src/Abduce.hs b/src/Abduce.hs --- a/src/Abduce.hs +++ b/src/Abduce.hs @@ -1,8 +1,5 @@ module Abduce ( abdAll, treehasED, cntEDAtt ) where --- (c) 2007 Hans van Thiel --- Version 0.2 License GPL - -- module: get partial order, if any, of RNF rules import Reduce (isSub ) @@ -49,7 +46,8 @@ isRoot ls x = and $ map ((LW /=) . (x `pcompare`)) ls initRoots :: Poset a => [a] -> Forest a -initRoots ls = map ((flip Node) []) ls +initRoots ls = map mkLeaf ls where + mkLeaf x = Node x [] lsinFor :: Poset a => [a] -> Forest a -> Forest a lsinFor [] for = for @@ -91,7 +89,7 @@ toEquals :: [([Int],Int)] -> [([Int],[Int])] toEquals orpl = nubBy eqOrg ls where ls = map (getEquals orpl) orpl - eqOrg (x1,y1) (x2,y2) = isSub x1 x2 && isSub x2 x1 + eqOrg (x1,_) (x2,_) = isSub x1 x2 && isSub x2 x1 ------------------------------------------------------- -- first orig indices, second red indices matched @@ -111,7 +109,7 @@ -- first in orig is high, low or not ordered instance Poset RuRe where - pcompare (x1,y1) (x2,y2) + pcompare (x1,_) (x2,_) | isSub x2 x1 = HI | isSub x1 x2 = LW | otherwise = NT @@ -169,18 +167,18 @@ -- fst is number of chains, snd number of singles cntEDVal :: (Eq a, Eq b) => Forest [[(a,b)]] -> (Int,Int) -cntEDVal for = (dep, sin) where +cntEDVal for = (dep, single) where dep = sum $ fst (unzip temp) - sin = sum $ snd (unzip temp) + single = sum $ snd (unzip temp) temp = map (mark . treehasED) for mark x | x == True = (1,0) - | x == False = (0,1) + | otherwise = (0,1) -- count branches and/or equals in attribute abduction -- fst is chain count, snd is number of unconnected rules cntEDAtt :: (Eq a, Eq b) => [Forest [[(a,b)]] ] -> (Int,Int) -cntEDAtt forls = (dep, sin) where +cntEDAtt forls = (dep, uncon) where dep = sum $ fst (unzip temp) - sin = sum $ snd (unzip temp) + uncon = sum $ snd (unzip temp) temp = map cntEDVal forls diff --git a/src/CSVParse.hs b/src/CSVParse.hs --- a/src/CSVParse.hs +++ b/src/CSVParse.hs @@ -7,28 +7,34 @@ a text field starts with " and ends with " a numerical field consists of digits only -} +comma:: GenParser Char a Char comma = char ',' +txtField :: GenParser Char a String txtField = do { char '\"' ; txt <- many (noneOf "\""); char '\"'; return txt } - + +numField :: GenParser Char a String numField = many1 digit +getField :: GenParser Char a String getField = do {many (char ' '); txtField <|> numField } +csvLine :: GenParser Char a [String] csvLine = do { many comma; fields <- (sepBy getField comma); many (char ' '); newline; return fields } +csvTable :: GenParser Char a [[String]] csvTable = many csvLine getTable :: String -> IO [[String]] getTable fname = do pares <- parseFromFile csvTable fname let res = case pares of - Right res -> res - Left err -> error "CSVParse: Parse error in input file" + Right x -> x + Left err -> error (show err) return (res) -- test the table in csv format for parse errors diff --git a/src/CSVTable.hs b/src/CSVTable.hs --- a/src/CSVTable.hs +++ b/src/CSVTable.hs @@ -1,16 +1,13 @@ -module CSVTable (rule2Attls,res2CSVTb,abd2CSVTb,amb2CSVTb ) where - --- (c) 2007 Hans van Thiel --- Version 0.2 License GPL +module CSVTable (rule2Attls,res2CSVTb,abd2CSVTb,amb2CSVTb, topAbd2CSVTb) where -- module: convert reduction result to a CSV -- format that can be read by Open Office Calc import Data.Char (isDigit ) -import Data.List ( delete ) import Data.Array import Data.Tree ( Tree(..), Forest ) + -- auxiliary functions -- check whether a string is a number or text @@ -45,14 +42,14 @@ -- lookup an av pair from an attribute lkp :: Int -> [(Int,Int)] -> Maybe (Int,Int) -lkp att [] = Nothing +lkp _ [] = Nothing lkp att (x:xs) | att == fst x = Just x | otherwise = lkp att xs -- order a reduced rule to att list and fill in the blanks formatRed :: [Int] -> [(Int,Int)] -> [Maybe (Int,Int)] -formatRed [] red = [] +formatRed [] _ = [] formatRed (x:xs) red = (lkp x red): (formatRed xs red) -- transform a maybe av pair to a OO Calc string @@ -126,6 +123,7 @@ brTree (Node x for) = map (x:) brls where brls = concatMap brTree for + -- show the antecedent as a .csv string -- analogous to red2CSV, but on init, without consequent @@ -226,3 +224,38 @@ amb2CSVTb attvarr attls ambgrp = hdr2CSV attvarr attls ++ ambstr where ambstr = ambgrp2CSV attvarr ambgrp + +---------------------------------------------------------- +------------top level only of abduction to .csv + +-- add a consequent to a csv string of equals + +ruleEqs2CSV :: Array Int [String] -> [Int] -> String -> [[(Int,Int)]] -> String +ruleEqs2CSV attvarr attls cons eqls = + (eqs2CSV attvarr attls eqls) ++ ",\" is \"," ++ cons ++ "\n\n" + +-- get a .csv string of the top only of a tree + +topTree2CSV :: Array Int [String] -> [Int] -> Tree [[(Int,Int)]] -> String +topTree2CSV attvarr attls t = + ruleEqs2CSV attvarr attls cons eqls where + eqls = rootLabel t + cons = consfrTree attvarr t +-- do it for the forest + +topForest2CSV :: Array Int [String] -> [Int] -> Forest [[(Int,Int)]] -> String +topForest2CSV attvarr attls for = + concatMap (topTree2CSV attvarr attls) for + +-- do it for all abductions + +topAbds2CSV :: Array Int [String] -> [Int] -> [Forest [[(Int,Int)]] ]-> String +topAbds2CSV attvarr attls abdgrp = + concatMap (topForest2CSV attvarr attls) abdgrp + +-- add the header to the .csv table + +topAbd2CSVTb :: Array Int [String] -> [Int] -> [Forest [[(Int,Int)]] ] -> String +topAbd2CSVTb attvarr attls abdgrp = + (hdr2CSV attvarr attls) ++ topAbds2CSV attvarr attls abdgrp + diff --git a/src/Codec.hs b/src/Codec.hs --- a/src/Codec.hs +++ b/src/Codec.hs @@ -1,8 +1,5 @@ module Codec ( avCod, avArr )where --- (c) 2007 Hans van Thiel --- Version 0.2 License GPL - {- module: code a table of attributes and values Note: extended Haskell because of dependent parameters @@ -51,6 +48,8 @@ -- Note: see comment at start for indexing scheme avLs :: [[String]] -> [[String]] +avLs [] = error "Codec avLs: empty String list" +avLs (_:[]) = error "Codec avLs : only one element in String list" avLs (x:xs) = zipWith (:) x (values xs) where values = (map getTb) . transpose @@ -59,7 +58,9 @@ -- Note: see comment at start for indexing scheme avCod :: [[String]] -> [[(Int, Int)]] -avCod (x:xs) = map (zip [0..]) (values xs) +avCod [] = error "Codec avCod: empty String list" +avCod (_:[]) = error "Codec avCod : only one element in String list" +avCod ls = map (zip [0..]) (values (tail ls)) where values = transpose . (map getInds) . transpose -- make an array of attribute-value lists from the diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,8 +1,5 @@ module Main ( main ) where --- (c) 2007 Hans van Thiel --- Version 0.2 License GPL - -- module: reduce a table of facts in .csv format -- output the reduction to a .csv table for OO Calc @@ -11,9 +8,10 @@ import CSVParse (getTable ) import Codec (avArr, avCod ) import Reduce ( f2Grp, redAll, ambOrg ) -import CSVTable (rule2Attls ,res2CSVTb,abd2CSVTb,amb2CSVTb ) +import CSVTable (rule2Attls ,res2CSVTb,abd2CSVTb, amb2CSVTb, topAbd2CSVTb) import Abduce (abdAll, cntEDAtt ) +main :: IO () main = do [fname] <- getArgs tb <- getTable fname let attvarr = avArr tb @@ -25,17 +23,19 @@ attls = rule2Attls ((head . head) rulegrp) outTable = res2CSVTb attvarr attls redres abdres = abdAll rulegrp redres - (dep, sin) = cntEDAtt abdres + (dep, single) = cntEDAtt abdres abdTable= abd2CSVTb attvarr attls abdres ambigTable = amb2CSVTb attvarr attls ambgrp + topTable = topAbd2CSVTb attvarr attls abdres writeFile ("RNF_" ++ consNm ++ ".csv") outTable + writeFile ("TOP_" ++ consNm ++ ".csv") topTable putStrLn ("Ambiguous Rules: " ++ show (length ambgrp)) if ambgrp == [] then return () else writeFile ("AMB_" ++ consNm ++ ".csv") ambigTable putStrLn ("Dependency Trees: " ++ (show dep)) - putStrLn ("Unconnected Rules: " ++ (show sin)) + putStrLn ("Unconnected Rules: " ++ (show single)) if dep == 0 then return() - else writeFile ("DPT_" ++ consNm ++ ".csv") abdTable + else showDPT abdTable consNm --------------------------------------------------- -- auxiliary functions for getConsAtt @@ -50,7 +50,7 @@ usrAtt :: String -> Array Int [String] -> Maybe Int usrAtt att attvarr = slAtt att (indices attvarr) attvarr where - slAtt at [] arr = Nothing + slAtt _ [] _ = Nothing slAtt at (x:xs) arr | att == (head (arr ! x)) = Just x | otherwise = slAtt at xs arr @@ -75,5 +75,13 @@ Nothing -> do { putStrLn "Unknown Attribute.." ; getConsAtt attvarr } } +-- show dependencies if user types "y" + +showDPT :: String -> String -> IO () +showDPT abdT cnsNm = do putStrLn "Show all dependencies? (y = yes)" + answ <- getLine + if answ == "y" then writeFile ("DPT_" ++ cnsNm ++ ".csv") abdT + else return () + diff --git a/src/Reduce.hs b/src/Reduce.hs --- a/src/Reduce.hs +++ b/src/Reduce.hs @@ -1,8 +1,5 @@ module Reduce (isSub,f2Grp, redAll, ambOrg ) where --- (c) 2007 Hans van Thiel --- Version 0.2 License GPL - {- module: get the reduced normal form of a rule model a fact is a list of attribute value pairs @@ -20,13 +17,11 @@ -- some general purpose functions -isSub, isSuper :: Eq a => [a] -> [a] -> Bool -isSub [] y = True +isSub :: Eq a => [a] -> [a] -> Bool +isSub [] _ = True isSub (x:xs) y | not (x `elem` y) = False | otherwise = isSub xs y -isSuper = flip isSub - isEq :: Eq a => [a] -> [a] -> Bool isEq x y = isSub x y && isSub y x @@ -39,7 +34,7 @@ -- partitions a list according to an equivalence relation partitionBy :: (a -> a -> Bool) -> [a] -> [[a]] -partitionBy eq [] = [] +partitionBy _ [] = [] partitionBy eq ls = x:(partitionBy eq y) where (x,y) = partition ((head ls) `eq`) ls @@ -56,48 +51,152 @@ match :: Eq a => [a] -> [[a]] -> [[a]] match h = map (h \\) --- 2. transform the orlist of andlists to andlist of orlists +-- B.2 falsification --- test if an attribute is in the list and get it +-- count the occurrences of something in a list and +-- return the list without it (if it is an element) -attElem :: (Eq a, Eq b) => (a,b) -> [(a,b)] -> Maybe (a,b) -attElem x [] = Nothing -attElem x (y:ys) = if fst x == fst y then Just y - else attElem x ys -{- and a predicate to an andlist - attributes with different values contradict - attributes with the same value are equal -} +delCount :: Eq a => a -> [a] -> (Int, [a]) +delCount _ [] = (0,[]) +delCount x (y:ys) + | x == y = (fst(delCount x ys) + 1,snd (delCount x ys)) + | otherwise = (fst(delCount x ys), y:snd(delCount x ys)) -andP :: (Eq a,Eq b) => (a,b) -> [(a,b)] -> [(a,b)] -andP x ans = case attElem x ans of - Nothing -> x:ans - Just y -> if snd x == snd y - then ans - else [] +-- return the elements of a list with their counts --- first: anding an orlist to an orlist of andlists --- remove all the empty lists +elWCnt :: Eq a => [a] -> [(a, Int)] +elWCnt [] = [] +elWCnt (x:xs) = (x, cnt) : elWCnt res where + cnt = fst (delCount x (x:xs)) + res = snd (delCount x (x:xs)) -repandPls :: (Eq a,Eq b) => [(a,b)] -> [[(a,b)]] -> [[(a,b)]] -repandPls ors als = - filter (/= []) [ andP x y | x <- ors, y <- als ] +-- sort the frequency list, most occurring first --- then: extract the smallest sublists from an orlist of andlists +freqSort :: Eq a => [(a,Int)] -> [(a,Int)] +freqSort [] = [] +freqSort [x] = [x] +freqSort (x:xs) = + (freqSort high) ++ [x] ++ (freqSort low) where + high = [h | h <- xs, (snd h) >= (snd x)] + low = [l | l <- xs, (snd l) < (snd x)] +-- make the list from which the roots and root children +-- are built. (a is an av pair in Reduce, not needed) + +mkavRtLs :: Eq a => [[a]] -> [a] +mkavRtLs = fst . unzip . freqSort . elWCnt . concat + +-- delete an element with a property, if it is there, and +-- report its presence. Lists without that element unchanged. + +findDel :: Eq a => (a -> Bool) -> [a] -> Bool -> ([a],Bool) +findDel _ [] s = ([],s) +findDel p (y:ys) s + | p y = (fst $ findDel p ys s, True) + | otherwise = (y:(fst $ findDel p ys s), snd $ findDel p ys s) + +-- fst: list without element that satisfies p (may be []) +-- snd: True if there was such an element, else False + +findDelPred :: Eq a => (a -> Bool) -> [a] -> ([a],Bool) +findDelPred p ls = findDel p ls False + +-- from an av and an or-list, get the children or-list +-- and the or-list for the next av. There are 4 possibilities. + +-- test a possible child or-list + +chldsrc ::(Eq a, Eq b) => a -> [([(a,b)],Bool)] -> Maybe [[(a,b)]] +chldsrc att porls2 + | porls2 == [] = Just [] -- will be leaf + | otherwise = + let porls3 = map fst porls2 + chorls = map (findDelPred (\x -> att == fst x)) porls3 in + if ([],True) `elem` chorls -- or-list contradiction + then Nothing + else Just (map fst chorls) + +-- test a possible next in a forest +tnextsrc :: (Eq a, Eq b) => [([(a,b)],Bool)] -> Maybe [[(a,b)]] +tnextsrc porls1 | porls1 == [] = Nothing + | otherwise = if ([],True) `elem` porls1 + then Nothing -- contradiction + else Just (map fst porls1) + +-- split an original or-list into children (fst) and next (snd) + +splitOrls :: (Eq a, Eq b) => (a,b)-> [[(a,b)]] -> (Maybe [[(a,b)]],Maybe [[(a,b)]]) +splitOrls av orls = (x,y) where + x = chldsrc (fst av) v + y = if (tnextsrc u) == Nothing + then Nothing + else Just (map fst imls) + (u,v) = partition snd imls + imls = map (findDelPred (av ==)) orls +-- changes here ---------------------------- + +-- make root list with children from sorted possibles + +rootLs :: (Eq a, Eq b)=>[(a,b)]->[[(a,b)]]->[Maybe ((a,b),[[(a,b)]])] +rootLs _ [] = [] +rootLs [] _ = error "Reduce rootLs: root source is []" +rootLs (x:xs) orls = tsrc:rootLs xs next where + tsrc = case pchld of + Nothing -> Nothing + Just chld -> Just (x,chld) + next = case pnext of + Nothing -> [] + Just nxt -> nxt + (pchld, pnext) = splitOrls x orls + +-- make root list with childsource from or list + +makeRtChldLs :: (Eq a, Eq b) => [[(a,b)]] -> [Maybe ((a,b),[[(a,b)]])] +makeRtChldLs [] = error "Reduce makeRtChldLs: list is []" +makeRtChldLs orls = rootLs (mkavRtLs orls) orls + +-- define a rose tree that can have empty branches + +data Maytree a = Niets | Wel {avLabel::a, avChils :: Mayfor a} + deriving Eq +type Mayfor a = [Maytree a] + +-- make a tree and forest from Maybe roots and source children + +mkAVMTree :: (Eq a, Eq b) => Maybe ((a,b),[[(a,b)]]) -> Maytree (a,b) +mkAVMTree rtchls = + case rtchls of + Nothing -> Niets + Just (x,[]) -> Wel {avLabel = x, avChils = []} + Just (x, suborls) -> Wel {avLabel = x, + avChils = mkAVMFor suborls } + +mkAVMFor:: (Eq a, Eq b) => [[(a,b)]] -> Mayfor (a,b) +mkAVMFor suborls = map mkAVMTree rtchls where + rtchls = makeRtChldLs suborls + +-- get the branches of a Maytree +-- the empty lists are lost because of concatMap + +brMayTree :: Maytree a -> [[a]] +brMayTree t = case t of + Niets -> [] + (Wel x []) -> [[x]] + (Wel x for) -> map (x:) brls where + brls = concatMap brMayTree for + +-- extract the smallest sublists from the orlist of andlists + extrMin :: Eq a => [[a]] -> [[a]] extrMin ls = nubBy isEq [ getMinin x ls | x <-ls ] where getMinin x y = foldr minLs x y --- B.2.1: anding an orlist to an orlist of andlists - -andOrAnds :: (Eq a,Eq b) => [(a,b)] -> [[(a,b)]] -> [[(a,b)]] -andOrAnds x = extrMin . (repandPls x) - --- B.2.2: transform andlist of orlists to orlist of andlists in batch +-- final transformation of an and-list of ors to or-list of ands +-- replaces the identically named function in Reduce in Emping 0.2 -trAndOr :: (Eq a,Eq b) => [[(a,b)]] -> [[(a,b)]] -trAndOr x = foldr andOrAnds (raise (last x)) (init x) - where raise ls = [ [y] | y <- ls] +trAndOr :: (Eq a, Eq b) => [[(a,b)]] -> [[(a,b)]] +trAndOr orls = + extrMin (concatMap brMayTree for) where for = mkAVMFor orls -- C: Verify the falsification result with the original positive rules @@ -152,3 +251,4 @@ ambOrg grp = filter (\x -> (length x) > 1) anteqs where anteqs = partitionBy (\x y -> (init x) == (init y)) ols ols = concat grp + diff --git a/test_data/NumQuinFacts.csv b/test_data/NumQuinFacts.csv deleted file mode 100644 --- a/test_data/NumQuinFacts.csv +++ /dev/null @@ -1,16 +0,0 @@ -"Number","Weather","Temperature","Humidity","Windy","Fishing" -,,,,, -1,"sunny","hot","high","no","bad" -2,"sunny","hot","high","yes","bad" -3,"cloudy","hot","high","no","good" -4,"rain","mild","high","no","good" -5,"rain","cool","normal","no","good" -6,"rain","cool","normal","yes","bad" -7,"cloudy","cool","normal","yes","good" -8,"sunny","mild","high","no","bad" -9,"sunny","cool","normal","no","good" -10,"rain","mild","normal","no","good" -11,"sunny","mild","normal","yes","good" -12,"cloudy","mild","high","yes","good" -13,"cloudy","hot","normal","no","good" -14,"rain","mild","high","yes","bad" diff --git a/test_data/QuinFacts.csv b/test_data/QuinFacts.csv deleted file mode 100644 --- a/test_data/QuinFacts.csv +++ /dev/null @@ -1,16 +0,0 @@ -,"Weather","Temperature","Humidity","Windy","Fishing" -,,,,, -,"sunny","hot","high","no","bad" -,"sunny","hot","high","yes","bad" -,"cloudy","hot","high","no","good" -,"rain","mild","high","no","good" -,"rain","cool","normal","no","good" -,"rain","cool","normal","yes","bad" -,"cloudy","cool","normal","yes","good" -,"sunny","mild","high","no","bad" -,"sunny","cool","normal","no","good" -,"rain","mild","normal","no","good" -,"sunny","mild","normal","yes","good" -,"cloudy","mild","high","yes","good" -,"cloudy","hot","normal","no","good" -,"rain","mild","high","yes","bad"