diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2011, Alp Mestanogullari + +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 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. diff --git a/Math/KMeans.hs b/Math/KMeans.hs new file mode 100644 --- /dev/null +++ b/Math/KMeans.hs @@ -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 + + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/kmeans-vector.cabal b/kmeans-vector.cabal new file mode 100644 --- /dev/null +++ b/kmeans-vector.cabal @@ -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): + . + 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 + +-- An email address to which users can send suggestions, bug reports, +-- and patches. +Maintainer: Alp Mestanogullari + +-- 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