diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,10 @@ -# Version 0.3 +# Version 0.4 + + * reimplemented resampling function + * Implemented Sessions + + +# Version 0.3 (2016-12-18) * slice has different order of its parameters * valueAt has different order of its parameters diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -15,6 +15,7 @@ * Calculate statistics * min, max * median, variance, standard deviation + * Finding sessions (periods of activity with small breaks) ## Installation diff --git a/benchmark/Benchmarks.hs b/benchmark/Benchmarks.hs --- a/benchmark/Benchmarks.hs +++ b/benchmark/Benchmarks.hs @@ -28,21 +28,21 @@ smallSeries = TS.tsSeries [1..10^4] [1..] startTime :: UTCTime -startTime = posixSecondsToUTCTime $ fromIntegral 1 +startTime = posixSecondsToUTCTime 1 main :: IO () main = defaultMain [ bgroup "Basic operations" [ bench "size" $ nf TS.size bigSeries - , bench "valueAt" $ nf (\xs -> TS.valueAt lastIndex xs) bigSeries - , bench "slice" $ nf (\xs -> TS.valueAt (index 1) (TS.slice (index 2) lastIndex xs)) bigSeries + , bench "valueAt" $ nf (TS.valueAt lastIndex) bigSeries + , bench "slice" $ nf (TS.valueAt (index 1) . TS.slice (index 2) lastIndex) bigSeries , bench "max" $ nf maximum bigSeries , bench "fmap" $ nf (fmap (+ 2)) bigSeries ] , bgroup "Group operation" [ bench "rolling" $ nf (TS.rolling 20 sum) smallSeries - , bench "resampling" $ nf (TS.resample startTime (TS.seconds 20) sum) smallSeries + , bench "resampling" $ nf (TS.resample startTime (TS.seconds 20)) smallSeries ] , bgroup "IO" [ bench "load CSV" $ nfIO (TS.loadCSV TS.NoHeader parseISODateTime "testdata/test-100K.csv") ] diff --git a/src/Data/TimeSeries.hs b/src/Data/TimeSeries.hs --- a/src/Data/TimeSeries.hs +++ b/src/Data/TimeSeries.hs @@ -1,15 +1,7 @@ -- | TimeSeries library -module Data.TimeSeries - ( module Data.TimeSeries.Series - , module Data.TimeSeries.Stats - , module Data.TimeSeries.Time - , module Data.TimeSeries.IO.CSVReader - , module Data.TimeSeries.IO.CSVWriter - ) where - - -import Data.TimeSeries.Series -import Data.TimeSeries.Stats -import Data.TimeSeries.Time -import Data.TimeSeries.IO.CSVReader -import Data.TimeSeries.IO.CSVWriter +module Data.TimeSeries (module X) where + import Data.TimeSeries.Series as X + import Data.TimeSeries.Stats as X + import Data.TimeSeries.Time as X + import Data.TimeSeries.IO.CSVReader as X + import Data.TimeSeries.IO.CSVWriter as X diff --git a/src/Data/TimeSeries/IO/CSVWriter.hs b/src/Data/TimeSeries/IO/CSVWriter.hs --- a/src/Data/TimeSeries/IO/CSVWriter.hs +++ b/src/Data/TimeSeries/IO/CSVWriter.hs @@ -4,6 +4,7 @@ import Prelude hiding (writeFile) +import Control.Arrow (first) import Data.Csv import Data.ByteString.Lazy (writeFile) import Data.Text.Time ( formatISODateTime ) @@ -16,6 +17,6 @@ -- As a first argument provide function to convert date from ByteString to UTCTime saveCSV :: Series Double -> FilePath -> IO () saveCSV ts filePath = do - let rs = map (\(x, y) -> (formatISODateTime x, y)) (toList ts) + let rs = map (first formatISODateTime) (toList ts) let rs' = encode rs writeFile filePath rs' diff --git a/src/Data/TimeSeries/Series.hs b/src/Data/TimeSeries/Series.hs --- a/src/Data/TimeSeries/Series.hs +++ b/src/Data/TimeSeries/Series.hs @@ -8,25 +8,30 @@ Definition and basic operation on Series. -} -module Data.TimeSeries.Series - ( DataPoint +module Data.TimeSeries.Series ( + -- * Series datatype + DataPoint , Series , dpIndex , dpValue + -- * Create series , emptySeries + , tsSeries + , series + -- * Conversion between types + , toList + , values + -- * Selecting data from series , rolling , resample - , series , size , slice - , toList - , tsSeries , valueAt - , values ) where import Prelude hiding (max, min) -import Data.Time (UTCTime, NominalDiffTime, diffUTCTime) +import Data.Time ( UTCTime + , diffUTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.TimeSeries.Time (TimeResolution, nextTime) @@ -63,7 +68,7 @@ -- | Create series series :: [(UTCTime, a)] -> Series a -series xs = Series $ map (\(x, y) -> DP x y) xs +series xs = Series $ map (uncurry DP) xs -- | Create time series from timestamps and values @@ -84,7 +89,7 @@ -- | Get series values values :: Series a -> [a] -values ts = map (\(_, y) -> y) (toList ts) +values ts = map snd (toList ts) -- | Get series size. @@ -125,14 +130,14 @@ -- | Apply function to rolling window to create new Series -- Rolling window is also called Sliding Window. -rolling :: NominalDiffTime -- ^ Window size +rolling :: TimeResolution -- ^ Window size -> ([a] -> b) -- ^ Function applied to each window -> Series a -- ^ Input Series -> Series b -- ^ Converted Series rolling dt f (Series xs) = Series $ map (\(i, vs) -> DP i (f vs)) (windows dt xs) -- Create rolling windows based on given delta time. -windows :: NominalDiffTime -> [DataPoint a] -> [(UTCTime, [a])] +windows :: TimeResolution -> [DataPoint a] -> [(UTCTime, [a])] windows _ [] = [] windows dt xs = g ys : if length xs > length ys then windows dt (tail xs) else [] where @@ -142,25 +147,28 @@ g vs = (dpIndex (last vs), values (Series vs)) -- Check if two DataPoints are closer then given time difference -isInTimeRange :: NominalDiffTime -> DataPoint a -> DataPoint a -> Bool -isInTimeRange dt (DP i _) (DP j _) = diffUTCTime j i < dt +isInTimeRange :: TimeResolution -> DataPoint a -> DataPoint a -> Bool +isInTimeRange dt (DP i _) (DP j _) = j < nextTime dt i -- | Resample Time series -resample :: UTCTime -- ^ Starting time +resample :: Fractional a + => UTCTime -- ^ Starting time -> TimeResolution -- ^ Resampling resolution - -> ([a] -> b) -- ^ Function for aggregating data points -> Series a -- ^ Input series - -> Series b -- ^ Resampled series -resample utc res f (Series xs) = Series (map (\(i, vs) -> DP i (f (g vs))) (resample' utc res xs)) - where - g :: [DataPoint a] -> [a] - g = map dpValue + -> Series a -- ^ Resampled series +resample _ _ (Series []) = emptySeries +resample utc res (Series xs) = Series (resample' utc res (head xs) xs) -- | Resample based on list -resample' :: UTCTime -> TimeResolution -> [DataPoint a] -> [(UTCTime, [DataPoint a])] -resample' _ _ [] = [] -resample' utc res xs = (utc, ys) : resample' utc2 res zs +resample' :: Fractional a => UTCTime -> TimeResolution -> DataPoint a -> [DataPoint a] -> [DataPoint a] +resample' _ _ _ [] = [] +resample' utc res y (x:xs) + | utc < dpIndex x = DP utc mu : resample' utc2 res y (x:xs) + | utc == dpIndex x = DP utc (dpValue x) : resample' utc2 res x xs + | otherwise = resample' utc res x xs where utc2 = nextTime res utc - (ys, zs) = break (\(DP x _) -> x >= utc2) xs + mu = (ty/(tx+ty)) * dpValue x + ((tx/(tx+ty)) * dpValue y) + tx = abs $ realToFrac (diffUTCTime utc (dpIndex x)) + ty = abs $ realToFrac (diffUTCTime utc (dpIndex y)) diff --git a/src/Data/TimeSeries/Sessions.hs b/src/Data/TimeSeries/Sessions.hs new file mode 100644 --- /dev/null +++ b/src/Data/TimeSeries/Sessions.hs @@ -0,0 +1,49 @@ + +module Data.TimeSeries.Sessions + ( Session(..) + , find + ) where + +import Data.Time (UTCTime) +import Data.TimeSeries.Series (Series, toList) + +import Data.TimeSeries.Time(TimeResolution, nextTime) + + +-- | Session is a time range of a single event +-- Some examples: +-- * Session with web application +-- * Rain event +data Session = Session { sessionStart :: UTCTime + , sessionEnd :: UTCTime } + deriving (Eq, Show) + + +-- | Find all session in a given time series +find :: TimeResolution -> Series Bool -> [Session] +find dt ts = map (uncurry Session) xs' + where + xs = findChanges False (toList ts) + xs' = join dt (cnv xs) + + +-- Helper function for finding all places where value changes from True to False or vice versa +findChanges :: Bool -> [(a, Bool)] -> [a] +findChanges _ [] = [] +findChanges True [x] = [fst x] +findChanges v (x:xs) | v == snd x = findChanges v xs + | otherwise = fst x : findChanges (snd x) xs + +-- Convert list of changes into tuple2 +cnv :: [a] -> [(a, a)] +cnv [] = [] +cnv [_] = [] +cnv (x:y:z) = (x, y) : cnv z + +-- Join events close to each other into single session +join :: TimeResolution -> [(UTCTime, UTCTime)] -> [(UTCTime, UTCTime)] +join _ [] = [] +join _ [x] = [x] +join dt (x:y:z) = if nextTime dt (snd x) < fst y + then x:join dt (y:z) + else join dt ((fst x, snd y):z) diff --git a/src/Data/TimeSeries/Time.hs b/src/Data/TimeSeries/Time.hs --- a/src/Data/TimeSeries/Time.hs +++ b/src/Data/TimeSeries/Time.hs @@ -15,6 +15,9 @@ , addUTCTime) +-- | TimeResolution is for holding time periods which can't easy be translated to number of seconds +-- For example day doesn't always have 86400 and month have different number of days. +-- So if we want to define 1 month period we can't use DiffTime for it. data TimeResolution = Years Integer | Months Integer | Days Integer @@ -23,12 +26,12 @@ -- | Create Time Resolution from days days :: Integer -> TimeResolution -days n = Days n +days = Days -- | Create Time Resolution from months months :: Integer -> TimeResolution -months n = Months n +months = Months -- | Create Time Resolution from seconds @@ -38,7 +41,7 @@ -- | Create Time Resolution from years years :: Integer -> TimeResolution -years n = Years n +years = Years -- | Return Time Series mean diff --git a/test-src/Data/TimeSeries/IO/CSVSpec.hs b/test-src/Data/TimeSeries/IO/CSVSpec.hs --- a/test-src/Data/TimeSeries/IO/CSVSpec.hs +++ b/test-src/Data/TimeSeries/IO/CSVSpec.hs @@ -8,9 +8,9 @@ spec :: Spec -spec = do +spec = - describe "Reader" $ do + describe "Reader" $ it "co2 test data" $ do xs <- CSV.loadCSV CSV.HasHeader parseISODateTime "testdata/co2.csv" diff --git a/test-src/Data/TimeSeries/SeriesSpec.hs b/test-src/Data/TimeSeries/SeriesSpec.hs --- a/test-src/Data/TimeSeries/SeriesSpec.hs +++ b/test-src/Data/TimeSeries/SeriesSpec.hs @@ -1,6 +1,7 @@ module Data.TimeSeries.SeriesSpec (spec) where import Test.Hspec +import Control.Arrow (first) import Data.Time (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import qualified Statistics.Sample as S @@ -17,23 +18,23 @@ spec :: Spec spec = do - describe "Converting Series" $ do + describe "Converting Series" $ it "toList" $ do let xs = TS.toList sampleSeries - map (\(x, y) -> (utcTimeToPOSIXSeconds x, y)) xs `shouldBe` [(1, 10.0), (2, 1.2), (3, 32.4), (4, 0.6), (5, 11.0)] + map (first utcTimeToPOSIXSeconds) xs `shouldBe` [(1, 10.0), (2, 1.2), (3, 32.4), (4, 0.6), (5, 11.0)] describe "Selecting sub Series" $ do it "return data point value at given index" $ do - let pos = posixSecondsToUTCTime $ fromIntegral 2 + let pos = posixSecondsToUTCTime 2 TS.valueAt pos sampleSeries `shouldBe` Just 1.2 it "return Nothing value if wrong index" $ do let idx = [10, 20, 30] let values = [10.0, 12.0, 32.4] - let pos = posixSecondsToUTCTime $ fromIntegral 1234 + let pos = posixSecondsToUTCTime 1234 TS.valueAt pos (TS.tsSeries idx values) `shouldBe` Nothing it "return subset" $ do @@ -42,6 +43,12 @@ let end = utcFromSeconds 3 TS.size (TS.slice start end xs) `shouldBe` 2 + it "return range" $ do + let xs = TS.tsSeries [0, 5..] [1.0, 1.2, 32.4, 0.65, 11.0] + let start = utcFromSeconds 2 + let end = utcFromSeconds 130 + TS.size (TS.slice start end xs) `shouldBe` 4 + it "return empty subset" $ do let xs = TS.tsSeries [1..5] [10.0, 1.2, 32.4, 0.65, 11.0] let start = utcFromSeconds 12 @@ -60,8 +67,8 @@ let ys = fmap (+ 2) xs TS.values ys `shouldBe` [12.0, 3.2, 34.4, 2.65, 13.0] - it "fold over series" $ do - foldr (\v acc -> v + acc) 0.0 sampleSeries `shouldBe` 55.2 + it "fold over series" $ + foldr (+) 0.0 sampleSeries `shouldBe` 55.2 it "maximum value" $ do let xs = TS.tsSeries [1..] [10.0, 1.2, 32.4, 0.65, 11.0] @@ -76,16 +83,34 @@ it "rolling window" $ do let xs = TS.tsSeries [1..] [1.0, 2.0, 3.0, 4.0, 5.0] - TS.rolling 2 sum xs `shouldBe` TS.tsSeries [2..] [3.0, 5.0, 7.0, 9.0] + TS.rolling (TS.seconds 2) sum xs `shouldBe` TS.tsSeries [2..] [3.0, 5.0, 7.0, 9.0] it "smoothing" $ do let xs = TS.tsSeries [1..] [1.0, 2.0, 3.0, 4.0, 5.0] - TS.rolling 3 (S.mean . V.fromList) xs `shouldBe` TS.tsSeries [3..] [2.0, 3.0, 4.0] + TS.rolling (TS.seconds 3) (S.mean . V.fromList) xs `shouldBe` TS.tsSeries [3..] [2.0, 3.0, 4.0] - it "resampling" $ do + + describe "Resampling" $ do + + it "the same" $ do let xs = TS.tsSeries [1..] [1.0, 2.0, 3.0, 4.0, 5.0, 6.0] - let startTime = posixSecondsToUTCTime $ fromIntegral 1 - TS.resample startTime (seconds 2) sum xs `shouldBe` TS.tsSeries [1, 3, 5] [3.0, 7.0, 11.0] + let startTime = posixSecondsToUTCTime 1 + TS.resample startTime (seconds 2) xs `shouldBe` TS.tsSeries [1, 3, 5] [1.0, 3.0, 5.0] + + it "missing values" $ do + let xs = TS.tsSeries [1, 2, 3, 5] [1.0, 2.0, 3.0, 5.0] + let startTime = posixSecondsToUTCTime 1 + TS.resample startTime (seconds 1) xs `shouldBe` TS.tsSeries [1, 2, 3, 4, 5] [1.0, 2.0, 3.0, 4.0, 5.0] + + it "missing lots of values" $ do + let xs = TS.tsSeries [1, 5] [1.0, 5.0] + let startTime = posixSecondsToUTCTime 1 + TS.resample startTime (seconds 1) xs `shouldBe` TS.tsSeries [1, 2, 3, 4, 5] [1.0, 2.0, 3.0, 4.0, 5.0] + + it "middle values" $ do + let xs = TS.tsSeries [1, 3, 5] [1.0, 3.0, 5.0] + let startTime = posixSecondsToUTCTime 0 + TS.resample startTime (seconds 2) xs `shouldBe` TS.tsSeries [0, 2, 4] [1.0, 2.0, 4.0] diff --git a/test-src/Data/TimeSeries/SessionsSpec.hs b/test-src/Data/TimeSeries/SessionsSpec.hs new file mode 100644 --- /dev/null +++ b/test-src/Data/TimeSeries/SessionsSpec.hs @@ -0,0 +1,38 @@ +module Data.TimeSeries.SessionsSpec (spec) where + +import Test.Hspec +import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) +import Data.Time (NominalDiffTime) +import qualified Data.TimeSeries.Sessions as S + +import qualified Data.TimeSeries as TS + + +sessionFromSeconds :: NominalDiffTime -> NominalDiffTime -> S.Session +sessionFromSeconds n m = S.Session (posixSecondsToUTCTime n) (posixSecondsToUTCTime m) + +spec :: Spec +spec = + + describe "Sessions" $ do + + it "Without breaks" $ do + let idx = [1..6] + let values = repeat True + S.find (TS.seconds 1) (TS.tsSeries idx values) `shouldBe` [sessionFromSeconds 1 6] + + it "Single session" $ do + let idx = [1..] + let values = [False, True, True, True, True, True, False, False] + S.find (TS.seconds 1) (TS.tsSeries idx values) `shouldBe` [sessionFromSeconds 2 7] + + it "2 sessions" $ do + let idx = [1..] + let values = [False, True, True, True, False, False, True, False] + S.find (TS.seconds 1) (TS.tsSeries idx values) `shouldBe` [ sessionFromSeconds 2 5 + , sessionFromSeconds 7 8] + it "Single session 2 events" $ do + let idx = [1..] + let values = [False, True, True, False, True, True, False, False] + S.find (TS.seconds 2) (TS.tsSeries idx values) `shouldBe` [sessionFromSeconds 2 7] + diff --git a/test-src/Data/TimeSeries/TimeSpec.hs b/test-src/Data/TimeSeries/TimeSpec.hs --- a/test-src/Data/TimeSeries/TimeSpec.hs +++ b/test-src/Data/TimeSeries/TimeSpec.hs @@ -8,7 +8,7 @@ spec :: Spec -spec = do +spec = describe "Time resolution" $ do diff --git a/test-src/Spec.hs b/test-src/Spec.hs --- a/test-src/Spec.hs +++ b/test-src/Spec.hs @@ -1,5 +1,6 @@ import Test.Hspec import qualified Data.TimeSeries.SeriesSpec +import qualified Data.TimeSeries.SessionsSpec import qualified Data.TimeSeries.StatsSpec import qualified Data.TimeSeries.TimeSpec import qualified Data.TimeSeries.IO.CSVSpec @@ -8,6 +9,7 @@ main :: IO () main = hspec $ do describe "Series" Data.TimeSeries.SeriesSpec.spec + describe "Sessions" Data.TimeSeries.SessionsSpec.spec describe "Statistcs" Data.TimeSeries.StatsSpec.spec describe "Time" Data.TimeSeries.TimeSpec.spec describe "CSV" Data.TimeSeries.IO.CSVSpec.spec diff --git a/testdata/rain.csv b/testdata/rain.csv new file mode 100644 # file too large to diff: testdata/rain.csv diff --git a/timeseries.cabal b/timeseries.cabal --- a/timeseries.cabal +++ b/timeseries.cabal @@ -1,9 +1,10 @@ name: timeseries -version: 0.3.0 +version: 0.4.0 synopsis: Library for Time Series processing License: BSD3 License-file: LICENSE Copyright: (c) 2016 Krzysztof Langner +stability: Unstable interface, incomplete features. Extra-Source-Files: README.md, CHANGES.md, @@ -39,10 +40,11 @@ vector < 0.12 exposed-modules: Data.TimeSeries + Data.TimeSeries.Sessions other-modules: - Data.TimeSeries.Series, - Data.TimeSeries.Stats, - Data.TimeSeries.Time, + Data.TimeSeries.Series + Data.TimeSeries.Stats + Data.TimeSeries.Time Data.TimeSeries.IO.CSVReader Data.TimeSeries.IO.CSVWriter @@ -64,12 +66,14 @@ time >= 1.5 && < 2, vector < 0.12 other-modules: - Data.TimeSeries, - Data.TimeSeries.Series, - Data.TimeSeries.Stats, - Data.TimeSeries.Time, + Data.TimeSeries + Data.TimeSeries.Series + Data.TimeSeries.Sessions + Data.TimeSeries.Stats + Data.TimeSeries.Time Data.TimeSeries.SeriesSpec - Data.TimeSeries.TimeSpec, + Data.TimeSeries.SessionsSpec + Data.TimeSeries.TimeSpec Data.TimeSeries.IO.CSVReader Data.TimeSeries.IO.CSVWriter Data.TimeSeries.IO.CSVSpec