-}
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedLists #-} -- allows to write Map and HashMap as lists
{-# LANGUAGE TypeOperators #-}
mcId <- getClosestParentIdByType nId NodeCorpus
let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
- printDebug "[getGraph] getting list for cId" cId
+ -- printDebug "[getGraph] getting list for cId" cId
listId <- defaultList cId
- repo <- getRepo' [listId]
+ repo <- getRepo [listId]
-- TODO Distance in Graph params
case graph of
Nothing -> do
- let defaultMetric = Order1
- graph' <- computeGraph cId Spinglass (withMetric defaultMetric) NgramsTerms repo
- mt <- defaultGraphMetadata cId "Title" repo defaultMetric
+ let defaultMetric = Order1
+ let defaultPartitionMethod = Spinglass
+ let defaultEdgesStrength = Strong
+ graph' <- computeGraph cId defaultPartitionMethod (withMetric defaultMetric) defaultEdgesStrength NgramsTerms repo
+ mt <- defaultGraphMetadata cId "Title" repo defaultMetric defaultEdgesStrength
let
graph'' = set graph_metadata (Just mt) graph'
hg = HyperdataGraphAPI graph'' camera
-> NodeId
-> PartitionMethod
-> Maybe GraphMetric
+ -> Maybe Strength
-> Bool
-> m Graph
-recomputeGraph _uId nId method maybeDistance force = do
+recomputeGraph _uId nId method maybeDistance maybeStrength force = do
nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
let
graph = nodeGraph ^. node_hyperdata . hyperdataGraph
Nothing -> withMetric Order1
Just m -> withMetric m
+ strength = case maybeStrength of
+ Nothing -> case graph ^? _Just . graph_metadata . _Just . gm_edgesStrength of
+ Nothing -> Strong
+ Just mr -> fromMaybe Strong mr
+ Just r -> r
+
mcId <- getClosestParentIdByType nId NodeCorpus
let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
listId <- defaultList cId
- repo <- getRepo' [listId]
+ repo <- getRepo [listId]
let v = repo ^. unNodeStory . at listId . _Just . a_version
let computeG mt = do
- g <- computeGraph cId method similarity NgramsTerms repo
+ !g <- computeGraph cId method similarity strength NgramsTerms repo
let g' = set graph_metadata mt g
- _ <- updateHyperdata nId (HyperdataGraph (Just g') camera)
+ _nentries <- updateHyperdata nId (HyperdataGraph (Just g') camera)
pure g'
case graph of
Nothing -> do
- mt <- defaultGraphMetadata cId "Title" repo (fromMaybe Order1 maybeDistance)
+ mt <- defaultGraphMetadata cId "Title" repo (fromMaybe Order1 maybeDistance) strength
g <- computeG $ Just mt
pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" g
Just graph' -> if (listVersion == Just v) && (not force)
=> CorpusId
-> PartitionMethod
-> Distance
+ -> Strength
-> NgramsType
-> NodeListStory
-> m Graph
-computeGraph cId method d nt repo = do
+computeGraph cId method d strength nt repo = do
lId <- defaultList cId
lIds <- selectNodesWithUsername NodeList userMaster
-
- let ngs = filterListWithRoot MapTerm
+ let ngs = filterListWithRoot [MapTerm]
$ mapTermListRoot [lId] nt repo
- myCooc <- HashMap.filter (>1) -- Removing the hapax (ngrams with 1 cooc)
- -- <$> HashMap.filterWithKey (\(x,y) _ -> x /= y)
- -- <$> getCoocByNgrams (if d == Conditional then Diagonal True else Diagonal False)
+ !myCooc <- HashMap.filter (>1) -- Removing the hapax (ngrams with 1 cooc)
<$> getCoocByNgrams (Diagonal True)
<$> groupNodesByNgrams ngs
<$> getContextsByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
- -- printDebug "myCooc" myCooc
- -- saveAsFileDebug "debug/my-cooc" myCooc
-
- listNgrams <- getListNgrams [lId] nt
+ graph <- liftBase $ cooc2graphWith method d 0 strength myCooc
- -- graph <- liftBase $ cooc2graphWith Confluence d 0 myCooc
- -- graph <- liftBase $ cooc2graphWith Spinglass d 0 myCooc
- graph <- liftBase $ cooc2graphWith method d 0 myCooc
- -- saveAsFileDebug "debug/graph" graph
+ --listNgrams <- getListNgrams [lId] nt
+ --let graph' = mergeGraphNgrams graph (Just listNgrams)
+ -- saveAsFileDebug "/tmp/graphWithNodes" graph'
- pure $ mergeGraphNgrams graph (Just listNgrams)
+ pure graph
defaultGraphMetadata :: HasNodeError err
-> Text
-> NodeListStory
-> GraphMetric
+ -> Strength
-> Cmd err GraphMetadata
-defaultGraphMetadata cId t repo gm = do
+defaultGraphMetadata cId t repo gm str = do
lId <- defaultList cId
- pure $ GraphMetadata {
- _gm_title = t
- , _gm_metric = gm
- , _gm_corpusId = [cId]
- , _gm_legend = [
- LegendField 1 "#FFF" "Cluster1"
- , LegendField 2 "#FFF" "Cluster2"
- , LegendField 3 "#FFF" "Cluster3"
- , LegendField 4 "#FFF" "Cluster4"
- ]
- , _gm_list = (ListForGraph lId (repo ^. unNodeStory . at lId . _Just . a_version))
- , _gm_startForceAtlas = True
- }
+ pure $ GraphMetadata { _gm_title = t
+ , _gm_metric = gm
+ , _gm_edgesStrength = Just str
+ , _gm_corpusId = [cId]
+ , _gm_legend = [
+ LegendField 1 "#FFF" "Cluster1"
+ , LegendField 2 "#FFF" "Cluster2"
+ , LegendField 3 "#FFF" "Cluster3"
+ , LegendField 4 "#FFF" "Cluster4"
+ ]
+ , _gm_list = (ListForGraph lId (repo ^. unNodeStory . at lId . _Just . a_version))
+ , _gm_startForceAtlas = True
+ }
-- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
------------------------------------------------------------
, _scst_remaining = Just 1
, _scst_events = Just []
}
- _g <- trace (show u) $ recomputeGraph u n Spinglass Nothing False
+ _g <- recomputeGraph u n Spinglass Nothing Nothing False
pure JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0
, _scst_remaining = Just 0
else panic "[G.V.G.API] list not found after iterations"
Just listId -> do
- repo <- getRepo' [listId]
+ repo <- getRepo [listId]
let v = repo ^. unNodeStory . at listId . _Just . a_version
- printDebug "graphVersions" v
+ -- printDebug "graphVersions" v
pure $ GraphVersions { gv_graph = listVersion
, gv_repo = v }
=> UserId
-> NodeId
-> m Graph
-recomputeVersions uId nId = recomputeGraph uId nId Spinglass Nothing False
+recomputeVersions uId nId = recomputeGraph uId nId Spinglass Nothing Nothing False
------------------------------------------------------------
graphClone :: UserId