<commit_before><commit_msg>new module Axioms, holds functions for the modal axioms K, T, 4, 5, etc.<commit_after>module Axioms
( reflSymSubSet
, reflTransSubSets
, symTransSubSets
, reflSymTransSubSets
) where

import Control.Monad (liftM)
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Text as T
import Database.PostgreSQL.Simple

import DB
import Util

-- |Reflexive (T) and symmetric (B) subset of R.
reflSymSubSet :: Connection -> IO [(T.Text, T.Text)]
reflSymSubSet c = do
    refls <- reflSubSet c
    syms  <- symSubSet c
    let reflSyms = filter (pairIn refls) syms
    let symRefls = [(x, x) | x <- map fst reflSyms] -- generate needed reflexivs
    return (reflSyms ++ symRefls)

-- |Reflexive (T) and transitive (4) subsets of R.
reflTransSubSets :: Connection -> IO [[(T.Text, T.Text)]]
reflTransSubSets c = do
    refls <- reflSubSet c
    trans <- transSubSets c
    -- both ends of a relation must be reflexive
    let reflTrans = filter (/= []) (map (filter (pairIn refls)) trans)
    -- generate needed reflexives to zip together the results
    let transRefls = map (makeReflTuples . flattenTuples) reflTrans
    return (map L.nub (zipWith (++) reflTrans transRefls))

-- |Symmetric (4) and transitive (4) subsets of R.
symTransSubSets :: Connection -> IO [[(T.Text, T.Text)]]
symTransSubSets c = do
    syms  <- symSubSet c
    trans <- transSubSets c
    let trans'     = map (filter (uncurry (/=))) trans
    -- drop relations interacting with the source world of a missing symmetry
    let badOnes    = map (startOfMissingSyms syms) trans' 
    let symTrans   = [dropRelsWithElemIn bs ts | (ts, bs) <- zip trans' badOnes]
    let resultSets = map addSyms symTrans -- add symmetric relations to result
    return (dropDuplicates resultSets) -- we might have constructed duplicates

-- |Reflexive (T), symmetric (B) and transitive (4) subsets of R.
reflSymTransSubSets :: Connection -> IO [[(T.Text, T.Text)]]
reflSymTransSubSets c = do
    refls <- reflSubSet c
    st    <- symTransSubSets c
    -- both ends of a relation must be reflexive
    let refSymTrans = filter (/= []) (map (filter (pairIn refls)) st)
    -- generate needed reflexives to zip together the results
    let symtraRefls = map (makeReflTuples . flattenTuples) refSymTrans
    let resultSets = map L.nub (zipWith (++) refSymTrans symtraRefls)
    return (dropDuplicates resultSets) -- we might have constructed duplicates

-- |True, if both pair elements are elems of the list.
pairIn :: (Eq a) => [a] -> (a, a) -> Bool
pairIn xs (y, z) = y `elem` xs && z `elem` xs

-- |Construct reflexive tuples out of list elements.
makeReflTuples :: [a] -> [(a, a)]
makeReflTuples xs = [(x, x) | x <- xs]

startOfMissingSyms :: (Eq a) => [(a, a)] -> [(a, a)] -> [a]
startOfMissingSyms syms rels = [y | (x, y) <- rels, (y, x) `notElem` syms]

-- |Make a relation symmetric.
addSyms :: (Eq a) => [(a, a)] -> [(a, a)]
addSyms = L.nub . concatMap (\(x, y) -> [(x, y), (y, x)])

-- |Drops duplicate lists, don't care about order.
dropDuplicates :: (Eq a, Ord a) => [[a]] -> [[a]]
dropDuplicates = map S.toList . L.nub . map S.fromList

{'fraction_non_alphanumeric': 0.1288888888888889, 'fraction_numerical': 0.0019047619047619048, 'mean_word_length': 3.3703190013869624, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 19, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '190610', 'n_tokens_mistral': 1134, 'n_tokens_neox': 1073, 'n_words': 389}