diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -135,7 +135,7 @@ Dense -> do (items, mat) <- readDenseAdjMatrix decodeOpt stdin - let cluster items = HD.hierarchicalSpectralCluster + let cluster items = HD.hierarchicalSpectralClusterAdj eigenGroup' (fmap unNumEigen numEigen') (fmap unMinSize minSize') diff --git a/hierarchical-spectral-clustering.cabal b/hierarchical-spectral-clustering.cabal --- a/hierarchical-spectral-clustering.cabal +++ b/hierarchical-spectral-clustering.cabal @@ -1,9 +1,9 @@ cabal-version: >=1.10 name: hierarchical-spectral-clustering -version: 0.2.1.1 +version: 0.2.2.0 license: GPL-3 license-file: LICENSE -copyright: 2018 Gregory W. Schwartz +copyright: 2019 Gregory W. Schwartz maintainer: gsch@pennmedicine.upenn.edu author: Gregory W. Schwartz homepage: http://github.com/GregorySchwartz/hierarchical-spectral-clustering#readme @@ -44,11 +44,11 @@ hmatrix >=0.19.0.0, fgl >=5.6.0.0, managed >=1.0.6, - modularity >=0.2.0.3, + modularity >=0.2.1.0, mtl >=2.2.2, safe >=0.3.17, sparse-linear-algebra >=0.3.1, - spectral-clustering >=0.2.1.2, + spectral-clustering >=0.2.2.0, streaming >=0.2.1.0, streaming-bytestring >=0.1.6, streaming-cassava >=0.1.0.1, diff --git a/src/Math/Clustering/Hierarchical/Spectral/Dense.hs b/src/Math/Clustering/Hierarchical/Spectral/Dense.hs --- a/src/Math/Clustering/Hierarchical/Spectral/Dense.hs +++ b/src/Math/Clustering/Hierarchical/Spectral/Dense.hs @@ -8,8 +8,11 @@ module Math.Clustering.Hierarchical.Spectral.Dense ( hierarchicalSpectralCluster - , AdjacencyMatrix (..) + , hierarchicalSpectralClusterAdj + , FeatureMatrix (..) + , B (..) , Items (..) + , ShowB (..) ) where -- Remote @@ -17,8 +20,8 @@ import Data.Clustering.Hierarchical (Dendrogram (..)) import Data.Maybe (fromMaybe) import Data.Tree (Tree (..)) -import Math.Clustering.Spectral.Dense (spectralClusterNorm, spectralClusterKNorm) -import Math.Modularity.Dense (getModularity) +import Math.Clustering.Spectral.Dense (B (..), AdjacencyMatrix (..), getB, spectralCluster, spectralClusterK, spectralClusterNorm, spectralClusterKNorm) +import Math.Modularity.Dense (getModularity, getBModularity) import Math.Modularity.Types (Q (..)) import qualified Data.Foldable as F import qualified Data.Set as Set @@ -30,24 +33,81 @@ import Math.Clustering.Hierarchical.Spectral.Types import Math.Clustering.Hierarchical.Spectral.Utility -type AdjacencyMatrix = H.Matrix Double +type FeatureMatrix = H.Matrix Double type Items a = V.Vector a +type ShowB = ((Int, Int), [(Int, Int, Double)]) +type NormalizeFlag = Bool -- | Check if there is more than one cluster. hasMultipleClusters :: H.Vector Double -> Bool hasMultipleClusters = (> 1) . Set.size . Set.fromList . H.toList -- | Generates a tree through divisive hierarchical clustering using +-- Newman-Girvan modularity as a stopping criteria. Can use minimum number of +-- observations in a cluster as a stopping criteria. Assumes the feature matrix +-- has column features and row observations. Items correspond to rows. Can +-- use FeatureMatrix or a pre-generated B matrix. See Shu et al., "Efficient +-- Spectral Neighborhood Blocking for Entity Resolution", 2011. +hierarchicalSpectralCluster :: EigenGroup + -> NormalizeFlag + -> Maybe NumEigen + -> Maybe Int + -> Maybe Q + -> Items a + -> Either FeatureMatrix B + -> ClusteringTree a +hierarchicalSpectralCluster eigenGroup normFlag numEigenMay minSizeMay minModMay initItems initMat = + go initItems initB + where + initB = either (getB normFlag) id $ initMat + minMod = fromMaybe (Q 0) minModMay + minSize = fromMaybe 1 minSizeMay + numEigen = fromMaybe 1 numEigenMay + go :: Items a -> B -> ClusteringTree a + go !items !b = + if (H.rows $ unB b) > 1 + && hasMultipleClusters clusters + && ngMod > minMod + && H.rows (unB left) >= minSize + && H.rows (unB right) >= minSize + then + Node { rootLabel = vertex + , subForest = [ go (subsetVector items leftIdxs) left + , go (subsetVector items rightIdxs) right + ] + } + + else + Node {rootLabel = vertex, subForest = []} + where + vertex = ClusteringVertex + { _clusteringItems = items + , _ngMod = ngMod + } + clusters :: H.Vector Double + clusters = spectralClustering eigenGroup b + spectralClustering :: EigenGroup -> B -> H.Vector Double + spectralClustering SignGroup = spectralCluster + spectralClustering KMeansGroup = spectralClusterK numEigen 2 + ngMod :: Q + ngMod = getBModularity clusters $ b + getIdxs val = VS.ifoldr' (\ !i !v !acc -> bool acc (i:acc) $ v == val) [] + leftIdxs = getIdxs 0 $ clusters + rightIdxs = getIdxs 1 $ clusters + left = B $ (unB b) H.? leftIdxs + right = B $ (unB b) H.? rightIdxs + +-- | Generates a tree through divisive hierarchical clustering using -- Newman-Girvan modularity as a stopping criteria. Can also use minimum number -- of observations in a cluster as the stopping criteria. -hierarchicalSpectralCluster :: (Show a) => EigenGroup +hierarchicalSpectralClusterAdj :: (Show a) => EigenGroup -> Maybe NumEigen -> Maybe Int -> Maybe Q -> Items a -> AdjacencyMatrix -> ClusteringTree a -hierarchicalSpectralCluster !eigenGroup !numEigenMay !minSizeMay !minModMay !items !adjMat = +hierarchicalSpectralClusterAdj !eigenGroup !numEigenMay !minSizeMay !minModMay !items !adjMat = if H.rows adjMat > 1 && hasMultipleClusters clusters && ngMod > minMod @@ -56,14 +116,14 @@ then Node { rootLabel = vertex , subForest = - [ hierarchicalSpectralCluster + [ hierarchicalSpectralClusterAdj eigenGroup numEigenMay minSizeMay minModMay (subsetVector items leftIdxs) left - , hierarchicalSpectralCluster + , hierarchicalSpectralClusterAdj eigenGroup numEigenMay minSizeMay diff --git a/src/Math/Clustering/Hierarchical/Spectral/Test.hs b/src/Math/Clustering/Hierarchical/Spectral/Test.hs --- a/src/Math/Clustering/Hierarchical/Spectral/Test.hs +++ b/src/Math/Clustering/Hierarchical/Spectral/Test.hs @@ -125,21 +125,45 @@ . S.toListSM $ adjacencyExample +denseFeatureExample :: H.Matrix Double +denseFeatureExample = H.assoc (S.dimSM (exampleMatrix 3 exampleData)) 0 + . fmap (\(!x, !y, !z) -> ((x, y), z)) + . S.toListSM + $ exampleMatrix 3 exampleData + +denseClusterAdjExample = Dense.hierarchicalSpectralClusterAdj + SignGroup + Nothing + Nothing + Nothing + exampleItems + denseAdjacencyExample + +denseClusterAdjKExample = Dense.hierarchicalSpectralClusterAdj + KMeansGroup + (Just 2) + Nothing + Nothing + exampleItems + denseAdjacencyExample + denseClusterExample = Dense.hierarchicalSpectralCluster SignGroup + True Nothing Nothing Nothing exampleItems - denseAdjacencyExample + (Left denseFeatureExample) denseClusterKExample = Dense.hierarchicalSpectralCluster KMeansGroup + True (Just 2) Nothing Nothing exampleItems - denseAdjacencyExample + (Left denseFeatureExample) -- | Generate the matrix of qgrams from a list of records and qgram length. exampleEigenMatrix :: Int -> [String] -> E.SparseMatrixXd