This patch consist of two parts:
* change Statistics.hs introducing Stat typeclass in order to unify
work with Statistics. This also allow not to write empty stabs for
unwanted types.
* reimplement Metrics.hs in the type safe manner. Also split
the implementation into several files:
1) MetricsComponents.hs file contains MetricComponent data type
describes a metrics component. Each metrics component is
represented by a variable of type MetricComponent.
2) MetricsTH.hs file generates functions dealing with cluster
statistics from given metricComponents list using TemplateHaskell
3) Metrics.hs file contains the others non-template functions and
provides the rest interface
Signed-off-by: Oleg Ponomarev <[email protected]>
---
Makefile.am | 2 +
src/Ganeti/HTools/Cluster/AllocatePrimitives.hs | 6 +-
src/Ganeti/HTools/Cluster/Metrics.hs | 163 ++-----------
src/Ganeti/HTools/Cluster/MetricsComponents.hs | 291 ++++++++++++++++++++++++
src/Ganeti/HTools/Cluster/MetricsTH.hs | 237 +++++++++++++++++++
src/Ganeti/Utils/Statistics.hs | 180 ++++++++-------
test/hs/Test/Ganeti/Utils/Statistics.hs | 4 +-
7 files changed, 641 insertions(+), 242 deletions(-)
create mode 100644 src/Ganeti/HTools/Cluster/MetricsComponents.hs
create mode 100644 src/Ganeti/HTools/Cluster/MetricsTH.hs
diff --git a/Makefile.am b/Makefile.am
index eee2035..b0255fb 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -921,6 +921,8 @@ HS_LIB_SRCS = \
src/Ganeti/HTools/Cluster/AllocationSolution.hs \
src/Ganeti/HTools/Cluster/Evacuate.hs \
src/Ganeti/HTools/Cluster/Metrics.hs \
+ src/Ganeti/HTools/Cluster/MetricsComponents.hs \
+ src/Ganeti/HTools/Cluster/MetricsTH.hs \
src/Ganeti/HTools/Cluster/Moves.hs \
src/Ganeti/HTools/Cluster/Utils.hs \
src/Ganeti/HTools/Container.hs \
diff --git a/src/Ganeti/HTools/Cluster/AllocatePrimitives.hs
b/src/Ganeti/HTools/Cluster/AllocatePrimitives.hs
index 3e90e02..f8e9aa9 100644
--- a/src/Ganeti/HTools/Cluster/AllocatePrimitives.hs
+++ b/src/Ganeti/HTools/Cluster/AllocatePrimitives.hs
@@ -39,14 +39,14 @@ module Ganeti.HTools.Cluster.AllocatePrimitives
import Ganeti.HTools.AlgorithmParams (AlgorithmOptions(..))
import Ganeti.HTools.Cluster.AllocationSolution (AllocElement)
-import Ganeti.HTools.Cluster.Metrics ( compCV, compCVfromStats
+import Ganeti.HTools.Cluster.Metrics ( ClusterStatistics, compCV
+ , compCVfromStats
, updateClusterStatisticsTwice)
import Ganeti.HTools.Cluster.Moves (setInstanceLocationScore)
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
import Ganeti.HTools.Types
-import Ganeti.Utils.Statistics
-- | Tries to allocate an instance on one given node.
allocateOnSingle :: AlgorithmOptions
@@ -65,7 +65,7 @@ allocateOnSingle opts nl inst new_pdx =
-- | Tries to allocate an instance on a given pair of nodes.
allocateOnPair :: AlgorithmOptions
- -> [Statistics]
+ -> ClusterStatistics
-> Node.List -> Instance.Instance -> Ndx -> Ndx
-> OpResult AllocElement
allocateOnPair opts stats nl inst new_pdx new_sdx =
diff --git a/src/Ganeti/HTools/Cluster/Metrics.hs
b/src/Ganeti/HTools/Cluster/Metrics.hs
index a1681ee..4f1e90d 100644
--- a/src/Ganeti/HTools/Cluster/Metrics.hs
+++ b/src/Ganeti/HTools/Cluster/Metrics.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+
{-| Implementation of the cluster metric
-}
@@ -33,7 +35,8 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
module Ganeti.HTools.Cluster.Metrics
- ( compCV
+ ( ClusterStatistics
+ , compCV
, compCVfromStats
, compCVNodes
, compClusterStatistics
@@ -43,54 +46,15 @@ module Ganeti.HTools.Cluster.Metrics
) where
import Control.Monad (guard)
-import Data.List (partition, transpose)
import Data.Maybe (fromMaybe)
-import Text.Printf (printf)
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.PeerMap as P
-import Ganeti.HTools.Types
-import Ganeti.Utils (printTable)
-import Ganeti.Utils.Statistics
-
--- | Coefficient for the total reserved memory in the cluster metric. We
--- use a (local) constant here, as it is also used in the computation of
--- the best possible cluster score.
-reservedMemRtotalCoeff :: Double
-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)
- , ([AggregateComponent] -> Statistics, Bool))]
-detailedCVInfoExt = [ ((0.5, "free_mem_cv"), (getStdDevStatistics, True))
- , ((0.5, "free_disk_cv"), (getStdDevStatistics, True))
- , ((1, "n1_cnt"), (getSumStatistics, True))
- , ((1, "reserved_mem_cv"), (getStdDevStatistics, True))
- , ((4, "offline_all_cnt"), (getSumStatistics, False))
- , ((16, "offline_pri_cnt"), (getSumStatistics, False))
- , ( (0.5, "vcpu_ratio_cv")
- , (getStdDevStatistics, True))
- , ((1, "cpu_load_cv"), (getStdDevStatistics, True))
- , ((1, "mem_load_cv"), (getStdDevStatistics, True))
- , ((1, "disk_load_cv"), (getStdDevStatistics, True))
- , ((1, "net_load_cv"), (getStdDevStatistics, True))
- , ((2, "pri_tags_score"), (getSumStatistics, True))
- , ((0.5, "spindles_cv"), (getStdDevStatistics, True))
- , ((0.5, "free_mem_cv_forth"), (getStdDevStatistics,
True))
- , ( (0.5, "free_disk_cv_forth")
- , (getStdDevStatistics, True))
- , ( (0.5, "vcpu_ratio_cv_forth")
- , (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))
- ]
+import qualified Ganeti.HTools.Cluster.MetricsComponents as M
+import Ganeti.HTools.Cluster.MetricsTH
+
+$(declareStatistics M.metricComponents)
-- | Compute the lower bound of the cluster score, i.e., the sum of the minimal
-- values for all cluster score values that are not 0 on a perfectly balanced
@@ -107,107 +71,19 @@ optimalCVScore nodelist = fromMaybe 0 $ do
optimalUsage = totalDrbdMem / totalMem
optimalUsageOneLessNode = totalDrbdMem / totalMemOneLessNode
relativeReserved = optimalUsageOneLessNode - optimalUsage
- return $ reservedMemRtotalCoeff * relativeReserved
-
--- | The names and weights of the individual elements in the CV list.
-detailedCVInfo :: [(Double, String)]
-detailedCVInfo = map fst detailedCVInfoExt
-
--- | Holds the weights used by 'compCVNodes' for each metric.
-detailedCVWeights :: [Double]
-detailedCVWeights = map fst detailedCVInfo
-
--- | The aggregation functions for the weights
-detailedCVAggregation :: [([AggregateComponent] -> Statistics, Bool)]
-detailedCVAggregation = map snd detailedCVInfoExt
-
--- | The bit vector describing which parts of the statistics are
--- for online nodes.
-detailedCVOnlineStatus :: [Bool]
-detailedCVOnlineStatus = map snd detailedCVAggregation
-
--- | Compute statistical measures of a single node.
-compDetailedCVNode :: Node.Node -> [AggregateComponent]
-compDetailedCVNode node =
- let mem = Node.pMem node
- memF = Node.pMemForth node
- dsk = Node.pDsk node
- dskF = Node.pDskForth node
- n1 = fromIntegral
- $ if Node.failN1 node
- then length (Node.sList node) + length (Node.pList node)
- else 0
- res = Node.pRem node
- ipri = fromIntegral . length $ Node.pList node
- isec = fromIntegral . length $ Node.sList node
- ioff = ipri + isec
- cpu = Node.pCpuEff node
- cpuF = Node.pCpuEffForth node
- DynUtil c1 m1 d1 nn1 = Node.utilLoad node
- DynUtil c2 m2 d2 nn2 = Node.utilPool node
- (c_load, m_load, d_load, n_load) = (c1/c2, m1/m2, d1/d2, nn1/nn2)
- pri_tags = fromIntegral $ Node.conflictingPrimaries node
- spindles = Node.instSpindles node / Node.hiSpindles node
- spindlesF = Node.instSpindlesForth node / Node.hiSpindles node
- location_score = fromIntegral $ Node.locationScore node
- 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.
-compClusterStatistics :: [Node.Node] -> [Statistics]
-compClusterStatistics all_nodes =
- let (offline, nodes) = partition Node.offline all_nodes
- offline_values = transpose (map compDetailedCVNode offline)
- ++ repeat []
- -- transpose of an empty list is empty and not k times the empty list, as
- -- would be the transpose of a 0 x k matrix
- online_values = transpose $ map compDetailedCVNode nodes
- aggregate (f, True) (onNodes, _) = f onNodes
- aggregate (f, False) (_, offNodes) = f offNodes
- in zipWith aggregate detailedCVAggregation
- $ zip online_values offline_values
-
--- | Update a cluster statistics by replacing the contribution of one
--- node by that of another.
-updateClusterStatistics :: [Statistics]
- -> (Node.Node, Node.Node) -> [Statistics]
-updateClusterStatistics stats (old, new) =
- let update = zip (compDetailedCVNode old) (compDetailedCVNode new)
- online = not $ Node.offline old
- updateStat forOnline stat upd = if forOnline == online
- then updateStatistics stat upd
- else stat
- in zipWith3 updateStat detailedCVOnlineStatus stats update
+ return $ $(M.weight M.reservedMemRTotal) * relativeReserved
-- | Update a cluster statistics twice.
-updateClusterStatisticsTwice :: [Statistics]
+updateClusterStatisticsTwice :: ClusterStatistics
-> (Node.Node, Node.Node)
-> (Node.Node, Node.Node)
- -> [Statistics]
+ -> ClusterStatistics
updateClusterStatisticsTwice s a =
updateClusterStatistics (updateClusterStatistics s a)
--- | Compute cluster statistics
-compDetailedCV :: [Node.Node] -> [Double]
-compDetailedCV = map getStatisticValue . compClusterStatistics
-
--- | Compute the cluster score from its statistics
-compCVfromStats :: [Statistics] -> Double
-compCVfromStats = sum . zipWith (*) detailedCVWeights . map getStatisticValue
-
--- | Compute the /total/ variance.
+-- | Compute the total cluster store given the nodes.
compCVNodes :: [Node.Node] -> Double
-compCVNodes = sum . zipWith (*) detailedCVWeights . compDetailedCV
+compCVNodes = compCVfromStats . compClusterStatistics
-- | Wrapper over 'compCVNodes' for callers that have a 'Node.List'.
compCV :: Node.List -> Double
@@ -215,14 +91,5 @@ compCV = compCVNodes . Container.elems
-- | Shows statistics for a given node list.
printStats :: String -> Node.List -> String
-printStats lp nl =
- let dcvs = compDetailedCV $ Container.elems nl
- (weights, names) = unzip detailedCVInfo
- hd = zip3 (weights ++ repeat 1) (names ++ repeat "unknown") dcvs
- header = [ "Field", "Value", "Weight" ]
- formatted = map (\(w, h, val) ->
- [ h
- , printf "%.8f" val
- , printf "x%.2f" w
- ]) hd
- in printTable lp header formatted $ False:repeat True
+printStats lp =
+ showClusterStatistics lp . compClusterStatistics . Container.elems
diff --git a/src/Ganeti/HTools/Cluster/MetricsComponents.hs
b/src/Ganeti/HTools/Cluster/MetricsComponents.hs
new file mode 100644
index 0000000..153969d
--- /dev/null
+++ b/src/Ganeti/HTools/Cluster/MetricsComponents.hs
@@ -0,0 +1,291 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+{-| Module describing cluster metrics components.
+
+ Metrics components are used for generation of functions deaing with cluster
+ statistics.
+
+-}
+
+{-
+
+Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015 Google Inc.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+-}
+
+module Ganeti.HTools.Cluster.MetricsComponents
+ ( MetricComponent
+ , metricComponents
+ , reservedMemRTotal
+ , name
+ , weight
+ , fromNode
+ , fromNodeType
+ , statisticsType
+ , forOnlineNodes
+ ) where
+
+import qualified Ganeti.HTools.Node as Node
+import Ganeti.HTools.Cluster.MetricsTH (MetricComponent(..))
+import Ganeti.HTools.Types
+import Ganeti.Utils.Statistics
+
+-- | List containing all currently enabled cluster metrics components
+metricComponents :: [MetricComponent]
+metricComponents = [ freeMemPercent
+ , freeDiskPercent
+ , cpuEffRatio
+ , spindlesUsageRatio
+ , n1FailsCount
+ , reservedMemPercent
+ , offlineInstCount
+ , offlinePriInstCount
+ , cpuLoadRatio
+ , memLoadRatio
+ , diskLoadRatio
+ , netLoadRatio
+ , priTagsScore
+ , locationScore
+ , locationExclusionScore
+ , reservedMemRTotal
+ , freeMemPercentForth
+ , freeDiskPercentForth
+ , cpuEffRatioForth
+ , spindlesUsageRatioForth
+ ]
+
+freeMemPercent :: MetricComponent
+freeMemPercent = MetricComponent
+ { name = "free_mem_cv"
+ , weight = [| 0.5 :: Double |]
+ , fromNode = [| Node.pMem |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| StdDevStat |]
+ , forOnlineNodes = True
+ }
+
+freeDiskPercent :: MetricComponent
+freeDiskPercent = MetricComponent
+ { name = "free_disk_cv"
+ , weight = [| 0.5 :: Double |]
+ , fromNode = [| Node.pDsk |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| StdDevStat |]
+ , forOnlineNodes = True
+ }
+
+cpuEffRatio :: MetricComponent
+cpuEffRatio = MetricComponent
+ { name = "vcpu_ratio_cv"
+ , weight = [| 0.5 :: Double |]
+ , fromNode = [| Node.pCpuEff |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| StdDevStat |]
+ , forOnlineNodes = True
+ }
+
+spindlesUsageRatio :: MetricComponent
+spindlesUsageRatio = MetricComponent
+ { name = "spindles_cv"
+ , weight = [| 0.5 :: Double |]
+ , fromNode = [| \n -> Node.instSpindles n / Node.hiSpindles n |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| SumStat |]
+ , forOnlineNodes = True
+ }
+
+n1FailsCount :: MetricComponent
+n1FailsCount = MetricComponent
+ { name = "fail_n1"
+ , weight = [| 0.5 :: Double |]
+ , fromNode = [| \n -> if Node.failN1 n
+ then toDouble $
+ length (Node.sList n) + length (Node.pList n)
+ else 0 |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| SumStat |]
+ , forOnlineNodes = True
+ }
+
+reservedMemPercent :: MetricComponent
+reservedMemPercent = MetricComponent
+ { name = "reserved_mem_cv"
+ , weight = [| 1 :: Double |]
+ , fromNode = [| Node.pRem |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| StdDevStat |]
+ , forOnlineNodes = True
+ }
+
+offlineInstCount :: MetricComponent
+offlineInstCount = MetricComponent
+ { name = "offline_all_cnt"
+ , weight = [| 4 :: Double |]
+ , fromNode = [| \n -> toDouble $
+ length (Node.pList n) + length (Node.sList n) |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| SumStat |]
+ , forOnlineNodes = False
+ }
+
+offlinePriInstCount :: MetricComponent
+offlinePriInstCount = MetricComponent
+ { name = "offline_pri_cnt"
+ , weight = [| 16 :: Double |]
+ , fromNode = [| toDouble . length . Node.pList |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| SumStat |]
+ , forOnlineNodes = False
+ }
+
+cpuLoadRatio :: MetricComponent
+cpuLoadRatio = MetricComponent
+ { name = "cpu_load_cv"
+ , weight = [| 1 :: Double |]
+ , fromNode = [| \n -> let DynUtil c1 _ _ _ = Node.utilLoad n
+ DynUtil c2 _ _ _ = Node.utilPool n
+ in c1/c2 |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| StdDevStat |]
+ , forOnlineNodes = True
+ }
+
+memLoadRatio :: MetricComponent
+memLoadRatio = MetricComponent
+ { name = "mem_load_cv"
+ , weight = [| 1 :: Double |]
+ , fromNode = [| \n -> let DynUtil _ m1 _ _ = Node.utilLoad n
+ DynUtil _ m2 _ _ = Node.utilPool n
+ in m1/m2 |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| StdDevStat |]
+ , forOnlineNodes = True
+ }
+
+diskLoadRatio :: MetricComponent
+diskLoadRatio = MetricComponent
+ { name = "disk_load_cv"
+ , weight = [| 1 :: Double |]
+ , fromNode = [| \n -> let DynUtil _ _ d1 _ = Node.utilLoad n
+ DynUtil _ _ d2 _ = Node.utilPool n
+ in d1/d2 |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| StdDevStat |]
+ , forOnlineNodes = True
+ }
+
+netLoadRatio :: MetricComponent
+netLoadRatio = MetricComponent
+ { name = "net_load_cv"
+ , weight = [| 1 :: Double |]
+ , fromNode = [| \n -> let DynUtil _ _ _ n1 = Node.utilLoad n
+ DynUtil _ _ _ n2 = Node.utilPool n
+ in n1/n2 |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| StdDevStat |]
+ , forOnlineNodes = True
+ }
+
+priTagsScore :: MetricComponent
+priTagsScore = MetricComponent
+ { name = "pri_tags_score"
+ , weight = [| 2 :: Double |]
+ , fromNode = [| toDouble . Node.conflictingPrimaries |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| SumStat |]
+ , forOnlineNodes = True
+ }
+
+locationScore :: MetricComponent
+locationScore = MetricComponent
+ { name = "location_score"
+ , weight = [| 1 :: Double |]
+ , fromNode = [| toDouble . Node.locationScore |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| SumStat |]
+ , forOnlineNodes = True
+ }
+
+locationExclusionScore :: MetricComponent
+locationExclusionScore = MetricComponent
+ { name = "location_exclusion_score"
+ , weight = [| 1 :: Double |]
+ , fromNode = [| MapData . Node.instanceMap |]
+ , fromNodeType = [t| MapData |]
+ , statisticsType = [t| MapStat |]
+ , forOnlineNodes = True
+ }
+
+reservedMemRTotal :: MetricComponent
+reservedMemRTotal = MetricComponent
+ { name = "reserved_mem_rtotal"
+ , weight = [| 0.25 :: Double |]
+ , fromNode = [| Node.pRem |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| SumStat |]
+ , forOnlineNodes = True
+ }
+
+freeMemPercentForth :: MetricComponent
+freeMemPercentForth = MetricComponent
+ { name = "free_mem_cv_forth"
+ , weight = [| 0.5 :: Double |]
+ , fromNode = [| Node.pMemForth |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| StdDevStat |]
+ , forOnlineNodes = True
+ }
+
+freeDiskPercentForth :: MetricComponent
+freeDiskPercentForth = MetricComponent
+ { name = "free_disk_cv_forth"
+ , weight = [| 0.5 :: Double |]
+ , fromNode = [| Node.pDskForth |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| StdDevStat |]
+ , forOnlineNodes = True
+ }
+
+cpuEffRatioForth :: MetricComponent
+cpuEffRatioForth = MetricComponent
+ { name = "vcpu_ratio_cv_forth"
+ , weight = [| 0.5 :: Double |]
+ , fromNode = [| Node.pCpuEffForth |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| StdDevStat |]
+ , forOnlineNodes = True
+ }
+
+spindlesUsageRatioForth :: MetricComponent
+spindlesUsageRatioForth = MetricComponent
+ { name = "spindles_cv_forth"
+ , weight = [| 0.5 :: Double |]
+ , fromNode = [| \n -> Node.instSpindlesForth n / Node.hiSpindles n |]
+ , fromNodeType = [t| Double |]
+ , statisticsType = [t| SumStat |]
+ , forOnlineNodes = True
+ }
diff --git a/src/Ganeti/HTools/Cluster/MetricsTH.hs
b/src/Ganeti/HTools/Cluster/MetricsTH.hs
new file mode 100644
index 0000000..566b844
--- /dev/null
+++ b/src/Ganeti/HTools/Cluster/MetricsTH.hs
@@ -0,0 +1,237 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+{-| Declaration of the datatypes and functions dealing with cluster metrics
+ generated by template haskell.
+
+-}
+
+{-
+
+Copyright (C) 2015 Google Inc.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+-}
+
+
+module Ganeti.HTools.Cluster.MetricsTH
+ ( MetricComponent(..)
+ , declareStatistics
+ ) where
+
+import Data.List (partition)
+import Language.Haskell.TH
+import Text.Printf (printf)
+
+import qualified Ganeti.HTools.Node as Node
+import Ganeti.Utils (printTable)
+import Ganeti.Utils.Statistics
+
+-- | Data type describing the metric component. The information provided by
+-- this data type is used to generate statistics data types and functions
+-- dealing with them
+data MetricComponent = MetricComponent
+ { name :: String -- ^ The component name
+ , weight :: Q Exp -- ^ The component weight in the statistics sum
+ , fromNode :: Q Exp -- ^ Quasi quoted function obtaining spread value
+ -- from a node given (Node.Node -> fromNodeType)
+ , fromNodeType :: Q Type -- ^ Quasi quoted spread value type
+ , statisticsType :: Q Type -- ^ Quasi quoted statistics data type. Stat
+ -- instance for fromNodeType and statisticsType
+ -- should be defined
+ , forOnlineNodes :: Bool -- ^ Whether this component should be calculated
+ -- for online or offline nodes
+ }
+
+-- | Declares all functions and data types implemented in template haskell
+declareStatistics :: [MetricComponent] -> Q [Dec]
+declareStatistics components = do
+ nodeValues <- nodeValuesDecl components
+ getNodeValues <- getNodeValuesDecl components
+ clusterStatistics <- clusterStatisticsDecl components
+ compClusterStatistics <- compClusterStatisticsDecl components
+ updateClusterStatistics <- updateClusterStatisticsDecl components
+ compCVfromStats <- compCVfromStatsDecl components
+ showClusterStatistics <- showClusterStatisticsDecl components
+ return $ nodeValues ++ getNodeValues ++ clusterStatistics ++
+ compClusterStatistics ++ updateClusterStatistics ++
+ compCVfromStats ++ showClusterStatistics
+
+-- | Helper function constructing VarStringTypeQ
+getVarStrictTypeQ :: (String, Q Type) -> VarStrictTypeQ
+getVarStrictTypeQ (n, t) = do
+ t' <- t
+ return (mkName n, NotStrict, t')
+
+-- | Function constructs NodeValues data type for metric components given.
+-- The data type is used to store all spread values of one Node.
+nodeValuesDecl :: [MetricComponent] -> Q [Dec]
+nodeValuesDecl components = do
+ let names = map (("nv_" ++ ) . name ) components
+ types = map fromNodeType components
+ strict_types <- mapM getVarStrictTypeQ $ zip names types
+ return [DataD [] (mkName "NodeValues") []
+ [RecC (mkName "NodeValues") strict_types] []]
+
+-- | Function constructs ClusterStatistics data type for metric components
+-- given. The data type is used to store all Statistics constructed from the
+-- [NodeValues].
+clusterStatisticsDecl :: [MetricComponent] -> Q [Dec]
+clusterStatisticsDecl components = do
+ let names = map (("cs_" ++ ) . name ) components
+ types = map statisticsType components
+ strict_types <- mapM getVarStrictTypeQ $ zip names types
+ return [DataD [] (mkName "ClusterStatistics") []
+ [RecC (mkName "ClusterStatistics") strict_types] []]
+
+-- | Generates (getNodeValues :: Node.Node -> NodeValues) declaration for
+-- metric components given. The function constructs NodeValues by calling
+-- fromNode function for each metrics component.
+getNodeValuesDecl :: [MetricComponent] -> Q [Dec]
+getNodeValuesDecl components = do
+ extract_functions <- mapM fromNode components
+ x <- newName "node"
+ node_t <- [t| Node.Node |]
+ let names = map (mkName . ("nv_" ++) . name) components
+ values = map (\f -> AppE f (VarE x)) extract_functions
+ body_exp = RecConE (mkName "NodeValues") $ zip names values
+ fname = mkName "getNodeValues"
+ nv_t = ConT $ mkName "NodeValues"
+ sig_d = SigD fname (ArrowT `AppT` node_t `AppT` nv_t)
+ fun_d = FunD fname [Clause [VarP x] (NormalB body_exp) []]
+ return [sig_d, fun_d]
+
+-- | Helper function passing two arguments to a function
+appTwice :: Q Exp -> Q Exp -> Q Exp -> Q Exp
+appTwice fun arg1 = appE $ appE fun arg1
+
+-- | Helper function constructing Q (Name, Exp)
+getQNameExp :: String -> Q Exp -> Q (Name, Exp)
+getQNameExp n e = do
+ e' <- e
+ return (mkName n, e')
+
+-- | Generates (compClusterStatisticsHelper :: [Node.Node] ->
+-- ClusterStatistics) declaration for metric components given. The function
+-- constructs ClusterStatistics by calling calculate function for each spread
+-- values list. Spread values lists are obtained by getNodeValues call.
+compClusterStatisticsDecl :: [MetricComponent] -> Q [Dec]
+compClusterStatisticsDecl components = do
+ nl_i <- newName "nl"
+ let splitted = appTwice [| partition |] [| Node.offline |] nl
+ (nl_off, nl_on) = (appE [| fst |] partitioned, appE [| snd |] splitted)
+ (online, offline) = partition forOnlineNodes components
+ nv_f nm = varE . mkName $ "nv_" ++ nm
+ nvl_f = appTwice [| map |] (varE (mkName "getNodeValues"))
+ nv_field nm = appTwice [| map |] $ nv_f nm
+ cs_field nm nvl = appE [| calculate |] $ nv_field nm nvl
+ (online_names, offline_names) = (map name online, map name offline)
+ offline_f = map (\nm -> getQNameExp ("cs_" ++ nm) .
+ cs_field nm $ nvl_f nl_off) offline_names
+ online_f = map (\nm -> getQNameExp ("cs_" ++ nm) .
+ cs_field nm $ nvl_f nl_on ) online_names
+ body = recConE (mkName "ClusterStatistics") $ offline_f ++ online_f
+ cls_stat_t = conT $ mkName "ClusterStatistics"
+ fname = mkName "compClusterStatistics"
+ sig_d <- sigD fname ((arrowT `appT` [t| [Node.Node] |]) `appT` cls_stat_t)
+ fun_d <- funD fname [clause [varP nl_i] (normalB body) []]
+ return [sig_d, fun_d]
+
+-- | Generates (updateClusterStatistics :: ClusterStatistics ->
+-- (Node.Node, Node.Node) -> ClusterStatistics) declaration for metric
+-- components given. The function calls update for each ClusterStatistics
+-- field if the node is online or preserves the old ClusterStatistics
+-- otherwise. This action replaces contribution of the first node by the
+-- contribution of the second node.
+updateClusterStatisticsDecl :: [MetricComponent] -> Q [Dec]
+updateClusterStatisticsDecl components = do
+ old_s <- newName "old_s"
+ n <- newName "n"
+ n' <- newName "n'"
+ let (online, offline) = partition forOnlineNodes components
+ pattern = [varP old_s, tupP [varP n, varP n']]
+ is_node_online = appE [| not . Node.offline |] $ varE n
+ get_nv nd = appE (varE $ mkName "getNodeValues") $ varE nd
+ nv_get_field nm nd = appE (varE . mkName $ "nv_" ++ nm) $ get_nv nd
+ cs_cur_field nm = appE (varE . mkName $ "cs_" ++ nm) $ varE old_s
+ update_field nm = appTwice (appE [| update |] $ cs_cur_field nm)
+ (nv_get_field nm n) (nv_get_field nm n')
+ (online_names, offline_names) = (map name online, map name offline)
+ offline_f = map (\nm -> getQNameExp ("cs_" ++ nm) $
+ cs_cur_field nm) offline_names
+ online_f = map (\nm -> getQNameExp ("cs_" ++ nm) $
+ update_field nm) online_names
+ body = condE is_node_online
+ (recConE (mkName "ClusterStatistics") $ offline_f ++ online_f)
+ (varE old_s)
+ fname = mkName "updateClusterStatistics"
+ cs_t = conT $ mkName "ClusterStatistics"
+ sig_d <- sigD fname ((arrowT `appT` cs_t) `appT`
+ ((arrowT `appT` [t| (Node.Node, Node.Node) |]) `appT`
+ cs_t))
+ fun_d <- funD fname [clause pattern (normalB body) []]
+ return [sig_d, fun_d]
+
+-- | Generates (compCVFromStats :: ClusterStatistics -> Double) declaration
+-- for metric components given. The function computes the cluster score from
+-- the ClusterStatistics.
+compCVfromStatsDecl :: [MetricComponent] -> Q [Dec]
+compCVfromStatsDecl components = do
+ cs <- newName "cs"
+ let get_comp c = appE (varE . mkName $ "cs_" ++ name c) $ varE cs
+ get_val c = appE [| getValue |] $ get_comp c
+ term c = appTwice [| (*) :: Double -> Double -> Double |]
+ (get_val c) (weight c)
+ stat = appE [| sum :: [Double] -> Double |] . listE $ map term components
+ fname = mkName "compCVfromStats"
+ cs_t = conT $ mkName "ClusterStatistics"
+ sig_d <- sigD fname ((arrowT `appT` cs_t) `appT` [t| Double |])
+ fun_d <- funD fname [clause [varP cs] (normalB stat) []]
+ return [sig_d, fun_d]
+
+-- | Generates (showClusterStatistics :: ClusterStatistics -> String)
+-- declaration for metric components given. The function converts
+-- ClusterStatistics to a string containing a table obtained by printTable.
+showClusterStatisticsDecl :: [MetricComponent] -> Q [Dec]
+showClusterStatisticsDecl components = do
+ lp <- newName "lp"
+ cs <- newName "cs"
+ let get_comp c = appE (varE . mkName $ "cs_" ++ name c) $ varE cs
+ get_val c = appE [| getValue |] $ get_comp c
+ format w h val = listE [ h
+ , appE [| printf "%.8f" |] val
+ , appE [| printf "x%.2f"|] w
+ ]
+ print_line c = format (weight c) (litE . StringL $ name c) (get_val c)
+ header = [| [ "Field", "Value", "Weight" ] |]
+ printed = listE $ map print_line components
+ result = appTwice (appTwice [| printTable |] (varE lp) header)
+ printed [| False:repeat True |]
+ fname = mkName "showClusterStatistics"
+ cs_t = conT $ mkName "ClusterStatistics"
+ sig_d <- sigD fname ((arrowT `appT` [t| String |]) `appT`
+ ((arrowT `appT` cs_t) `appT` [t| String |]))
+ fun_d <- funD fname [clause [varP lp, varP cs] (normalB result) []]
+ return [sig_d, fun_d]
diff --git a/src/Ganeti/Utils/Statistics.hs b/src/Ganeti/Utils/Statistics.hs
index 7057973..ff91d93 100644
--- a/src/Ganeti/Utils/Statistics.hs
+++ b/src/Ganeti/Utils/Statistics.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE BangPatterns #-}
-
+{-# LANGUAGE BangPatterns, MultiParamTypeClasses, FunctionalDependencies#-}
{-| Utility functions for statistical accumulation. -}
@@ -34,100 +33,105 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
DAMAGE.
-}
module Ganeti.Utils.Statistics
- ( Statistics
+ ( Stat
+ , SumStat(..)
+ , StdDevStat(..)
, TagTagMap
- , AggregateComponent(..)
- , getSumStatistics
- , getStdDevStatistics
- , getMapStatistics
- , getStatisticValue
- , updateStatistics
+ , MapData(..)
+ , MapStat(..)
+ , update
+ , calculate
+ , getValue
+ , toDouble
) where
import qualified Data.Foldable as Foldable
import Data.List (foldl')
import qualified Data.Map as Map
+-- | Typeclass describing necessary statistical accumulations functions. Types
+-- defining an instance of Stat 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. c is the statistical accumulation data type itself while s is
+-- a type of spread values used to calculate a statistics. s defined as a
+-- type dependent from c in order to pretend ambiguity.
+class (Show c) => Stat s c | c -> s where
+ -- | Calculate a statistics from the spread values list.
+ calculate :: [s] -> c
+ -- | 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.
+ update :: c -> s -> s -> c
+ -- | Obtain the value of a statistics.
+ getValue :: c -> Double
+
+-- | Type of statistical accumulations representing simple sum of values
+data SumStat = SumStat Double deriving Show
+-- | Type of statistical accumulations representing values standard deviation
+data StdDevStat = StdDevStat Double Double Double deriving Show
+ -- count, sum, and not the sum of squares---instead the
+ -- computed variance for better precission.
+-- | Type of statistical accumulations representing the amount of instances per
+-- each tags pair. See Also TagTagMap documentation.
+data MapStat = MapStat TagTagMap deriving Show
+
+instance Stat Double SumStat where
+ calculate xs =
+ let addComponent s x =
+ let !s' = s + x
+ in s'
+ st = foldl' addComponent 0 xs
+ in SumStat st
+ update (SumStat s) x x' =
+ SumStat $ s + x' - x
+ getValue (SumStat s) = s
+
+instance Stat Double StdDevStat where
+ calculate xs =
+ let addComponent (n, s) x =
+ let !n' = n + 1
+ !s' = s + x
+ in (n', s')
+ (nt, st) = foldl' addComponent (0, 0) xs
+ mean = st / nt
+ center x = x - mean
+ nvar = foldl' (\v x -> let d = center x in v + d * d) 0 xs
+ in StdDevStat nt st (nvar / nt)
+ update (StdDevStat n s var) x x' =
+ let !ds = x' - x
+ !dss = x' * x' - x * x
+ !dnnvar = (n * dss - 2 * s * ds) - ds * ds
+ !s' = s + ds
+ !var' = max 0 $ var + dnnvar / (n * n)
+ in StdDevStat n s' var'
+ getValue (StdDevStat _ _ var) = sqrt var
+
-- | 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
- -- 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 :: [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 :: [AggregateComponent] -> Statistics
-getStdDevStatistics 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
- 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 -> (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
+-- | Data type used to store spread values of type TagTagMap. This data type
+-- is introduced only to defin an instance of Stat for TagTagMap.
+data MapData = MapData TagTagMap
+
+-- | Helper function unpacking [MapData] spread values list.
+mapTmpToMap :: [MapData] -> [TagTagMap]
+mapTmpToMap (MapData m : xs) = m : mapTmpToMap xs
+mapTmpToMap _ = []
+
+instance Stat MapData MapStat where
+ calculate xs =
+ let addComponent m x =
+ let !m' = Map.unionWith (+) m x
+ in m'
+ mt = foldl' addComponent Map.empty (mapTmpToMap xs)
+ in MapStat mt
+ update (MapStat m) (MapData x) (MapData x') =
+ let nm = Map.unionWith (+) (Map.unionWith (-) m x) x'
+ in MapStat nm
+ getValue (MapStat m) = fromIntegral $ Foldable.sum m - Map.size m
+
+-- | Converts Integral types to Double. It's usefull than it's not enough type
+-- information in the expression to call fromIntegral directly.
+toDouble :: (Integral a) => a -> Double
+toDouble = fromIntegral
diff --git a/test/hs/Test/Ganeti/Utils/Statistics.hs
b/test/hs/Test/Ganeti/Utils/Statistics.hs
index f39546b..573769c 100644
--- a/test/hs/Test/Ganeti/Utils/Statistics.hs
+++ b/test/hs/Test/Ganeti/Utils/Statistics.hs
@@ -55,9 +55,7 @@ prop_stddev_update =
let original = xs ++ [a] ++ ys
modified = xs ++ [b] ++ ys
with_update =
- getStatisticValue
- $ updateStatistics (getStdDevStatistics $ map SimpleNumber original)
- (SimpleNumber a, SimpleNumber b)
+ getValue $ update (calculate original :: StdDevStat) a b
direct = stdDev modified
in counterexample ("Value computed by update " ++ show with_update
++ " differs too much from correct value " ++ show direct)
--
1.9.1
