Emping-0.5: src/CSVTable.hs
{- | Emping 0.5 (provisional)
Module CSVTable converts results to a CSV format that can be read by Open Office Calc
and a rule graph to .dot format that can be read by a Graphviz viewer.
Fri 04 Apr 2008 07:19:30 PM CEST
-}
module CSVTable ( allDup2CSVTb , allAmb2CSVTb, rnf2CSVTb, allTops2CSVTb, allNodes2CSVTb, graph2DOT ) where
import Data.Char (isDigit )
import Data.Array
import Data.Graph.Inductive
import Aux (AVp, Ant, Rule)
import CSVParse (blankId)
-- | 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 ++ "\""
{- | get an OO Calc value String (-1 is \" \") from an attribute-value pair
Warning: for the time being all values of -1 are written as an NA field, not as blanks.
-}
showValue :: Array Int (String, [String]) -> AVp -> String
showValue attvarr (att, val)
| val == -1 = toCalc "NA" -- blank field
| otherwise = toCalc ((snd (attvarr ! att)) !! val)
-- | get an OO Calc value string from a Maybe AVp (Nothing is \" \")
showMaybeValue :: Array Int (String, [String]) -> Maybe AVp -> String
showMaybeValue attvarr mbav =
case mbav of
Just x -> showValue attvarr x
Nothing -> " "
-- | get an OO Calc attribute string from an attribute index (blankId is \" \")
showAttribute :: Array Int (String, [String]) -> Int -> String
showAttribute attvarr att
| attstr == blankId = " "
| otherwise = toCalc attstr
where attstr = fst (attvarr ! att)
-- | insert a separator s between two strings
inSep :: String -> String -> String -> String
inSep s x y = x ++ s ++ y
-- | from an ORIGINAL rule, get the display sequence (fst is the antecedent)
displayGuide :: Rule -> ([Int], Int)
displayGuide (ant, cons) = (map fst ant, fst cons)
-- | lookup an attribute-value pair for an attribute in a reduced antecedent
lkp :: Int -> Ant -> Maybe AVp
lkp _ [] = Nothing
lkp att (x:xs) | att == fst x = Just x
| otherwise = lkp att xs
-- | order a reduced antecedent according to a display guide first, including Nothing
formatAnt :: [Int] -> Ant-> [Maybe AVp]
formatAnt [] _ = []
formatAnt (x:xs) antec = (lkp x antec): (formatAnt xs antec)
-- | get a list of OO Calc value strings from an antecedent
ant2CalStr :: Array Int (String, [String]) -> [Int] -> Ant -> [String]
ant2CalStr attvarr attls antec =
map (showMaybeValue attvarr) frmant where
frmant = formatAnt attls antec
-- | convert a reduced rule to a .csv table row (with \\n)
red2CSV :: Array Int (String,[String]) -> ([Int],Int) -> Rule -> String
red2CSV attvarr (attls, _ ) (ant,cons) =
(foldr1 (inSep ",") calstr)
++ ",\" is \","
++ (showValue attvarr cons)
++ "\n"
where calstr = ant2CalStr attvarr attls ant
-- | convert the table header to a .csv row
hdr2CSV :: Array Int (String, [String]) -> ([Int], Int) -> String
hdr2CSV attvarr (attls, consatt) =
(foldr1 (inSep ",") calstr)
++ ", ,"
++ (showAttribute attvarr consatt)
++ "\n"
where calstr = map (showAttribute attvarr) attls
--------------------------------------------------
-- | convert a list of reductions with the same consequent to .csv
sameCons2CSV :: Array Int (String,[String]) -> ([Int], Int) -> [Rule] -> String
sameCons2CSV attvarr dispg redcons =
concatMap (red2CSV attvarr dispg) redcons
-- | convert the reductions for all values of an attribute to .csv
allReds2CSV :: Array Int (String,[String]) -> ([Int], Int) -> [[Rule]] -> String
allReds2CSV attvarr dispg redgrp =
concatMap (sameCons2CSV attvarr dispg) redgrp
--------------------------------------------------
{- | convert a reduced normal form to .csv table with a header.
Warning: Get the display guide from the original rules
-}
rnf2CSVTb :: Array Int (String,[String]) -> [[Rule]] -> [[Rule]] -> String
rnf2CSVTb attvarr origs redgrp =
(hdr2CSV attvarr dispg) ++ (allReds2CSV attvarr dispg redgrp) where
dispg = displayGuide (head (head origs))
----------------------- .csv output of equals ---------------
-- | convert a duplicate and its occurrence count into a .csv String
dup2CSV :: Array Int (String, [String]) -> ([AVp], Int) -> String
dup2CSV attvarr (fct, cnt) =
(foldr1 (inSep ",") strls) ++ "," ++ ((toCalc . show) cnt) ++ "\n" where
strls = map (showValue attvarr) fct
-- | get a header from a duplicate and convert it .csv String WITHOUT newline
dup2HdrCSV :: Array Int (String, [String]) -> ([AVp],Int) -> String
dup2HdrCSV attvarr (fct, _) =
(foldr1 (inSep ",") strls) ++ "," ++ (toCalc "Number") ++ "\n" where
strls = map ((showAttribute attvarr) . fst) fct
-- | transform a list of representatives of duplicate and their counts to a .csv String
allDup2CSVTb :: Array Int (String,[String]) -> [([AVp],Int)] -> String
allDup2CSVTb attvarr dbls = (dup2HdrCSV attvarr (head dbls)) ++
concatMap (dup2CSV attvarr) dbls
-----------------------------------------------------
{- | show ambiguous original rules in .csv format
Note: original rules do not need intermediate Maybe's, like reduced rules
-}
org2CSV :: Array Int (String, [String]) -> Rule -> String
org2CSV attvarr orule =
antstr ++ ",\" is \"," ++ constr ++ "\n" where
antstr = foldr1 (inSep ",") antstrls
antstrls = map (showValue attvarr) (fst orule)
constr = showValue attvarr (snd orule)
-- | ambiguous rules to .csv (always more than one) with extra newline
ambs2CSV :: Array Int (String,[String]) -> [Rule] -> String
ambs2CSV attvarr ambrls =
(concatMap (org2CSV attvarr) ambrls) ++ "\n"
-- | a group of ambiguous rules, with different consequents, to .csv
ambgrp2CSV :: Array Int (String,[String]) -> [[Rule]] -> String
ambgrp2CSV attvarr ambgrp
| length ambgrp == 1 = ambs2CSV attvarr (head ambgrp)
| otherwise = concatMap (ambs2CSV attvarr) ambgrp
-- | display ambiguous rules in a .csv table. The guide for the header is obtained from the first rule.
allAmb2CSVTb :: Array Int (String,[String]) -> [[Rule]] -> String
allAmb2CSVTb attvarr ambgrp =
(hdr2CSV attvarr (antatt,consatt)) ++ ambstr where
(antatt, consatt) = ((map fst ant), (fst cons))
(ant, cons) = head (head ambgrp)
ambstr = ambgrp2CSV attvarr ambgrp
----------------------------------------------------------
-- ------------------------------------ The .csv output of top level abductions ---------------------
-- | show the antecedent as a .csv string. Analogous to red2CSV, but without extras for the consequent
ant2CSV :: Array Int (String,[String]) -> [Int] -> Rule -> String
ant2CSV attvarr attls red =
foldr1 (inSep ",") calcs where
calcs = ant2CalStr attvarr attls (fst red)
-- | show a list of equal antecedents in .csv format. Warning: as before, the guide is the first of a display guide, NO consequent yet.
eqs2CSV :: Array Int (String,[String]) -> [Int] -> [Rule] -> 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
-- | append the consequent value, 2 newlines for readability.
eqsWCons2CSV :: Array Int (String, [String]) -> [Int] -> [Rule] -> String
eqsWCons2CSV attvarr attls eqls = (eqs2CSV attvarr attls eqls)
++ ",\" is \","
++ (showValue attvarr ( snd (head eqls)))
++ "\n\n"
-- convert all rule equivalences in a top level for a consequent
tops2CSV :: Array Int (String, [String]) -> [Int] -> [[Rule]] -> String
tops2CSV attvarr attls abdtops = concatMap (eqsWCons2CSV attvarr attls) abdtops
-- convert all rule equivalences to .csv for all the top level abductions
allTops2CSV :: Array Int (String, [String]) -> [Int] -> [[[Rule]]] -> String
allTops2CSV attvarr attls topsgrp = concatMap (tops2CSV attvarr attls) topsgrp
-------------------------------------------------------------
-- | transform the abduction result to .csv table with header
allTops2CSVTb :: Array Int (String,[String]) -> [[Rule]] -> [[[Rule]]] -> String
allTops2CSVTb attvarr origs topsgrp =
(hdr2CSV attvarr guide) ++ allTops2CSV attvarr (fst guide) topsgrp where guide = displayGuide (head (head origs))
---------------------------- Graph Legend to .csv ------------------------
-- | display a list of equals in .csv, but allow for the first column to be empty, for any antecedent AFTER the first
nods2CSV :: Array Int (String,[String]) -> [Int] -> [Rule] -> String
nods2CSV attvarr attls eqls
| length eqls == 1 = fstline
| otherwise = foldr1 (inSep ",\"equals\"\n") strls
where fstline = ant2CSV attvarr attls (head eqls)
strls = fstline:(map foline (tail eqls))
foline x = ',': (ant2CSV attvarr attls x)
-- | exactly like eqsWCons2CSV
nodsWCons2CSV :: Array Int (String, [String]) -> [Int] -> [Rule] -> String
nodsWCons2CSV attvarr attls eqls = (nods2CSV attvarr attls eqls)
++ ",\" is \","
++ (showValue attvarr ( snd (head eqls)))
++ "\n\n"
-- | put the node in front of the equals with cons
lnode2CSV :: Array Int (String,[String]) -> [Int] -> LNode [Rule] -> String
lnode2CSV attvarr attls (nd,eqls) =
((toCalc .show) nd) ++ "," ++ (nodsWCons2CSV attvarr attls eqls)
-- | get all nodes from a graph legend
allNodes2CSV :: Array Int (String,[String]) -> [Int] -> [LNode [Rule]] -> String
allNodes2CSV attvarr attls legend = concatMap (lnode2CSV attvarr attls) legend
-- | prepend the header with Node in the first column
allNodes2CSVTb :: Array Int (String,[String]) -> [[Rule]] -> [LNode [Rule]] -> String
allNodes2CSVTb attvarr origs legend =
(toCalc "Node")
++ ","
++ (hdr2CSV attvarr guide)
++ (allNodes2CSV attvarr (fst guide) legend ) where guide = displayGuide (head (head origs))
------------------------ transform a graph to .dot format ----------------------------------
-- | use the graphviz function with defaults. Page matrix is sqrt of number of nodes.
-- Page is smallest of A4 and US Letter. Specific graph type used, not class.
graph2DOT :: Gr (Int,Int) () -> String -> String
graph2DOT graph name =
graphviz graph name (8.3,11.0) (pgn,pgn) Portrait where
pgn = 1 + (round . sqrt . (/ nodpp) . fromIntegral) (noNodes graph)
nodpp = 50