Emping-0.2: src/Codec.hs

module Codec ( avCod, avArr )where

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

{- module: code a table of attributes and values

Note: extended Haskell because of dependent parameters

first row of table: attribute names (must be unique)
following rows of table: attribute values

avArr produces an array of string lists
head of each list, with index 0, is an attribute name
tail of each list, starting with index 1, has value names

avCod produces a list of lists of attribute-value tuples 
first of each tuple codes an attribute as an Int index
into the attribute-value array
second of each tuble codes a value as an index into the
list indexed by its attribute (0 is the attribute name,
and 1 is the first value in the list)
-}

import Data.List (transpose, elemIndex)
import Control.Monad.State
import Data.Array

-- get unique value-list and code strings as indices
-- Note: index incremented by 1, index 0 is the attribute

repl1 :: String -> [String] -> (Int, [String])
repl1 x tb  = case elemIndex x tb of
                 Nothing -> ((length tb) + 1, tb ++ [x] )
                 Just i -> (i + 1, tb)

toState :: String -> State [String] Int
toState x = State (repl1 x)

getVals :: [String] -> ([Int],[String])
getVals x = (runState (getState x)) [] where
                  getState = sequence . (map toState)

getInds :: [String] -> [Int]
getInds  =  fst . getVals

getTb :: [String] -> [String]
getTb = snd . getVals

-- get attribute-value lists from the table
-- Note: see comment at start for indexing scheme

avLs :: [[String]] -> [[String]]
avLs (x:xs) = zipWith (:)  x (values xs) where 
        values  = (map getTb) . transpose 

-- replace table, except first line, with:
-- tuples representing attribute-value pair
-- Note: see comment at start for indexing scheme

avCod :: [[String]] -> [[(Int, Int)]]
avCod (x:xs) = map (zip [0..]) (values xs) 
  where  values = transpose . (map getInds) . transpose

-- make an array of attribute-value lists from the 
-- table, instead of a list of lists of Strings

avArr :: [[String]] -> Array Int [String]
avArr tb = listArray (0, (length attvals) -1) attvals where
      attvals = avLs tb