module Satyros.BellmanFord.IDLGraph where import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Set as Set import qualified Satyros.QFIDL as QFIDL data PositiveInfiniteInt = Finite Int | PositiveInfinity deriving stock (PositiveInfiniteInt -> PositiveInfiniteInt -> Bool (PositiveInfiniteInt -> PositiveInfiniteInt -> Bool) -> (PositiveInfiniteInt -> PositiveInfiniteInt -> Bool) -> Eq PositiveInfiniteInt forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: PositiveInfiniteInt -> PositiveInfiniteInt -> Bool $c/= :: PositiveInfiniteInt -> PositiveInfiniteInt -> Bool == :: PositiveInfiniteInt -> PositiveInfiniteInt -> Bool $c== :: PositiveInfiniteInt -> PositiveInfiniteInt -> Bool Eq, Eq PositiveInfiniteInt Eq PositiveInfiniteInt -> (PositiveInfiniteInt -> PositiveInfiniteInt -> Ordering) -> (PositiveInfiniteInt -> PositiveInfiniteInt -> Bool) -> (PositiveInfiniteInt -> PositiveInfiniteInt -> Bool) -> (PositiveInfiniteInt -> PositiveInfiniteInt -> Bool) -> (PositiveInfiniteInt -> PositiveInfiniteInt -> Bool) -> (PositiveInfiniteInt -> PositiveInfiniteInt -> PositiveInfiniteInt) -> (PositiveInfiniteInt -> PositiveInfiniteInt -> PositiveInfiniteInt) -> Ord PositiveInfiniteInt PositiveInfiniteInt -> PositiveInfiniteInt -> Bool PositiveInfiniteInt -> PositiveInfiniteInt -> Ordering PositiveInfiniteInt -> PositiveInfiniteInt -> PositiveInfiniteInt forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: PositiveInfiniteInt -> PositiveInfiniteInt -> PositiveInfiniteInt $cmin :: PositiveInfiniteInt -> PositiveInfiniteInt -> PositiveInfiniteInt max :: PositiveInfiniteInt -> PositiveInfiniteInt -> PositiveInfiniteInt $cmax :: PositiveInfiniteInt -> PositiveInfiniteInt -> PositiveInfiniteInt >= :: PositiveInfiniteInt -> PositiveInfiniteInt -> Bool $c>= :: PositiveInfiniteInt -> PositiveInfiniteInt -> Bool > :: PositiveInfiniteInt -> PositiveInfiniteInt -> Bool $c> :: PositiveInfiniteInt -> PositiveInfiniteInt -> Bool <= :: PositiveInfiniteInt -> PositiveInfiniteInt -> Bool $c<= :: PositiveInfiniteInt -> PositiveInfiniteInt -> Bool < :: PositiveInfiniteInt -> PositiveInfiniteInt -> Bool $c< :: PositiveInfiniteInt -> PositiveInfiniteInt -> Bool compare :: PositiveInfiniteInt -> PositiveInfiniteInt -> Ordering $ccompare :: PositiveInfiniteInt -> PositiveInfiniteInt -> Ordering $cp1Ord :: Eq PositiveInfiniteInt Ord, Int -> PositiveInfiniteInt -> ShowS [PositiveInfiniteInt] -> ShowS PositiveInfiniteInt -> String (Int -> PositiveInfiniteInt -> ShowS) -> (PositiveInfiniteInt -> String) -> ([PositiveInfiniteInt] -> ShowS) -> Show PositiveInfiniteInt forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [PositiveInfiniteInt] -> ShowS $cshowList :: [PositiveInfiniteInt] -> ShowS show :: PositiveInfiniteInt -> String $cshow :: PositiveInfiniteInt -> String showsPrec :: Int -> PositiveInfiniteInt -> ShowS $cshowsPrec :: Int -> PositiveInfiniteInt -> ShowS Show) addPositiveInfiniteInt :: PositiveInfiniteInt -> PositiveInfiniteInt -> PositiveInfiniteInt addPositiveInfiniteInt :: PositiveInfiniteInt -> PositiveInfiniteInt -> PositiveInfiniteInt addPositiveInfiniteInt (Finite Int n) (Finite Int m) = Int -> PositiveInfiniteInt Finite (Int n Int -> Int -> Int forall a. Num a => a -> a -> a + Int m) addPositiveInfiniteInt PositiveInfiniteInt _ PositiveInfiniteInt PositiveInfinity = PositiveInfiniteInt PositiveInfinity addPositiveInfiniteInt PositiveInfiniteInt PositiveInfinity PositiveInfiniteInt _ = PositiveInfiniteInt PositiveInfinity toInt :: PositiveInfiniteInt -> Maybe Int toInt :: PositiveInfiniteInt -> Maybe Int toInt (Finite Int n) = Int -> Maybe Int forall a. a -> Maybe a Just Int n toInt PositiveInfiniteInt PositiveInfinity = Maybe Int forall a. Maybe a Nothing type IDLGraph = Map (IDLGraphVertex, IDLGraphVertex) Int type IDLGraphVertex = Maybe QFIDL.Variable type IDLWeightMap = Map IDLGraphVertex (IDLGraphVertex, PositiveInfiniteInt) rootIDLGraphVertex :: IDLGraphVertex rootIDLGraphVertex :: IDLGraphVertex rootIDLGraphVertex = IDLGraphVertex forall a. Maybe a Nothing initializeIDL :: [QFIDL.Expressed] -> (IDLGraph, IDLWeightMap) initializeIDL :: [Expressed] -> (IDLGraph, IDLWeightMap) initializeIDL [Expressed] es = ([((IDLGraphVertex, IDLGraphVertex), Int)] -> IDLGraph forall k a. Ord k => [(k, a)] -> Map k a Map.fromList ([((IDLGraphVertex, IDLGraphVertex), Int)] -> IDLGraph) -> [((IDLGraphVertex, IDLGraphVertex), Int)] -> IDLGraph forall a b. (a -> b) -> a -> b $ [((IDLGraphVertex rootIDLGraphVertex, IDLGraphVertex rootIDLGraphVertex), Int 0)] [((IDLGraphVertex, IDLGraphVertex), Int)] -> [((IDLGraphVertex, IDLGraphVertex), Int)] -> [((IDLGraphVertex, IDLGraphVertex), Int)] forall a. Semigroup a => a -> a -> a <> ((, Int 0) ((IDLGraphVertex, IDLGraphVertex) -> ((IDLGraphVertex, IDLGraphVertex), Int)) -> (Variable -> (IDLGraphVertex, IDLGraphVertex)) -> Variable -> ((IDLGraphVertex, IDLGraphVertex), Int) forall b c a. (b -> c) -> (a -> b) -> a -> c . (IDLGraphVertex rootIDLGraphVertex, ) (IDLGraphVertex -> (IDLGraphVertex, IDLGraphVertex)) -> (Variable -> IDLGraphVertex) -> Variable -> (IDLGraphVertex, IDLGraphVertex) forall b c a. (b -> c) -> (a -> b) -> a -> c . Variable -> IDLGraphVertex forall a. a -> Maybe a Just (Variable -> ((IDLGraphVertex, IDLGraphVertex), Int)) -> [Variable] -> [((IDLGraphVertex, IDLGraphVertex), Int)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Variable] vars) [((IDLGraphVertex, IDLGraphVertex), Int)] -> [((IDLGraphVertex, IDLGraphVertex), Int)] -> [((IDLGraphVertex, IDLGraphVertex), Int)] forall a. Semigroup a => a -> a -> a <> [((IDLGraphVertex, IDLGraphVertex), Int)] edges, [(IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt))] -> IDLWeightMap forall k a. Ord k => [(k, a)] -> Map k a Map.fromList ([(IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt))] -> IDLWeightMap) -> ([(IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt))] -> [(IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt))]) -> [(IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt))] -> IDLWeightMap forall b c a. (b -> c) -> (a -> b) -> a -> c . ((IDLGraphVertex rootIDLGraphVertex, (IDLGraphVertex rootIDLGraphVertex, Int -> PositiveInfiniteInt Finite Int 0)) (IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt)) -> [(IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt))] -> [(IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt))] forall a. a -> [a] -> [a] :) ([(IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt))] -> IDLWeightMap) -> [(IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt))] -> IDLWeightMap forall a b. (a -> b) -> a -> b $ ((,) (IDLGraphVertex -> (IDLGraphVertex, PositiveInfiniteInt) -> (IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt))) -> (IDLGraphVertex -> (IDLGraphVertex, PositiveInfiniteInt)) -> IDLGraphVertex -> (IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (, PositiveInfiniteInt PositiveInfinity)) (IDLGraphVertex -> (IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt))) -> (Variable -> IDLGraphVertex) -> Variable -> (IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt)) forall b c a. (b -> c) -> (a -> b) -> a -> c . Variable -> IDLGraphVertex forall a. a -> Maybe a Just (Variable -> (IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt))) -> [Variable] -> [(IDLGraphVertex, (IDLGraphVertex, PositiveInfiniteInt))] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Variable] vars) where vars :: [Variable] vars = Set Variable -> [Variable] forall a. Set a -> [a] Set.toList (Set Variable -> [Variable]) -> ([Set Variable] -> Set Variable) -> [Set Variable] -> [Variable] forall b c a. (b -> c) -> (a -> b) -> a -> c . [Set Variable] -> Set Variable forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a Set.unions ([Set Variable] -> [Variable]) -> [Set Variable] -> [Variable] forall a b. (a -> b) -> a -> b $ (Expressed -> Set Variable) -> [Expressed] -> [Set Variable] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Expressed -> Set Variable QFIDL.variablesInExpressed [Expressed] es edges :: [((IDLGraphVertex, IDLGraphVertex), Int)] edges = (\(QFIDL.LessThanEqualTo Variable x1 Variable x2 Int v) -> ((Variable -> IDLGraphVertex forall a. a -> Maybe a Just Variable x1, Variable -> IDLGraphVertex forall a. a -> Maybe a Just Variable x2), Int v)) (Expressed -> ((IDLGraphVertex, IDLGraphVertex), Int)) -> [Expressed] -> [((IDLGraphVertex, IDLGraphVertex), Int)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Expressed] es