kmeans-par 1.1.0 → 1.2.0

raw patch · 4 files changed

+48/−56 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• benchmark/Main.lhs +9/−9
• kmeans-par.cabal +3/−3
• src/Algorithms/Lloyd/Sequential.lhs +29/−37
• src/Algorithms/Lloyd/Strategies.lhs +7/−7

@@ -12,15 +12,15 @@  We draw 2e3 normally distributed 2D points: -> points :: [Point]-> points = concat $ [0..2000-1] `forM` \n -> do->   return . Point . fromList $ [normals!!n, normals!!(n*2)]->   where normals = take 4000 $ mkNormals 0x29a+> points :: [Point Int]+> points = [Point (vector n) n | n <- [1..2000-1]]+>   where vector n = fromList [normals!!n, normals!!n*2]+>         normals  = mkNormals 0x29a  Three of which form the centroids of our initial clusters:   > clusters :: [Cluster]-> clusters = map (uncurry Cluster) $ zip [0..] (take 3 points)+> clusters = take 3 . map (uncurry Cluster) $ zip [0..] (map point points)  To correctly benchmark the result of a pure function, we need to be able to evaluate it to normal form:@@ -28,13 +28,13 @@ > instance NFData Cluster where >   rnf (Cluster i c) = rnf i `seq` rnf c >-> instance NFData Point where->   rnf (Point v) = rnf v+> instance NFData a => NFData (Point a) where+>   rnf (Point a b) = rnf a `seq` rnf b   Together the subject of our benchmarks:   > main :: IO () > main = defaultMain->   [ bench "Sequential" $ nf (Sequential.kmeans Euclidean points) clusters->   , bench "Strategies" $ nf (Strategies.kmeans Euclidean 64 points) clusters+>   [ bench "Sequential" $ nf (Sequential.kmeans 80 Euclidean points) clusters+>   , bench "Strategies" $ nf (Strategies.kmeans 80 Euclidean 64 points) clusters >   ] 

@@ -1,5 +1,5 @@ name:                kmeans-par-version:             1.1.0+version:             1.2.0 synopsis:            Sequential and parallel implementations of Lloyd's algorithm. license:             MIT license-file:        LICENSE@@ -16,7 +16,7 @@   other-extensions:    ViewPatterns    build-depends:       base == 4.*, vector, semigroups, parallel, split, metric   hs-source-dirs:      src-  ghc-options:         -threaded+  ghc-options:         -threaded -O2 -with-rtsopts=-N -rtsopts   default-language:    Haskell2010  benchmark kmeans-benchmark@@ -24,5 +24,5 @@   main-is:          Main.lhs   hs-source-dirs:   benchmark   build-depends:    base == 4.*, random, criterion, normaldistribution, kmeans-par, deepseq, vector, metric-  ghc-options:      -threaded+  ghc-options:      -threaded -O2 -with-rtsopts=-N -rtsopts   default-language: Haskell2010

@@ -15,17 +15,19 @@ > import Data.Vector (Vector(..), toList, create, zipWith, map, foldr1, empty, replicate) > import qualified Data.Vector.Mutable as MV (replicate, read, write)  -A data point is represented by an n-dimensional real vector:+A data point is comprised of an n-dimensional real vector, and an+associated value: -> data Point = Point +> data Point a = Point  >   { point :: Vector Double->   } deriving (Eq, Show)+>   , value :: a+>   }  -Point isn't parametrised, so we can't define a functor (or any functor-family)-instances. Instead, we define a specialised map, `pmap`:+Two data-points are defined as equivalent if they've a point vector in+common: -> pmap :: (Double -> Double) -> Point -> Point-> pmap f = Point . map f . point+> instance Eq (Point a) where+>   (==) = (==) `on` point  To define distance between data-points, we admit arbitrary metric spaces over real vectors; **However:** it should be noted that convergence is@@ -33,19 +35,14 @@ same criterion as minimum-distance assignment (`assign` below.) For this reason, Euclidean-distance is popularly used for mean assignment. -> useMetric :: Metric a => (Vector Double -> a) -> Point -> Point -> Double-> useMetric metric = distance `on` (metric . point)- -`Point`s may be combined using simple vector addition:--> instance Semigroup Point where->   (<>) = Point ..: zipWith (+) `on` point+> useMetric :: Metric a => (Vector Double -> a) -> Vector Double -> Vector Double -> Double+> useMetric = on distance  Clusters are represented by an identifier and a centroid:  > data Cluster = Cluster >   { identifier :: Int->   , centroid   :: Point+>   , centroid   :: Vector Double >   } deriving (Show)  Clusters are treated as equivalent if they share a centroid:@@ -57,47 +54,46 @@ of points in a set when constructing new clusters. It consists of a count of included points, as well as the vector sum of the constituent points: -> data PointSum = PointSum Int Point deriving (Show)+> data PointSum = PointSum Int (Vector Double) deriving (Show)  Two `PointSum`s can be combined by summing corresponding values:  > instance Semigroup PointSum where->   PointSum c0 p0 <> PointSum c1 p1 = PointSum (c0+c1) (p0<>p1)+>   PointSum c0 p0 <> PointSum c1 p1 = PointSum (c0+c1) (zipWith (+) p0 p1)  Without dependent types, we can't define a valid Monoid instance for PointSum, as the identity varies with the dimensions of the point vector. But we can construct one at runtime:  > emptyPointSum :: Int -> PointSum-> emptyPointSum length = PointSum 0 . Point $ replicate length 0+> emptyPointSum length = PointSum 0 $ replicate length 0  A point sum is constructed by incrementally adding points likeso: -> addPoint :: PointSum -> Point -> PointSum-> addPoint sum point = sum <> pure point->   where pure = PointSum 1 +> addPoint :: PointSum -> Point a -> PointSum+> addPoint sum = (sum <>) . PointSum 1 . point  A point sum can be turned into a cluster by computing its centroid, the average of all points associated with the cluster:  > toCluster :: Int -> PointSum -> Cluster-> toCluster cid (PointSum count point) = Cluster+> toCluster cid (PointSum count vector) = Cluster >   { identifier = cid->   , centroid   = pmap (// count) point+>   , centroid   = map (//count) vector >   } > > (//) :: Double -> Int -> Double > x // y = x / fromIntegral y-         +            After each iteration, points are associated with the cluster having the nearest centroid: -> closestCluster :: Metric a => (Vector Double -> a) -> [Cluster] -> Point -> Cluster-> closestCluster (useMetric -> d) clusters point = fst . minimumBy (compare `on` snd) $ do+> closestCluster :: Metric a => (Vector Double -> a) -> [Cluster] -> Point b -> Cluster+> closestCluster (useMetric -> d) clusters (point->point) = fst . minimumBy (compare `on` snd) $ do >   cluster <- clusters >   return (cluster, point `d` centroid cluster) >-> assign :: Metric a => (Vector Double -> a) -> [Cluster] -> [Point] -> Vector PointSum+> assign :: Metric a => (Vector Double -> a) -> [Cluster] -> [Point b] -> Vector PointSum > assign metric clusters points = let nc = length clusters in create $ do >   vector <- MV.replicate nc $ emptyPointSum nc >   points `forM_` \point -> do@@ -115,27 +111,23 @@ >                     -- computing the centroid. >   return $ toCluster index pointSum >-> step :: Metric a => (Vector Double -> a) -> [Cluster] -> [Point] -> [Cluster]+> step :: Metric a => (Vector Double -> a) -> [Cluster] -> [Point b] -> [Cluster] > step = makeNewClusters ...: assign->  The algorithm consists of iteratively finding the centroid of each existing cluster, then reallocating points according to which centroid is closest, until convergence. As the algorithm isn't guaranteed to converge, we cut execution if convergence hasn't been observed after eighty iterations: -> kmeans :: Metric a => (Vector Double -> a) -> [Point] -> [Cluster] -> [Cluster]-> kmeans = flip kmeans' 0 +> kmeans :: Metric a => Int -> (Vector Double -> a) -> [Point b] -> [Cluster] -> [Cluster]+> kmeans expectDivergent metric = kmeans' expectDivergent metric 0  >-> kmeans' :: Metric a => (Vector Double -> a) -> Int -> [Point] -> [Cluster] -> [Cluster]-> kmeans' metric iterations points clusters +> kmeans' :: Metric a => Int -> (Vector Double -> a) -> Int -> [Point b] -> [Cluster] -> [Cluster]+> kmeans' expectDivergent metric iterations points clusters  >   | iterations >= expectDivergent = clusters >   | clusters' == clusters         = clusters ->   | otherwise                     = kmeans' metric (succ iterations) points clusters'+>   | otherwise                     = kmeans' expectDivergent metric (succ iterations) points clusters' >   where clusters' = step metric clusters points->-> expectDivergent :: Int-> expectDivergent = 80  A note on initialisation: typically clusters are randomly assigned to data points prior to the first update step.

@@ -12,7 +12,7 @@ > import Data.Metric (Metric(..)) > import Data.Semigroup (Semigroup(..)) > import Data.Vector (Vector(..), zipWith)-> import Algorithms.Lloyd.Sequential (Cluster(..), Point(..), PointSum(..), makeNewClusters, assign, expectDivergent)+> import Algorithms.Lloyd.Sequential (Cluster(..), Point(..), PointSum(..), makeNewClusters, assign)  We can combine two vectors of some same type $t$ provided we know how to combine two $t$s:@@ -23,7 +23,7 @@ Step is modified to, given a partitioned list of points, perform classification in parallel: -> step :: Metric a => (Vector Double -> a) -> [Cluster] -> [[Point]] -> [Cluster]+> step :: Metric a => (Vector Double -> a) -> [Cluster] -> [[Point b]] -> [Cluster] > step = makeNewClusters . foldr1 (<>) . with (parTraversable rseq) ..: map ..: assign  > > with :: Strategy a -> a -> a@@ -38,12 +38,12 @@ are too few items, and those items vary in cost, some of our cores may be unused for part of the computation. -> kmeans :: Metric a => (Vector Double -> a) -> Int -> [Point] -> [Cluster] -> [Cluster]-> kmeans metric = kmeans' metric 0  ..: chunksOf+> kmeans :: Metric a => Int -> (Vector Double -> a) -> Int -> [Point b] -> [Cluster] -> [Cluster]+> kmeans expectDivergent metric = kmeans' expectDivergent metric 0  ..: chunksOf >-> kmeans' :: Metric a => (Vector Double -> a) -> Int -> [[Point]] -> [Cluster] -> [Cluster]-> kmeans' metric iterations points clusters +> kmeans' :: Metric a => Int -> (Vector Double -> a) -> Int -> [[Point b]] -> [Cluster] -> [Cluster]+> kmeans' expectDivergent metric iterations points clusters  >   | iterations >= expectDivergent = clusters >   | clusters' == clusters         = clusters ->   | otherwise                     = kmeans' metric (succ iterations) points clusters'+>   | otherwise                     = kmeans' expectDivergent metric (succ iterations) points clusters' >   where clusters' = step metric clusters points