use vector in local status

Thought was that this would be faster than a map, since a vector can be
updated more efficiently. It turns out to not seem to matter; runtime and
memory usage are basically identical.
This commit is contained in:
Joey Hess 2013-10-07 04:05:14 -04:00
parent 1200788859
commit eb3ce3581a
4 changed files with 39 additions and 18 deletions

View file

@ -11,6 +11,8 @@ module Command.Status where
import "mtl" Control.Monad.State.Strict
import qualified Data.Map as M
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import Text.JSON
import Data.Tuple
import Data.Ord
@ -48,16 +50,23 @@ data KeyData = KeyData
}
data NumCopiesStats = NumCopiesStats
{ numCopiesVarianceMap :: M.Map Variance Integer
{ numCopiesVariances :: V.Vector Int
}
newtype Variance = Variance Int
deriving (Eq, Ord)
{- Since variances can be negative, maxVariance will be
- added to a variance to get its position within the vector. -}
maxVariance :: Int
maxVariance = 1000
instance Show Variance where
show (Variance n)
toVariance :: Int -> Int
toVariance n = n + maxVariance
showVariance :: Int -> String
showVariance v
| n >= 0 = "numcopies +" ++ show n
| otherwise = "numcopies " ++ show n
| otherwise = "numcopies -" ++ show n
where
n = v - maxVariance
-- cached info that multiple Stats use
data StatInfo = StatInfo
@ -267,12 +276,14 @@ backend_usage = stat "backend usage" $ nojson $
M.unionWith (+) x y
numcopies_stats :: Stat
numcopies_stats = stat "numcopies stats" $ nojson $
calc <$> (maybe M.empty numCopiesVarianceMap <$> cachedNumCopiesStats)
numcopies_stats = stat "numcopies stats" $ nojson $ do
gen . calc . maybe [] (V.toList . numCopiesVariances)
<$> cachedNumCopiesStats
where
calc = multiLine
. map (\(variance, count) -> show variance ++ ": " ++ show count)
. reverse . sortBy (comparing snd) . M.toList
gen = multiLine
. map (\(variance, count) -> showVariance variance ++ ": " ++ show count)
. reverse . sortBy (comparing snd)
calc = filter (\(_variance, count) -> count > 0) . zip [0..]
cachedPresentData :: StatState KeyData
cachedPresentData = do
@ -328,7 +339,7 @@ emptyKeyData :: KeyData
emptyKeyData = KeyData 0 0 0 M.empty
emptyNumCopiesStats :: NumCopiesStats
emptyNumCopiesStats = NumCopiesStats M.empty
emptyNumCopiesStats = NumCopiesStats $ V.replicate (maxVariance * 2) 0
foldKeys :: [Key] -> KeyData
foldKeys = foldl' (flip addKey) emptyKeyData
@ -346,11 +357,19 @@ addKey key (KeyData count size unknownsize backends) =
ks = keySize key
updateNumCopiesStats :: Key -> FilePath -> NumCopiesStats -> Annex NumCopiesStats
updateNumCopiesStats key file (NumCopiesStats m) = do
!variance <- Variance <$> numCopiesCheck file key (-)
let !m' = M.insertWith' (+) variance 1 m
let !ret = NumCopiesStats m'
updateNumCopiesStats key file (NumCopiesStats v) = do
!variance <- toVariance <$> numCopiesCheck file key (-)
let !v' = V.modify (update variance) v
let !ret = NumCopiesStats v'
return ret
where
update variance mv
-- ignore really large variances (extremely unlikely)
| variance < 0 || variance >= maxVariance * 2 = noop
| otherwise = do
n <- MV.read mv variance
let !n' = n+1
MV.write mv variance n'
showSizeKeys :: KeyData -> String
showSizeKeys d = total ++ missingnote

1
debian/control vendored
View file

@ -8,6 +8,7 @@ Build-Depends:
libghc-missingh-dev,
libghc-hslogger-dev,
libghc-pcre-light-dev,
libghc-vector-dev,
libghc-sha-dev,
libghc-cryptohash-dev,
libghc-regex-tdfa-dev [!mips !mipsel !s390],

View file

@ -6,6 +6,7 @@ quite a lot.
* [mtl](http://hackage.haskell.org.package/mtl) (2.1.1 or newer)
* [MissingH](http://github.com/jgoerzen/missingh/wiki)
* [utf8-string](http://hackage.haskell.org/package/utf8-string)
* [vector](http://hackage.haskell.org/package/vector)
* [SHA](http://hackage.haskell.org/package/SHA)
* [cryptohash](http://hackage.haskell.org/package/cryptohash) (optional but recommended)
* [dataenc](http://hackage.haskell.org/package/dataenc)

View file

@ -78,7 +78,7 @@ Executable git-annex
Main-Is: git-annex.hs
Build-Depends: MissingH, hslogger, directory, filepath,
containers, utf8-string, network (>= 2.0), mtl (>= 2),
bytestring, old-locale, time, HTTP,
bytestring, old-locale, time, HTTP, vector,
extensible-exceptions, dataenc, SHA, process, json,
base (>= 4.5 && < 4.9), monad-control, MonadCatchIO-transformers,
IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process,