diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -45,7 +45,8 @@ import Math.Clustering.Hierarchical.Spectral.Types import Math.Graph.Components import qualified Math.Clustering.Hierarchical.Spectral.Dense as HD -import qualified Math.Clustering.Hierarchical.Spectral.Eigen.AdjacencyMatrix as HS +-- import qualified Math.Clustering.Hierarchical.Spectral.Eigen.AdjacencyMatrix as HS +import qualified Math.Clustering.Hierarchical.Spectral.Sparse as HS newtype Delimiter = Delimiter { unDelimiter :: Char } deriving (Read, Show) newtype Row = Row { unRow :: Int } deriving (Eq, Ord, Read, Show) @@ -158,10 +159,11 @@ $ mat else Single $ cluster items mat Sparse -> do - (items, mat) <- readEigenSparseAdjMatrix decodeOpt stdin + -- (items, mat) <- readEigenSparseAdjMatrix decodeOpt stdin + (items, mat) <- readSparseAdjMatrix decodeOpt stdin let cluster items = clusteringTreeToGenericClusteringTree - . HS.hierarchicalSpectralCluster + . HS.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,6 +1,6 @@ cabal-version: >=1.10 name: hierarchical-spectral-clustering -version: 0.4.1.1 +version: 0.4.1.2 license: GPL-3 license-file: LICENSE copyright: 2019 Gregory W. Schwartz @@ -22,8 +22,6 @@ Math.Clustering.Hierarchical.Spectral.Dense Math.Clustering.Hierarchical.Spectral.Sparse Math.Clustering.Hierarchical.Spectral.Load - Math.Clustering.Hierarchical.Spectral.Eigen.AdjacencyMatrix - Math.Clustering.Hierarchical.Spectral.Eigen.FeatureMatrix Math.Clustering.Hierarchical.Spectral.Types Math.Clustering.Hierarchical.Spectral.Utility Math.Graph.Components @@ -39,16 +37,15 @@ cassava >=0.5.1.0, clustering >=0.4.0, containers >=0.5.11.0, - eigen ==3.3.4.1, hierarchical-clustering >=0.4.6, hmatrix >=0.19.0.0, fgl >=5.6.0.0, managed >=1.0.6, - modularity >=0.2.1.0, + modularity >=0.2.1.1, mtl >=2.2.2, safe >=0.3.17, sparse-linear-algebra >=0.3.1, - spectral-clustering >=0.3.1.0, + spectral-clustering >=0.3.1.1, streaming >=0.2.1.0, streaming-bytestring >=0.1.6, streaming-cassava >=0.1.0.1, diff --git a/src/Math/Clustering/Hierarchical/Spectral/Eigen/AdjacencyMatrix.hs b/src/Math/Clustering/Hierarchical/Spectral/Eigen/AdjacencyMatrix.hs deleted file mode 100644 --- a/src/Math/Clustering/Hierarchical/Spectral/Eigen/AdjacencyMatrix.hs +++ /dev/null @@ -1,100 +0,0 @@ -{- Math.Clustering.Hierarchical.Spectral.Eigen.AdjacencyMatrix -Gregory W. Schwartz - -Collects the functions pertaining to hierarchical spectral clustering. --} - -{-# LANGUAGE BangPatterns #-} - -module Math.Clustering.Hierarchical.Spectral.Eigen.AdjacencyMatrix - ( hierarchicalSpectralCluster - , AdjacencyMatrix (..) - , Items (..) - ) where - --- Remote -import Data.Bool (bool) -import Data.Clustering.Hierarchical (Dendrogram (..)) -import Data.Maybe (fromMaybe) -import Data.Tree (Tree (..)) -import Math.Clustering.Spectral.Eigen.AdjacencyMatrix (spectralClusterNorm, spectralClusterKNorm) -import Math.Modularity.Eigen.Sparse (getModularity) -import Math.Modularity.Types (Q (..)) -import Safe (headMay) -import qualified Data.Foldable as F -import qualified Data.Set as Set -import qualified Data.Eigen.SparseMatrix as S -import qualified Data.Vector as V -import qualified Data.Vector.Storable as VS - --- Local -import Math.Clustering.Hierarchical.Spectral.Types -import Math.Clustering.Hierarchical.Spectral.Utility - -type AdjacencyMatrix = S.SparseMatrixXd -type Items a = V.Vector a - --- | Check if there is more than one cluster. -hasMultipleClusters :: S.SparseMatrixXd -> Bool -hasMultipleClusters = (> 1) - . Set.size - . Set.fromList - . concat - . S.toDenseList - --- | 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 :: EigenGroup - -> Maybe NumEigen - -> Maybe Int - -> Maybe Q - -> Items a - -> AdjacencyMatrix - -> ClusteringTree a -hierarchicalSpectralCluster !eigenGroup !numEigenMay !minSizeMay !minModMay !items !adjMat = - - if S.rows adjMat > 1 - && hasMultipleClusters clusters - && ngMod > minMod - && S.rows left >= minSize - && S.rows right >= minSize - then do - Node { rootLabel = vertex - , subForest = [ hierarchicalSpectralCluster - eigenGroup - numEigenMay - minSizeMay - minModMay - (subsetVector items leftIdxs) - left - , hierarchicalSpectralCluster - eigenGroup - numEigenMay - minSizeMay - minModMay (subsetVector items rightIdxs) - right - ] - } - else - Node {rootLabel = vertex, subForest = []} - where - clusters = spectralClustering eigenGroup adjMat - spectralClustering :: EigenGroup -> AdjacencyMatrix -> S.SparseMatrixXd - spectralClustering SignGroup = spectralClusterNorm - spectralClustering KMeansGroup = spectralClusterKNorm numEigen 2 - minMod = fromMaybe (Q 0) minModMay - minSize = fromMaybe 1 minSizeMay - numEigen = fromMaybe 1 numEigenMay - vertex = ClusteringVertex { _clusteringItems = items - , _ngMod = ngMod - } - ngMod = getModularity clusters adjMat - getIdxs val = VS.ifoldr' (\ !i !v !acc -> bool acc (i:acc) $ v == val) [] - . VS.fromList - . concat - . S.toDenseList - leftIdxs = getIdxs 0 clusters - rightIdxs = getIdxs 1 clusters - left = S.squareSubset leftIdxs adjMat - right = S.squareSubset rightIdxs adjMat diff --git a/src/Math/Clustering/Hierarchical/Spectral/Eigen/FeatureMatrix.hs b/src/Math/Clustering/Hierarchical/Spectral/Eigen/FeatureMatrix.hs deleted file mode 100644 --- a/src/Math/Clustering/Hierarchical/Spectral/Eigen/FeatureMatrix.hs +++ /dev/null @@ -1,113 +0,0 @@ -{- Math.Clustering.Hierarchical.Spectral.Eigen.FeatureMatrix -Gregory W. Schwartz - -Collects the functions pertaining to hierarchical spectral clustering for -feature matrices. --} - -{-# LANGUAGE BangPatterns #-} - -module Math.Clustering.Hierarchical.Spectral.Eigen.FeatureMatrix - ( hierarchicalSpectralCluster - , FeatureMatrix (..) - , B (..) - , Items (..) - , ShowB (..) - ) where - --- Remote -import Data.Bool (bool) -import Data.Clustering.Hierarchical (Dendrogram (..)) -import Data.Maybe (fromMaybe) -import Data.Tree (Tree (..)) -import Math.Clustering.Spectral.Eigen.FeatureMatrix (B (..), getB, spectralCluster, spectralClusterK) -import Math.Modularity.Eigen.Sparse (getBModularity) -import Math.Modularity.Types (Q (..)) -import qualified Data.Foldable as F -import qualified Data.Set as Set -import qualified Data.Eigen.SparseMatrix as S -import qualified Data.Vector as V -import qualified Data.Vector.Storable as VS - --- Local -import Math.Clustering.Hierarchical.Spectral.Types -import Math.Clustering.Hierarchical.Spectral.Utility - -type FeatureMatrix = S.SparseMatrixXd -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 :: S.SparseMatrixXd -> Bool -hasMultipleClusters = (> 1) - . Set.size - . Set.fromList - . concat - . S.toDenseList - --- | 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 (S.rows $ unB b) > 1 - && hasMultipleClusters clusters - && ngMod > minMod - && S.rows (unB left) >= minSize - && S.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 :: S.SparseMatrixXd - clusters = spectralClustering eigenGroup b - spectralClustering :: EigenGroup -> B -> S.SparseMatrixXd - spectralClustering SignGroup = spectralCluster - spectralClustering KMeansGroup = spectralClusterK numEigen 2 - ngMod :: Q - ngMod = getBModularity clusters b - getSortedIdxs :: Double -> S.SparseMatrixXd -> [Int] - getSortedIdxs val = VS.ifoldr' (\ !i !v !acc -> bool acc (i:acc) $ v == val) [] - . VS.fromList - . concat - . S.toDenseList - leftIdxs :: [Int] - leftIdxs = getSortedIdxs 0 clusters - rightIdxs :: [Int] - rightIdxs = getSortedIdxs 1 clusters - left :: B - left = B $ extractRows (unB b) leftIdxs - right :: B - right = B $ extractRows (unB b) rightIdxs - extractRows :: S.SparseMatrixXd -> [Int] -> S.SparseMatrixXd - extractRows mat [] = S.fromList 0 0 [] - extractRows mat xs = S.fromRows . fmap (flip S.getRow mat) $ xs diff --git a/src/Math/Clustering/Hierarchical/Spectral/Load.hs b/src/Math/Clustering/Hierarchical/Spectral/Load.hs --- a/src/Math/Clustering/Hierarchical/Spectral/Load.hs +++ b/src/Math/Clustering/Hierarchical/Spectral/Load.hs @@ -10,7 +10,7 @@ module Math.Clustering.Hierarchical.Spectral.Load ( readDenseAdjMatrix , readSparseAdjMatrix - , readEigenSparseAdjMatrix + -- , readEigenSparseAdjMatrix ) where -- Remote @@ -20,7 +20,7 @@ import System.IO (Handle (..)) import qualified Data.ByteString.Streaming.Char8 as BS import qualified Data.Csv as CSV -import qualified Data.Eigen.SparseMatrix as E +-- import qualified Data.Eigen.SparseMatrix as E import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Sparse.Common as SH @@ -140,28 +140,28 @@ return (items, mat) --- | Get a sparse adjacency matrix from a handle. -readEigenSparseAdjMatrix :: CSV.DecodeOptions - -> Handle - -> IO (V.Vector T.Text, E.SparseMatrixXd) -readEigenSparseAdjMatrix decodeOpt handle = flip with return $ do - let getAssocList = S.toList_ . S.map parseRow +-- -- | Get a sparse adjacency matrix from a handle. +-- readEigenSparseAdjMatrix :: CSV.DecodeOptions +-- -> Handle +-- -> IO (V.Vector T.Text, E.SparseMatrixXd) +-- readEigenSparseAdjMatrix decodeOpt handle = flip with return $ do +-- let getAssocList = S.toList_ . S.map parseRow - assocList <- - fmap (either (error . show) id) - . runExceptT - . getAssocList - . S.decodeWith decodeOpt S.NoHeader - $ (BS.hGetContents handle :: BS.ByteString (ExceptT S.CsvParseException Managed) ()) +-- assocList <- +-- fmap (either (error . show) id) +-- . runExceptT +-- . getAssocList +-- . S.decodeWith decodeOpt S.NoHeader +-- $ (BS.hGetContents handle :: BS.ByteString (ExceptT S.CsvParseException Managed) ()) - let items = V.fromList $ getAllIndices assocList - mat = E.fromList (V.length items) (V.length items) - . Set.toList - . Set.fromList -- Ensure no duplicates. - . fmap (\((i, j), v) -> (i, j, v)) - . symmetric -- Ensure symmetry. - . zeroDiag -- Ensure zeros on diagonal. - . getNewIndices -- Only look at present rows by converting indices. - $ assocList +-- let items = V.fromList $ getAllIndices assocList +-- mat = E.fromList (V.length items) (V.length items) +-- . Set.toList +-- . Set.fromList -- Ensure no duplicates. +-- . fmap (\((i, j), v) -> (i, j, v)) +-- . symmetric -- Ensure symmetry. +-- . zeroDiag -- Ensure zeros on diagonal. +-- . getNewIndices -- Only look at present rows by converting indices. +-- $ assocList - return (items, mat) +-- return (items, mat) 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 @@ -16,17 +16,17 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Sparse.Common as S -import qualified Data.Eigen.SparseMatrix as E +-- import qualified Data.Eigen.SparseMatrix as E import qualified Data.Vector as V -import qualified Math.Clustering.Spectral.Eigen.FeatureMatrix as EF +-- import qualified Math.Clustering.Spectral.Eigen.FeatureMatrix as EF import qualified Numeric.LinearAlgebra as H -- Local import Math.Clustering.Hierarchical.Spectral.Types import Math.Clustering.Hierarchical.Spectral.Sparse import qualified Math.Clustering.Hierarchical.Spectral.Dense as Dense -import qualified Math.Clustering.Hierarchical.Spectral.Eigen.FeatureMatrix as EF -import qualified Math.Clustering.Hierarchical.Spectral.Eigen.AdjacencyMatrix as EA +-- import qualified Math.Clustering.Hierarchical.Spectral.Eigen.FeatureMatrix as EF +-- import qualified Math.Clustering.Hierarchical.Spectral.Eigen.AdjacencyMatrix as EA newtype QGram = QGram { unQGram :: String } deriving (Eq, Ord, Read, Show) newtype QGramMap = QGramMap @@ -165,48 +165,48 @@ exampleItems (Left denseFeatureExample) --- | Generate the matrix of qgrams from a list of records and qgram length. -exampleEigenMatrix :: Int -> [String] -> E.SparseMatrixXd -exampleEigenMatrix n records = E.fromList (S.nrows mat) (S.ncols mat) . S.toListSM $ mat - where - mat = exampleMatrix n records +-- -- | Generate the matrix of qgrams from a list of records and qgram length. +-- exampleEigenMatrix :: Int -> [String] -> E.SparseMatrixXd +-- exampleEigenMatrix n records = E.fromList (S.nrows mat) (S.ncols mat) . S.toListSM $ mat +-- where +-- mat = exampleMatrix n records -adjacencyEigenExample :: E.SparseMatrixXd -adjacencyEigenExample = E._imap (\i j v -> if i == j then 0 else v) - $ (EF.unB b) * E.transpose (EF.unB b) - where - b = EF.getB True $ exampleEigenMatrix 3 exampleData +-- adjacencyEigenExample :: E.SparseMatrixXd +-- adjacencyEigenExample = E._imap (\i j v -> if i == j then 0 else v) +-- $ (EF.unB b) * E.transpose (EF.unB b) +-- where +-- b = EF.getB True $ exampleEigenMatrix 3 exampleData -clusterEigenExample = EF.hierarchicalSpectralCluster - SignGroup - True - Nothing - Nothing - Nothing - exampleItems - (Left $ exampleEigenMatrix 3 exampleData) +-- clusterEigenExample = EF.hierarchicalSpectralCluster +-- SignGroup +-- True +-- Nothing +-- Nothing +-- Nothing +-- exampleItems +-- (Left $ exampleEigenMatrix 3 exampleData) -clusterKEigenExample = EF.hierarchicalSpectralCluster - KMeansGroup - True - (Just 2) - Nothing - Nothing - exampleItems - (Left $ exampleEigenMatrix 3 exampleData) +-- clusterKEigenExample = EF.hierarchicalSpectralCluster +-- KMeansGroup +-- True +-- (Just 2) +-- Nothing +-- Nothing +-- exampleItems +-- (Left $ exampleEigenMatrix 3 exampleData) -clusterAdjEigenExample = EA.hierarchicalSpectralCluster - SignGroup - Nothing - Nothing - Nothing - exampleItems - adjacencyEigenExample +-- clusterAdjEigenExample = EA.hierarchicalSpectralCluster +-- SignGroup +-- Nothing +-- Nothing +-- Nothing +-- exampleItems +-- adjacencyEigenExample -clusterKAdjEigenExample = EA.hierarchicalSpectralCluster - KMeansGroup - (Just 2) - Nothing - Nothing - exampleItems - adjacencyEigenExample +-- clusterKAdjEigenExample = EA.hierarchicalSpectralCluster +-- KMeansGroup +-- (Just 2) +-- Nothing +-- Nothing +-- exampleItems +-- adjacencyEigenExample diff --git a/src/Math/Graph/Types.hs b/src/Math/Graph/Types.hs --- a/src/Math/Graph/Types.hs +++ b/src/Math/Graph/Types.hs @@ -12,7 +12,7 @@ -- Remote import Data.List (sort) -import qualified Data.Eigen.SparseMatrix as E +-- import qualified Data.Eigen.SparseMatrix as E import qualified Data.Map.Strict as Map import qualified Data.Graph.Inductive as G import qualified Data.Sparse.Common as S @@ -23,7 +23,7 @@ -- Local import qualified Math.Clustering.Spectral.Dense as D -import qualified Math.Clustering.Spectral.Eigen.AdjacencyMatrix as E +-- import qualified Math.Clustering.Spectral.Eigen.AdjacencyMatrix as E import qualified Math.Clustering.Spectral.Sparse as S -- | Get a re-mapped edge list with nodes ordered from 0 to the number of nodes @@ -63,9 +63,9 @@ $ mat fromGraph gr = S.fromListSM (G.noNodes gr, G.noNodes gr) . orderedEdges $ gr -instance Graphable E.AdjacencyMatrix where - toGraph mat = G.mkGraph (zip [0 .. E.rows mat - 1] [0 .. E.rows mat - 1]) - . filter (\(_, _, x) -> x /= 0) - . E.toList - $ mat - fromGraph gr = E.fromList (G.noNodes gr) (G.noNodes gr) . orderedEdges $ gr +-- instance Graphable E.AdjacencyMatrix where +-- toGraph mat = G.mkGraph (zip [0 .. E.rows mat - 1] [0 .. E.rows mat - 1]) +-- . filter (\(_, _, x) -> x /= 0) +-- . E.toList +-- $ mat +-- fromGraph gr = E.fromList (G.noNodes gr) (G.noNodes gr) . orderedEdges $ gr