petri net export bug for floops

Author: adamburkegh

src/main/haskell/PetriNet.hs

@@ -113,4 +113,23 @@ validateWeightedNet wnet
           valFailInit = "Validation failed for net. "
 
 
+debugTransition :: WTransition String -> String
+debugTransition (WTransition a nodeId weight) 
+    = "t" ++ a ++ ":" ++ show weight ++ "[" ++ nodeId ++ "]"
+
+debugPlace :: Place String -> String
+debugPlace (Place a nodeId) = "p(" ++ a  ++  "[" ++ nodeId ++ "] )"  
+
+debugEdge :: WEdge String -> String
+debugEdge (WToPlace a b)      = debugTransition a ++ " -> " ++ debugPlace b 
+debugEdge (WToTransition a b) = debugPlace a ++ " -> " ++ debugTransition b 
+
+formatWNetDebug :: WeightedNet -> String
+formatWNetDebug wnet =
+       "Places: "  ++ unwords ( map debugPlace (toList (wnplaces wnet)) ) 
+    ++ " Transitions: " 
+    ++ unwords ( map debugTransition (toList(wntransitions wnet)) )
+    ++ " Edges: " 
+    ++ unwords ( map debugEdge (toList (wnedges wnet) ) )
+
 

src/main/haskell/TPMine.hs

@@ -75,17 +75,7 @@ ptreeWeightedNet (NodeN Choice ptl w) pi po idp =
         pi po (wnmaxnodeid (last ptlr))
 
 ptreeWeightedNet (Node1 FLoop x m w) pi po idp
-    | m <= 1 = ptreeWeightedNet x pi po idp
-    | m > 1  =
-        let midp1 = midp (idp+1)
-            px      =   ptreeWeightedNet x pi midp1 ( idp+2 )
-            nx      =   ptreeWeightedNet (Node1 FLoop x (m-1) w) midp1 po
-                                                        ( wnmaxnodeid px )
-        in WeightedNet (unions [wnplaces px,wnplaces nx,
-                               fromList [midp1,pi,po]]) 
-                   (wntransitions px `union` wntransitions nx)
-                   (wnedges px `union` wnedges nx)
-                   pi po (wnmaxnodeid px)
+    = ptreeWeightedNet (seqP (replicate (round m) x) w ) pi po idp
 
 ptreeWeightedNet (Node1 PLoop x m w) pi po idp =
     let midp1 = midp (idp+1)

src/test/haskell/TPMineTest.hs

@@ -48,7 +48,6 @@ lb2 = Leaf "b" 2
 lb3 = Leaf "b" 3
 lc2 = Leaf "c" 2
 ld2 = Leaf "d" 2
-loopa1 = Node1 FLoop la 1 1
 
 
 -- Tests
@@ -194,7 +193,7 @@ ttauout1 = WTransition "tauout" "t5" 1
 ttauout2 = WTransition "tauout" "t5" 2
 
 
-translateLoops = [
+translatePLoops = [
     "translateLoopLeaf" ~:
         WeightedNet (fromList [pin,pout,pmidLoop1])
                  (fromList [tlpa4_id6, ttauin5, ttauout1])
@@ -245,7 +244,27 @@ translateLoops = [
                   ~=? translate (Node1 PLoop (NodeN Choice [la8,lb2] 10) 5 10)
                 ]
 
-translateTests = translateLoops ++ translateRest 
+
+tla5_1 = WTransition "a" "t3" 5
+tla5_2 = WTransition "a" "t4" 5
+pfl1 = Place "" "p2"
+
+translateFLoops = [
+    "translateLoopLeaf" ~:
+        WeightedNet (fromList [pin,pout,pfl1] )
+                 (fromList [tla5_1,tla5_2])
+                 (fromList [WToPlace tla5_1 pfl1,
+                            WToPlace tla5_2 pout,
+                            WToTransition pfl1 tla5_2,
+                            WToTransition pin  tla5_1 ])
+                   pin pout 4
+                   ~=? translate (Node1 FLoop la5 2 5),
+    "translateLoopLeaf3" ~:
+                   translate (NodeN Seq [la5,la5,la5] 5)
+                   ~=? translate (Node1 FLoop la5 3 5)
+                ]
+
+translateTests = translatePLoops ++ translateFLoops ++ translateRest 
 
 validationTests = [
     "validNet1" ~: valOk