[TEMP] some temporary commits

parent 539a9ae2
This diff is collapsed.
......@@ -1053,7 +1053,7 @@ test-suite garg-test-tasty
, servant-server
, shelly >= 1.9 && < 2
, stm ^>= 2.5.0.1
, tasty ^>= 1.4.2.1
, tasty ^>= 1.5
, tasty-hspec
, tasty-hunit
, tasty-quickcheck
......@@ -1163,7 +1163,7 @@ test-suite garg-test-hspec
, servant-server
, shelly >= 1.9 && < 2
, stm ^>= 2.5.0.1
, tasty ^>= 1.4.2.1
, tasty ^>= 1.5
, tasty-hspec
, tasty-hunit
, tasty-quickcheck
......
......@@ -211,7 +211,7 @@ instance Arbitrary PublicData where
defaultPublicData :: PublicData
defaultPublicData =
PublicData { title = "Title"
, abstract = foldl (<>) "" $ replicate 100 "abstract "
, abstract = foldl' (<>) "" $ replicate 100 "abstract "
, img = "images/Gargantextuel-212x300.jpg"
, url = "https://.."
, date = "YY/MM/DD"
......
......@@ -17,12 +17,12 @@ Motivation and definition of the @Distributional@ distance.
module Gargantext.Core.Methods.Similarities.Distributional
where
import Data.Map qualified as M
import Data.Matrix hiding (identity)
import qualified Data.Map as M
import Data.Vector (Vector)
import qualified Data.Vector as V
import Gargantext.Prelude
import Data.Vector qualified as V
import Gargantext.Core.Viz.Graph.Utils
import Gargantext.Prelude
distributional' :: (Floating a, Ord a) => Matrix a -> [((Int, Int), a)]
......
......@@ -390,7 +390,7 @@ getNodeStory c nId = do
pure ()
-}
pure $ NodeStory $ Map.singleton nId $ foldl combine initArchive dbData
pure $ NodeStory $ Map.singleton nId $ foldl' combine initArchive dbData
where
-- NOTE (<>) for Archive doesn't concatenate states, so we have to use `combine`
combine a1 a2 = a1 & a_state %~ combineState (a2 ^. a_state)
......
......@@ -56,8 +56,8 @@ toDoc' la (HAL.Corpus { .. }) = do
, _hd_uniqIdBdd = Nothing
, _hd_page = Nothing
, _hd_title = Just $ intercalate " " _corpus_title
, _hd_authors = Just $ foldl (\x y -> if x == "" then y else x <> ", " <> y) "" _corpus_authors_names
, _hd_institutes = Just $ foldl (\x y -> if x == "" then y else x <> ", " <> y) "" $ _corpus_authors_affiliations <> map show _corpus_struct_id
, _hd_authors = Just $ foldl' (\x y -> if x == "" then y else x <> ", " <> y) "" _corpus_authors_names
, _hd_institutes = Just $ foldl' (\x y -> if x == "" then y else x <> ", " <> y) "" $ _corpus_authors_affiliations <> map show _corpus_struct_id
, _hd_source = Just $ maybe "Nothing" identity _corpus_source
, _hd_abstract = Just abstract
, _hd_publication_date = fmap show utctime
......
......@@ -92,7 +92,7 @@ toDocs v = V.toList
, d_authors = csv_authors })
(V.enumFromN 1 (V.length v'')) v''
where
v'' = V.foldl (\v' sep -> V.concatMap (splitDoc (docsSize v') sep) v') v seps
v'' = V.foldl' (\v' sep -> V.concatMap (splitDoc (docsSize v') sep) v') v seps
seps= (V.fromList [Paragraphs 1, Sentences 3, Chars 3])
---------------------------------------------------------------
......
......@@ -105,7 +105,7 @@ data Line =
deriving (Show)
parseLines :: Text -> Either ParseError Parsed
parseLines text = foldl f emptyParsed <$> lst
parseLines text = foldl' f emptyParsed <$> lst
where
lst = parse documentLines "" (unpack text)
f (Parsed { .. }) (LAuthors as) = Parsed { authors = as , .. }
......
......@@ -41,9 +41,9 @@ toDoc la (ISTEX.Document i t a ab d s) = do
, _hd_uniqIdBdd = Nothing
, _hd_page = Nothing
, _hd_title = t
, _hd_authors = Just $ foldl (\x y -> if x == "" then y else x <> ", " <> y) "" (map ISTEX._author_name a)
, _hd_institutes = Just $ foldl (\x y -> if x == "" then y else x <> ", " <> y) "" (concat $ (map ISTEX._author_affiliations) a)
, _hd_source = Just $ foldl (\x y -> if x == "" then y else x <> ", " <> y) "" (ISTEX._source_title s)
, _hd_authors = Just $ foldl' (\x y -> if x == "" then y else x <> ", " <> y) "" (map ISTEX._author_name a)
, _hd_institutes = Just $ foldl' (\x y -> if x == "" then y else x <> ", " <> y) "" (concat $ (map ISTEX._author_affiliations) a)
, _hd_source = Just $ foldl' (\x y -> if x == "" then y else x <> ", " <> y) "" (ISTEX._source_title s)
, _hd_abstract = ab
, _hd_publication_date = fmap (T.pack . show) utctime
, _hd_publication_year = pub_year
......
......@@ -103,7 +103,7 @@ grid s e tr te = do
score'' :: Map (Maybe Bool) Int -> Double
score'' m'' = maybe 0 (\t -> (fromIntegral t)/total) (Map.lookup (Just True) m'')
where
total = fromIntegral $ foldl (+) 0 $ Map.elems m''
total = fromIntegral $ foldl' (+) 0 $ Map.elems m''
getScore m t = do
let (res, toGuess) = List.unzip
......
......@@ -20,7 +20,7 @@ countElem :: (Ord k) => DM.Map k Int -> k -> DM.Map k Int
countElem m e = DM.insertWith (+) e 1 m
freq :: (Ord k) => [k] -> DM.Map k Int
freq = foldl countElem DM.empty
freq = foldl' countElem DM.empty
getMaxFromMap :: Ord a => Map a1 a -> [a1]
getMaxFromMap m = go [] Nothing (DM.toList m)
......
......@@ -229,7 +229,7 @@ instance IsTrie Trie where
nodeChild k (Node _ _ cs) = fromMaybe emptyTrie (Map.lookup k cs)
nodeChild _ (Leaf _) = emptyTrie
findTrie ks t = L.foldl (flip nodeChild) t ks
findTrie ks t = L.foldl' (flip nodeChild) t ks
printTrie inE t = do
P.putStrLn . Tree.drawTree
......
......@@ -292,7 +292,7 @@ filterByBranchSize thr export =
processFilters :: [Filter] -> Quality -> PhyloExport -> PhyloExport
processFilters filters qua export =
foldl (\export' f -> case f of
foldl' (\export' f -> case f of
ByBranchSize thr -> if (thr < (fromIntegral $ qua ^. qua_minBranch))
then filterByBranchSize (fromIntegral $ qua ^. qua_minBranch) export'
else filterByBranchSize thr export'
......@@ -488,8 +488,8 @@ mostInclusive nth foundations export =
. traverse )
(\b ->
let groups = filter (\g -> g ^. phylo_groupBranchId == b ^. branch_id) $ export ^. export_groups
cooc = foldl (\acc g -> unionWith (+) acc (g ^. phylo_groupCooc)) empty groups
ngrams = sort $ foldl (\acc g -> union acc (g ^. phylo_groupNgrams)) [] groups
cooc = foldl' (\acc g -> unionWith (+) acc (g ^. phylo_groupCooc)) empty groups
ngrams = sort $ foldl' (\acc g -> union acc (g ^. phylo_groupNgrams)) [] groups
inc = map (\n -> inclusion cooc (ngrams \\ [n]) n) ngrams
lbl = ngramsToLabel foundations $ getNthMostMeta nth inc ngrams
in b & branch_label .~ lbl ) export
......@@ -513,7 +513,7 @@ mostEmergentInclusive nth foundations export =
processLabels :: [PhyloLabel] -> Vector Ngrams -> Map Int Double -> PhyloExport -> PhyloExport
processLabels labels foundations freq export =
foldl (\export' label ->
foldl' (\export' label ->
case label of
GroupLabel tagger nth ->
case tagger of
......@@ -565,7 +565,7 @@ processDynamics groups =
let dates' = sort dates
in (head' "dynamics" dates', last' "dynamics" dates'))
$ fromListWith (++)
$ foldl (\acc g -> acc ++ ( map (\n -> (n,[fst $ g ^. phylo_groupPeriod, snd $ g ^. phylo_groupPeriod]))
$ foldl' (\acc g -> acc ++ ( map (\n -> (n,[fst $ g ^. phylo_groupPeriod, snd $ g ^. phylo_groupPeriod]))
$ (g ^. phylo_groupNgrams))) [] groups
......
......@@ -121,7 +121,7 @@ evolvSeaLadder nbFdt lambda freq similarities graph = map snd
--------
-- 1.2)
qua' :: [(Double,Double)]
qua' = foldl (\acc (s,q) ->
qua' = foldl' (\acc (s,q) ->
if length acc == 0
then [(s,q)]
else if (snd (List.last acc)) == q
......@@ -203,13 +203,13 @@ appendGroups f lvl m phylo =
pId' = phyloLvl ^. phylo_scalePeriodStr
phyloCUnit = m ! pId
in phyloLvl
& phylo_scaleGroups .~ (fromList $ foldl (\groups obj ->
& phylo_scaleGroups .~ (fromList $ foldl' (\groups obj ->
groups ++ [ (((pId,lvl),length groups)
, f obj pId pId' lvl (length groups)
-- select the cooc of the periods
(elems $ restrictKeys (getCoocByDate phylo) $ periodsToYears [pId])
-- select and merge the roots count of the periods
(foldl (\acc count -> unionWith (+) acc count) empty
(foldl' (\acc count -> unionWith (+) acc count) empty
$ elems $ restrictKeys (getRootsCountByDate phylo) $ periodsToYears [pId]))
] ) [] phyloCUnit)
else
......@@ -312,7 +312,7 @@ filterCliqueBySize thr l = filter (\clq -> (length $ clq ^. clustering_roots) >=
filterCliqueByNested :: Map (Date, Date) [Clustering] -> Map (Date, Date) [Clustering]
filterCliqueByNested m =
let clq = map (\l ->
foldl (\mem f -> if (any (\f' -> isNested (f' ^. clustering_roots) (f ^. clustering_roots)) mem)
foldl' (\mem f -> if (any (\f' -> isNested (f' ^. clustering_roots) (f ^. clustering_roots)) mem)
then mem
else
let fMax = filter (\f' -> not $ isNested (f ^. clustering_roots) (f' ^. clustering_roots)) mem
......@@ -355,7 +355,7 @@ toSeriesOfClustering phylo phyloDocs = case (clique $ getConfig phylo) of
MaxClique _ thr filterType ->
let mcl = map (\(prd,docs) ->
let cooc = map round
$ foldl sumCooc empty
$ foldl' sumCooc empty
$ map listToMatrix
$ map (\d -> ngramsToIdx (text d) (getRoots phylo)) docs
in (prd, map (\cl -> Clustering cl 0 prd Nothing []) $ getMaxCliques filterType Conditional thr cooc))
......
......@@ -234,7 +234,7 @@ keepFilled f thr l = if (null $ f thr l) && (not $ null l)
traceClique :: Map (Date, Date) [Clustering] -> String
traceClique mFis = foldl (\msg cpt -> msg <> show (countSup cpt cliques) <> " (>" <> show (cpt) <> ") " ) "" [1..6]
traceClique mFis = foldl' (\msg cpt -> msg <> show (countSup cpt cliques) <> " (>" <> show (cpt) <> ") " ) "" [1..6]
where
--------------------------------------
cliques :: [Double]
......@@ -243,7 +243,7 @@ traceClique mFis = foldl (\msg cpt -> msg <> show (countSup cpt cliques) <> " (>
traceSupport :: Map (Date, Date) [Clustering] -> String
traceSupport mFis = foldl (\msg cpt -> msg <> show (countSup cpt supports) <> " (>" <> show (cpt) <> ") " ) "" [1..6]
traceSupport mFis = foldl' (\msg cpt -> msg <> show (countSup cpt supports) <> " (>" <> show (cpt) <> ") " ) "" [1..6]
where
--------------------------------------
supports :: [Double]
......@@ -311,7 +311,7 @@ coocToAdjacency cooc = Map.map (\_ -> 1) cooc
-- | To build the local cooc matrix of each phylogroup
ngramsToCooc :: [Int] -> [Cooc] -> Cooc
ngramsToCooc ngrams coocs =
let cooc = foldl (\acc cooc' -> sumCooc acc cooc') empty coocs
let cooc = foldl' (\acc cooc' -> sumCooc acc cooc') empty coocs
pairs = listToKeys ngrams
in filterWithKey (\k _ -> elem k pairs) cooc
......@@ -327,7 +327,7 @@ ngramsToCooc ngrams coocs =
-- Scientometric 22: 155–205.
ngramsToDensity :: [Int] -> [Cooc] -> (Map Int Double) -> Double
ngramsToDensity ngrams coocs rootsCount =
let cooc = foldl (\acc cooc' -> sumCooc acc cooc') empty coocs
let cooc = foldl' (\acc cooc' -> sumCooc acc cooc') empty coocs
pairs = listToCombi' ngrams
density = map (\(i,j) ->
let nij = findWithDefault 0 (i,j) cooc
......@@ -382,7 +382,7 @@ regimeToDefaultLevel cooc roots
coocToConfidence :: Phylo -> Cooc
coocToConfidence phylo =
let count = getRootsCount phylo
cooc = foldl (\acc cooc' -> sumCooc acc cooc') empty
cooc = foldl' (\acc cooc' -> sumCooc acc cooc') empty
$ elems $ getCoocByDate phylo
in Map.mapWithKey (\(a,b) w -> confidence a b w count) cooc
where
......@@ -749,7 +749,7 @@ branchIdsToSimilarity :: PhyloBranchId -> PhyloBranchId -> Double -> Double -> D
branchIdsToSimilarity id id' thrInit thrStep = thrInit + thrStep * (fromIntegral $ length $ intersectInit [] (snd id) (snd id'))
ngramsInBranches :: [[PhyloGroup]] -> [Int]
ngramsInBranches branches = nub $ foldl (\acc g -> acc ++ (g ^. phylo_groupNgrams)) [] $ concat branches
ngramsInBranches branches = nub $ foldl' (\acc g -> acc ++ (g ^. phylo_groupNgrams)) [] $ concat branches
traceMatchSuccess :: Double -> Double -> Double -> [[[PhyloGroup]]] -> [[[PhyloGroup]]]
......
......@@ -31,7 +31,7 @@ import Gargantext.Prelude hiding (empty)
mergeGroups :: [Cooc] -> PhyloGroupId -> Map PhyloGroupId PhyloGroupId -> [PhyloGroup] -> PhyloGroup
mergeGroups coocs id mapIds childs =
let ngrams = (sort . nub . concat) $ map _phylo_groupNgrams childs
counts = foldl (\acc count -> unionWith (+) acc count) empty $ map _phylo_groupRootsCount childs
counts = foldl' (\acc count -> unionWith (+) acc count) empty $ map _phylo_groupRootsCount childs
in PhyloGroup (fst $ fst id) (_phylo_groupPeriod' $ head' "mergeGroups" childs)
(snd $ fst id) (snd id) ""
(sum $ map _phylo_groupSupport childs)
......
......@@ -50,14 +50,14 @@ jaccard inter' union' = ((fromIntegral . length) $ inter') / ((fromIntegral . le
-- process the inverse sumLog
-}
sumInvLog' :: Double -> Double -> [Double] -> Double
sumInvLog' s nb diago = foldl (\mem occ -> mem + (1 / (log (occ + 1/ tan (s * pi / 2)) / log (nb + 1/ tan (s * pi / 2))))) 0 diago
sumInvLog' s nb diago = foldl' (\mem occ -> mem + (1 / (log (occ + 1/ tan (s * pi / 2)) / log (nb + 1/ tan (s * pi / 2))))) 0 diago
{-
-- process the sumLog
-}
sumLog' :: Double -> Double -> [Double] -> Double
sumLog' s nb diago = foldl (\mem occ -> mem + (log (occ + 1 / tan (s * pi / 2)) / log (nb + 1/ tan (s * pi / 2)))) 0 diago
sumLog' s nb diago = foldl' (\mem occ -> mem + (log (occ + 1 / tan (s * pi / 2)) / log (nb + 1/ tan (s * pi / 2)))) 0 diago
{-
......@@ -176,7 +176,7 @@ filterPointers' proxi thr pts = filter (\((_,w),_) -> filterSimilarity proxi thr
reduceDiagos :: Map Date Cooc -> Map Int Double
reduceDiagos diagos = mapKeys (\(k,_) -> k)
$ foldl (\acc diago -> unionWith (+) acc diago) empty (elems diagos)
$ foldl' (\acc diago -> unionWith (+) acc diago) empty (elems diagos)
filterPointersByPeriod :: Filiation -> [(Pointer,[Int])] -> [Pointer]
filterPointersByPeriod fil pts =
......
......@@ -58,7 +58,7 @@ selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
query lIds' dId' nt' = proc () -> do
(ng,nng,cnng) <- join' -< ()
restrict -< foldl (\b lId -> ((pgNodeId lId) .== nng^.nng_node_id) .|| b) (sqlBool True) lIds'
restrict -< foldl' (\b lId -> ((pgNodeId lId) .== nng^.nng_node_id) .|| b) (sqlBool True) lIds'
restrict -< (pgNodeId dId') .== cnng^.cnng2_context_id
restrict -< (pgNgramsType nt') .== nng^.nng_ngrams_type
returnA -< ng^.ngrams_terms
......
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