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

1
debian/control vendored
View file

@ -8,6 +8,7 @@ Build-Depends:
libghc-missingh-dev, libghc-missingh-dev,
libghc-hslogger-dev, libghc-hslogger-dev,
libghc-pcre-light-dev, libghc-pcre-light-dev,
libghc-vector-dev,
libghc-sha-dev, libghc-sha-dev,
libghc-cryptohash-dev, libghc-cryptohash-dev,
libghc-regex-tdfa-dev [!mips !mipsel !s390], 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) * [mtl](http://hackage.haskell.org.package/mtl) (2.1.1 or newer)
* [MissingH](http://github.com/jgoerzen/missingh/wiki) * [MissingH](http://github.com/jgoerzen/missingh/wiki)
* [utf8-string](http://hackage.haskell.org/package/utf8-string) * [utf8-string](http://hackage.haskell.org/package/utf8-string)
* [vector](http://hackage.haskell.org/package/vector)
* [SHA](http://hackage.haskell.org/package/SHA) * [SHA](http://hackage.haskell.org/package/SHA)
* [cryptohash](http://hackage.haskell.org/package/cryptohash) (optional but recommended) * [cryptohash](http://hackage.haskell.org/package/cryptohash) (optional but recommended)
* [dataenc](http://hackage.haskell.org/package/dataenc) * [dataenc](http://hackage.haskell.org/package/dataenc)

View file

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