kmeans-vector 0.1.1 → 0.2
raw patch · 2 files changed
+60/−55 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Math.KMeans: Cluster :: !Int -> !Vector Double -> Cluster
+ Math.KMeans: center :: Cluster -> !Vector Double
+ Math.KMeans: cid :: Cluster -> !Int
+ Math.KMeans: computeClusters :: [[Vector Double]] -> [Cluster]
+ Math.KMeans: data Cluster
+ Math.KMeans: type Point a = (Vector Double, a)
- Math.KMeans: kmeans :: Int -> [Vector Double] -> [[Vector Double]]
+ Math.KMeans: kmeans :: Int -> [Point a] -> [[Point a]]
Files
- Math/KMeans.hs +49/−24
- kmeans-vector.cabal +11/−31
Math/KMeans.hs view
@@ -1,64 +1,89 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-} {- | Module : Math.KMeans-Copyright : (c) Alp Mestanogullari, 2011+Copyright : (c) Alp Mestanogullari, Ville Tirronen, 2011-2012 License : BSD3-Maintainer : alpmestan@gmail.com+Maintainer : Alp Mestanogullari <alpmestan@gmail.com> Stability : experimental An implementation of the k-means clustering algorithm based on the efficient vector package. -} -module Math.KMeans (kmeans) where+module Math.KMeans (kmeans, Point, Cluster(..), computeClusters) where import qualified Data.Vector.Unboxed as V+import qualified Data.Vector as G import qualified Data.List as L import Data.Function (on)-import Debug.Trace --- * K-Means clustering algorithm -type Vec = V.Vector Double+-- | Type holding an object of any type and its associated feature vector+type Point a = (V.Vector Double, a)++-- | Type representing a cluster (group) of vectors by its center and an id data Cluster = Cluster { cid :: !Int,- center :: !Vec- }+ center :: !(V.Vector Double)+ } -- deriving (Show,Eq) -distance :: Vec -> Vec -> Double-distance u v = V.sum $ V.zipWith (\a b -> (a - b)^2) u v+-- genVec = V.fromList `fmap` vectorOf 3 arbitrary+-- genPts = (flip zip) [0..] `fmap` replicateM 10 genVec+-- genClusters = do+-- cs <- replicateM 5 genVec+-- return (zipWith Cluster [0.. ] cs)+--+-- prop_regroup = forAll genClusters $ \c ->+-- forAll genPts $ \v ->+-- s (regroupPoints c v) == s (regroupPoints' c v)+-- where+-- same xs = length (L.nub xs) == length xs+-- s = map L.sort -partitionPoints :: Int -> [Vec] -> [[Vec]]-partitionPoints k vs = go vs++{-#INLINE distance#-}+distance :: Point a -> V.Vector Double -> Double+distance (u,_) v = V.sum $ V.zipWith (\a b -> (a - b)^2) u v++partition :: Int -> [a] -> [[a]]+partition k vs = go vs where go vs = case L.splitAt n vs of (vs', []) -> [vs'] (vs', vss) -> vs' : go vss n = (length vs + k - 1) `div` k- -computeClusters :: [[Vec]] -> [Cluster]++{-#INLINE computeClusters#-}+computeClusters :: [[V.Vector Double]] -> [Cluster] computeClusters = zipWith Cluster [0..] . map f where f (x:xs) = let (n, v) = L.foldl' (\(k, s) v' -> (k+1, V.zipWith (+) s v')) (1, x) xs in V.map (\x -> x / (fromIntegral n)) v -regroupPoints :: [Cluster] -> [Vec] -> [[Vec]]-regroupPoints clusters points = go points+{-#INLINE regroupPoints#-}+regroupPoints :: forall a. [Cluster] -> [Point a] -> [[Point a]]+regroupPoints clusters points = L.filter (not.null) . G.toList . G.accum (flip (:)) (G.replicate (length clusters) []) . map closest $ points+ where+ closest p = (cid (L.minimumBy (compare `on` (distance p . center)) clusters),p)++regroupPoints' :: forall a. [Cluster] -> [Point a] -> [[Point a]]+regroupPoints' clusters points = go points where go points = map (map snd) . L.groupBy ((==) `on` fst) . L.sortBy (compare `on` fst) $ map (\p -> (closest p, p)) points closest p = cid $ L.minimumBy (compare `on` (distance p . center)) clusters- -kmeansStep :: [Vec] -> [[Vec]] -> [[Vec]]-kmeansStep points pgroups = regroupPoints (computeClusters pgroups) points -kmeansAux :: [Vec] -> [[Vec]] -> [[Vec]]+kmeansStep :: [Point a] -> [[Point a]] -> [[Point a]]+kmeansStep points pgroups = regroupPoints (computeClusters . map (map fst) $ pgroups) points++kmeansAux :: [Point a] -> [[Point a]] -> [[Point a]] kmeansAux points pgroups = let pss = kmeansStep points pgroups in- case pss == pgroups of+ case map (map fst) pss == map (map fst) pgroups of True -> pgroups- False -> kmeansAux points pss + False -> kmeansAux points pss -- | Performs the k-means clustering algorithm -- using trying to use 'k' clusters on the given list of points-kmeans :: Int -> [V.Vector Double] -> [[V.Vector Double]]+kmeans :: Int -> [Point a] -> [[Point a]] kmeans k points = kmeansAux points pgroups- where pgroups = partitionPoints k points+ where pgroups = partition k points
kmeans-vector.cabal view
@@ -1,30 +1,25 @@ Name: kmeans-vector-Version: 0.1.1+Version: 0.2 Synopsis: An implementation of the kmeans clustering algorithm based on the vector package-Description: Provides a simple (but efficient) implementation of the k-means clustering algorithm. The goal of this algorithm is to, given a list of n-dimensional points, regroup them in k groups, such that each point gets to be in the group to which it is the closest to (using the 'center' of the group). - .- Sample output (after some gnuplot hackery -- see the tests dir in the repository): <http://i.imgur.com/IpIPC.png>- .- Expect some improvements on the initial clustering, thus resulting in a better clustering, for future versions.+Description: Provides a simple (but efficient) implementation of the k-means clustering algorithm. The goal of this algorithm is to, given a list of n-dimensional points, regroup them in k groups, such that each point gets to be in the group to which it is the closest to (using the 'center' of the group).+ .+ CHANGELOG+ .+ kmeans-vector-0.2 supports having feature vectors associated to objects, and thus computing kmeans on these vectors, letting you recover the initial objects. --- URL for the project homepage or repository. Homepage: http://github.com/alpmestan/kmeans-vector+ Bug-reports: https://github.com/alpmestan/kmeans-vector/issues--- The license under which the package is released.+ License: BSD3 --- The file containing the license text. License-file: LICENSE --- The package author(s).-Author: Alp Mestanogullari <alpmestan@gmail.com>+Author: Alp Mestanogullari <alpmestan@gmail.com>, Ville Tirronen --- An email address to which users can send suggestions, bug reports,--- and patches. Maintainer: Alp Mestanogullari <alpmestan@gmail.com> --- A copyright notice.-Copyright: 2011 Alp Mestanogullari+Copyright: 2011-2012 Alp Mestanogullari Stability: Experimental @@ -32,29 +27,14 @@ Build-type: Simple --- Extra files to be distributed with the package, such as examples or--- a README.--- Extra-source-files: ---- Constraint on the version of Cabal needed to build this package. Cabal-version: >=1.6 - Library- -- Modules exported by the library. Exposed-modules: Math.KMeans- - -- Packages needed in order to build this package. Build-depends: base >= 4 && < 5, vector >= 0.7 ghc-prof-options: -prof -auto-all ghc-options: -O2 -funbox-strict-fields- - -- Modules not exported by this package.- -- Other-modules: - - -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.- -- Build-tools: - + source-repository head type: git location: http://github.com/alpmestan/kmeans-vector.git