Commit 4a5fdbd6 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX name] GraphTerm -> MapTerm

parent ccd84a0f
Pipeline #908 failed with stage
...@@ -28,7 +28,7 @@ import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..)) ...@@ -28,7 +28,7 @@ import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
import Gargantext.Text.Context (TermList) import Gargantext.Text.Context (TermList)
import Gargantext.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year) import Gargantext.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year)
import Gargantext.Text.Corpus.Parsers (FileFormat(..),parseFile) import Gargantext.Text.Corpus.Parsers (FileFormat(..),parseFile)
import Gargantext.Text.List.CSV (csvGraphTermList) import Gargantext.Text.List.CSV (csvMapTermList)
import Gargantext.Text.Terms.WithList (Patterns, buildPatterns, extractTermsWithList) import Gargantext.Text.Terms.WithList (Patterns, buildPatterns, extractTermsWithList)
import Gargantext.Viz.AdaptativePhylo import Gargantext.Viz.AdaptativePhylo
import Gargantext.Viz.Phylo.PhyloMaker (toPhylo) import Gargantext.Viz.Phylo.PhyloMaker (toPhylo)
...@@ -144,7 +144,7 @@ main = do ...@@ -144,7 +144,7 @@ main = do
Right config -> do Right config -> do
printIOMsg "Parse the corpus" printIOMsg "Parse the corpus"
mapList <- csvGraphTermList (listPath config) mapList <- csvMapTermList (listPath config)
corpus <- fileToDocs (corpusParser config) (corpusPath config) mapList corpus <- fileToDocs (corpusParser config) (corpusPath config) mapList
printIOComment (show (length corpus) <> " parsed docs from the corpus") printIOComment (show (length corpus) <> " parsed docs from the corpus")
......
...@@ -53,7 +53,7 @@ import Gargantext.Text.Terms ...@@ -53,7 +53,7 @@ import Gargantext.Text.Terms
import Gargantext.Text.Context import Gargantext.Text.Context
import Gargantext.Text.Terms.WithList import Gargantext.Text.Terms.WithList
import Gargantext.Text.Corpus.Parsers.CSV (readFile, csv_title, csv_abstract, csv_publication_year) import Gargantext.Text.Corpus.Parsers.CSV (readFile, csv_title, csv_abstract, csv_publication_year)
import Gargantext.Text.List.CSV (csvGraphTermList) import Gargantext.Text.List.CSV (csvMapTermList)
import Gargantext.Text.Terms (terms) import Gargantext.Text.Terms (terms)
import Gargantext.Text.Metrics.Count (coocOnContexts, Coocs) import Gargantext.Text.Metrics.Count (coocOnContexts, Coocs)
...@@ -103,7 +103,7 @@ main = do ...@@ -103,7 +103,7 @@ main = do
<$> readFile corpusFile <$> readFile corpusFile
-- termListMap :: [Text] -- termListMap :: [Text]
termList <- csvGraphTermList termListFile termList <- csvMapTermList termListFile
putStrLn $ show $ length termList putStrLn $ show $ length termList
......
...@@ -31,7 +31,7 @@ import Gargantext.Prelude ...@@ -31,7 +31,7 @@ import Gargantext.Prelude
import Gargantext.Text.Context (TermList) import Gargantext.Text.Context (TermList)
import Gargantext.Text.Corpus.Parsers (FileFormat(..),parseFile) import Gargantext.Text.Corpus.Parsers (FileFormat(..),parseFile)
import Gargantext.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year) import Gargantext.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year)
import Gargantext.Text.List.CSV (csvGraphTermList) import Gargantext.Text.List.CSV (csvMapTermList)
import Gargantext.Text.Terms.WithList import Gargantext.Text.Terms.WithList
import Gargantext.Viz.Phylo import Gargantext.Viz.Phylo
import Gargantext.Viz.Phylo.LevelMaker import Gargantext.Viz.Phylo.LevelMaker
...@@ -191,7 +191,7 @@ main = do ...@@ -191,7 +191,7 @@ main = do
P.Left err -> putStrLn err P.Left err -> putStrLn err
P.Right conf -> do P.Right conf -> do
termList <- csvGraphTermList (listPath conf) termList <- csvMapTermList (listPath conf)
corpus <- parse (corpusType conf) (limit conf) (corpusPath conf) termList corpus <- parse (corpusType conf) (limit conf) (corpusPath conf) termList
......
...@@ -235,7 +235,7 @@ updatePie' cId maybeListId tabType _maybeLimit = do ...@@ -235,7 +235,7 @@ updatePie' cId maybeListId tabType _maybeLimit = do
, hd_scatter = hds , hd_scatter = hds
, hd_tree = hdt }) = node ^. node_hyperdata , hd_tree = hdt }) = node ^. node_hyperdata
p <- pieData cId (ngramsTypeFromTabType tabType) GraphTerm p <- pieData cId (ngramsTypeFromTabType tabType) MapTerm
_ <- updateHyperdata listId $ HyperdataList hdc hdl (Just $ ChartMetrics p) hds hdt _ <- updateHyperdata listId $ HyperdataList hdc hdl (Just $ ChartMetrics p) hds hdt
pure $ ChartMetrics p pure $ ChartMetrics p
......
...@@ -260,7 +260,7 @@ mkNgramsElement ngrams list rp children = ...@@ -260,7 +260,7 @@ mkNgramsElement ngrams list rp children =
newNgramsElement :: Maybe ListType -> NgramsTerm -> NgramsElement newNgramsElement :: Maybe ListType -> NgramsTerm -> NgramsElement
newNgramsElement mayList ngrams = newNgramsElement mayList ngrams =
mkNgramsElement ngrams (fromMaybe GraphTerm mayList) Nothing mempty mkNgramsElement ngrams (fromMaybe MapTerm mayList) Nothing mempty
instance ToSchema NgramsElement where instance ToSchema NgramsElement where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ne_") declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ne_")
...@@ -348,16 +348,16 @@ toNgramsElement ns = map toNgramsElement' ns ...@@ -348,16 +348,16 @@ toNgramsElement ns = map toNgramsElement' ns
mockTable :: NgramsTable mockTable :: NgramsTable
mockTable = NgramsTable mockTable = NgramsTable
[ mkNgramsElement "animal" GraphTerm Nothing (mSetFromList ["dog", "cat"]) [ mkNgramsElement "animal" MapTerm Nothing (mSetFromList ["dog", "cat"])
, mkNgramsElement "cat" GraphTerm (rp "animal") mempty , mkNgramsElement "cat" MapTerm (rp "animal") mempty
, mkNgramsElement "cats" StopTerm Nothing mempty , mkNgramsElement "cats" StopTerm Nothing mempty
, mkNgramsElement "dog" GraphTerm (rp "animal") (mSetFromList ["dogs"]) , mkNgramsElement "dog" MapTerm (rp "animal") (mSetFromList ["dogs"])
, mkNgramsElement "dogs" StopTerm (rp "dog") mempty , mkNgramsElement "dogs" StopTerm (rp "dog") mempty
, mkNgramsElement "fox" GraphTerm Nothing mempty , mkNgramsElement "fox" MapTerm Nothing mempty
, mkNgramsElement "object" CandidateTerm Nothing mempty , mkNgramsElement "object" CandidateTerm Nothing mempty
, mkNgramsElement "nothing" StopTerm Nothing mempty , mkNgramsElement "nothing" StopTerm Nothing mempty
, mkNgramsElement "organic" GraphTerm Nothing (mSetFromList ["flower"]) , mkNgramsElement "organic" MapTerm Nothing (mSetFromList ["flower"])
, mkNgramsElement "flower" GraphTerm (rp "organic") mempty , mkNgramsElement "flower" MapTerm (rp "organic") mempty
, mkNgramsElement "moon" CandidateTerm Nothing mempty , mkNgramsElement "moon" CandidateTerm Nothing mempty
, mkNgramsElement "sky" StopTerm Nothing mempty , mkNgramsElement "sky" StopTerm Nothing mempty
] ]
...@@ -695,8 +695,8 @@ ngramsIdPatch = fromList $ catMaybes $ reverse [ replace (1::NgramsId) (Just $ n ...@@ -695,8 +695,8 @@ ngramsIdPatch = fromList $ catMaybes $ reverse [ replace (1::NgramsId) (Just $ n
{- {-
-- TODO: Replace.old is ignored which means that if the current list -- TODO: Replace.old is ignored which means that if the current list
-- `GraphTerm` and that the patch is `Replace CandidateTerm StopTerm` then -- `MapTerm` and that the patch is `Replace CandidateTerm StopTerm` then
-- the list is going to be `StopTerm` while it should keep `GraphTerm`. -- the list is going to be `StopTerm` while it should keep `MapTerm`.
-- However this should not happen in non conflicting situations. -- However this should not happen in non conflicting situations.
mkListsUpdate :: NgramsType -> NgramsTablePatch -> [(NgramsTypeId, NgramsTerm, ListTypeId)] mkListsUpdate :: NgramsType -> NgramsTablePatch -> [(NgramsTypeId, NgramsTerm, ListTypeId)]
mkListsUpdate nt patches = mkListsUpdate nt patches =
......
...@@ -79,9 +79,9 @@ filterListWithRoot :: ListType -> Map Text (ListType, Maybe Text) ...@@ -79,9 +79,9 @@ filterListWithRoot :: ListType -> Map Text (ListType, Maybe Text)
-> Map Text (Maybe RootTerm) -> Map Text (Maybe RootTerm)
filterListWithRoot lt m = Map.fromList filterListWithRoot lt m = Map.fromList
$ map (\(t,(_,r)) -> (t,r)) $ map (\(t,(_,r)) -> (t,r))
$ filter isGraphTerm (Map.toList m) $ filter isMapTerm (Map.toList m)
where where
isGraphTerm (_t,(l, maybeRoot)) = case maybeRoot of isMapTerm (_t,(l, maybeRoot)) = case maybeRoot of
Nothing -> l == lt Nothing -> l == lt
Just r -> case Map.lookup r m of Just r -> case Map.lookup r m of
Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> r Nothing -> panic $ "Garg.API.Ngrams.Tools: filterWithRoot, unknown key: " <> r
......
...@@ -137,7 +137,7 @@ getNodeNgrams cId lId' nt repo = do ...@@ -137,7 +137,7 @@ getNodeNgrams cId lId' nt repo = do
Just l -> pure l Just l -> pure l
lIds <- selectNodesWithUsername NodeList userMaster lIds <- selectNodesWithUsername NodeList userMaster
let ngs = filterListWithRoot GraphTerm $ mapTermListRoot [lId] nt repo let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
r <- getNgramsByNodeOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs) r <- getNgramsByNodeOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)
pure r pure r
......
...@@ -53,7 +53,7 @@ type HashId = Text ...@@ -53,7 +53,7 @@ type HashId = Text
type TypeId = Int type TypeId = Int
-- TODO multiple ListType declaration, remove it -- TODO multiple ListType declaration, remove it
data ListType = StopTerm | CandidateTerm | GraphTerm data ListType = StopTerm | CandidateTerm | MapTerm
deriving (Generic, Eq, Ord, Show, Read, Enum, Bounded) deriving (Generic, Eq, Ord, Show, Read, Enum, Bounded)
instance ToJSON ListType instance ToJSON ListType
...@@ -71,7 +71,7 @@ type ListTypeId = Int ...@@ -71,7 +71,7 @@ type ListTypeId = Int
listTypeId :: ListType -> ListTypeId listTypeId :: ListType -> ListTypeId
listTypeId StopTerm = 0 listTypeId StopTerm = 0
listTypeId CandidateTerm = 1 listTypeId CandidateTerm = 1
listTypeId GraphTerm = 2 listTypeId MapTerm = 2
fromListTypeId :: ListTypeId -> Maybe ListType fromListTypeId :: ListTypeId -> Maybe ListType
fromListTypeId i = lookup i $ fromList [ (listTypeId l, l) | l <- [minBound..maxBound]] fromListTypeId i = lookup i $ fromList [ (listTypeId l, l) | l <- [minBound..maxBound]]
......
...@@ -73,6 +73,6 @@ getNgrams cId maybeListId tabType = do ...@@ -73,6 +73,6 @@ getNgrams cId maybeListId tabType = do
lists <- mapTermListRoot [lId] (ngramsTypeFromTabType tabType) <$> getRepo lists <- mapTermListRoot [lId] (ngramsTypeFromTabType tabType) <$> getRepo
let maybeSyn = Map.unions $ map (\t -> filterListWithRoot t lists) let maybeSyn = Map.unions $ map (\t -> filterListWithRoot t lists)
[GraphTerm, StopTerm, CandidateTerm] [MapTerm, StopTerm, CandidateTerm]
pure (lists, maybeSyn) pure (lists, maybeSyn)
...@@ -79,7 +79,7 @@ buildNgramsOthersList uCid groupIt nt = do ...@@ -79,7 +79,7 @@ buildNgramsOthersList uCid groupIt nt = do
graphTerms = List.take listSize all' graphTerms = List.take listSize all'
candiTerms = List.drop listSize all' candiTerms = List.drop listSize all'
pure $ Map.unionsWith (<>) [ toElements GraphTerm graphTerms pure $ Map.unionsWith (<>) [ toElements MapTerm graphTerms
, toElements CandidateTerm candiTerms , toElements CandidateTerm candiTerms
] ]
where where
...@@ -122,7 +122,7 @@ buildNgramsTermsList' uCid groupIt stop gls is = do ...@@ -122,7 +122,7 @@ buildNgramsTermsList' uCid groupIt stop gls is = do
$ map toNgramsElement $ map toNgramsElement
$ map (\t -> (StopTerm , toList' t)) s $ map (\t -> (StopTerm , toList' t)) s
<> map (\t -> (CandidateTerm, toList' t)) c <> map (\t -> (CandidateTerm, toList' t)) c
<> map (\t -> (GraphTerm , toList' t)) m <> map (\t -> (MapTerm , toList' t)) m
pure $ Map.fromList [(NgramsTerms, ngs')] pure $ Map.fromList [(NgramsTerms, ngs')]
-} -}
...@@ -151,7 +151,7 @@ buildNgramsTermsList l n m s uCid mCid = do ...@@ -151,7 +151,7 @@ buildNgramsTermsList l n m s uCid mCid = do
termList = termList =
-- (toTermList a b ((isStopTerm s) . fst) candidatesHead) -- (toTermList a b ((isStopTerm s) . fst) candidatesHead)
(map (toGargList ((isStopTerm s) .fst) GraphTerm) candidatesHead) (map (toGargList ((isStopTerm s) .fst) MapTerm) candidatesHead)
<> (map (toGargList ((isStopTerm s) .fst) CandidateTerm) candidatesTail) <> (map (toGargList ((isStopTerm s) .fst) CandidateTerm) candidatesTail)
ngs = List.concat $ map toNgramsElement termList ngs = List.concat $ map toNgramsElement termList
...@@ -167,7 +167,7 @@ toTermList :: Int ...@@ -167,7 +167,7 @@ toTermList :: Int
toTermList _ _ _ [] = [] toTermList _ _ _ [] = []
toTermList a b stop ns = -- trace ("computing toTermList") $ toTermList a b stop ns = -- trace ("computing toTermList") $
map (toGargList stop CandidateTerm) xs map (toGargList stop CandidateTerm) xs
<> map (toGargList stop GraphTerm) ys <> map (toGargList stop MapTerm) ys
<> toTermList a b stop zs <> toTermList a b stop zs
where where
xs = take a ns xs = take a ns
......
...@@ -35,8 +35,8 @@ import Gargantext.Text.Context ...@@ -35,8 +35,8 @@ import Gargantext.Text.Context
------------------------------------------------------------------------ ------------------------------------------------------------------------
csvGraphTermList :: FilePath -> IO TermList csvMapTermList :: FilePath -> IO TermList
csvGraphTermList fp = csv2list CsvMap <$> snd <$> fromCsvListFile fp csvMapTermList fp = csv2list CsvMap <$> snd <$> fromCsvListFile fp
csv2list :: CsvListType -> Vector CsvList -> TermList csv2list :: CsvListType -> Vector CsvList -> TermList
csv2list lt vs = V.toList $ V.map (\(CsvList _ label forms) csv2list lt vs = V.toList $ V.map (\(CsvList _ label forms)
......
...@@ -148,7 +148,7 @@ computeGraph cId d nt repo = do ...@@ -148,7 +148,7 @@ computeGraph cId d nt repo = do
-- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10]) -- (map (\n -> LegendField n "#FFFFFF" (pack $ show n)) [1..10])
lIds <- selectNodesWithUsername NodeList userMaster lIds <- selectNodesWithUsername NodeList userMaster
let ngs = filterListWithRoot GraphTerm $ mapTermListRoot [lId] nt repo let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
myCooc <- Map.filter (>1) myCooc <- Map.filter (>1)
<$> getCoocByNgrams (Diagonal True) <$> getCoocByNgrams (Diagonal True)
......
...@@ -49,7 +49,7 @@ flowPhylo :: FlowCmdM env err m ...@@ -49,7 +49,7 @@ flowPhylo :: FlowCmdM env err m
flowPhylo cId = do flowPhylo cId = do
list <- defaultList cId list <- defaultList cId
termList <- Map.toList <$> getTermsWith Text.words [list] NgramsTerms GraphTerm termList <- Map.toList <$> getTermsWith Text.words [list] NgramsTerms MapTerm
docs' <- catMaybes docs' <- catMaybes
<$> map (\h -> (,) <$> _hyperdataDocument_publication_year h <$> map (\h -> (,) <$> _hyperdataDocument_publication_year h
......
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