packages feed

hyperloglog (empty) → 0.1

raw patch · 16 files changed

+770/−0 lines, 16 filesdep +approximatedep +basedep +binarybuild-type:Customsetup-changed

Dependencies added: approximate, base, binary, bits, bytes, cereal, cereal-vector, comonad, deepseq, directory, distributive, doctest, filepath, generic-deriving, hashable, hashable-extras, lens, reflection, safecopy, semigroupoids, semigroups, simple-reflect, tagged, vector

Files

+ .ghci view
@@ -0,0 +1,1 @@+:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h -optP-Iincludes
+ .gitignore view
@@ -0,0 +1,13 @@+dist+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#
+ .travis.yml view
@@ -0,0 +1,26 @@+language: haskell+before_install:+  # Uncomment whenever hackage is down.+  # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && cabal update+  - cabal update++  # Try installing some of the build-deps with apt-get for speed.+  - travis/cabal-apt-install $mode++install:+  - cabal configure -flib-Werror $mode+  - cabal build++script:+  - $script && hlint src --cpp-define HLINT++notifications:+  irc:+    channels:+      - "irc.freenode.org#haskell-lens"+    skip_join: true+    template:+      - "\x0313hyperloglog\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"++env:+  - mode="--enable-tests" script="cabal test --show-details=always"
+ .vim.custom view
@@ -0,0 +1,31 @@+" Add the following to your .vimrc to automatically load this on startup++" if filereadable(".vim.custom")+"     so .vim.custom+" endif++function StripTrailingWhitespace()+  let myline=line(".")+  let mycolumn = col(".")+  silent %s/  *$//+  call cursor(myline, mycolumn)+endfunction++" enable syntax highlighting+syntax on++" search for the tags file anywhere between here and /+set tags=TAGS;/++" highlight tabs and trailing spaces+set listchars=tab:‗‗,trail:‗+set list++" f2 runs hasktags+map <F2> :exec ":!hasktags -x -c --ignore src"<CR><CR>++" strip trailing whitespace before saving+" au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace()++" rebuild hasktags after saving+au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src"
+ AUTHORS.markdown view
@@ -0,0 +1,11 @@+Analytics was started by [Edward Kmett](https://github.com/ekmett) in response to a question by [Alec Heller](https://github.com/deviant-logic) about if he should use `bound` to implement datalog. It has since somewhat expanded in scope.++`hyperloglog` was split out of the `analytics` repository, and borrows innovations from [Ozgun Ataman](https://github.com/soostone)'s implementation of `HyperLogLog` in Haskell as well as twitter's `algebird` project.++You can watch contributors carry on the quest for bragging rights in the [contributors graph](https://github.com/analytics/compensated/graphs/contributors).++Omission from this list is by no means an attempt to discount your contribution.++Thank you for all of your help!++-Edward Kmett
+ CHANGELOG.markdown view
@@ -0,0 +1,3 @@+0.1+---+* Ported `Data.Analytics.Approximate.HyperLogLog` from [analytics](http://github.com/analytics) into a separate package.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright 2013 Edward Kmett++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.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+ README.markdown view
@@ -0,0 +1,15 @@+hyperloglog+===========++[![Build Status](https://secure.travis-ci.org/ekmett/hyperloglog.png?branch=master)](http://travis-ci.org/ekmett/hyperloglog)++This package provides a working implementation of HyperLogLog.++Contact Information+-------------------++Contributions and bug reports are welcome!++Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net.++-Edward Kmett
+ Setup.lhs view
@@ -0,0 +1,55 @@+#!/usr/bin/runhaskell+\begin{code}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Text ( display )+import Distribution.Verbosity ( Verbosity, normal )+import System.FilePath ( (</>) )++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+     buildHook simpleUserHooks pkg lbi hooks flags+  , postHaddock = \args flags pkg lbi -> do+     copyFiles normal (haddockOutputDir flags pkg) []+     postHaddock simpleUserHooks args flags pkg lbi+  }++haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath+haddockOutputDir flags pkg = destDir where+  baseDir = case haddockDistPref flags of+    NoFlag -> "."+    Flag x -> x+  destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+  let dir = autogenModulesDir lbi+  createDirectoryIfMissingVerbose verbosity True dir+  withLibLBI pkg lbi $ \_ libcfg -> do+    withTestLBI pkg lbi $ \suite suitecfg -> do+      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+        [ "module Build_" ++ testName suite ++ " where"+        , "deps :: [String]"+        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+        ]+  where+    formatdeps = map (formatone . snd)+    formatone p = case packageName p of+      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys++\end{code}
+ hyperloglog.cabal view
@@ -0,0 +1,102 @@+name:          hyperloglog+category:      Numeric+version:       0.1+license:       BSD3+cabal-version: >= 1.8+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     provisional+homepage:      http://github.com/analytics/hyperloglog+bug-reports:   http://github.com/analytics/hyperloglog/issues+copyright:     Copyright (C) 2013 Edward A. Kmett+build-type:    Custom+tested-with:   GHC == 7.4.1, GHC == 7.6.1+synopsis:      An approximate streaming (constant space) unique object counter+description:+  This package provides an approximate streaming (constant space) unique object counter.+  .+  See the original paper for details:+  <http://algo.inria.fr/flajolet/Publications/FlFuGaMe07.pdf>+  .+  Notably it can be used to approximate a set of several billion elements with 1-2% inaccuracy+  in around 1.5k of memory.++extra-source-files:+  .travis.yml+  .ghci+  .gitignore+  .vim.custom+  travis/cabal-apt-install+  travis/config+  AUTHORS.markdown+  README.markdown+  CHANGELOG.markdown++source-repository head+  type: git+  location: git://github.com/analytics/hyperloglog.git++-- You can disable the doctests test suite with -f-test-doctests+flag test-doctests+  default: True+  manual: True++flag lib-Werror+  default: False+  manual: True++library+  build-depends:+    approximate               >= 0.1      && < 1,+    base                      >= 4.3      && < 5,+    binary                    >= 0.5      && < 0.8,+    bits                      >= 0.2      && < 1,+    bytes                     >= 0.7      && < 1,+    cereal                    >= 0.3.5    && < 0.4,+    cereal-vector             >= 0.2      && < 0.3,+    comonad                   >= 3        && < 4,+    deepseq                   >= 1.3      && < 1.5,+    distributive              >= 0.3      && < 1,+    generic-deriving          >= 1.4      && < 1.6,+    hashable                  >= 1.1.2.3  && < 1.3,+    hashable-extras           >= 0.1      && < 1,+    lens                      >= 3.9      && < 4,+    reflection                >= 1.3      && < 2,+    semigroupoids             >= 3.0.2    && < 4,+    semigroups                >= 0.8.4    && < 1,+    safecopy                  >= 0.8.1    && < 0.9,+    tagged                    >= 0.4.5    && < 1,+    vector                    >= 0.9      && < 0.11++  exposed-modules:+    Data.HyperLogLog+    Data.HyperLogLog.Config+    Data.HyperLogLog.Type++  if flag(lib-Werror)+    ghc-options: -Werror++  ghc-options: -Wall -fwarn-tabs -O2+  hs-source-dirs: src++test-suite doctests+  type:           exitcode-stdio-1.0+  main-is:        doctests.hs+  ghc-options:    -Wall -threaded+  hs-source-dirs: tests++  if !flag(test-doctests)+    buildable: False+  else+    build-depends:+      base,+      directory      >= 1.0,+      doctest        >= 0.9.1,+      filepath,+      generic-deriving,+      semigroups     >= 0.9,+      simple-reflect >= 0.3.1++  if impl(ghc<7.6.1)+    ghc-options: -Werror
+ src/Data/HyperLogLog.hs view
@@ -0,0 +1,29 @@+--------------------------------------------------------------------+-- |+-- Copyright :  (c) Edward Kmett 2013+-- License   :  BSD3+-- Maintainer:  Edward Kmett <ekmett@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--+-- See the original paper for details:+-- <http://algo.inria.fr/flajolet/Publications/FlFuGaMe07.pdf>+--------------------------------------------------------------------+module Data.HyperLogLog+  (+  -- * HyperLogLog+    HyperLogLog+  , HasHyperLogLog(..)+  , size+  , intersectionSize+  , cast+  -- * Config+  , Config+  , hll+  -- * ReifiesConfig+  , ReifiesConfig+  , reifyConfig+  ) where++import Data.HyperLogLog.Config+import Data.HyperLogLog.Type
+ src/Data/HyperLogLog/Config.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+#define USE_TYPE_LITS 1+#endif++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+--------------------------------------------------------------------+-- |+-- Copyright :  (c) Edward Kmett 2013+-- License   :  BSD3+-- Maintainer:  Edward Kmett <ekmett@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--+--------------------------------------------------------------------+module Data.HyperLogLog.Config+  (+  -- * Config+    Config+  , HasConfig(..)+  , hll+  , numBits, numBuckets, smallRange, interRange, rawFact, alpha, bucketMask+  -- * ReifiesConfig+  , ReifiesConfig(..)+  , reifyConfig+  -- * Rank+  , Rank+  , calcBucket+  , calcRank+  , lim32+  ) where++import Control.Lens+import Data.Bits+import Data.Bits.Extras+import Data.Proxy+import Data.Reflection+import Data.Serialize+import Data.Vector.Serialize ()+import GHC.Int+import GHC.Word+import Generics.Deriving hiding (to, D)+#ifdef USE_TYPE_LITS+import GHC.TypeLits+#endif++type Rank = Int8++------------------------------------------------------------------------------+-- Config+------------------------------------------------------------------------------++-- | Constants required for a bucketing factor b+data Config = Config+  { _numBits    :: {-# UNPACK #-} !Int+  , _numBuckets :: {-# UNPACK #-} !Int+  , _smallRange :: {-# UNPACK #-} !Double+  , _interRange :: {-# UNPACK #-} !Double+  , _rawFact    :: {-# UNPACK #-} !Double+  , _alpha      :: {-# UNPACK #-} !Double+  , _bucketMask :: {-# UNPACK #-} !Word32+  } deriving (Eq, Show, Generic)++class HasConfig t where+  config :: Getter t Config++makeLensesWith ?? ''Config $ classyRules+  & generateSignatures .~ False+  & createClass        .~ False+  & createInstance     .~ False++instance HasConfig Config where+  config = id+  {-# INLINE config #-}++instance Serialize Config -- serialize as a number?++-- | Precalculate constants for a given bucketing factor b+hll :: Int -> Config+hll b = Config+  { _numBits = b+  , _numBuckets = m+  , _smallRange = 5/2 * m'+  , _interRange = lim32 / 30+  , _rawFact = a * m' * m'+  , _alpha = a+  , _bucketMask = bit b - 1+  } where+  m = bit b+  m' = fromIntegral m+  a = 0.7213 / (1 + 1.079 / m')+{-# INLINE hll #-}++------------------------------------------------------------------------------+-- ReifiesConfig+------------------------------------------------------------------------------++class ReifiesConfig o where+  reflectConfig :: p o -> Config++#ifdef USE_TYPE_LITS+instance SingRep n Integer => ReifiesConfig (n :: Nat) where+  reflectConfig _ = hll $ fromInteger $ withSing $ \(x :: Sing n) -> fromSing x+  {-# INLINE reflectConfig #-}+#endif++data ReifiedConfig (s :: *)++retagReifiedConfig :: (Proxy s -> a) -> proxy (ReifiedConfig s) -> a+retagReifiedConfig f _ = f Proxy+{-# INLINE retagReifiedConfig #-}++instance Reifies s Config => ReifiesConfig (ReifiedConfig s) where+  reflectConfig = retagReifiedConfig reflect+  {-# INLINE reflectConfig #-}++reifyConfig :: Int -> (forall (o :: *). ReifiesConfig o => Proxy o -> r) -> r+reifyConfig i f = reify (hll i) (go f) where+  go :: Reifies o Config => (Proxy (ReifiedConfig o) -> a) -> proxy o -> a+  go g _ = g Proxy++{-# INLINE reifyConfig #-}++instance Reifies n Int => ReifiesConfig (D n) where+  reflectConfig = hll . reflect+  {-# INLINE reflectConfig #-}++-- this way we only get instances for positive natural numbers+instance Reifies n Int => ReifiesConfig (SD n) where+  reflectConfig = hll . reflect+  {-# INLINE reflectConfig #-}++------------------------------------------------------------------------------+-- Util+------------------------------------------------------------------------------++calcBucket :: HasConfig t => t -> Word32 -> Int+calcBucket t w = fromIntegral (w .&. t^.bucketMask)+{-# INLINE calcBucket #-}++calcRank :: HasConfig t => t -> Word32 -> Int8+calcRank t w = fromIntegral $ rank $ shiftR w $ t^.numBits+{-# INLINE calcRank #-}++lim32 :: Double+lim32 = fromInteger (bit 32)+{-# INLINE lim32 #-}
+ src/Data/HyperLogLog/Type.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE BangPatterns              #-}+{-# LANGUAGE CPP                       #-}+{-# LANGUAGE DeriveGeneric             #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE FunctionalDependencies    #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RankNTypes                #-}+{-# LANGUAGE RecordWildCards           #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TemplateHaskell           #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE UndecidableInstances      #-}++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE PolyKinds                 #-}+#endif++--------------------------------------------------------------------+-- |+-- Copyright :  (c) Edward Kmett 2013+-- License   :  BSD3+-- Maintainer:  Edward Kmett <ekmett@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--+-- This package provides an approximate streaming (constant space)+-- unique object counter.+--+-- See the original paper for details:+-- <http://algo.inria.fr/flajolet/Publications/FlFuGaMe07.pdf>+--------------------------------------------------------------------+module Data.HyperLogLog.Type+  (+  -- * HyperLogLog+    HyperLogLog(..)+  , HasHyperLogLog(..)+  , size+  , intersectionSize+  , cast+  ) where++import           Control.Applicative+import           Control.Lens+import           Control.Monad+import           Data.Approximate.Type+import           Data.Bits+import           Data.Bits.Extras+import           Data.Hashable+import           Data.HyperLogLog.Config+import           Data.Proxy+import           Data.Semigroup+import           Data.Serialize+import qualified Data.Vector.Unboxed                           as V+import qualified Data.Vector.Unboxed.Mutable                   as MV+import           Generics.Deriving                             hiding (D, to)+import           GHC.Int++-- $setup+-- >>> :set -XTemplateHaskell+-- >>> :load Data.HyperLogLog+-- >>> import Control.Lens+-- >>> import Data.Reflection+-- >>> import Data.Monoid++------------------------------------------------------------------------------+-- HyperLogLog+------------------------------------------------------------------------------++-- |+--+-- Initialize a new counter:+--+-- >>> mempty :: HyperLogLog $(3)+-- HyperLogLog {runHyperLogLog = fromList [0,0,0,0,0,0,0,0]}+--+-- Please note how you specify a counter size with the @$(n)@+-- invocation. Sizes of up to 16 are valid, with 7 being a+-- likely good minimum for decent accuracy.+--+-- Let's count a list of unique items and get the latest estimate:+--+-- >>> size (foldr cons mempty [1..10] :: HyperLogLog $(4))+-- Approximate {_confidence = 0.9972, _lo = 2, _estimate = 11, _hi = 20}+--+-- Note how 'cons' can be used to add new observations to the+-- approximate counter.+newtype HyperLogLog p = HyperLogLog { runHyperLogLog :: V.Vector Rank }+    deriving (Eq, Show, Generic)++instance Serialize (HyperLogLog p)++makeClassy ''HyperLogLog++_HyperLogLog :: Iso' (HyperLogLog p) (V.Vector Rank)+_HyperLogLog = iso runHyperLogLog HyperLogLog+{-# INLINE _HyperLogLog #-}++instance ReifiesConfig p => HasConfig (HyperLogLog p) where+  config = to reflectConfig+  {-# INLINE config #-}++instance Semigroup (HyperLogLog p) where+  HyperLogLog a <> HyperLogLog b = HyperLogLog (V.zipWith max a b)+  {-# INLINE (<>) #-}++-- The 'Monoid' instance \"should\" just work. Give me two estimators and I+-- can give you an estimator for the union set of the two.+instance ReifiesConfig p => Monoid (HyperLogLog p) where+  mempty = HyperLogLog $ V.replicate (reflectConfig (Proxy :: Proxy p) ^. numBuckets) 0+  {-# INLINE mempty #-}+  mappend = (<>)+  {-# INLINE mappend #-}++instance (Profunctor p, Bifunctor p, Functor f, ReifiesConfig s, Hashable a, s ~ t, a ~ b) => Cons p f (HyperLogLog s) (HyperLogLog t) a b where+  _Cons = unto go where+    go (a,m@(HyperLogLog v)) = HyperLogLog $ V.modify (\x -> do old <- MV.read x bk; when (rnk > old) $ MV.write x bk rnk) v where+      !h = w32 (hash a)+      !bk = calcBucket m h+      !rnk = calcRank m h+  {-# INLINE _Cons #-}++instance (Profunctor p, Bifunctor p, Functor f, ReifiesConfig s, Hashable a, s ~ t, a ~ b) => Snoc p f (HyperLogLog s) (HyperLogLog t) a b where+  _Snoc = unto go where+    go (m@(HyperLogLog v), a) = HyperLogLog $ V.modify (\x -> do old <- MV.read x bk; when (rnk > old) $ MV.write x bk rnk) v where+      !h = w32 (hash a)+      !bk = calcBucket m h+      !rnk = calcRank m h+  {-# INLINE _Snoc #-}++-- | Approximate size of our set+size :: ReifiesConfig p => HyperLogLog p -> Approximate Int64+size m@(HyperLogLog bs) = Approximate 0.9972 l expected h where+  m' = fromIntegral (m^.numBuckets)+  numZeros = fromIntegral . V.length . V.filter (== 0) $ bs+  res = case raw < m^.smallRange of+    True | numZeros > 0 -> m' * log (m' / numZeros)+         | otherwise -> raw+    False | raw <= m^.interRange -> raw+          | otherwise -> -1 * lim32 * log (1 - raw / lim32)+  raw = m^.rawFact * (1 / sm)+  sm = V.sum $ V.map (\x -> 1 / (2 ^^ x)) bs+  expected = round res+  sd = err (m^.numBits)+  err n = 1.04 / sqrt (fromInteger (bit n))+  l = floor $ max (res*(1-3*sd)) 0+  h = ceiling $ res*(1+3*sd)+{-# INLINE size #-}++intersectionSize :: ReifiesConfig p => [HyperLogLog p] -> Approximate Int64+intersectionSize [] = 0+intersectionSize (x:xs) = withMin 0 $ size x + intersectionSize xs - intersectionSize (mappend x <$> xs)+{-# INLINE intersectionSize #-}++cast :: forall p q. (ReifiesConfig p, ReifiesConfig q) => HyperLogLog p -> Maybe (HyperLogLog q)+cast old+  | newBuckets <= oldBuckets = Just $ over _HyperLogLog ?? mempty $ V.modify $ \m ->+    V.forM_ (V.indexed $ old^._HyperLogLog) $ \ (i,o) -> do+      let j = mod i newBuckets+      a <- MV.read m j+      MV.write m j (max o a)+  | otherwise = Nothing -- TODO?+  where+  newConfig = reflectConfig (Proxy :: Proxy q)+  newBuckets = newConfig^.numBuckets+  oldBuckets = old^.numBuckets+{-# INLINE cast #-}
+ tests/doctests.hsc view
@@ -0,0 +1,79 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Main (doctests)+-- Copyright   :  (C) 2012-13 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- This module provides doctests for a project based on the actual versions+-- of the packages it was built with. It requires a corresponding Setup.lhs+-- to be added to the project+-----------------------------------------------------------------------------+module Main where++import Build_doctests (deps)+import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.FilePath+import Test.DocTest++##ifdef mingw32_HOST_OS+##ifdef i386_HOST_ARCH+##define USE_CP+import Control.Applicative+import Control.Exception+import Foreign.C.Types+foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool+foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##elif defined(x86_64_HOST_ARCH)+##define USE_CP+import Control.Applicative+import Control.Exception+import Foreign.C.Types+foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool+foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##endif+##endif++-- | Run in a modified codepage where we can print UTF-8 values on Windows.+withUnicode :: IO a -> IO a+##ifdef USE_CP+withUnicode m = do+  cp <- c_GetConsoleCP+  (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp+##else+withUnicode m = m+##endif++main :: IO ()+main = withUnicode $ getSources >>= \sources -> doctest $+    "-isrc"+  : "-idist/build/autogen"+  : "-idist/build"+  : "-optP-include"+  : "-optPdist/build/autogen/cabal_macros.h"+  : "dist/build/cbits/crc32.o"+  : "dist/build/cbits/debruijn.o"+  : "dist/build/cbits/fast.o"+  : "dist/build/cbits/rolling.o"+  : "dist/build/cbits/storage.o"+  : "-hide-all-packages"+  : map ("-package="++) deps ++ sources++getSources :: IO [FilePath]+getSources = filter (isSuffixOf ".hs") <$> go "src"+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c
+ travis/cabal-apt-install view
@@ -0,0 +1,27 @@+#! /bin/bash+set -eu++APT="sudo apt-get -q -y"+CABAL_INSTALL_DEPS="cabal install --only-dependencies --force-reinstall"++$APT update+$APT install dctrl-tools++# Find potential system packages to satisfy cabal dependencies+deps()+{+	local M='^\([^ ]\+\)-[0-9.]\+ (.*$'+	local G=' -o ( -FPackage -X libghc-\L\1\E-dev )'+	local E="$($CABAL_INSTALL_DEPS "$@" --dry-run -v 2> /dev/null \+		| sed -ne "s/$M/$G/p" | sort -u)"+	grep-aptavail -n -sPackage \( -FNone -X None \) $E | sort -u+}++$APT install $(deps "$@") libghc-quickcheck2-dev # QuickCheck is special+$CABAL_INSTALL_DEPS "$@" # Install the rest via Hackage++if ! $APT install hlint ; then+	$APT install $(deps hlint)+	cabal install hlint+fi+
+ travis/config view
@@ -0,0 +1,16 @@+-- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix+--+-- This is particularly useful for travis-ci to get it to stop complaining+-- about a broken build when everything is still correct on our end.+--+-- This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead+--+-- To enable this, uncomment the before_script in .travis.yml++remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive+remote-repo-cache: ~/.cabal/packages+world-file: ~/.cabal/world+build-summary: ~/.cabal/logs/build.log+remote-build-reporting: anonymous+install-dirs user+install-dirs global