diff --git a/data/scenarios/Testing/_Validation/2198-prerequisite-SCC.yaml b/data/scenarios/Testing/_Validation/2198-prerequisite-SCC.yaml new file mode 100644 index 000000000..85a1cee01 --- /dev/null +++ b/data/scenarios/Testing/_Validation/2198-prerequisite-SCC.yaml @@ -0,0 +1,38 @@ +version: 1 +name: | + Prerequisite objectives: dependency cycles in a larger SCC +author: Brent Yorgey +description: | + This should be rejected by the parser due to cyclic dependencies. + The dependency graph is strongly connected, but not all four + dependencies are in a single cycle together. +robots: + - name: base +objectives: + - id: a + condition: 'true' + prerequisite: + logic: + and: + - b + - c + - d + - id: b + condition: 'true' + prerequisite: a + - id: c + condition: 'true' + prerequisite: + logic: + and: + - a + - d + - id: d + condition: 'true' + prerequisite: + logic: + and: + - a + - c +world: + dsl: '{stone}' diff --git a/src/swarm-util/Swarm/Util/Graph.hs b/src/swarm-util/Swarm/Util/Graph.hs index 06181c4df..c00d18d0c 100644 --- a/src/swarm-util/Swarm/Util/Graph.hs +++ b/src/swarm-util/Swarm/Util/Graph.hs @@ -6,13 +6,17 @@ -- Graph utilities shared by multiple aspects of scenarios module Swarm.Util.Graph ( isAcyclicGraph, + findCycle, failOnCyclicGraph, ) where import Control.Monad (forM_) -import Data.Graph (SCC (..), stronglyConnComp) -import Data.List.NonEmpty qualified as NE -import Data.Maybe (mapMaybe) +import Control.Monad.ST +import Data.Array ((!)) +import Data.Array.ST +import Data.Graph (SCC (..), Vertex, graphFromEdges) +import Data.IntSet (IntSet) +import Data.IntSet qualified as IS import Data.Text (Text) import Data.Text qualified as T import Swarm.Util @@ -25,13 +29,62 @@ isAcyclicGraph = AcyclicSCC _ -> True _ -> False -getGraphCycles :: [SCC a] -> [[a]] -getGraphCycles = - mapMaybe getCycle +-- | Keep track of the current search path in a DFS, both as a set of +-- vertices (for fast membership testing) and as a reversed list of +-- vertices visited along the current path, in order. +-- +-- Note this is different than just keeping track of which vertices +-- have been visited at all; visited vertices remain visited when +-- DFS backtracks, but the DFSPath gets shorter again. +data DFSPath = DFSPath IntSet [Vertex] + +emptyDFSPath :: DFSPath +emptyDFSPath = DFSPath IS.empty [] + +appendPath :: DFSPath -> Vertex -> DFSPath +appendPath (DFSPath s p) v = DFSPath (IS.insert v s) (v : p) + +-- | Find a cycle in a directed graph (if any exist) via DFS. +-- +-- >>> findCycle [("a", 0, [0])] +-- Just ["a"] +-- >>> findCycle [("a", 0, [1]), ("b", 1, [])] +-- Nothing +-- >>> findCycle [("a", 0, [1]), ("b", 1, [0])] +-- Just ["a","b"] +-- >>> findCycle [("a", 0, [1]), ("b", 1, [2]), ("c", 2, [1])] +-- Just ["b","c"] +-- >>> findCycle [("a",3,[1]), ("b",1,[0,3]), ("c",2,[1]), ("d",0,[])] +-- Just ["b","a"] +-- >>> findCycle [("a",3,[]), ("b",1,[0,3]), ("c",2,[1]), ("d",0,[])] +-- Nothing +-- >>> findCycle [("a",3,[1]), ("b",1,[0,3]), ("c",2,[1]), ("d",0,[2])] +-- Just ["d","c","b"] +findCycle :: Ord key => [(a, key, [key])] -> Maybe [a] +findCycle es = runST $ do + visited <- newArray (0, n - 1) False + (fmap . map) (fst3 . v2l) <$> dfsL visited emptyDFSPath [0 .. n - 1] where - getCycle = \case - AcyclicSCC _ -> Nothing - CyclicSCC c -> Just c + n = length es + (g, v2l, _) = graphFromEdges es + fst3 (a, _, _) = a + + dfsL :: STUArray s Vertex Bool -> DFSPath -> [Vertex] -> ST s (Maybe [Vertex]) + dfsL _ _ [] = pure Nothing + dfsL visited path (v : vs) = do + found <- dfs visited path v + case found of + Nothing -> dfsL visited path vs + Just cyc -> pure (Just cyc) + + dfs :: STUArray s Vertex Bool -> DFSPath -> Vertex -> ST s (Maybe [Vertex]) + dfs visited p@(DFSPath pathMembers path) v + | v `IS.member` pathMembers = pure . Just . (v :) . reverse $ takeWhile (/= v) path + | otherwise = do + vis <- readArray visited v + case vis of + True -> pure Nothing + False -> dfsL visited (appendPath p v) (g ! v) failOnCyclicGraph :: Ord key => @@ -40,12 +93,10 @@ failOnCyclicGraph :: [(a, key, [key])] -> Either Text () failOnCyclicGraph graphType keyFunction gEdges = - forM_ (NE.nonEmpty $ getGraphCycles $ stronglyConnComp gEdges) $ \cycles -> + forM_ (findCycle gEdges) $ \cyc -> Left $ T.unwords [ graphType - , "graph contains cycles:" - , commaList $ - NE.toList $ - fmap (brackets . T.intercalate " -> " . fmap keyFunction) cycles + , "graph contains a cycle:" + , brackets . T.intercalate " -> " . fmap keyFunction $ cyc ]