Permalink
Browse files

a little bit of strictness

  • Loading branch information...
1 parent a9c97ab commit e1487c9d6d9586e0ded9b1be8d5c4200cd06e71a @kirel committed Nov 8, 2010
Showing with 9 additions and 8 deletions.
  1. +2 −1 DTW.hs
  2. +5 −5 LB.hs
  3. +2 −2 Strokes.hs
View
3 DTW.hs
@@ -4,6 +4,7 @@ module DTW
) where
import Data.Array
+import Data.List (foldl1')
add :: (Double, Int) -> (Double, Int) -> (Double, Int)
add (a, b) (c, d) = (a+c, b+d)
@@ -45,7 +46,7 @@ gdtw :: Eq a => ( a -> a -> Double ) -> [a] -> [a] -> Double
gdtw measure s [] = gdtw measure [] s
gdtw measure [] _ = error "Can not compare empty series!"
gdtw measure s o = quo $ gdtw' measure s o (measure (head s) (head o), 1) where
- gdtw' measure [a] s (r,l) = (r + foldl1 (+) (map (measure a) s), l + length s)
+ gdtw' measure [a] s (r,l) = (r + foldl1' (+) (map (measure a) s), l + length s)
gdtw' measure s [a] (r,l) = gdtw' measure [a] s (r,l)
gdtw' measure s o (r,l) | left == min = gdtw' measure (tail s) o (r + left, l+1)
| middle == min = gdtw' measure (tail s) (tail o) (r + middle, l+1)
View
10 LB.hs
@@ -5,7 +5,7 @@ module LB
) where
import Data.Maybe
-import Data.List (sortBy, transpose, nub, foldl')
+import Data.List (sortBy, transpose, nub, foldl', foldl1')
import Strokes
newtype ConvexHull = ConvexHull [Point] deriving (Show)
@@ -24,8 +24,8 @@ angle (Point (x, y)) = x/y
grahamConvexHull :: Points -> ConvexHull
-- grahamConvexHull [_] = [_]
grahamConvexHull points | length points < 4 = ConvexHull $ nub points
-grahamConvexHull points = ConvexHull $ reverse $ nub $ foldl step [] sortedPoints where
- minP = foldl1 st points where -- checked!
+grahamConvexHull points = ConvexHull $ reverse $ nub $ foldl' step [] sortedPoints where
+ minP = foldl1' st points where -- checked!
st (Point (minPx, minPy)) (Point (px, py)) | py < minPy || (py == minPy && px < minPx) = Point (px, py)
| otherwise = Point (minPx, minPy)
comp v w = compare (negate $ angle v, norm v) (negate $ angle w, norm w)
@@ -97,12 +97,12 @@ pointHullDistance point (ConvexHull hull) =
-- Stroke -> Hulls -> Double
dtwlb :: Stroke -> [ConvexHull] -> Double
-dtwlb stroke hulls = foldl (+) 0 $ zipWith pointHullDistance stroke hulls
+dtwlb stroke hulls = foldl' (+) 0 $ zipWith pointHullDistance stroke hulls
for = flip map
naivedtw :: Eq a => ( a -> a -> Double ) -> Int -> [a] -> [a] -> Double
-naivedtw measure w s o = foldl1 (+) $ for (zip s o') $ \(p, ps) ->
+naivedtw measure w s o = foldl1' (+) $ for (zip s o') $ \(p, ps) ->
minimum $ for ps $ \p' -> measure p p'
where
o' = shiftedSeries o w
View
4 Strokes.hs
@@ -8,7 +8,7 @@ module Strokes
limit, dropEmpty
) where
-import Data.List (sort, sortBy)
+import Data.List (sort, sortBy, foldl')
import Sim
-- data types
@@ -78,7 +78,7 @@ slength (p:q:ps) = p `dist` q + (slength (q:ps))
slength _ = 0
boundingbox [] = error "An empty stroke has no bounding box"
-boundingbox ((Point (x,y)):ps) = foldl step (Point (x,y), Point (x,y)) ps where
+boundingbox ((Point (x,y)):ps) = foldl' step (Point (x,y), Point (x,y)) ps where
step :: Rect -> Point -> Rect
step (Point (minX, minY), Point (maxX, maxY)) (Point (x,y)) = (Point (min minX x, min minY y), Point (max maxX x, max maxY y))

0 comments on commit e1487c9

Please sign in to comment.