Portability : POSIX
Mainly reexport functions in @Data.Text.Metrics@
+
-}
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
-module Gargantext.Text.Metrics where
+module Gargantext.Text.Metrics
+ where
-import Data.Text (Text, pack)
-import qualified Data.Text as T
-import Data.List (concat)
+--import Data.Array.Accelerate ((:.)(..), Z(..))
+--import Math.KMeans (kmeans, euclidSq, elements)
---import GHC.Real (Ratio)
---import qualified Data.Text.Metrics as DTM
+--import GHC.Float (exp)
+import Data.Map (Map)
+import Data.List.Extra (sortOn)
+import GHC.Real (round)
import Gargantext.Prelude
+import Gargantext.Viz.Graph.Distances.Matrice
+import Gargantext.Viz.Graph.Index
+import qualified Data.Array.Accelerate as DAA
+import qualified Data.Array.Accelerate.Interpreter as DAA
+import qualified Data.List as List
+import qualified Data.Map as Map
-import Gargantext.Text.Metrics.Count (occurrences, cooc)
-import Gargantext.Text.Terms (TermType(Multi), terms)
-import Gargantext.Core (Lang(EN))
-import Gargantext.Core.Types (Terms(..))
-import Gargantext.Text.Context (splitBy, SplitContext(Sentences))
+import Numeric.Statistics.PCA (pcaReduceN)
+import qualified Data.Vector.Storable as Vec
+import Data.Array.IArray (Array, listArray, elems)
---noApax :: Ord a => Map a Occ -> Map a Occ
---noApax m = M.filter (>1) m
+type GraphListSize = Int
+type InclusionSize = Int
-metrics_text :: Text
-metrics_text = T.concat ["A table is an object."
- ,"A glas is an object too."
- ,"Using a glas to dring is a function."
- ,"Using a spoon to eat is a function."
- ,"The spoon is an object to eat."
- ]
-metrics_sentences' :: [Text]
-metrics_sentences' = splitBy (Sentences 0) metrics_text
+toScored :: Ord t => [Map t (Vec.Vector Double)] -> [Scored t]
+toScored = map2scored
+ . (reduceTo (Dimension 2))
+ . (Map.filter (\v -> Vec.length v > 1))
+ . (Map.unionsWith (<>))
--- | Sentences
-metrics_sentences :: [Text]
-metrics_sentences = ["A table is an object."
- ,"A glas is an object too."
- ,"The glas and the spoon are on the table."
- ,"The spoon is an object to eat."
- ,"The spoon is on the table and the plate and the glas."]
+scored :: Ord t => Map (t,t) Int -> [Scored t]
+scored = map2scored . (reduceTo (Dimension 2)) . scored2map
-metrics_sentences_Test = metrics_sentences == metrics_sentences'
+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
--- | Terms reordered to visually check occurrences
-metrics_terms :: [[Text]]
-metrics_terms = undefined
+map2scored :: Ord t => Map t (Vec.Vector Double) -> [Scored t]
+map2scored = map (\(t, ds) -> Scored t (Vec.head ds) (Vec.last ds)) . Map.toList
-metrics_terms' :: IO [[Terms]]
-metrics_terms' = mapM (terms Multi EN) $ splitBy (Sentences 0) metrics_text
+-- TODO change type with (x,y)
+data Scored ts = Scored
+ { _scored_terms :: !ts
+ , _scored_incExc :: !InclusionExclusion
+ , _scored_speGen :: !SpecificityGenericity
+ } deriving (Show)
---metrics_terms_Test = metrics_terms == ((map _terms_label) <$> metrics_terms')
+data Dimension = Dimension Int
--- | Occurrences
-{-
-fromList [ (fromList ["table"] ,fromList [(["table"] , 3 )])]
- , (fromList ["object"],fromList [(["object"], 3 )])
- , (fromList ["glas"] ,fromList [(["glas"] , 2 )])
- , (fromList ["spoon"] ,fromList [(["spoon"] , 2 )])
--}
-metrics_occ = occurrences <$> concat <$> (mapM (terms Multi EN) $ splitBy (Sentences 0) metrics_text)
+reduceTo :: Ord t
+ => Dimension
+ -> Map t (Vec.Vector Double)
+ -> Map t (Vec.Vector Double)
+reduceTo (Dimension d) ss = Map.fromList $ zip txts $ elems $ pcaReduceN ss'' d
+ where
+ ss'' :: Array Int (Vec.Vector Double)
+ ss'' = listArray (1, List.length ss') ss'
-{-
--- fromList [((["glas"],["object"]),6)
- ,((["glas"],["spoon"]),4)
- ,((["glas"],["table"]),6),((["object"],["spoon"]),6),((["object"],["table"]),9),((["spoon"],["table"]),6)]
+ (txts,ss') = List.unzip $ Map.toList ss
--}
-metrics_cooc = cooc <$> (mapM (terms Multi EN) $ splitBy (Sentences 0) metrics_text)
-metrics_cooc' = (mapM (terms Multi EN) $ splitBy (Sentences 0) "The table object. The table object.")
+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]))
+ (Map.toList fi)
+ scores
+ where
+ (ti, fi) = createIndices m
+ (is, ss) = incExcSpeGen $ cooc2mat ti m
+ scores = DAA.toList
+ $ DAA.run
+ $ DAA.zip (DAA.use is) (DAA.use ss)
+
+
+
+
+-- TODO Code to be remove below
+-- TODO in the textflow we end up needing these indices , it might be
+-- better to compute them earlier and pass them around.
+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
+ scores = DAA.toList
+ $ DAA.run
+ $ DAA.zip (DAA.use is) (DAA.use ss)
+
+
+
+
+
+
+takeScored :: Ord t => GraphListSize -> InclusionSize -> Map (t,t) Int -> [t]
+takeScored listSize incSize = map _scored_terms
+ . linearTakes listSize incSize _scored_speGen
+ _scored_incExc
+ . scored
+
+-- | Filter Scored data
+-- >>> linearTakes 2 3 fst snd $ Prelude.zip ([1..10] :: [Int]) (reverse $ [1..10] :: [Int])
+-- [(3,8),(6,5)]
+linearTakes :: (Ord b1, Ord b2)
+ => GraphListSize -> InclusionSize
+ -> (a -> b2) -> (a -> b1) -> [a] -> [a]
+linearTakes gls incSize speGen incExc = take gls
+ . List.concat
+ . map (take $ round
+ $ (fromIntegral gls :: Double)
+ / (fromIntegral incSize :: Double)
+ )
+ . map (sortOn incExc)
+ . splitEvery incSize
+ . sortOn speGen