[FEAT] Graph Multipartite connected, need to change the node shape in Graph and tests
[gargantext.git] / src / Gargantext / Core / Text / Metrics.hs
index 94ecd7aeadcd476a53ceba63dc2f553130e3e073..ed2db87a9a44382eaabaf8f708d7bbb23243c112 100644 (file)
@@ -11,43 +11,58 @@ Mainly reexport functions in @Data.Text.Metrics@
 
 -}
 
-{-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE TemplateHaskell   #-}
 
 module Gargantext.Core.Text.Metrics
   where
 
 --import Data.Array.Accelerate ((:.)(..), Z(..))
 --import Math.KMeans (kmeans, euclidSq, elements)
+import Control.Lens (makeLenses)
 import Data.Map (Map)
-import Gargantext.Prelude
-import Gargantext.Core.Methods.Distances.Accelerate.SpeGen
-import Gargantext.Core.Viz.Graph.Index
+import Data.Monoid (Monoid, mempty)
+import Data.HashMap.Strict (HashMap)
+import Data.Semigroup (Semigroup)
+import Gargantext.Core.Methods.Similarities.Accelerate.SpeGen
 import Gargantext.Core.Statistics (pcaReduceTo, Dimension(..))
+import Gargantext.Core.Viz.Graph.Index
+import Gargantext.Prelude
 import qualified Data.Array.Accelerate as DAA
 import qualified Data.Array.Accelerate.Interpreter as DAA
 import qualified Data.Map  as Map
-
+import qualified Data.Vector as V
 import qualified Data.Vector.Storable as Vec
+import qualified Data.HashMap.Strict as HashMap
+
 
 type MapListSize = Int
 type InclusionSize = Int
 
-scored :: Ord t => Map (t,t) Int -> [Scored t]
-scored = map2scored . (pcaReduceTo (Dimension 2)) . scored2map
+scored :: Ord t => HashMap (t,t) Int -> V.Vector (Scored t)
+scored = map2scored . (pcaReduceTo (Dimension 2)) . scored2map . Map.fromList . HashMap.toList
   where
     scored2map :: Ord t => Map (t,t) Int -> Map t (Vec.Vector Double)
     scored2map m = Map.fromList $ map (\(Scored t i s) -> (t, Vec.fromList [i,s])) $ scored' m
 
-    map2scored :: Ord t => Map t (Vec.Vector Double) -> [Scored t]
-    map2scored = map (\(t, ds) -> Scored t (Vec.head ds) (Vec.last ds)) . Map.toList
+    map2scored :: Ord t => Map t (Vec.Vector Double) -> V.Vector (Scored t)
+    map2scored = V.map (\(t, ds) -> Scored t (Vec.head ds) (Vec.last ds)) . V.fromList . Map.toList
 
 -- TODO change type with (x,y)
 data Scored ts = Scored
   { _scored_terms  :: !ts
   , _scored_genInc :: !GenericityInclusion
   , _scored_speExc :: !SpecificityExclusion
-  } deriving (Show)
+  } deriving (Show, Eq, Ord)
+
+instance Monoid a => Monoid (Scored a) where
+  mempty = Scored mempty mempty mempty
 
+instance Semigroup a => Semigroup (Scored a) where
+  (<>) (Scored a  b  c )
+       (Scored _a' b' c')
+      = Scored (a {-<> a'-})
+               (b <> b')
+               (c <> c')
 
 localMetrics' :: Ord t => Map (t,t) Int -> Map t (Vec.Vector Double)
 localMetrics' m = Map.fromList $ zipWith (\(_,t) (inc,spe) -> (t, Vec.fromList [inc,spe]))
@@ -55,7 +70,7 @@ localMetrics' m = Map.fromList $ zipWith (\(_,t) (inc,spe) -> (t, Vec.fromList [
                                           scores
   where
     (ti, fi) = createIndices m
-    (is, ss) = incExcSpeGen $ cooc2mat ti m
+    (is, ss) = incExcSpeGen $ cooc2mat Triangle ti m
     scores   = DAA.toList
              $ DAA.run
              $ DAA.zip (DAA.use is) (DAA.use ss)
@@ -67,7 +82,7 @@ scored' :: Ord t => Map (t,t) Int -> [Scored t]
 scored' m = zipWith (\(_,t) (inc,spe) -> Scored t inc spe) (Map.toList fi) scores
   where
     (ti, fi) = createIndices m
-    (is, ss) = incExcSpeGen $ cooc2mat ti m
+    (is, ss) = incExcSpeGen $ cooc2mat Triangle ti m
     scores   = DAA.toList
              $ DAA.run
              $ DAA.zip (DAA.use is) (DAA.use ss)
@@ -96,5 +111,5 @@ normalizeLocal (Scored t s1 s2) = Scored t (log' 5 s1) (log' 2 s2)
 
 
 
-
-
+-- | Type Instances
+makeLenses 'Scored