module HAHP.Reporting where
import Data.List
import qualified Data.Map as M
import Data.Time
import HAHP.Data
import Numeric.LinearAlgebra.HMatrix
import Text.Printf
reportHeader :: String
-> String
-> UTCTime
-> String
reportHeader title author time = unlines
[ "% " ++ title
, "% " ++ author
, "% " ++ showGregorian(utctDay time)
]
simpleSummary :: (AHPDataSet, [TreeError], [AlternativesError])
-> String
simpleSummary ((ahpTree, alts), treeErrors, altsErrors) = treeSummary ++ altSummary ++ errorSummary ++ "\\newpage \n"
where treeSummary = showConfiguration ahpTree
altSummary = showAlternatives alts
errorSummary = showErrors treeErrors altsErrors
showConfiguration :: AHPTree
-> String
showConfiguration ahpTree = unlines $
[ "# Configuration \"" ++ name ahpTree ++ "\""
, ""
, "## AHP tree preview"
, ""
]
++
lines (showAhpTree ahpTree)
showErrors :: [TreeError]
-> [AlternativesError]
-> String
showErrors treeErrors altsErrors = unlines $
[ ""
, "## Input data validation"
, ""
, "### Summary"
, ""
, if null treeErrors
then "This tree is valid"
else "This tree is NOT valid"
, ""
, if null altsErrors
then "Theses alternatives are valid"
else "Theses alternatives are NOT valid"
, ""
, "### Tree errors"
, ""
]
++
lines (concatMap showTreeError treeErrors)
++
[ ""
, "### Alternatives errors"
, ""
]
++
lines (concatMap showAltsError altsErrors)
showTreeError :: TreeError
-> String
showTreeError validationError = "* in \"" ++ (name . ahpTree $ validationError) ++ "\": " ++
case validationError of
(ConsistencyError ahpTree consistencyTreshold consistency) ->
"too much unconsistency, $value = " ++ printf "%.4f" consistency ++ "$, $treshold = " ++ show consistencyTreshold ++ "$\n"
(ChildrenUnicityError ahpTree repeated) ->
"repeated children names: " ++ show repeated ++ "\n"
(InverseError ahpTree) ->
"preference values $M(i,j) \\neq \\dfrac{1}{M(j,i)}$" ++ "\n"
(LeavesUnicityError ahpTree repeated) ->
"repeated leaves names: " ++ show repeated ++ "\n"
(NotComputedConsistencyError ahpTree) ->
"consistency not computed !" ++ "\n"
(NotUnitaryDiagError ahpTree) ->
"diagonal is not '1'" ++ "\n"
(NullDivisionError ahpTree) ->
"divide by zero !" ++ "\n"
(ParentChildrenSizeMismatchError ahpTree parent children) ->
"parent and child size mismatch, $parent size = " ++ show parent ++ "$, $children size = " ++ show children ++ "$\n"
(PositivePreferenceError ahpTree) ->
"one or more preference value is $\\leq 0$ !" ++ "\n"
(SquareMatrixError ahpTree rows cols) ->
"matrix not square, $rows = " ++ show rows ++ "$, $columns = " ++ show cols ++ "$\n"
showAltsError :: AlternativesError
-> String
showAltsError altError = "* " ++
case altError of
NoAlternativesError ->
"no alternatives !" ++ "\n"
(AlternativesUnicityError names) ->
"repeated alternatives names: " ++ show names ++ "\n"
(IndicatorsValuesExistenceError errors) ->
"missing indicators values:" ++ show (map (\x -> ((altName . fst) x, snd x)) errors) ++ "\n"
showAlternatives :: [Alternative]
-> String
showAlternatives alts = unlines $
[ ""
, "## Alternatives values"
, ""
]
++
lines (concatMap (showAlternative 0) alts)
showAlternative :: Int
-> Alternative
-> String
showAlternative level a = unlines $
(tabs ++ "1. " ++ altName a)
:
lines (showIndicatorValues (level + 1) (indValues a))
where tabs = variableTabs level
showIndicatorValues :: Int
-> IndicatorValues
-> String
showIndicatorValues level values = unlines $
[ tabs ++ ""
, tabs ++ "| Indicator | Value |"
, tabs ++ "|-----------|-------|"
]
++
map (showIndicatorValue level) (M.toList values)
++
[""]
where tabs = variableTabs level
showIndicatorValue :: Int -> (String, Double) -> String
showIndicatorValue level (key, value) = tabs ++ "| " ++ key ++ " | " ++ show value ++ " |"
where tabs = variableTabs level
showAhpTree :: AHPTree -> String
showAhpTree = showAhpSubTree 0
showAhpSubTree :: Int -> AHPTree -> String
showAhpSubTree level (AHPTree name prefMatrix consistency childrenPriority alternativesPriority children) = unlines $
[ tabs ++ "* Tree : " ++ name
, tabs ++ "\t- pairwise comparison matrix :"
, tabs
]
++
lines (showMatrix (level + 2) prefMatrix)
++
[ tabs ++ "\t- consistency ratio = " ++ maybe "N/A" show consistency
, tabs ++ "\t- children priority vector :"
, tabs
]
++
lines (maybe (variableTabs (level + 2) ++ "N/A") (showMatrix (level + 2)) childrenPriority)
++
[ tabs ++ "\t- alternatives priority vector :"
, tabs
]
++
lines (maybe (variableTabs (level + 2) ++ "N/A") (showMatrix (level + 2)) alternativesPriority)
++
lines (concatMap (showAhpSubTree (level + 1)) children)
where tabs = variableTabs level
showAhpSubTree level (AHPLeaf name maximize alternativesPriority) = unlines $
[ tabs ++ "* Leaf : " ++ name
, tabs ++ "\t- " ++ (if maximize then "indicator is maximized" else "indicator is minimized")
, tabs ++ "\t- alternatives priority vector :"
, tabs
]
++
lines (maybe (variableTabs (level + 2) ++ "N/A") (showMatrix (level + 1)) alternativesPriority)
where tabs = variableTabs level
showMatrix :: Int -> Matrix Double -> String
showMatrix level = showMatrix' (level + 2)
showMatrix' :: Int -> Matrix Double -> String
showMatrix' level matrix = concatMap showMatrixLine lists
where lists = toLists matrix
showMatrixLine line = variableTabs level ++ " | " ++
concatMap (\x -> printf "%.4f" x ++ " ") line ++
"|\n"
variableTabs :: Int -> String
variableTabs level = replicate level '\t'