module HAHP.Algorithm.Ranking where
import Control.Parallel.Strategies
import Data.List
import qualified Data.Map as M
import Data.Maybe
import Debug.Trace
import HAHP.Algorithm.PriorityVector
import HAHP.Data
import Numeric.LinearAlgebra.HMatrix
computeTreeAlternativesPriorities :: [Alternative] -> AHPTree -> AHPTree
computeTreeAlternativesPriorities alts ahpTree =
case ahpTree of
AHPTree {} -> agregateTreeAlternativesPriorities . computeChildrenTreeAlternativesPriorities alts $ ahpTree
AHPLeaf {} -> ahpTree
{ alternativesPriority = Just $ computeAlternativesPriority ahpTree alts
}
agregateTreeAlternativesPriorities :: AHPTree -> AHPTree
agregateTreeAlternativesPriorities ahpTree = ahpTree {
alternativesPriority = Just . agregatePriorities $ ahpTree
}
computeChildrenTreeAlternativesPriorities :: [Alternative] -> AHPTree -> AHPTree
computeChildrenTreeAlternativesPriorities alts ahpTree = ahpTree {
children = parMap rseq (computeTreeAlternativesPriorities alts) (children ahpTree)
}
agregatePriorities :: AHPTree -> PriorityVector
agregatePriorities ahpTree = catChildVectors <> childPriorities
where childVectors = parMap rseq (fromJust . alternativesPriority) (children ahpTree)
catChildVectors = foldl1 (|||) childVectors
childPriorities = fromJust . childrenPriority $ ahpTree
computeAlternativesPriority :: AHPTree -> [Alternative] -> PriorityVector
computeAlternativesPriority ahpTree alts = result
where pairwiseAlternatives = buildAlternativePairwiseMatrix ahpTree alts
result = priorityVector pairwiseAlternatives
buildAlternativePairwiseMatrix :: AHPTree -> [Alternative] -> Matrix Double
buildAlternativePairwiseMatrix ahpTree alts = (length alts >< length alts) matrix
where vals = parMap rseq (selectIndValue (name ahpTree)) alts
cartesianProduct = [(x, y) | x <- vals, y <- vals]
matrix = map operator cartesianProduct
operator = if maximize ahpTree
then uncurry (/)
else uncurry (flip (/))
selectIndValue :: IndicatorName -> Alternative -> Double
selectIndValue name alt = selectIndValue' name (M.toList . indValues $ alt)
selectIndValue' :: IndicatorName -> [(IndicatorName, Double)] -> Double
selectIndValue' name values = fromJust (lookup name values)