dtw 1.0.1.0 → 1.0.2.0
raw patch · 3 files changed
+26/−12 lines, 3 filesdep ~QuickCheck
Dependency ranges changed: QuickCheck
Files
- dtw.cabal +3/−2
- src/Data/DTW.hs +10/−10
- test/MainTest.hs +13/−0
dtw.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: dtw-version: 1.0.1.0+version: 1.0.2.0 synopsis: (Fast) Dynamic Time Warping description: This package implements dynamic time warping as described here <http://en.wikipedia.org/w/index.php?title=Dynamic_time_warping>@@ -42,7 +42,8 @@ containers, test-framework, test-framework-quickcheck2,- QuickCheck <2.8+ QuickCheck ghc-options: -O2 -Wall+ ghc-prof-options: -fprof-auto -auto-all -caf-all -rtsopts hs-source-dirs: src default-language: Haskell2010
src/Data/DTW.hs view
@@ -91,7 +91,7 @@ type Path = [Index] type Window = Set.Set Index -data Result a = Result { cost :: a, path :: Path } deriving (Show,Read,Eq)+data Result a = Result { cost :: {-# UNPACK #-} !a, path :: Path } deriving (Show,Read,Eq) -- | this is the naive implementation of dynamic time warping@@ -101,14 +101,14 @@ dtwNaive :: (Ord c, Fractional c, DataSet a, DataSet b) => (Item a -> Item b -> c) -> a -> b -> c-dtwNaive δ as bs = go (len as - 1) (len bs - 1)+dtwNaive δ as bs = go (len as) (len bs) where go 0 0 = 0 go _ 0 = 1/0 go 0 _ = 1/0- go x y = δ (ix as x) (ix bs y) + minimum [ go (x-1) y- , go x (y-1)- , go (x-1) (y-1)- ]+ go x y = δ (ix as (x-1)) (ix bs (y-1)) + minimum [ go (x-1) y+ , go x (y-1)+ , go (x-1) (y-1)+ ] ------------------------------------------------------------------------------------- @@ -128,7 +128,7 @@ -> a -> b -> Result c-dtwMemoWindowed δ inWindow as bs = go (len as - 1) (len bs - 1)+dtwMemoWindowed δ inWindow as bs = go (len as) (len bs) where -- wrap go' in a memoziation function so that each value -- is calculated only once go = vecMemo2 (len as) (len bs) go'@@ -146,13 +146,13 @@ , go x (y-1) , go (x-1) (y-1) ] newPath = (x,y) : path minResult- newCost = δ (ix as x) (ix bs y) + cost minResult+ newCost = δ (ix as (x-1)) (ix bs (y-1)) + cost minResult {-# INLINABLE dtwMemoWindowed #-} vecMemo2 :: Int -> Int -> (Int -> Int -> a) -> Int -> Int -> a-vecMemo2 w h f = \x y -> v V.! (x + y*w)- where v = V.generate (w*h) (\i -> let (y,x) = i `divMod` w in f x y)+vecMemo2 w h f = \x y -> v V.! (x + y*(w+1))+ where v = V.generate ((w+1)*(h+1)) (\i -> let (y,x) = i `divMod` (w+1) in f x y) -------------------------------------------------------------------------------------
test/MainTest.hs view
@@ -70,9 +70,22 @@ {- costB = cost (fastDtw dist 10 sa sb)-} {- matSize = fromIntegral $ S.length sa * S.length sb-} +testNaiveSingleElements :: (Double,Double) -> Bool+testNaiveSingleElements (a,b) = abs (ca - cb) < 0.0001+ where ca = dist a b+ cb = dtwNaive dist [a] [b]++testFastSingleElements :: (Double,Double) -> Bool+testFastSingleElements (a,b) = abs (ca - cb) < 0.0001+ where ca = dist a b+ cb = cost $ fastDtw dist reduceByHalf 2 (S.singleton a) (S.singleton b)++ main :: IO () main = defaultMain [ testProperty "dtwMemo ≡ dtwNaive" testDTWMemoVSDTWNaive , testProperty "fastDtw ≅ dtwNaive" testFastDTWvsDTWNaive {-, testProperty "fastDtw == dtwMemo" testFastDTWvsDTWMemo-}+ , testProperty "single element dtwNaive" testNaiveSingleElements+ , testProperty "single element dtwFast" testFastSingleElements ]