{- | 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.0 :: Double