Emping-0.4: src/CSVTable.hs

{- | Emping 0.4 (provisional)

Module CSVTable converts results to a CSV format that can be read by Open Office Calc
-}
module CSVTable ( allDup2CSVTb , allAmb2CSVTb, rnf2CSVTb, allAbd2CSVTb, topAbd2CSVTb ) where

import Data.Char (isDigit )
import Data.Array
import Data.Tree ( Tree(..), Forest )
import Aux (AVp, Ant, Rule)
import CSVParse (blankId)
--import Data.Tree ( Tree(..), Forest )

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

-- | A general function to get the branches of a tree. Only used here, but could as well be in Aux.

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

-- | show a chain of equals in .csv format.

chain2CSV :: Array Int (String,[String]) -> [Int] -> [[Rule]] -> 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

-- | show a chain of implications, including equals, in .csv format. 
ruleChain2CSV :: Array Int (String,[String]) -> [Int] -> [[Rule]] ->  String
ruleChain2CSV attvarr attls chain  = (chain2CSV attvarr attls chain) 
                                      ++ ",\" is \","
                                      ++ (showValue attvarr ( snd (head (head chain))))
                                      ++ "\n\n"

-- | show a tree in .csv format. Warning: reverse is needed to get the most general rule at the end.
tree2CSV :: Array Int (String,[String]) -> [Int] -> Tree [Rule] -> String
tree2CSV attvarr attls t = 
     concatMap (ruleChain2CSV attvarr attls) chains where  chains = map reverse (brTree t)

-- | a forest of abduction trees to .csv format
forest2CSV :: Array Int (String,[String]) -> [Int] -> Forest [Rule] -> String
forest2CSV attvarr attls for = 
    concatMap (tree2CSV attvarr attls) for
-----------------------------------------------------
-- | abduction result to .csv format
allAbds2CSV :: Array Int (String,[String]) -> [Int] -> [Forest [Rule]]-> String
allAbds2CSV attvarr attls abdgrp =
    concatMap (forest2CSV attvarr attls) abdgrp

----------------------------------------------------
-- | transform the abduction result to .csv table with header 

allAbd2CSVTb :: Array Int (String,[String]) -> [[Rule]] -> [Forest [Rule]] -> String
allAbd2CSVTb attvarr origs abdgrp = (hdr2CSV attvarr guide) 
                                  ++ allAbds2CSV attvarr (fst guide) abdgrp where guide = displayGuide (head (head origs))

------------------------------------------ Top level abductions only ----------------------------------

-- | get a .csv string of (possibly equals) from the top only of a tree, including the consequent
topTree2CSV :: Array Int (String,[String]) -> [Int] -> Tree [Rule] -> String
topTree2CSV attvarr guide t =   let eqls = rootLabel t
                                in  (eqs2CSV attvarr guide eqls)
                                    ++ ",\" is \","
                                    ++ (showValue attvarr (snd (head eqls)))
                                    ++ "\n\n"   

-- | do it for the forest
topForest2CSV :: Array Int (String,[String]) -> [Int] -> Forest [Rule] -> String
topForest2CSV attvarr guide for = concatMap (topTree2CSV attvarr guide) for

-- | do it for all abductions
topAbds2CSV :: Array Int (String,[String]) -> [Int] -> [Forest [Rule]]-> String
topAbds2CSV attvarr guide abdgrp = concatMap (topForest2CSV attvarr guide) abdgrp

-- | add the header to the .csv table as with allAbd2CSVTb.  
topAbd2CSVTb :: Array Int (String,[String]) -> [[Rule]] -> [Forest [Rule]] -> String
topAbd2CSVTb attvarr origs abdgrp = (hdr2CSV attvarr guide) 
                                     ++ topAbds2CSV attvarr (fst guide) abdgrp where guide = displayGuide (head (head origs))
--------------------------------------------------------------------------------------------------------------------------