Commit 690629a4 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli Committed by Alfredo Di Napoli

Refactor createIndices

parent 8f4d901a
...@@ -709,6 +709,7 @@ common testDependencies ...@@ -709,6 +709,7 @@ common testDependencies
, aeson ^>= 2.1.2.1 , aeson ^>= 2.1.2.1
, aeson-qq , aeson-qq
, async ^>= 2.2.4 , async ^>= 2.2.4
, bimap >= 0.5.0
, bytestring ^>= 0.11.5.3 , bytestring ^>= 0.11.5.3
, cache >= 0.1.3.0 , cache >= 0.1.3.0
, containers ^>= 0.6.7 , containers ^>= 0.6.7
......
{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-| {-|
Module : Gargantext.Core.LinearAlgebra Module : Gargantext.Core.LinearAlgebra
Description : Linear Algebra utility functions Description : Linear Algebra utility functions
...@@ -19,27 +20,22 @@ module Gargantext.Core.LinearAlgebra ( ...@@ -19,27 +20,22 @@ module Gargantext.Core.LinearAlgebra (
, createIndices , createIndices
) where ) where
import Prelude import Data.Bimap (Bimap)
import Data.Bimap qualified as Bimap
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as M import Data.Map.Strict qualified as M
import Data.Set qualified as S import Data.Set qualified as S
import Data.Set (Set) import Data.Set (Set)
import Data.Map.Strict (Map) import Prelude
import Data.Foldable (foldl')
newtype Index = Index { _Index :: Int } newtype Index = Index { _Index :: Int }
deriving newtype (Eq, Show, Ord, Num, Enum) deriving newtype (Eq, Show, Ord, Num, Enum)
createIndices :: Ord t => Map (t, t) b -> (Map t Index, Map Index t) createIndices :: Ord t => Map (t, t) b -> Bimap Index t
createIndices = set2indices . map2set createIndices = set2indices . map2set
where where
map2set :: Ord t => Map (t, t) a -> Set t map2set :: Ord t => Map (t, t) a -> Set t
map2set cs' = foldl' (\s ((t1,t2),_) -> insert [t1,t2] s ) S.empty (M.toList cs') map2set cs' = foldr (\(t1, t2) s -> S.insert t1 $! S.insert t2 $! s) mempty $ M.keys cs'
where
insert as s = foldl' (\s' t -> S.insert t s') s as
set2indices :: Ord t => Set t -> (Map t Index, Map Index t) set2indices :: Ord t => Set t -> Bimap Index t
set2indices s = (M.fromList toIndex', M.fromList fromIndex') set2indices s = foldr (uncurry Bimap.insert) Bimap.empty (zip [0..] $ S.toList s)
where
fromIndex' = zip [0..] xs
toIndex' = zip xs [0..]
xs = S.toList s
...@@ -9,6 +9,9 @@ import Test.Tasty ...@@ -9,6 +9,9 @@ import Test.Tasty
import Gargantext.Core.Viz.Graph.Index qualified as Legacy import Gargantext.Core.Viz.Graph.Index qualified as Legacy
import Data.Map.Strict (Map) import Data.Map.Strict (Map)
import Data.Map.Strict qualified as M import Data.Map.Strict qualified as M
import Data.Bimap (Bimap)
import qualified Data.Bimap as Bimap
import Data.Bifunctor (first)
compareImplementations :: (Arbitrary a, Eq b, Show b) compareImplementations :: (Arbitrary a, Eq b, Show b)
=> (a -> b) => (a -> b)
...@@ -19,8 +22,8 @@ compareImplementations :: (Arbitrary a, Eq b, Show b) ...@@ -19,8 +22,8 @@ compareImplementations :: (Arbitrary a, Eq b, Show b)
compareImplementations implementation1 implementation2 mapResults inputData compareImplementations implementation1 implementation2 mapResults inputData
= implementation1 inputData === mapResults (implementation2 inputData) = implementation1 inputData === mapResults (implementation2 inputData)
mapCreateIndices :: (Map t Legacy.Index, Map Legacy.Index t) -> (Map t LA.Index, Map LA.Index t) mapCreateIndices :: Ord t => (Map t Legacy.Index, Map Legacy.Index t) -> Bimap LA.Index t
mapCreateIndices (m1, m2) = (M.map LA.Index m1, M.mapKeys LA.Index m2) mapCreateIndices (_m1, m2) = Bimap.fromList $ map (first LA.Index) $ M.toList m2
tests :: TestTree tests :: TestTree
tests = testGroup "LinearAlgebra" [ tests = testGroup "LinearAlgebra" [
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment