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.Array import Data.Tree ( Tree(..), Forest ) -- auxiliary functions -- check whether a string is a number or text allDigit :: String -> Bool allDigit [] = True allDigit (x:xs) | isDigit x = allDigit xs | otherwise = False -- convert string or number to OO Calc format toCalc :: String -> String toCalc x | allDigit x = x | otherwise = "\"" ++ x ++ "\"" -- insert a separator s between two strings inSep :: String -> String -> String -> String inSep s x y = x ++ s ++ y -- value string of an attribute-value tuple av2ValStr :: Array Int [String] -> (Int,Int) -> String av2ValStr attvarr (x,y) = toCalc ((attvarr ! x) !! y) -- get attribute string from index to array a2AttStr :: Array Int [String] -> Int -> String a2AttStr attvarr ix = head (attvarr ! ix) -- lookup an av pair from an attribute lkp :: Int -> [(Int,Int)] -> Maybe (Int,Int) 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 [] _ = [] formatRed (x:xs) red = (lkp x red): (formatRed xs red) -- transform a maybe av pair to a OO Calc string mbAV2Calc :: Array Int [String] -> Maybe (Int,Int) -> String mbAV2Calc attvarr avp = case avp of Just x -> av2ValStr attvarr x Nothing -> " " -- transform a reduced rule to a list of OOCalc strings red2CalStr :: Array Int [String] -> [Int] -> [(Int,Int)] -> [String] red2CalStr attvarr attls red = map (mbAV2Calc attvarr) frmred where frmred = formatRed attls red -- convert a reduced rule to a .csv table row red2CSV :: Array Int [String] -> [Int] -> [(Int,Int)] -> String red2CSV attvarr attls red = (foldr1 (inSep ",") (init calcs)) ++ ",\" is \"," ++ (last calcs) ++ "\n" where calcs = red2CalStr attvarr attls red -------------------------------------------------- -- get the attributes from a rule (ORIGINAL RULE) rule2Attls :: [(Int,Int)] -> [Int] rule2Attls rule = map fst rule ---------------------------------------------------- -- convert header to .csv table row hdr2CSV :: Array Int [String] -> [Int] -> String hdr2CSV attvarr attls = (foldr1 (inSep ",") (init calcs)) ++ ", ," ++ (last calcs) ++ "\n" where strls = map (a2AttStr attvarr) attls calcs = map toCalc strls -------------------------------------------------- -- convert a reduction for the same av consequent to .csv sameCons2CSV :: Array Int [String] -> [Int] -> [[(Int,Int)]] -> String sameCons2CSV attvarr attls redsame = concatMap (red2CSV attvarr attls) redsame -- convert a reductions for an attribute to .csv allReds2CSV :: Array Int [String] -> [Int] -> [[[(Int,Int)]]] -> String allReds2CSV attvarr attls redgrp = concatMap (sameCons2CSV attvarr attls) redgrp -------------------------------------------------- -- convert all reductions for an attribute to .csv table res2CSVTb :: Array Int [String] -> [Int] -> [[[(Int,Int)]]] -> String res2CSVTb attvarr attls redgrp = (hdr2CSV attvarr attls) ++ allReds2CSV attvarr attls redgrp ---------------------------------------------------- ---------------------------------------------------- -- section for .csv output of abductions -- get the branches of a tree brTree :: Tree a -> [[a]] brTree (Node x []) = [[x]] 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 ant2CSV :: Array Int [String] -> [Int] -> [(Int,Int)] -> String ant2CSV attvarr attls red = foldr1 (inSep ",") calcs where calcs = red2CalStr attvarr (init attls) (init red) -- show a list of equals in .csv format eqs2CSV :: Array Int [String] -> [Int] -> [[(Int,Int)]] -> String eqs2CSV attvarr attls eqls | length eqls == 1 = ant2CSV attvarr attls (head eqls) | otherwise = foldr1 (inSep ",\"equals\"\n") strls where strls = map (ant2CSV attvarr attls) eqls -- show a chain of equals in .csv format chain2CSV :: Array Int [String] -> [Int] -> [[[(Int,Int)]]] -> String chain2CSV attvarr attls chain | length chain == 1 = eqs2CSV attvarr attls (head chain) | otherwise = foldr1 (inSep ",\"implies\"\n") strls where strls = map (eqs2CSV attvarr attls) chain ruleChain2CSV :: Array Int [String] -> [Int] -> String -> [[[(Int,Int)]]] -> String ruleChain2CSV attvarr attls cons chain = (chain2CSV attvarr attls chain) ++ ",\" is \"," ++ cons ++ "\n\n" ------------------------------------------------------- -- get the consequent value string from a tree consfrTree :: Array Int [String] -> Tree [[(Int,Int)]] -> String consfrTree attvarr t = av2ValStr attvarr cns where cns = last (head (rootLabel t)) -- list of chains from a tree -- Note: reverse all branches chainsfrTree :: Tree [[(Int,Int)]] -> [[[[(Int,Int)]]]] chainsfrTree t = map reverse (brTree t) -- show a tree in .csv format tree2CSV :: Array Int [String] -> [Int] -> Tree [[(Int,Int)]] -> String tree2CSV attvarr attls t = concatMap (ruleChain2CSV attvarr attls cons) chains where chains = chainsfrTree t cons = consfrTree attvarr t --------------------------------------------------------- -- a forest of abduction trees to .csv format forest2CSV :: Array Int [String] -> [Int] -> Forest [[(Int,Int)]] -> String forest2CSV attvarr attls for = concatMap (tree2CSV attvarr attls) for ----------------------------------------------------- -- abduction result to .csv format allAbds2CSV :: Array Int [String] -> [Int] -> [Forest [[(Int,Int)]] ]-> String allAbds2CSV attvarr attls abdgrp = concatMap (forest2CSV attvarr attls) abdgrp ---------------------------------------------------- -- abduction result to .csv table abd2CSVTb :: Array Int [String] -> [Int] -> [Forest [[(Int,Int)]] ] -> String abd2CSVTb attvarr attls abdgrp = (hdr2CSV attvarr attls) ++ allAbds2CSV attvarr attls abdgrp ----------------------------------------------------- ----------------------------------------------------- -- show ambiguous original rules in .csv format -- Note: original rules do not need intermediate Maybe's org2CSV :: Array Int [String] -> [(Int,Int)] -> String org2CSV attvarr orule = antstr ++ ",\" is \"," ++ constr ++ "\n" where antstr = foldr1 (inSep ",") antstrls antstrls = init rulestrls constr = last rulestrls rulestrls = map (av2ValStr attvarr) orule -- ambiguous rules to .csv (always more than one) ambs2CSV :: Array Int [String] -> [[(Int,Int)]] -> String ambs2CSV attvarr ambrls = (concatMap (org2CSV attvarr) ambrls) ++ "\n" ambgrp2CSV :: Array Int [String] -> [[[(Int,Int)]]] -> String ambgrp2CSV attvarr ambgrp | length ambgrp == 1 = ambs2CSV attvarr (head ambgrp) | otherwise = concatMap (ambs2CSV attvarr) ambgrp amb2CSVTb :: Array Int [String] -> [Int] -> [[[(Int,Int)]]] -> String 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