packages feed

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 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