dgim (empty) → 0.0.2

raw patch · 7 files changed

+253/−0 lines, 7 filesdep +Cabaldep +QuickCheckdep +basesetup-changed

Dependencies added: Cabal, QuickCheck, base, dgim

Files

• LICENSE +20/−0
• Setup.hs +2/−0
• dgim.cabal +38/−0
• dist/build/dgim-testStub/dgim-testStub-tmp/dgim-testStub.hs +5/−0
• src/Data/Stream/Algorithms/DGIM.hs +16/−0
• src/Data/Stream/Algorithms/DGIM/Internal.hs +120/−0
• tests/Test/DGIM.hs +52/−0

@@ -0,0 +1,20 @@+Copyright (c) 2015 Utkarsh Upadhyay++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,38 @@+name:                dgim+version:             0.0.2+synopsis:            Implementation of DGIM algorithm+description:         A basic implementation of the DGIM algorithm for counting the occurrence of certain elements in a fixed length prefix of a stream.+license:             MIT+license-file:        LICENSE+author:              Utkarsh Upadhyay+maintainer:          musically.ut@gmail.com+stability:           alpha+homepage:            https://github.com/musically-ut/haskell-dgim+bug-reports:         https://github.com/musically-ut/haskell-dgim/issues/+category:            Data, Algorithms+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Data.Stream.Algorithms.DGIM+                     , Data.Stream.Algorithms.DGIM.Internal+  -- other-modules:       +  -- other-extensions:    +  ghc-options:         -Wall -fwarn-incomplete-patterns+  build-depends:       base >=4.7 && <4.8+  hs-source-dirs:      src+  default-language:    Haskell2010++source-repository head+  type:                git+  location:            git://github.com/musically-ut/haskell-dgim.git++Test-Suite dgim-test+  type:                detailed-0.9+  hs-source-dirs:      tests+  test-module:         Test.DGIM+  default-language:    Haskell2010+  build-depends:       base >=4.7 && <4.8+                     , Cabal >= 1.20.0+                     , QuickCheck >= 2.4+                     , dgim >= 0.0.1

@@ -0,0 +1,5 @@+module Main ( main ) where+import Distribution.Simple.Test.LibV09 ( stubMain )+import Test.DGIM ( tests )+main :: IO ()+main = stubMain tests

@@ -0,0 +1,16 @@+module Data.Stream.Algorithms.DGIM (+  -- * Type (no constructors)+    DGIM++  -- * External interface+  , mkDGIM++  , insert+  , insert_++  , querySince+  , queryAll+  , queryLen+) where++import Data.Stream.Algorithms.DGIM.Internal

@@ -0,0 +1,120 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RecordWildCards #-}+module Data.Stream.Algorithms.DGIM.Internal (+  -- * Type (with constructors)+    DGIM(..)++  -- * Creation+  , mkDGIM++  -- * Insertion+  , insert+  , insert_++  -- * Querying+  , querySince+  , queryAll+  , queryLen++) where++import Control.Exception ( assert )++type Index        = Integer+type NumOnesLog2  = Integer++data Bucket       = B !Index !NumOnesLog2 deriving (Show)++getIndex :: Bucket -> Index+getIndex (B idx _) = idx++getCount :: Bucket -> Integer+getCount (B _ val) = 2 ^ val++{- TODO: The index can only increase by one at a time.+   Should create a time-stamp dependent version and provide this as a simpler+   interface.+-}++-- | The core data structure which contains the current state as+-- well as the parameters needed for operation.+data DGIM a = DGIM {+    dgimPredicate     :: !(a -> Bool)+  , dgimBuckets       :: ![Bucket]+  , dgimMaxSameBucket :: !Integer+  , dgimCliff         :: !Integer+  , dgimCurrentIdx    :: !Integer+  }++instance Show (DGIM a) where+    show DGIM{..} = "r = "       ++ (show dgimMaxSameBucket) ++ " " +++                    "cliff = "   ++ (show dgimCliff        ) ++ " " +++                    "idx = "     ++ (show dgimCurrentIdx   ) ++ " " +++                    "buckets = " ++ (show dgimBuckets      )+++-- | Create a new DGIM structure given:+--  - Required accuracy+--  - Size of the stream to operate on+--  - Predicate to determine if an element should be counted+mkDGIM :: (RealFrac a, Eq b) => a -> Integer -> (b -> Bool) -> DGIM b+mkDGIM accuracy k predicate =+    assert (accuracy >= 0.0 || accuracy < 1.0) $+      let numBuckets = ceiling (1 / (1 - accuracy)) in+      DGIM predicate [] numBuckets k 0++incrIndex :: DGIM a -> DGIM a+incrIndex dg = dg { dgimCurrentIdx = dgimCurrentIdx dg + 1 }++-- | Insert an element which does not count+insert_ :: DGIM a -> DGIM a+insert_ = incrIndex++-- | Insert an element into the stream+insert :: a -> DGIM a -> DGIM a+insert !v !dgim =+     let newElem = if dgimPredicate dgim v then [ B (dgimCurrentIdx dgim + 1) 0 ] else [] in+     incrIndex $ dgim { dgimBuckets = reverse $ (go newElem (dgimBuckets dgim) (fromIntegral $ length newElem) 0) }+   where+     go newBuckets oldBuckets similarBuckets lastBucketValue =+         case oldBuckets of+           -- Visited all the buckets+           [] -> newBuckets++           -- The rest of the buckets are past the time-zone cliff, drop them+           ((B bucketIdx _):_) | dgimCurrentIdx dgim - bucketIdx > dgimCliff dgim+             -> newBuckets++           -- Combine the rth and r+1th bucket into a larger bucket+           ((B idxR vR):(B _ vR1):rest) | similarBuckets  == dgimMaxSameBucket dgim - 1 &&+                                          lastBucketValue == vR &&+                                          vR              == vR1+             -> go newBuckets ((B idxR (lastBucketValue + 1)):rest) similarBuckets lastBucketValue++           -- See another bucket with the same value+           (x@(B _ vR):rest) | lastBucketValue == vR+             -> go (x:newBuckets) rest (similarBuckets + 1) lastBucketValue++           -- See a bucket with a different value+           (x@(B _ vR):rest) -- | lastBucketValue /= vR+             -> go (x:newBuckets) rest 1 vR+++-- | Query how many elements have been counted since a time-stamp+querySince :: DGIM a -> Integer -> Integer+querySince dgim since =+    sumAll $ filter ((>= since) . getIndex) $ dgimBuckets dgim+  where+    sumAll []         = 0+    sumAll [x]        = let c = getCount x  in 1 + ((c - 1) `div` 2)+    sumAll (x:y:rest) = getCount x + sumAll (y:rest)++-- | Query how many elements have been counted in the remembered suffix of the+-- stream+queryAll :: DGIM a -> Integer+queryAll dgim = querySince dgim (dgimCurrentIdx dgim - dgimCliff dgim)++-- | Query how many elements in the given number of recent entries have been+-- counted.+queryLen :: DGIM a -> Integer -> Integer+queryLen dgim numPastEntries = querySince dgim (dgimCurrentIdx dgim - numPastEntries + 1)

@@ -0,0 +1,52 @@+{-# LANGUAGE PackageImports, NamedFieldPuns #-}+module Test.DGIM ( tests ) where++import Data.Stream.Algorithms.DGIM.Internal as DGIM++import qualified Test.QuickCheck as Q+import Distribution.TestSuite as TS++toTSResult :: Q.Result -> TS.Result+toTSResult Q.Success {}         = TS.Pass+toTSResult Q.GaveUp {}          = TS.Fail "GaveUp"+toTSResult Q.Failure {Q.reason} = TS.Fail reason++runQuickCheck :: Q.Testable p => p -> IO TS.Progress+runQuickCheck prop = do+        qres <- Q.quickCheckWithResult Q.stdArgs {Q.maxSuccess = 30,+                                                  Q.maxSize = 20} prop+        return $ (Finished . toTSResult) qres++tests :: IO [Test]+tests = return [Test $ TestInstance (runQuickCheck checkAccuracy)+                                    "checkAccuracy" ["empty-tag"] [] undefined+                -- Test $ TestInstance (runQuickCheck propCheckP1)+                --                     "propCheckP1" [] [] undefined+                ]+++data Elem = Zero | One deriving (Eq, Show)++instance Q.Arbitrary Elem where+  arbitrary = Q.elements [Zero, One]++type Stream = [Elem]++toNum :: Elem -> Integer+toNum Zero = 0+toNum One  = 1++countOnes :: Stream -> Int -> Integer+countOnes stream queryLen = sum $ map toNum $ take queryLen stream++checkAccuracy :: Stream -> Bool+checkAccuracy stream =+  let accuracy = 0.99 in+  let streamLen = fromIntegral $ length stream in+  let queryLen = streamLen `div` 2 in+  let truth    = countOnes stream queryLen in+  let dgim = foldr DGIM.insert+                   (DGIM.mkDGIM accuracy (fromIntegral queryLen) (== One))+                   stream in+  let prediction = DGIM.queryLen dgim (fromIntegral queryLen) in+  abs (fromIntegral $ truth - prediction) <= (1.0 - accuracy) * fromIntegral truth