-- | If someone wants to give a new reduction strategy have to: -- -- 1. add a new entry in @strategiesList@ (e.g. @(\"New Strategy string\", choose_NewStrategy_function)@) -- -- 2. define @choose_NewStrategy_function :: [EdgeNr] -> Document g n e -> PossibleResult EdgeNr@ module INReductionStrategies where import Document import Network import INRule import Palette import Data.Maybe data PossibleResult a = Result a | ErrorD String String | InfoD String String -- | Checks if the given edge is an active pair. isActivePair :: EdgeNr -> Palette n -> Network g n e -> Bool isActivePair edgeNr palette network = isPrincipalPort palette network nodeNrFrom portFrom && isPrincipalPort palette network nodeNrTo portTo && not (isInterfaceNode (nodeNrFrom, getNode nodeNrFrom network) ) && not (isInterfaceNode (nodeNrTo, getNode nodeNrTo network) ) where edge = getEdge edgeNr network (nodeNrFrom, portFrom) = getFullPortFrom edge (nodeNrTo, portTo) = getFullPortTo edge -- | Checks if an interface node is connected through an active pair. isTheInterfaceActivePair :: EdgeNr -> Palette n -> Network g n e -> Bool isTheInterfaceActivePair edgeNr palette network = isPrincipalPort palette network nodeNrFrom portFrom && isPrincipalPort palette network nodeNrTo portTo where edge = getEdge edgeNr network (nodeNrFrom, portFrom) = getFullPortFrom edge (nodeNrTo, portTo) = getFullPortTo edge type Strategy = String -- | List of pairs (Strategy name, strategy choose function) strategiesList :: [(Strategy -- strategy name , [EdgeNr] -- none empty list of all active pairs in the network -> Document g n e -- document -> PossibleResult EdgeNr -- edgeNr to reduce or thrown error message )] strategiesList = [ ("Manual selection", chooseManualSelection) , ("Random", chooseRandom) , ("WRINF", chooseWRINF) ] chooseManualSelection :: [EdgeNr] -> Document g n e -> PossibleResult EdgeNr chooseManualSelection _ doc = case getSelection doc of EdgeSelection Net edgeNr -> Result edgeNr _ -> ErrorD "Reduction error" "Please select an active pair first and press 'REDUCE' again." chooseRandom :: [EdgeNr] -> Document g n e -> PossibleResult EdgeNr chooseRandom lAPs _ = Result $ head lAPs -- | WRINF Strategy chooseWRINF :: [EdgeNr] -> Document g n e -> PossibleResult EdgeNr chooseWRINF _ doc = case filter isInterfaceNode $ getNodeAssocs network of [(interface,_)] -> if (isTheInterfaceActivePair (dd palette network interface) palette network) then InfoD "WRINF is done" "Nothing to be done using WRINF strategy" else case walk palette network [] interface of Nothing -> InfoD "WRINF is done" "Nothing to be done using WRINF strategy" Just e -> Result e where network = getNetwork doc palette = getPalette doc walk :: Palette n -> Network g n e -> [NodeNr] -> NodeNr -> Maybe EdgeNr walk palette network visited node_start | (node_start `elem` visited) = Nothing | otherwise = let pp = filter (isPrincipalPort palette network node_start . fst) . fromMaybe [] $ getPorts palette network node_start in case pp of [] -> Nothing [(x,_)] -> let edgeOnPPort = edgeConnectedOnPort network node_start x; in case edgeOnPPort of (Just e) -> if (isActivePair e palette network ) then (Just e) else let next_node = fst . fromJust $ otherExtremeOfEdgeConnectedOnPort network node_start x in walk palette network (node_start:visited) next_node; _ -> Nothing; dd :: Palette n -> Network g n e -> NodeNr -> EdgeNr dd palette nt nr = let por = map fst . fromMaybe [] $ getPorts palette nt nr in head . catMaybes $ map (edgeConnectedOnPort nt nr ) por -- END of WRINF -- chooseNewStrategy :: [EdgeNr] -> Document g n e -> PossibleResult EdgeNr