According to the design-location document (Improving location awareness)
cluster metric is extended by the component

- The number of pairs of exclusion tags and common-failure tags where
  there exist at least two instances with the given exclusion tag with
  the primary node having the given common-failure tag.

Also this patch fixes Statistics.hs test in order to work with new
Statistics because the test is broken by the changes in Statistics.hs.

Signed-off-by: Oleg Ponomarev <[email protected]>
---
 src/Ganeti/HTools/Cluster/Metrics.hs    | 27 +++++++-----
 src/Ganeti/HTools/Node.hs               | 41 ++++++++++++++----
 src/Ganeti/Utils/Statistics.hs          | 74 ++++++++++++++++++++++++++-------
 test/hs/Test/Ganeti/Utils/Statistics.hs |  6 ++-
 4 files changed, 113 insertions(+), 35 deletions(-)

diff --git a/src/Ganeti/HTools/Cluster/Metrics.hs 
b/src/Ganeti/HTools/Cluster/Metrics.hs
index 2d909ad..a1681ee 100644
--- a/src/Ganeti/HTools/Cluster/Metrics.hs
+++ b/src/Ganeti/HTools/Cluster/Metrics.hs
@@ -63,7 +63,8 @@ reservedMemRtotalCoeff = 0.25
 -- | The names and weights of the individual elements in the CV list, together
 -- with their statistical accumulation function and a bit to decide whether it
 -- is a statistics for online nodes.
-detailedCVInfoExt :: [((Double, String), ([Double] -> Statistics, Bool))]
+detailedCVInfoExt :: [((Double, String)
+                     , ([AggregateComponent] -> Statistics, Bool))]
 detailedCVInfoExt = [ ((0.5,  "free_mem_cv"), (getStdDevStatistics, True))
                     , ((0.5,  "free_disk_cv"), (getStdDevStatistics, True))
                     , ((1,  "n1_cnt"), (getSumStatistics, True))
@@ -85,6 +86,8 @@ detailedCVInfoExt = [ ((0.5,  "free_mem_cv"), 
(getStdDevStatistics, True))
                       , (getStdDevStatistics, True))
                     , ((0.5,  "spindles_cv_forth"), (getStdDevStatistics, 
True))
                     , ((1,  "location_score"), (getSumStatistics, True))
+                    , ( (1,  "location_exclusion_score")
+                      , (getMapStatistics, True))
                     , ( (reservedMemRtotalCoeff,  "reserved_mem_rtotal")
                       , (getSumStatistics, True))
                     ]
@@ -115,7 +118,7 @@ detailedCVWeights :: [Double]
 detailedCVWeights = map fst detailedCVInfo
 
 -- | The aggregation functions for the weights
-detailedCVAggregation :: [([Double] -> Statistics, Bool)]
+detailedCVAggregation :: [([AggregateComponent] -> Statistics, Bool)]
 detailedCVAggregation = map snd detailedCVInfoExt
 
 -- | The bit vector describing which parts of the statistics are
@@ -124,7 +127,7 @@ detailedCVOnlineStatus :: [Bool]
 detailedCVOnlineStatus = map snd detailedCVAggregation
 
 -- | Compute statistical measures of a single node.
-compDetailedCVNode :: Node.Node -> [Double]
+compDetailedCVNode  :: Node.Node -> [AggregateComponent]
 compDetailedCVNode node =
   let mem = Node.pMem node
       memF = Node.pMemForth node
@@ -147,12 +150,17 @@ compDetailedCVNode node =
       spindles = Node.instSpindles node / Node.hiSpindles node
       spindlesF = Node.instSpindlesForth node / Node.hiSpindles node
       location_score = fromIntegral $ Node.locationScore node
-  in [ mem, dsk, n1, res, ioff, ipri, cpu
-     , c_load, m_load, d_load, n_load
-     , pri_tags, spindles
-     , memF, dskF, cpuF, spindlesF
-     , location_score
-     , res
+      location_exclusion_score = Node.instanceMap node
+  in [ SimpleNumber mem, SimpleNumber dsk, SimpleNumber n1, SimpleNumber res
+     , SimpleNumber ioff, SimpleNumber ipri, SimpleNumber cpu
+     , SimpleNumber c_load, SimpleNumber m_load, SimpleNumber d_load
+     , SimpleNumber n_load
+     , SimpleNumber pri_tags, SimpleNumber spindles
+     , SimpleNumber memF, SimpleNumber dskF, SimpleNumber cpuF
+     , SimpleNumber spindlesF
+     , SimpleNumber location_score
+     , SpreadValues location_exclusion_score
+     , SimpleNumber res
      ]
 
 -- | Compute the statistics of a cluster.
@@ -218,4 +226,3 @@ printStats lp nl =
                          , printf "x%.2f" w
                          ]) hd
   in printTable lp header formatted $ False:repeat True
-
diff --git a/src/Ganeti/HTools/Node.hs b/src/Ganeti/HTools/Node.hs
index 1a2f261..79993ad 100644
--- a/src/Ganeti/HTools/Node.hs
+++ b/src/Ganeti/HTools/Node.hs
@@ -210,6 +210,9 @@ data Node = Node
                                    -- to
   , locationScore :: Int -- ^ Sum of instance location and desired location
                          -- scores
+  , instanceMap :: Map.Map (String, String) Int -- ^ Number of instances with
+                                                -- each exclusion/location tags
+                                                -- pair
   } deriving (Show, Eq)
 {- A note on how we handle spindles
 
@@ -251,23 +254,23 @@ noSecondary = -1
 
 -- * Helper functions
 
--- | Add a tag to a tagmap.
-addTag :: TagMap -> String -> TagMap
+-- | Add a value to a map.
+addTag :: (Ord k) => Map.Map k Int -> k -> Map.Map k Int
 addTag t s = Map.insertWith (+) s 1 t
 
--- | Add multiple tags.
-addTags :: TagMap -> [String] -> TagMap
+-- | Add multiple values.
+addTags :: (Ord k) => Map.Map k Int -> [k] -> Map.Map k Int
 addTags = foldl' addTag
 
--- | Adjust or delete a tag from a tagmap.
-delTag :: TagMap -> String -> TagMap
+-- | Adjust or delete a value from a map.
+delTag :: (Ord k) => Map.Map k Int -> k -> Map.Map k Int
 delTag t s = Map.update (\v -> if v > 1
                                  then Just (v-1)
                                  else Nothing)
              s t
 
--- | Remove multiple tags.
-delTags :: TagMap -> [String] -> TagMap
+-- | Remove multiple value.
+delTags :: (Ord k) => Map.Map k Int -> [k] -> Map.Map k Int
 delTags = foldl' delTag
 
 -- | Check if we can add a list of tags to a tagmap.
@@ -374,6 +377,7 @@ create name_init mem_t_init mem_n_init mem_f_init
        , rmigTags = Set.empty
        , locationTags = Set.empty
        , locationScore = 0
+       , instanceMap = Map.empty
        }
 
 -- | Conversion formula from mDsk\/tDsk to loDsk.
@@ -546,6 +550,15 @@ getInstanceDsrdLocScore p t =
           Set.size instTags - Set.size ( instTags `Set.intersection` nodeTags )
         -- this way we get the number of unsatisfied desired locations
 
+-- | Returns list of all pairs of node location and instance
+-- exclusion tags.
+getLocationExclusionPairs :: Node -- ^ the primary node of the instance
+                           -> Instance.Instance -- ^ the instance
+                           -> [(String, String)]
+getLocationExclusionPairs p inst =
+  [(loc, excl) | loc <- Set.toList (locationTags p)
+               , excl <- Instance.exclTags inst]
+
 -- | Assigns an instance to a node as primary and update the used VCPU
 -- count, utilisation data, tags map and desired location score.
 setPri :: Node -> Instance.Instance -> Node
@@ -560,6 +573,7 @@ setPri t inst
           , instSpindles = calcSpindleUse True t inst
           , locationScore = locationScore t + Instance.locationScore inst
                             + getInstanceDsrdLocScore t inst
+          , instanceMap = new_instance_map
           }
 
   -- Forthcoming instance, update forthcoming fields only.
@@ -569,6 +583,8 @@ setPri t inst
     new_count = Instance.applyIfOnline inst (+ Instance.vcpus inst) (uCpu t)
     new_count_forth = Instance.applyIfOnline inst (+ Instance.vcpus inst)
                                              (uCpuForth t)
+    new_instance_map = addTags (instanceMap t)
+                     $ getLocationExclusionPairs t inst
 
     uses_disk = Instance.usesLocalStorage inst
 
@@ -750,6 +766,9 @@ removePri t inst =
                 new_rcpu = fromIntegral new_ucpu / tCpu t
                 new_load = utilLoad t `T.subUtil` Instance.util inst
 
+                new_instance_map = delTags (instanceMap t)
+                                 $ getLocationExclusionPairs t inst
+
             in updateForthcomingFields $
                  t { pList = new_plist, fMem = new_mem, fDsk = new_dsk
                    , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp
@@ -758,6 +777,7 @@ removePri t inst =
                    , locationScore = locationScore t
                                      - Instance.locationScore inst
                                      - getInstanceDsrdLocScore t inst
+                   , instanceMap = new_instance_map
                    }
 
 -- | Removes a secondary instance.
@@ -847,7 +867,6 @@ addPriEx force t inst =
       l_cpu = T.iPolicyVcpuRatio $ iPolicy t
       old_tags = pTags t
       strict = not force
-
       inst_tags = Instance.exclTags inst
 
       new_mem_forth = fMemForth t - Instance.mem inst
@@ -910,6 +929,9 @@ addPriEx force t inst =
 
                new_plist = iname:pList t
                new_mp = fromIntegral new_mem / tMem t
+
+               new_instance_map = addTags (instanceMap t)
+                                $ getLocationExclusionPairs t inst
       in case () of
         _ | new_mem <= 0 -> Bad T.FailMem
           | uses_disk && new_dsk <= 0 -> Bad T.FailDisk
@@ -939,6 +961,7 @@ addPriEx force t inst =
                   , locationScore = locationScore t
                                     + Instance.locationScore inst
                                     + getInstanceDsrdLocScore t inst
+                  , instanceMap = new_instance_map
                   }
 
 -- | Adds a secondary instance (basic version).
diff --git a/src/Ganeti/Utils/Statistics.hs b/src/Ganeti/Utils/Statistics.hs
index 826a906..7057973 100644
--- a/src/Ganeti/Utils/Statistics.hs
+++ b/src/Ganeti/Utils/Statistics.hs
@@ -35,53 +35,99 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 module Ganeti.Utils.Statistics
   ( Statistics
+  , TagTagMap
+  , AggregateComponent(..)
   , getSumStatistics
   , getStdDevStatistics
+  , getMapStatistics
   , getStatisticValue
   , updateStatistics
   ) where
 
+import qualified Data.Foldable as Foldable
 import Data.List (foldl')
+import qualified Data.Map as Map
+
+-- | Type to store the number of instances for each exclusion and location
+-- pair. This is necessary to calculate second component of location score.
+type TagTagMap = Map.Map (String, String) Int
 
 -- | Abstract type of statistical accumulations. They behave as if the given
 -- statistics were computed on the list of values, but they allow a potentially
 -- more efficient update of a given value.
 data Statistics = SumStatistics Double
-                | StdDevStatistics Double Double Double deriving Show
+                | StdDevStatistics Double Double Double
                   -- count, sum, and not the sum of squares---instead the
                   -- computed variance for better precission.
+                | MapStatistics TagTagMap deriving Show
+
+-- | Abstract type of per-node statistics measures. The SimpleNumber is used
+-- to construct SumStatistics and StdDevStatistics while SpreadValues is used
+-- to construct MapStatistics.
+data AggregateComponent = SimpleNumber Double
+                        | SpreadValues TagTagMap
+-- Each function below depends on the contents of AggregateComponent but it's
+-- necessary to define each function as a function processing both
+-- SimpleNumber and SpreadValues instances (see Metrics.hs). That's why
+-- pattern matches for invalid type defined as functions which change nothing.
 
 -- | Get a statistics that sums up the values.
-getSumStatistics :: [Double] -> Statistics
-getSumStatistics = SumStatistics . sum
+getSumStatistics :: [AggregateComponent] -> Statistics
+getSumStatistics xs =
+  let addComponent s (SimpleNumber x) =
+        let !s' = s + x
+        in s'
+      addComponent s _ = s
+      st = foldl' addComponent 0 xs
+  in SumStatistics st
 
 -- | Get a statistics for the standard deviation.
-getStdDevStatistics :: [Double] -> Statistics
+getStdDevStatistics :: [AggregateComponent] -> Statistics
 getStdDevStatistics xs =
-  let (nt, st) = foldl' (\(n, s) x ->
-                            let !n' = n + 1
-                                !s' = s + x
-                            in (n', s'))
-                 (0, 0) xs
+  let addComponent (n, s) (SimpleNumber x) =
+        let !n' = n + 1
+            !s' = s + x
+        in (n', s')
+      addComponent (n, s) _ = (n, s)
+      (nt, st) = foldl' addComponent (0, 0) xs
       mean = st / nt
-      nvar = foldl' (\v x -> let d = x - mean in v + d * d) 0 xs
+      center (SimpleNumber x) = x - mean
+      center _ = 0
+      nvar = foldl' (\v x -> let d = center x in v + d * d) 0 xs
   in StdDevStatistics nt st (nvar / nt)
 
+-- | Get a statistics for the standard deviation.
+getMapStatistics :: [AggregateComponent] -> Statistics
+getMapStatistics xs =
+  let addComponent m (SpreadValues x) =
+        let !m' = Map.unionWith (+) m x
+        in m'
+      addComponent m _ = m
+      mt = foldl' addComponent Map.empty xs
+  in MapStatistics mt
+
 -- | Obtain the value of a statistics.
 getStatisticValue :: Statistics -> Double
 getStatisticValue (SumStatistics s) = s
 getStatisticValue (StdDevStatistics _ _ var) = sqrt var
+getStatisticValue (MapStatistics m) = fromIntegral $ Foldable.sum m - Map.size 
m
+-- Function above calculates sum (N_i - 1) over each map entry.
 
 -- | In a given statistics replace on value by another. This
 -- will only give meaningful results, if the original value
 -- was actually part of the statistics.
-updateStatistics :: Statistics -> (Double, Double) -> Statistics
-updateStatistics (SumStatistics s) (x, y) = SumStatistics $ s +  (y - x)
-updateStatistics (StdDevStatistics n s var) (x, y) =
+updateStatistics :: Statistics -> (AggregateComponent, AggregateComponent) ->
+                    Statistics
+updateStatistics (SumStatistics s) (SimpleNumber x, SimpleNumber y) =
+  SumStatistics $ s + (y - x)
+updateStatistics (StdDevStatistics n s var) (SimpleNumber x, SimpleNumber y) =
   let !ds = y - x
       !dss = y * y - x * x
       !dnnvar = (n * dss - 2 * s * ds) - ds * ds
       !s' = s + ds
       !var' = max 0 $ var + dnnvar / (n * n)
   in StdDevStatistics n s' var'
-
+updateStatistics (MapStatistics m) (SpreadValues x, SpreadValues y) =
+  let nm = Map.unionWith (+) (Map.unionWith (-) m x) y
+  in MapStatistics nm
+updateStatistics s _ = s
diff --git a/test/hs/Test/Ganeti/Utils/Statistics.hs 
b/test/hs/Test/Ganeti/Utils/Statistics.hs
index a74d6e4..f39546b 100644
--- a/test/hs/Test/Ganeti/Utils/Statistics.hs
+++ b/test/hs/Test/Ganeti/Utils/Statistics.hs
@@ -54,8 +54,10 @@ prop_stddev_update =
   forAll (choose (1, 6) >>= flip vectorOf (choose (0, 1))) $ \ys ->
   let original = xs ++ [a] ++ ys
       modified = xs ++ [b] ++ ys
-      with_update = getStatisticValue
-                    $ updateStatistics (getStdDevStatistics original) (a,b)
+      with_update =
+        getStatisticValue
+        $ updateStatistics (getStdDevStatistics $ map SimpleNumber original)
+                           (SimpleNumber a, SimpleNumber b)
       direct = stdDev modified
   in counterexample ("Value computed by update " ++ show with_update
                      ++ " differs too much from correct value " ++ show direct)
-- 
1.9.1

Reply via email to