INblobs-0.1.1: src/INReductionStrategies.hs

-- | 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