RelationAlgebra.hs

-----------------------------------------------------------------------------
-- Copyright 2013, Open Universiteit Nederland. This file is distributed
-- under the terms of the GNU General Public License. For more information,
-- see the file "LICENSE.txt", which is included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------
module Domain.RelationAlgebra (module Export) where

import Domain.RelationAlgebra.Exercises as Export
import Domain.RelationAlgebra.Formula as Export
import Domain.RelationAlgebra.Generator as Export
import Domain.RelationAlgebra.Parser as Export
import Domain.RelationAlgebra.Rules as Export
import Domain.RelationAlgebra.Strategies as Export
-- import Domain.RelationAlgebra.Equivalence

{-
import Control.Monad
import Data.List
import Ideas.Common.Classes
import Ideas.Common.Context
import System.Random
import Test.QuickCheck

nrpairs = 2000 -- 20000

repeatM :: Monad m => m a -> m [a]
repeatM m = liftM2 (:) m (repeatM m)

pairs :: [(RelAlg, RelAlg)]
pairs = take nrpairs $ generate 100 (mkStdGen 280578) (repeatM arbitrary)

precision :: IO ()
precision = do
   let f (x, y) = probablyEqualWithG (mkStdGen 28) x y
       ms   = map f pairs
       freq = map g $ group $ sort ms
       is   = [ n | (Just n, _)  <- freq ]
       g xs@(x:_) = (x, length xs)
       h n = let score = sum [ i | (Just m, i) <- freq, m <= n ]
             in putStrLn $ show n ++ ": " ++ showPerc (nrpairs - score - dif)
       troubles = [ (norm p, norm q) | (Nothing, (p, q)) <- zip ms pairs ]
       len = length unknown
       dif = length troubles - len
       unknown  = -- map (\(a,b) -> (a, b, isEquivalent a b)) $
                  filter (\(a,b) -> a /= b) troubles
   putStrLn $ map (maybe '!' (const '.')) ms
   mapM_ h is

   putStrLn $ unlines $ map show unknown
   putStrLn $ "(" ++ show len ++ " unknown)"

showPerc :: Int -> String
showPerc n = show (fromIntegral (100*n)/fromIntegral nrpairs) ++ "%"

norm :: RelAlg -> RelAlg
norm = fromContext . applyD toCNF . inContext

pair1 = ((Not (Inv (Var "q")) :&&: Not (Inv (Var "s"))) :&&: Inv (Var "s") :.: Inv (Var "q"),E)
pair2 = ((Var "s" :&&: (E :+: Not (Var "r")) :.: Inv (Var "r") :&&: ((Not (Var "s") :.: Var "q") :||: (Not (Var "s") :.: Var "s"))) :.: (Var "s" :+: Inv (Var "r") :.: (Inv (Var "s") :+: Inv (Var "r")) :&&: Inv (Var "q")),E)
pair3 = ((Not (Var "q") :||: Not (Var "s")) :||: ((Inv (Var "r") :+: E :.: Inv (Var "q")) :||: (Not (Var "q") :||: Var "s")),U)

test1 = uncurry isEquivalent pair1
test2 = uncurry isEquivalent pair2
test3 = uncurry isEquivalent pair3 -}