Emping-0.2: src/CSVTable.hs

module CSVTable (rule2Attls,res2CSVTb,abd2CSVTb,amb2CSVTb ) where

-- (c) 2007 Hans van Thiel
-- Version 0.2 License GPL

-- module: convert reduction result to a CSV 
-- format that can be read by Open Office Calc

import Data.Char (isDigit )
import Data.List ( delete )
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 att [] = 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 [] red = []
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