1 -- | If someone wants to give a new reduction strategy have to:
3 -- 1. add a new entry in @strategiesList@ (e.g. @(\"New Strategy string\", choose_NewStrategy_function)@)
5 -- 2. define @choose_NewStrategy_function :: [EdgeNr] -> Document g n e -> PossibleResult EdgeNr@
6 module INReductionStrategies where
15 data PossibleResult a = Result a | ErrorD String String | InfoD String String
17 -- | Checks if the given edge is an active pair.
18 isActivePair :: EdgeNr -> Palette n -> Network g n e -> Bool
19 isActivePair edgeNr palette network =
20 isPrincipalPort palette network nodeNrFrom portFrom
21 && isPrincipalPort palette network nodeNrTo portTo
22 && not (isInterfaceNode (nodeNrFrom, getNode nodeNrFrom network) )
23 && not (isInterfaceNode (nodeNrTo, getNode nodeNrTo network) )
24 where edge = getEdge edgeNr network
25 (nodeNrFrom, portFrom) = getFullPortFrom edge
26 (nodeNrTo, portTo) = getFullPortTo edge
28 -- | Checks if an interface node is connected through an active pair.
29 isTheInterfaceActivePair :: EdgeNr -> Palette n -> Network g n e -> Bool
30 isTheInterfaceActivePair edgeNr palette network =
31 isPrincipalPort palette network nodeNrFrom portFrom
32 && isPrincipalPort palette network nodeNrTo portTo
33 where edge = getEdge edgeNr network
34 (nodeNrFrom, portFrom) = getFullPortFrom edge
35 (nodeNrTo, portTo) = getFullPortTo edge
39 type Strategy = String
41 -- | List of pairs (Strategy name, strategy choose function)
42 strategiesList :: [(Strategy -- strategy name
43 , [EdgeNr] -- none empty list of all active pairs in the network
44 -> Document g n e -- document
45 -> PossibleResult EdgeNr -- edgeNr to reduce or thrown error message
48 [ ("Manual selection", chooseManualSelection)
49 , ("Random", chooseRandom)
50 , ("WRINF", chooseWRINF)
53 chooseManualSelection :: [EdgeNr] -> Document g n e -> PossibleResult EdgeNr
54 chooseManualSelection _ doc = case getSelection doc of
55 EdgeSelection Net edgeNr -> Result edgeNr
56 _ -> ErrorD "Reduction error" "Please select an active pair first and press 'REDUCE' again."
58 chooseRandom :: [EdgeNr] -> Document g n e -> PossibleResult EdgeNr
59 chooseRandom lAPs _ = Result $ head lAPs
63 chooseWRINF :: [EdgeNr] -> Document g n e -> PossibleResult EdgeNr
65 case filter isInterfaceNode $ getNodeAssocs network of
67 if (isTheInterfaceActivePair (dd palette network interface) palette network)
68 then InfoD "WRINF is done" "Nothing to be done using WRINF strategy"
69 else case walk palette network [] interface of
70 Nothing -> InfoD "WRINF is done" "Nothing to be done using WRINF strategy"
72 where network = getNetwork doc
73 palette = getPalette doc
75 walk :: Palette n -> Network g n e -> [NodeNr] -> NodeNr -> Maybe EdgeNr
76 walk palette network visited node_start | (node_start `elem` visited) = Nothing
77 | otherwise = let pp = filter (isPrincipalPort palette network node_start . fst)
78 . fromMaybe [] $ getPorts palette network node_start
81 [(x,_)] -> let edgeOnPPort = edgeConnectedOnPort network node_start x;
82 in case edgeOnPPort of
83 (Just e) -> if (isActivePair e palette network )
85 else let next_node = fst . fromJust $ otherExtremeOfEdgeConnectedOnPort network node_start x
86 in walk palette network (node_start:visited) next_node;
89 dd :: Palette n -> Network g n e -> NodeNr -> EdgeNr
90 dd palette nt nr = let por = map fst . fromMaybe [] $ getPorts palette nt nr
91 in head . catMaybes $ map (edgeConnectedOnPort nt nr ) por
95 -- chooseNewStrategy :: [EdgeNr] -> Document g n e -> PossibleResult EdgeNr