kmeans-vector (empty) → 0.1

raw patch · 4 files changed

+156/−0 lines, 4 filesdep +basedep +vectorsetup-changed

Dependencies added: base, vector

Files

• LICENSE +30/−0
• Math/KMeans.hs +64/−0
• Setup.hs +2/−0
• kmeans-vector.cabal +60/−0

@@ -0,0 +1,30 @@+Copyright (c)2011, Alp Mestanogullari <alpmestan@gmail.com>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alp Mestanogullari <alpmestan@gmail.com> nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,64 @@+{-# LANGUAGE BangPatterns #-}++{- |+Module      :  Math.KMeans+Copyright   :  (c) Alp Mestanogullari, 2011+License     :  BSD3+Maintainer  :  alpmestan@gmail.com+Stability   :  experimental++An implementation of the k-means clustering algorithm based on the efficient vector package.++-}++module Math.KMeans (kmeans) where++import qualified Data.Vector.Unboxed as V+import qualified Data.List as L+import Data.Function (on)+import Debug.Trace++--- * K-Means clustering algorithm++type Vec = V.Vector Double+data Cluster = Cluster {+  cid :: !Int,+  center :: !Vec+  }++distance :: Vec -> Vec -> Double+distance u v = V.sum $ V.zipWith (\a b -> (a - b)^2) u v++partitionPoints :: Int -> [Vec] -> [[Vec]]+partitionPoints 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]+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+  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]]+kmeansAux points pgroups = let pss = kmeansStep points pgroups in+  case pss == pgroups of+  True -> pgroups+  False -> kmeansStep 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 k points = kmeansAux points pgroups+  where pgroups = partitionPoints k points++

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,60 @@+Name:                kmeans-vector+Version:             0.1+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.++-- 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>++-- 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++Stability:	     Experimental++Category:            Math++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