[API] PostNodeAsync funs, before refactoring
[gargantext.git] / src / Gargantext / Text / Metrics.hs
index 70fd45778e6651899b12c088882df9ded807f227..5692b837ada29f292c59eff49ca605fe1a3011b4 100644 (file)
@@ -22,7 +22,7 @@ module Gargantext.Text.Metrics
 --import Math.KMeans (kmeans, euclidSq, elements)
 
 --import GHC.Float (exp)
-
+import Data.Tuple.Extra (both)
 import Data.Map (Map)
 import Data.List.Extra (sortOn)
 import GHC.Real (round)
@@ -40,21 +40,22 @@ import qualified Data.Vector.Storable as Vec
 type GraphListSize = Int
 type InclusionSize = Int
 
-toScored :: Ord t => [Map t (Vec.Vector Double)] -> [Scored t] 
-toScored = map2scored
+{-
+toScored' :: Ord t => [Map t (Vec.Vector Double)] -> [Scored t] 
+toScored' = map2scored
          . (pcaReduceTo (Dimension 2))
          . (Map.filter (\v -> Vec.length v > 1))
          . (Map.unionsWith (<>))
-
+-}
 
 scored :: Ord t => Map (t,t) Int -> [Scored t]
 scored = map2scored . (pcaReduceTo (Dimension 2)) . scored2map
+  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
 
-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) -> [Scored t]
+    map2scored = map (\(t, ds) -> Scored t (Vec.head ds) (Vec.last ds)) . Map.toList
 
 -- TODO change type with (x,y)
 data Scored ts = Scored
@@ -63,8 +64,8 @@ data Scored ts = Scored
   , _scored_speGen :: !SpecificityGenericity
   } deriving (Show)
 
-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]))
+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
@@ -88,8 +89,8 @@ scored' m = zipWith (\(_,t) (inc,spe) -> Scored t (inc) (spe)) (Map.toList fi) s
              $ DAA.zip (DAA.use is) (DAA.use ss)
 
 
-takeScored :: Ord t => GraphListSize -> InclusionSize -> Map (t,t) Int -> [t]
-takeScored listSize incSize = map _scored_terms
+takeScored :: Ord t => GraphListSize -> InclusionSize -> Map (t,t) Int -> ([t],[t])
+takeScored listSize incSize = both (map _scored_terms)
                             . linearTakes listSize incSize _scored_speGen
                                                            _scored_incExc
                             . scored
@@ -100,14 +101,27 @@ takeScored listSize incSize = map _scored_terms
 -- [(3,8),(6,5)]
 linearTakes :: (Ord b1, Ord b2)
             => GraphListSize -> InclusionSize
-            -> (a -> b2) -> (a -> b1) -> [a] -> [a]
-linearTakes gls incSize speGen incExc = take gls
+            -> (a -> b2) -> (a -> b1) -> [a] -> ([a],[a])
+linearTakes mls incSize speGen incExc = (List.splitAt mls)
                       . List.concat
                       . map (take $ round
-                                  $ (fromIntegral gls     :: Double)
+                                  $ (fromIntegral mls     :: Double)
                                   / (fromIntegral incSize :: Double)
                              )
-                      . map (sortOn incExc)
+                      . map (sortOn speGen)
                       . splitEvery incSize
-                      . sortOn speGen
+                      . take 5000
+                      . takePercent (0.70)
+                      . sortOn incExc
+
+takePercent :: Double -> [a] -> [a]
+takePercent l xs = List.take l' xs
+  where
+    l' = round $ l * (fromIntegral $ List.length xs)
+
+splitTake :: (Int, a -> Bool) -> (Int, a -> Bool) -> [a] -> ([a], [a])
+splitTake (a, af) (b, bf) xs = (mpa <> mpb, ca <> cb)
+  where
+    (mpa, ca) = List.splitAt a $ List.filter af xs
+    (mpb, cb) = List.splitAt b $ List.filter bf xs