Emping-0.2: src/Main.hs

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 }
                     }