gf-core/src/tools/gftest/EqRel.hs

module EqRel where

import qualified Data.Map as M
import Data.List ( sort )

data EqRel a = Top | Classes [[a]] deriving (Eq,Ord,Show)

(/\) :: (Ord a) => EqRel a -> EqRel a -> EqRel a
Top /\ r = r
r /\ Top = r
Classes xss /\ Classes yss = Classes $ sort $ map sort $ concat -- maybe throw away singleton lists?
  [ M.elems tabXs 
  | xs <- xss 
  , let tabXs = M.fromListWith (++) 
                   [ (tabYs M.! x, [x])
                   | x <- xs ] 
  ]

 where
  tabYs = M.fromList [ (y,representative)
                     | ys <- yss
                     , let representative = head ys 
                     , y <- ys ]

basic :: (Ord a) => [a] -> EqRel Int
basic xs = Classes $ sort $ map sort $ M.elems $ M.fromListWith (++) 
  [ (x,[i]) | (x,i) <- zip xs [0..] ]

rep :: EqRel Int -> Int -> Int
rep Top j           = 0
rep (Classes xss) j = head [ head xs | xs <- xss, j `elem` xs ]