spectral-clustering 0.3.1.3 → 0.3.2.1
raw patch · 2 files changed
+25/−34 lines, 2 filesdep ~sparse-linear-algebra
Dependency ranges changed: sparse-linear-algebra
Files
spectral-clustering.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: spectral-clustering-version: 0.3.1.3+version: 0.3.2.1 license: GPL-3 license-file: LICENSE copyright: 2019 Gregory W. Schwartz@@ -32,6 +32,6 @@ hmatrix-svdlibc >=0.5.0.1, mwc-random >=0.13.6.0, safe >=0.3.17,- sparse-linear-algebra >=0.3.1,+ sparse-linear-algebra >=0.3.2, statistics >=0.14.0.2, vector >=0.12.0.1
src/Math/Clustering/Spectral/Sparse.hs view
@@ -12,6 +12,7 @@ , B2 (..) , AdjacencyMatrix (..) , LabelVector (..)+ , secondLeft , spectral , spectralCluster , spectralClusterK@@ -27,7 +28,7 @@ import Data.Bool (bool) import Data.Maybe (fromMaybe) import Data.Function (on)-import Data.List (sortBy, foldl1', maximumBy, transpose)+import Data.List (sortBy, foldl1', foldl', maximumBy, transpose) import Safe (headMay) import qualified AI.Clustering.KMeans as K import qualified Data.Map.Strict as Map@@ -63,63 +64,54 @@ b1ToB2 :: B1 -> B2 b1ToB2 (B1 b1) = B2- . S.fromListSM (n, m)- . fmap (\ (!i, !j, !x)- -> (i, j, (log (fromIntegral n / (S.lookupDenseSV j dVec))) * x)- )- . S.toListSM+ . S.sparsifySM+ . S.imapSM (\ _ !j !x -> (log (n / getValD j)) * x) $ b1 where- dVec :: S.SpVector Double- dVec = S.vr- . fmap (sum . fmap (\x -> if x > 0 then 1 else 0))+ getValD j = fromMaybe (error $ "b1ToB2: Column not found: " <> show j <> " from vector of length " <> show (U.length dVec) <> " in matrix of dim " <> show (S.dimSM b1))+ $ dVec U.!? j+ dVec :: U.Vector Double+ dVec = U.fromList+ . fmap (foldl' (+) 0 . fmap (\x -> if x > 0 then 1 else 0)) . S.toRowsL -- faster than toColsL. . S.transposeSM $ b1- n = S.nrows b1+ n = fromIntegral $ S.nrows b1 m = S.ncols b1 -- | Euclidean norm each row. b2ToB :: B2 -> B b2ToB (B2 b2) = B- . S.fromListSM (n, m)- . fmap (\(!i, !j, !x) -> (i, j, x / (S.lookupDenseSV i eVec)))- . S.toListSM+ . S.imapSM (\ !i _ !x -> x / (getValE i)) $ b2 where- eVec :: S.SpVector Double- eVec = S.vr . fmap S.norm2 . S.toRowsL $ b2- n = S.nrows b2- m = S.ncols b2+ getValE i = fromMaybe (error $ "b2ToB: Row not found: " <> show i <> " from vector of length " <> show (U.length eVec) <> " in matrix of dim " <> show (S.dimSM b2))+ $ eVec U.!? i+ eVec :: U.Vector Double+ eVec = U.fromList . fmap S.norm2 . S.toRowsL $ b2 -- | Find the Euclidean norm of a vector. norm2 :: S.SpVector Double -> Double-norm2 = sqrt . sum . fmap (** 2)+norm2 = sqrt . foldl' (+) 0 . fmap (** 2) -- | Get the signed diagonal transformed B matrix. bToD :: B -> D bToD (B b) = D- -- . S.diagonalSM . flip S.extractCol 0- $ (fmap abs b)- S.#~# ((fmap abs $ S.transposeSM b) S.#~# (S.fromColsL [S.onesSV n]))+ $ b'+ S.#~# (S.transposeSM b' S.#~# (S.fromColsL [S.onesSV n])) where+ b' = fmap abs b n = S.nrows b -- | Get the matrix C as input for SVD. bdToC :: B -> D -> C-bdToC (B b) (D d) = C- . S.fromListSM (S.dimSM b)- . fmap (\ (!i, !j, !x)- -> (i, j, (S.lookupDenseSV i d') * x)- )- . S.toListSM- $ b+bdToC (B b) (D d) = C . S.imapSM (\ !i _ !x -> (S.lookupDenseSV i d') * x) $ b where d' = S.sparsifySV $ fmap (\x -> x ** (-1 / 2)) d --- | Obtain the second left singular vector (or N earlier) and E on of a sparse+-- | Obtain the second left singular vector (or from N) and E on of a sparse -- matrix. secondLeft :: Int -> Int -> S.SpMatrix Double -> [S.SpVector Double] secondLeft n e m =@@ -185,8 +177,7 @@ . S.toRowsL . S.fromColsL . fmap S.normalize2- . S.toColsL- . S.transpose+ . S.toRowsL . S.fromColsL -- | Consensus kmeans.@@ -237,7 +228,7 @@ lNorm = i S.^+^ (S.transpose invRootD S.#~# (mat S.#~# invRootD)) invRootD = S.diagonalSM . S.vr- . fmap ((\x -> if x == 0 then x else x ** (- 1 / 2)) . sum)+ . fmap ((\x -> if x == 0 then x else x ** (- 1 / 2)) . foldl' (+) 0) . S.toRowsL . fmap abs -- signed diagonal $ mat