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 import System.Environment (getArgs ) import Data.Array import CSVParse (getTable ) import Codec (avArr, avCod ) import Reduce ( f2Grp, redAll, ambOrg ) import CSVTable (rule2Attls ,res2CSVTb,abd2CSVTb,amb2CSVTb ) import Abduce (abdAll, cntEDAtt ) main = do [fname] <- getArgs tb <- getTable fname let attvarr = avArr tb facts = avCod tb (consNm, cons) <- getConsAtt attvarr let rulegrp = f2Grp cons facts redres = redAll rulegrp ambgrp = ambOrg rulegrp attls = rule2Attls ((head . head) rulegrp) outTable = res2CSVTb attvarr attls redres abdres = abdAll rulegrp redres (dep, sin) = cntEDAtt abdres abdTable= abd2CSVTb attvarr attls abdres ambigTable = amb2CSVTb attvarr attls ambgrp writeFile ("RNF_" ++ consNm ++ ".csv") outTable 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)) if dep == 0 then return() else writeFile ("DPT_" ++ consNm ++ ".csv") abdTable --------------------------------------------------- -- auxiliary functions for getConsAtt -- show list of attribute names for getConsN and getCons shAtts :: Array Int [String] -> IO () shAtts attvarr = print als where als = [ head x | x <- elems attvarr ] -- get the index of an attribute string usrAtt :: String -> Array Int [String] -> Maybe Int usrAtt att attvarr = slAtt att (indices attvarr) attvarr where slAtt at [] arr = Nothing slAtt at (x:xs) arr | att == (head (arr ! x)) = Just x | otherwise = slAtt at xs arr -- get the consequent attribute from the user -- (allow for typing errors of attribute name) getConsN :: Array Int [String] -> IO String getConsN attvarr = do { putStrLn "Select the consequent attribute ( ? to see all)" ; answ <- getLine ; if answ == "?" then do { shAtts attvarr; getConsN attvarr } else return answ } -- returns name and value of selected attribute getConsAtt :: Array Int [String] -> IO (String, Int) getConsAtt attvarr = do { nm <- getConsN attvarr ; case usrAtt nm attvarr of Just x -> return (nm, x) Nothing -> do { putStrLn "Unknown Attribute.." ; getConsAtt attvarr } }