packages feed

hahp 0.1.2 → 0.1.3

raw patch · 13 files changed

+168/−49 lines, 13 filesdep +random

Dependencies added: random

Files

hahp-example/Main.hs view
@@ -3,6 +3,7 @@ import           Data.Time import           HAHP.Algorithm import           HAHP.Data+import           HAHP.Generator import           HAHP.Reporting import           HAHP.Sample.Config1 import           HAHP.Sample.Config2@@ -19,8 +20,10 @@                         --, (sampleAHPConfig2, sampleAlternatives2)                         --, (sampleAHPConfig3, sampleAlternatives3)                         --, (smeConfig, smeAlternatives)-                        (leaderChoiceTree, leaderChoiceAlternatives)-                        , (carChoiceTree, carChoiceAlternatives)+                        --, (leaderChoiceTree, leaderChoiceAlternatives)+                        --, (carChoiceTree, carChoiceAlternatives)+                        generateDataSet $ GeneratorParameters True 3 3 100+                        ,generateDataSet $ GeneratorParameters False 3 3 100                         ]      time <- getCurrentTime@@ -28,5 +31,5 @@     putStrLn ""     mapM_ (putStrLn . simpleAHPSummary) inputDataSets -simpleAHPSummary :: (AHPTree, [Alternative]) -> String-simpleAHPSummary (ahpTree, alts) = simpleSummary $ simpleAHP ahpTree alts+simpleAHPSummary :: AHPDataSet -> String+simpleAHPSummary dataSet = simpleSummary . simpleAHP $ dataSet
hahp.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/  name:                hahp-version:             0.1.2+version:             0.1.3 synopsis:            Analytic Hierarchy Process description:         Analytic Hierarchy Process implementation. license:             AGPL-3@@ -22,7 +22,7 @@ library   -- other-modules:          -- other-extensions:    -  build-depends:       base >=4.7 && <5 , containers, hmatrix, parallel, time+  build-depends:       base >=4.7 && <5 , containers, hmatrix, parallel, random, time   hs-source-dirs:      src   default-language:    Haskell2010   exposed-modules:@@ -31,6 +31,7 @@     HAHP.Algorithm.PriorityVector     HAHP.Algorithm.Ranking     HAHP.Data+    HAHP.Generator     HAHP.Reporting     HAHP.Sample.Config1     HAHP.Sample.Config2@@ -40,6 +41,7 @@     HAHP.Sample.SquareMatrixError     HAHP.Validation.Alternatives     HAHP.Validation.Tree+    HAHP.Validation.Unique  executable hahp-example   main-is:             Main.hs
src/HAHP/Algorithm.hs view
@@ -14,18 +14,18 @@ -- |This function is a quick way to rank a set of alternatives with AHP algorithm. -- This function call everithing required to configure an execute AHP process. -- If something goes wrong, an error is raised.-simpleAHP :: AHPTree-          -> [Alternative]-          -> (AHPTree, [Alternative], [TreeError], [AlternativesError])-simpleAHP ahpTree alts =+simpleAHP :: AHPDataSet+          -> (AHPDataSet, [TreeError], [AlternativesError])+simpleAHP inputDataSet =     if null inputTreeErrors && null altsErrors-      then (completeTree, ranking, treeErrors, [])-      else (ahpTree, alts, inputTreeErrors ++ treeErrors, altsErrors)-    where initializedTree = initAHP ahpTree-          (completeTree, ranking) = rankAlternatives initializedTree alts+      then (processedDataSet, treeErrors, [])+      else (inputDataSet, inputTreeErrors ++ treeErrors, altsErrors)+    where (ahpTree, alts) = inputDataSet+          initializedTree = initAHP ahpTree+          processedDataSet = rankAlternatives (initializedTree, alts)           ---           inputTreeErrors = validateInputAHPTree ahpTree-          altsErrors = validateAlternatives ahpTree alts+          altsErrors = validateAlternatives inputDataSet           treeErrors = if null inputTreeErrors                          then validateAHPTree initializedTree                          else []@@ -38,13 +38,12 @@  -- * Part 2 = dynamic part -rankAlternatives :: AHPTree-                 -> [Alternative]-                 -> (AHPTree, [Alternative])-rankAlternatives ahpTree alts = (rankedAhpTree, reverse sortedRankedAlternatives)-    where ranks = concat . toLists . fromJust $ alternativesPriority rankedAhpTree+rankAlternatives :: AHPDataSet+                 -> AHPDataSet+rankAlternatives (ahpTree, alts) = (rankedAhpTree, sortedRankedAlternatives)+    where ranks = concat . toLists . fromJust . alternativesPriority $ rankedAhpTree           rankedAhpTree = computeTreeAlternativesPriorities alts ahpTree-          sortedRankedAlternatives = map fst . sortOn' snd $ zip alts ranks+          sortedRankedAlternatives = reverse . map fst . sortOn' snd $ zip alts ranks  -- | Sort a list by comparing the results of a key function applied to each -- element.  @sortOn f@ is equivalent to @sortBy . comparing f@, but has the
src/HAHP/Algorithm/Consistency.hs view
@@ -3,6 +3,7 @@     computeTreeConsistencies     ) where +import           Control.Parallel.Strategies import           HAHP.Data import           Numeric.LinearAlgebra.HMatrix @@ -13,7 +14,7 @@     case ahpTree of         (AHPTree _ prefMat _ _ _ children) -> ahpTree             { consistencyValue = Just $ matrixConsistency prefMat-            , children = map computeTreeConsistencies children+            , children = parMap rseq computeTreeConsistencies children             }         AHPLeaf {} -> ahpTree
src/HAHP/Algorithm/PriorityVector.hs view
@@ -4,6 +4,7 @@     priorityVector     ) where +import           Control.Parallel.Strategies import           HAHP.Data import           Numeric.LinearAlgebra.HMatrix @@ -12,7 +13,8 @@     case ahpTree of         (AHPTree _ prefMat _ _ _ children) -> ahpTree             { childrenPriority = Just $ priorityVector prefMat-            , children = map computeTreePriorityVectors children+            , children = parMap rseq computeTreePriorityVectors children+            --, children = map computeTreePriorityVectors children             }         AHPLeaf {} -> ahpTree
src/HAHP/Algorithm/Ranking.hs view
@@ -1,5 +1,6 @@ module HAHP.Algorithm.Ranking where +import           Control.Parallel.Strategies import           Data.List import qualified Data.Map                      as M import           Data.Maybe@@ -25,14 +26,14 @@  computeChildrenTreeAlternativesPriorities :: [Alternative] -> AHPTree -> AHPTree computeChildrenTreeAlternativesPriorities alts ahpTree = ahpTree {-        children = map (computeTreeAlternativesPriorities alts) (children ahpTree)+        children = parMap rseq (computeTreeAlternativesPriorities alts) (children ahpTree)     }  -- * Computation function  agregatePriorities :: AHPTree -> PriorityVector agregatePriorities ahpTree = catChildVectors <> childPriorities-    where childVectors = map (fromJust . alternativesPriority) (children ahpTree)+    where childVectors = parMap rseq (fromJust . alternativesPriority) (children ahpTree)           catChildVectors = foldl1 (|||) childVectors           childPriorities = fromJust . childrenPriority $ ahpTree @@ -43,8 +44,9 @@  buildAlternativePairwiseMatrix :: AHPTree -> [Alternative] -> Matrix Double buildAlternativePairwiseMatrix ahpTree alts = (length alts >< length alts) matrix-        where vals = map (selectIndValue (name ahpTree)) alts+        where vals = parMap rseq (selectIndValue (name ahpTree)) alts               cartesianProduct = [(x, y) | x <- vals, y <- vals]+              -- matrix = parMap rseq operator cartesianProduct               matrix = map operator cartesianProduct               operator = if maximize ahpTree                          -- `uncurry` permit the use of an operator on a pair
src/HAHP/Data.hs view
@@ -3,6 +3,16 @@ import           Data.Map                      (Map) import           Numeric.LinearAlgebra.HMatrix +-- * Data set macro type++type AHPDataSet = (AHPTree, [Alternative])++data GeneratorParameters = GeneratorParameters { randomSize :: Bool+                                               , maxTreeLevels :: Int+                                               , maxLevelChildren :: Int+                                               , maxAlternatives :: Int+                                               }+ -- * AHP tree definition  data AHPTree = AHPTree { name                 :: String
+ src/HAHP/Generator.hs view
@@ -0,0 +1,75 @@+module HAHP.Generator where++import           Data.List (insert)+import           Data.Map (empty, singleton, fromList)+import           HAHP.Data+import           Numeric.LinearAlgebra.Data (ident, (><))+import           System.IO.Unsafe+import           System.Random++-- * Data set generator++generateDataSet :: GeneratorParameters+                -> AHPDataSet+generateDataSet params = (ahpTree, alternatives)+    where ahpTree = generateAHPTree params+          alternatives = generateAlternatives params ahpTree++-- * AHP tree generator++generateAHPTree :: GeneratorParameters+                ->AHPTree+generateAHPTree params = generateAHPTree' params levels []+    where levels = if randomSize params+                      then unsafeRandomRIO (1, maxTreeLevels params)+                      else maxTreeLevels params++generateAHPTree' :: GeneratorParameters+                 -> Int+                 -> [Int]+                 -> AHPTree+generateAHPTree' params maxlevels parentIndexes = if (length parentIndexes) + 1 >= maxlevels+                                             then AHPLeaf treeName True Nothing+                                             else AHPTree { name = treeName+                                                          , preferenceMatrix = generateMatrix (childNum)+                                                          , consistencyValue = Nothing+                                                          , childrenPriority = Nothing+                                                          , alternativesPriority = Nothing+                                                          , children = children+                                                          }+  where treeName = if null parentIndexes+                      then "Global Objective"+                      else "Node " ++ (concatMap (\x -> show x ++ ".") parentIndexes)+        childNum = if randomSize params+                      then unsafeRandomRIO (1, maxLevelChildren params)+                      else maxLevelChildren params+        children = take childNum $ map (\x -> generateAHPTree' params maxlevels (parentIndexes ++ [x])) [1..]++generateMatrix :: Int+               -> PairwiseMatrix+generateMatrix size = (size><size) $ repeat 1++-- * Alternatives generator++generateAlternatives :: GeneratorParameters+                     -> AHPTree+                     -> [Alternative]+generateAlternatives params ahpTree = take altsNum randomAlts+  where altsNum = if randomSize params+                     then unsafeRandomRIO (1, maxAlternatives params)+                     else maxAlternatives params+        inds = map name . getTreeLeaves $ ahpTree+        randomAlts = map (generateAlternative inds) [1..]++generateAlternative :: [IndicatorName]+                    -> Int+                    -> Alternative+generateAlternative indNames index = Alternative name values+    where name = "Alternative " ++ show index+          values = fromList $ zip indNames randomValues+          randomValues = unsafePerformIO . sequence . replicate (length indNames) . randomRIO $ (1, 100)++-- * Tools++unsafeRandomRIO :: (Random a) => (a, a) -> a+unsafeRandomRIO range = unsafePerformIO . randomRIO $ range
src/HAHP/Reporting.hs view
@@ -21,9 +21,9 @@     ]  -- | Print a simple report about an AHP tree and ranking result-simpleSummary :: (AHPTree, [Alternative], [TreeError], [AlternativesError]) -- ^ AHP tree, some alternatives and the result of tree validation+simpleSummary :: (AHPDataSet, [TreeError], [AlternativesError]) -- ^ AHP tree, some alternatives and the result of tree validation               -> String                                                     -- ^ Report build from input-simpleSummary (ahpTree, alts, treeErrors, altsErrors) =  treeSummary ++ altSummary ++ errorSummary ++ "\\newpage \n"+simpleSummary ((ahpTree, alts), treeErrors, altsErrors) =  treeSummary ++ altSummary ++ errorSummary ++ "\\newpage \n"     where treeSummary = showConfiguration ahpTree           altSummary = showAlternatives alts           errorSummary = showErrors treeErrors altsErrors
src/HAHP/Sample/CarChoice.hs view
@@ -1,7 +1,7 @@ module HAHP.Sample.CarChoice where -import Data.Map-import    HAHP.Data+import           Data.Map+import           HAHP.Data import           Numeric.LinearAlgebra.HMatrix  carChoiceTree :: AHPTree
src/HAHP/Sample/LeaderChoice.hs view
@@ -1,7 +1,7 @@ module HAHP.Sample.LeaderChoice where -import Data.Map-import    HAHP.Data+import           Data.Map+import           HAHP.Data import           Numeric.LinearAlgebra.HMatrix  leaderChoiceTree :: AHPTree
src/HAHP/Validation/Alternatives.hs view
@@ -6,44 +6,39 @@ import           HAHP.Data import           HAHP.Validation.Unique -validateAlternatives :: AHPTree-                     -> [Alternative]+validateAlternatives :: AHPDataSet                      -> [AlternativesError]-validateAlternatives ahpTree alts = validate' ahpTree alts testsList+validateAlternatives dataSet = validate' dataSet testsList -validate' :: AHPTree-          -> [Alternative]-          -> [AHPTree -> [Alternative] -> Maybe AlternativesError]+validate' :: AHPDataSet+          -> [AHPDataSet -> Maybe AlternativesError]           -> [AlternativesError]-validate' ahpTree alts checks = catMaybes $ parMap rseq (\check -> check ahpTree alts) checks+validate' dataSet checks = catMaybes $ parMap rseq (\check -> check dataSet) checks -testsList :: [AHPTree -> [Alternative] -> Maybe AlternativesError]+testsList :: [AHPDataSet -> Maybe AlternativesError] testsList = [ noAlternativesTest             , alternativesUnicityTest             , indicatorsValuesExistenceTest             ] -noAlternativesTest :: AHPTree-                   -> [Alternative]+noAlternativesTest :: AHPDataSet                    -> Maybe AlternativesError-noAlternativesTest _ alts =+noAlternativesTest (_, alts) =     if not . null $ alts        then Nothing        else Just NoAlternativesError -alternativesUnicityTest :: AHPTree-                        -> [Alternative]+alternativesUnicityTest :: AHPDataSet                         -> Maybe AlternativesError-alternativesUnicityTest _ alts =+alternativesUnicityTest (_, alts) =     if null repeatedAlternativesNames        then Nothing        else Just AlternativesUnicityError {repeatedAlternativesNames = repeatedAlternativesNames}   where repeatedAlternativesNames = repeated . map altName $ alts -indicatorsValuesExistenceTest :: AHPTree-                              -> [Alternative]+indicatorsValuesExistenceTest :: AHPDataSet                               -> Maybe AlternativesError-indicatorsValuesExistenceTest ahpTree alts =+indicatorsValuesExistenceTest (ahpTree, alts) =     if null errors        then Nothing        else Just IndicatorsValuesExistenceError { indValuesErrors = errors}
+ src/HAHP/Validation/Unique.hs view
@@ -0,0 +1,30 @@+module HAHP.Validation.Unique where++--import           Data.List.Unique+import           Data.List (group, sort, sortBy)++-- * Unique++-- TO REMOVE+-- https://hackage.haskell.org/package/Unique-0.4.2/docs/src/Data-List-Unique.html#repeated++sg :: Ord a => [a] -> [[a]]+sg = group . sort++filterByLength :: Ord a => (Int -> Bool) -> [a] -> [[a]]+filterByLength p = filter (p . length) . sg++-- | 'repeated' finds only the elements that are present more than once in the list. Example:+--+-- > repeated  "foo bar" == "o"++repeated :: Ord a => [a] -> [a]+repeated = repeatedBy (>1)++-- | The repeatedBy function behaves just like repeated, except it uses a user-supplied equality predicate.+--+-- > repeatedBy (>2) "This is the test line" == " eist"++repeatedBy :: Ord a => (Int -> Bool) -> [a] -> [a]+repeatedBy p = map head . filterByLength p+