Commit 41908d30 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] Order 1 and Order 2, node size ok.

parent 083c1f50
...@@ -71,6 +71,7 @@ type Neighbor = Node ...@@ -71,6 +71,7 @@ type Neighbor = Node
-- | getMaxCliques -- | getMaxCliques
-- TODO chose distance order -- TODO chose distance order
getMaxCliques :: Ord a => CliqueFilter -> Distance -> Threshold -> Map (a, a) Int -> [[a]] getMaxCliques :: Ord a => CliqueFilter -> Distance -> Threshold -> Map (a, a) Int -> [[a]]
getMaxCliques f d t m = map fromIndices $ getMaxCliques' t m' getMaxCliques f d t m = map fromIndices $ getMaxCliques' t m'
where where
......
...@@ -9,7 +9,6 @@ Portability : POSIX ...@@ -9,7 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE OverloadedLists #-} -- allows to write Map and HashMap as lists {-# LANGUAGE OverloadedLists #-} -- allows to write Map and HashMap as lists
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
...@@ -159,13 +158,6 @@ recomputeGraph _uId nId maybeDistance = do ...@@ -159,13 +158,6 @@ recomputeGraph _uId nId maybeDistance = do
pure $ trace "[G.V.G.API] Graph exists, recomputing" graph''' pure $ trace "[G.V.G.API] Graph exists, recomputing" graph'''
-- TODO use Database Monad only here ?
--computeGraph :: HasNodeError err
-- => CorpusId
-- -> Distance
-- -> NgramsType
-- -> NodeListStory
-- -> Cmd err Graph
computeGraph :: FlowCmdM env err m computeGraph :: FlowCmdM env err m
=> CorpusId => CorpusId
-> Distance -> Distance
...@@ -180,7 +172,9 @@ computeGraph cId d nt repo = do ...@@ -180,7 +172,9 @@ computeGraph cId d nt repo = do
$ mapTermListRoot [lId] nt repo $ mapTermListRoot [lId] nt repo
myCooc <- HashMap.filter (>1) -- Removing the hapax (ngrams with 1 cooc) myCooc <- HashMap.filter (>1) -- Removing the hapax (ngrams with 1 cooc)
<$> getCoocByNgrams (if d == Conditional then Diagonal True else Diagonal False) -- <$> HashMap.filterWithKey (\(x,y) _ -> x /= y)
-- <$> getCoocByNgrams (if d == Conditional then Diagonal True else Diagonal False)
<$> getCoocByNgrams (Diagonal True)
<$> groupNodesByNgrams ngs <$> groupNodesByNgrams ngs
<$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs) <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
...@@ -220,7 +214,6 @@ defaultGraphMetadata cId t repo gm = do ...@@ -220,7 +214,6 @@ defaultGraphMetadata cId t repo gm = do
} }
-- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10]) -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
------------------------------------------------------------ ------------------------------------------------------------
type GraphAsyncAPI = Summary "Recompute graph" type GraphAsyncAPI = Summary "Recompute graph"
:> "recompute" :> "recompute"
...@@ -339,8 +332,3 @@ getGraphGexf uId nId = do ...@@ -339,8 +332,3 @@ getGraphGexf uId nId = do
HyperdataGraphAPI { _hyperdataAPIGraph = graph } <- getGraph uId nId HyperdataGraphAPI { _hyperdataAPIGraph = graph } <- getGraph uId nId
pure $ addHeader "attachment; filename=graph.gexf" graph pure $ addHeader "attachment; filename=graph.gexf" graph
...@@ -28,7 +28,7 @@ import qualified Data.Array.Accelerate as A ...@@ -28,7 +28,7 @@ import qualified Data.Array.Accelerate as A
import qualified Data.Array.Accelerate.Interpreter as A import qualified Data.Array.Accelerate.Interpreter as A
import Data.Array.Accelerate (Matrix, Elt, Shape, (:.)(..), Z(..)) import Data.Array.Accelerate (Matrix, Elt, Shape, (:.)(..), Z(..))
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe, catMaybes)
import Data.Set (Set) import Data.Set (Set)
import qualified Data.Set as S import qualified Data.Set as S
...@@ -69,7 +69,7 @@ map2mat sym def n m = A.fromFunction shape getData ...@@ -69,7 +69,7 @@ map2mat sym def n m = A.fromFunction shape getData
case sym of case sym of
Triangle -> fromMaybe def (M.lookup (x,y) m) Triangle -> fromMaybe def (M.lookup (x,y) m)
Square -> fromMaybe (fromMaybe def $ M.lookup (y,x) m) Square -> fromMaybe (fromMaybe def $ M.lookup (y,x) m)
$ M.lookup (x, y) m $ M.lookup (x,y) m
) )
shape = (Z :. n :. n) shape = (Z :. n :. n)
...@@ -93,8 +93,11 @@ fromIndex ni ns = indexConversion ni ns ...@@ -93,8 +93,11 @@ fromIndex ni ns = indexConversion ni ns
indexConversion :: (Ord b, Ord k) => Map k b -> Map (k,k) a -> Map (b, b) a indexConversion :: (Ord b, Ord k) => Map k b -> Map (k,k) a -> Map (b, b) a
indexConversion index ms = M.fromList indexConversion index ms = M.fromList
$ map (\((k1,k2),c) -> ( ((M.!) index k1, (M.!) index k2), c)) $ catMaybes
(M.toList ms) $ map (\((k1,k2),c) -> ((,) <$> ((,) <$> M.lookup k1 index <*> M.lookup k2 index)
<*> Just c)
)
$ M.toList ms
--------------------------------------------------------------------------------- ---------------------------------------------------------------------------------
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
......
This diff is collapsed.
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