# kirel/detexify-hs-backend

a little bit of strictness

• Loading branch information...
1 parent a9c97ab commit e1487c9d6d9586e0ded9b1be8d5c4200cd06e71a 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
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)
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
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.