Fix generateActionSequence and validActionSequence for Activity Final nodes

modelling-tasks.cabal

@@ -147,6 +147,7 @@ test-suite modelling-tasks-test
   type: exitcode-stdio-1.0
   main-is: Main.hs
   other-modules:
+      Modelling.ActivityDiagram.ActionSequencesActivityFinalSpec
       Modelling.ActivityDiagram.ActionSequencesSpec
       Modelling.ActivityDiagram.AlloySpec
       Modelling.ActivityDiagram.Auxiliary.ParserSpec

src/Modelling/ActivityDiagram/ActionSequences.hs

@@ -2,19 +2,21 @@
 module Modelling.ActivityDiagram.ActionSequences (
   validActionSequence,
   generateActionSequence,
+  isActivityFinalPetriNode,
 ) where
 
 import qualified Modelling.ActivityDiagram.Datatype as Ad (
   AdNode (label),
   )
 
-import qualified Data.Set as S (fromList)
+import qualified Data.Set as S (fromList, union, member, empty, toList)
 import qualified Data.Map as M (filter, map, keys, fromList, toList)
 
 import Modelling.ActivityDiagram.Datatype (
   AdNode (..),
   UMLActivityDiagram (..),
-  isActionNode
+  isActionNode,
+  isActivityFinalNode
   )
 
 import Modelling.ActivityDiagram.PetriNet (
@@ -34,7 +36,7 @@ import Modelling.PetriNet.Reach.Type (
   Net(..)
   )
 
-import Modelling.PetriNet.Reach.Step (levels', successors)
+import Modelling.PetriNet.Reach.Step (successors)
 
 import Control.Monad (guard)
 import Data.List (find, union)
@@ -54,7 +56,8 @@ fromPetriLike petri =
 --Generate one valid action sequence to each of the final nodes
 generateActionSequence :: UMLActivityDiagram -> [String]
 generateActionSequence diag =
-  let tSeq = generateActionSequence' diag
+  let activityFinalLabels = map Ad.label $ filter isActivityFinalNode $ nodes diag
+      tSeq = generateActionSequence' diag activityFinalLabels
       tSeqLabels = map (Ad.label . sourceNode) $ filter isNormalPetriNode tSeq
       actions = map
         (\n -> (Ad.label n, name n))
@@ -67,14 +70,46 @@ isNormalPetriNode pk =
     NormalPetriNode {} -> True
     _ -> False
 
+-- Check if a PetriKey corresponds to an Activity Final node
+isActivityFinalPetriNode :: PetriKey -> Bool
+isActivityFinalPetriNode pk =
+  case pk of
+    FinalPetriNode _ srcNode -> isActivityFinalNode srcNode
+    _ -> False
+
 --Generate at one sequence of transitions to each final node
-generateActionSequence' :: UMLActivityDiagram -> [PetriKey]
-generateActionSequence' diag =
+generateActionSequence' :: UMLActivityDiagram -> [Int] -> [PetriKey]
+generateActionSequence' diag activityFinalLabels =
   let petri = fromPetriLike $ convertToPetriNet diag
-      zeroState = State $ M.map (const 0) $ unState $ start petri
-      sequences = fromJust $ find (isJust . lookup zeroState) $ levels' petri
+      -- Use all places in the network to create the zero state for consistency
+      allPlaces = S.toList $ places petri
+      zeroState = State $ M.fromList [(p, 0) | p <- allPlaces]
+      sequences = fromJust $ find (isJust . lookup zeroState) $ levelsAS petri activityFinalLabels
   in reverse $ fromJust $ lookup zeroState sequences
 
+-- Modified version of levels' that handles Activity Final nodes
+levelsAS :: Ord s => Net s PetriKey -> [Int] -> [[(State s, [PetriKey])]]
+levelsAS n activityFinalLabels =
+  let -- Create zero state using all places in the network for consistency
+      allPlaces = S.toList $ places n
+      zeroState = State $ M.fromList [(p, 0) | p <- allPlaces]
+      -- Check if a transition corresponds to Activity Final
+      isActivityFinalTransition t = case t of
+        AuxiliaryPetriNode nodeLabel -> nodeLabel `elem` activityFinalLabels
+        _ -> False
+      f _ [] = []
+      f done xs =
+        let done' = S.fromList (map fst xs) `S.union` done
+            next = M.toList $ M.fromList [ (finalState, t:p) |
+                (x,p) <- xs,
+                (t,y) <- successors n x,
+                -- If this is an Activity Final transition, use consistent zero state
+                let finalState = if isActivityFinalTransition t then zeroState else y,
+                not $ S.member finalState done'
+              ]
+         in xs : f done' next
+  in f S.empty [(start n, [])]
+
 
 validActionSequence :: [String] -> UMLActivityDiagram -> Bool
 validActionSequence input diag =
@@ -88,28 +123,43 @@ validActionSequence input diag =
         $ filter isNormalPetriNode $ M.keys $ allNodes petri
       input' = mapMaybe (`lookup` petriKeyMap) labels
       actions = map snd $ filter (\(l,_) -> l `elem` map snd nameMap) petriKeyMap
-  in length input == length labels && validActionSequence' input' actions petri
+      -- Get Activity Final node labels from original diagram
+      activityFinalLabels = map Ad.label $ filter isActivityFinalNode $ nodes diag
+  in length input == length labels && validActionSequence' input' actions petri activityFinalLabels
 
 
 validActionSequence'
   :: [PetriKey]
   -> [PetriKey]
   -> PetriLike Node PetriKey
+  -> [Int]  -- Activity Final node labels
   -> Bool
-validActionSequence' input actions petri =
+validActionSequence' input actions petri activityFinalLabels =
   let net = fromPetriLike petri
-      zeroState = State $ M.map (const 0) $ unState $ start net
-  in any (isJust . lookup zeroState) (levelsCheckAS input actions net)
-
-
-levelsCheckAS :: [PetriKey] -> [PetriKey] -> Net PetriKey PetriKey-> [[(State PetriKey, [PetriKey])]]
-levelsCheckAS input actions n =
-  let g h xs = M.toList $
+      -- Use all places in the network to create the zero state, not just the start state
+      allPlaces = S.toList $ places net
+      zeroState = State $ M.fromList [(p, 0) | p <- allPlaces]
+  in any (isJust . lookup zeroState) (levelsCheckAS input actions net activityFinalLabels)
+
+
+levelsCheckAS :: [PetriKey] -> [PetriKey] -> Net PetriKey PetriKey -> [Int] -> [[(State PetriKey, [PetriKey])]]
+levelsCheckAS input actions n activityFinalLabels =
+  let -- Create zero state using all places in the network for consistency
+      allPlaces = S.toList $ places n
+      zeroState = State $ M.fromList [(p, 0) | p <- allPlaces]
+      -- Check if a transition corresponds to Activity Final by checking if it's an auxiliary node
+      -- with a label that matches an Activity Final node from the original diagram
+      isActivityFinalTransition t = case t of
+        AuxiliaryPetriNode nodeLabel -> nodeLabel `elem` activityFinalLabels
+        _ -> False
+      g h xs = M.toList $
         M.fromList $ do
           (x, p) <- xs
           (t, y) <- successors n x
           guard $ h t
-          return (y, t : p)
+          -- If this is an Activity Final transition, immediately go to zero state
+          let finalState = if isActivityFinalTransition t then zeroState else y
+          return (finalState, t : p)
       f _ [] = []
       f [] xs =
         let next = g (`notElem` actions) xs               -- No further actions should be processed if no input is left

test/Modelling/ActivityDiagram/ActionSequencesActivityFinalSpec.hs

@@ -0,0 +1,63 @@
+module Modelling.ActivityDiagram.ActionSequencesActivityFinalSpec where
+
+import Modelling.ActivityDiagram.ActionSequences (generateActionSequence, validActionSequence)
+
+import Modelling.ActivityDiagram.Datatype (
+  UMLActivityDiagram(..),
+  AdNode (..),
+  AdConnection (..)
+  )
+
+import Test.Hspec(Spec, context, describe, it, shouldBe)
+
+spec :: Spec
+spec =
+  describe "ActionSequences with Activity Final nodes" $ do
+    context "simple diagram with Activity Final" $ do
+      it "generates a valid sequence ending at Activity Final" $
+        generateActionSequence testDiagramSimpleActivityFinal `shouldBe` ["A"]
+      it "validates a sequence ending at Activity Final" $
+        validActionSequence ["A"] testDiagramSimpleActivityFinal `shouldBe` True
+    context "fork diagram with Activity Final" $ do
+      it "validates sequence ['A','B'] that reaches Activity Final and terminates all flows" $
+        validActionSequence ["A","B"] testDiagramForkActivityFinal `shouldBe` True
+      it "rejects incomplete sequence ['A'] that doesn't reach termination" $
+        validActionSequence ["A"] testDiagramForkActivityFinal `shouldBe` False
+      it "validates sequence ['A','C','B'] where Activity Final terminates all flows" $
+        validActionSequence ["A","C","B"] testDiagramForkActivityFinal `shouldBe` True
+
+-- Simple diagram: Initial -> A -> Activity Final
+testDiagramSimpleActivityFinal :: UMLActivityDiagram
+testDiagramSimpleActivityFinal = UMLActivityDiagram
+  { nodes =
+    [ AdInitialNode { label = 1 }
+    , AdActionNode { label = 2, name = "A" }
+    , AdActivityFinalNode { label = 3 }
+    ]
+  , connections =
+    [ AdConnection { from = 1, to = 2, guard = "" }
+    , AdConnection { from = 2, to = 3, guard = "" }
+    ]
+  }
+
+-- Fork diagram: Initial -> A -> Fork -> (B -> Activity Final, C -> Flow Final)
+testDiagramForkActivityFinal :: UMLActivityDiagram
+testDiagramForkActivityFinal = UMLActivityDiagram
+  { nodes =
+    [ AdInitialNode { label = 1 }
+    , AdActionNode { label = 2, name = "A" }
+    , AdForkNode { label = 3 }
+    , AdActionNode { label = 4, name = "B" }
+    , AdActionNode { label = 5, name = "C" }
+    , AdActivityFinalNode { label = 6 }
+    , AdFlowFinalNode { label = 7 }
+    ]
+  , connections =
+    [ AdConnection { from = 1, to = 2, guard = "" }
+    , AdConnection { from = 2, to = 3, guard = "" }
+    , AdConnection { from = 3, to = 4, guard = "" }
+    , AdConnection { from = 3, to = 5, guard = "" }
+    , AdConnection { from = 4, to = 6, guard = "" }  -- B leads to Activity Final
+    , AdConnection { from = 5, to = 7, guard = "" }  -- C leads to Flow Final
+    ]
+  }