module Gargantext.Core.Viz.Phylo.PhyloTools where
import Data.Vector (Vector, elemIndex)
-import Data.List (sort, concat, null, union, (++), tails, sortOn, nub, init, tail, partition, tails, nubBy, maximum, group)
+import Data.List (sort, concat, null, union, (++), tails, sortOn, nub, init, tail, partition, tails, nubBy, group)
import Data.Set (Set, disjoint)
import Data.Map (Map, elems, fromList, unionWith, keys, member, (!), filterWithKey, fromListWith, empty, restrictKeys)
import Data.String (String)
-import Data.Text (Text)
+import Data.Text (Text,unpack)
+
+import Prelude (floor,read)
import Gargantext.Prelude
import Gargantext.Core.Viz.AdaptativePhylo
-- | Misc | --
--------------
+-- truncate' :: Double -> Int -> Double
+-- truncate' x n = (fromIntegral (floor (x * t))) / t
+-- where t = 10^n
+
+truncate' :: Double -> Int -> Double
+truncate' x n = (fromIntegral $ (floor (x * t) :: Int)) / t
+ where
+ --------------
+ t :: Double
+ t = 10 ^n
+
+getInMap :: Int -> Map Int Double -> Double
+getInMap k m =
+ if (member k m)
+ then m ! k
+ else 0
roundToStr :: (PrintfArg a, Floating a) => Int -> a -> String
roundToStr = printf "%0.*f"
ngramsToIdx :: [Ngrams] -> Vector Ngrams -> [Int]
ngramsToIdx ns fdt = map (\n -> fromJust $ elemIndex n fdt) ns
+-- | To transform a list of sources into a list of sources' index
+sourcesToIdx :: [Text] -> Vector Text -> [Int]
+sourcesToIdx ss ps = nub $ map (\s -> fromJust $ elemIndex s ps) ss
+
-- | To transform a list of Ngrams Indexes into a Label
ngramsToLabel :: Vector Ngrams -> [Int] -> Text
ngramsToLabel ngrams l = Text.unwords $ tail' "ngramsToLabel" $ concat $ map (\n -> ["|",n]) $ ngramsToText ngrams l
$ chunkAlong p s [start .. end]
+toFstDate :: [Text] -> Text
+toFstDate ds = snd
+ $ head' "firstDate"
+ $ sortOn fst
+ $ map (\d ->
+ let d' = read (filter (\c -> c /= '-') $ unpack d)::Int
+ in (d',d)) ds
+
+toLstDate :: [Text] -> Text
+toLstDate ds = snd
+ $ head' "firstDate"
+ $ reverse
+ $ sortOn fst
+ $ map (\d ->
+ let d' = read (filter (\c -> c /= '-') $ unpack d)::Int
+ in (d',d)) ds
+
+
+getTimeScale :: Phylo -> [Char]
+getTimeScale p = case (timeUnit $ getConfig p) of
+ Year _ _ _ -> "year"
+ Month _ _ _ -> "month"
+ Week _ _ _ -> "week"
+ Day _ _ _ -> "day"
+
+
-- | Get a regular & ascendante timeScale from a given list of dates
toTimeScale :: [Date] -> Int -> [Date]
toTimeScale dates step =
getTimeStep :: TimeUnit -> Int
getTimeStep time = case time of
- Year _ s _ -> s
+ Year _ s _ -> s
+ Month _ s _ -> s
+ Week _ s _ -> s
+ Day _ s _ -> s
getTimePeriod :: TimeUnit -> Int
getTimePeriod time = case time of
- Year p _ _ -> p
+ Year p _ _ -> p
+ Month p _ _ -> p
+ Week p _ _ -> p
+ Day p _ _ -> p
getTimeFrame :: TimeUnit -> Int
getTimeFrame time = case time of
- Year _ _ f -> f
+ Year _ _ f -> f
+ Month _ _ f -> f
+ Week _ _ f -> f
+ Day _ _ f -> f
-------------
-- | Fis | --
getCliqueSupport :: Clique -> Int
getCliqueSupport unit = case unit of
Fis s _ -> s
- MaxClique _ -> 0
+ MaxClique _ _ _ -> 0
getCliqueSize :: Clique -> Int
getCliqueSize unit = case unit of
Fis _ s -> s
- MaxClique s -> s
+ MaxClique s _ _ -> s
--------------
filterProximity proximity thr local =
case proximity of
WeightedLogJaccard _ -> local >= thr
+ WeightedLogSim _ -> local >= thr
Hamming -> undefined
getProximityName :: Proximity -> String
getProximityName proximity =
case proximity of
WeightedLogJaccard _ -> "WLJaccard"
+ WeightedLogSim _ -> "WeightedLogSim"
Hamming -> "Hamming"
---------------
getConfig phylo = (phylo ^. phylo_param) ^. phyloParam_config
+setConfig :: Config -> Phylo -> Phylo
+setConfig config phylo = phylo
+ & phylo_param .~ (PhyloParam
+ ((phylo ^. phylo_param) ^. phyloParam_version)
+ ((phylo ^. phylo_param) ^. phyloParam_software)
+ config)
+
+-- & phylo_param & phyloParam_config & phyloParam_config .~ config
+
+
getRoots :: Phylo -> Vector Ngrams
getRoots phylo = (phylo ^. phylo_foundations) ^. foundations_roots
+getSources :: Phylo -> Vector Text
+getSources phylo = _sources (phylo ^. phylo_sources)
+
phyloToLastBranches :: Phylo -> [[PhyloGroup]]
phyloToLastBranches phylo = elems
$ fromListWith (++)
then m ! id
else g ) phylo
+updatePeriods :: Map (Date,Date) (Text,Text) -> Phylo -> Phylo
+updatePeriods periods' phylo =
+ over (phylo_periods . traverse)
+ (\prd ->
+ let prd' = periods' ! (prd ^. phylo_periodPeriod)
+ lvls = map (\lvl -> lvl & phylo_levelPeriod' .~ prd') $ prd ^. phylo_periodLevels
+ in prd & phylo_periodPeriod' .~ prd'
+ & phylo_periodLevels .~ lvls
+ ) phylo
+
traceToPhylo :: Level -> Phylo -> Phylo
traceToPhylo lvl phylo =
groupsToBranches :: Map PhyloGroupId PhyloGroup -> [[PhyloGroup]]
groupsToBranches groups =
- -- | run the related component algorithm
+ {- run the related component algorithm -}
let egos = map (\g -> [getGroupId g]
++ (map fst $ g ^. phylo_groupPeriodParents)
++ (map fst $ g ^. phylo_groupPeriodChilds)
++ (map fst $ g ^. phylo_groupAncestors)) $ elems groups
graph = relatedComponents egos
- -- | update each group's branch id
+ {- update each group's branch id -}
in map (\ids ->
let groups' = elems $ restrictKeys groups (Set.fromList ids)
bId = mergeBranchIds $ map (\g -> snd $ g ^. phylo_groupBranchId) groups'
traceSynchronyEnd :: Phylo -> Phylo
traceSynchronyEnd phylo =
- trace ( "\n" <> "-- | End synchronic clustering at level " <> show (getLastLevel phylo)
+ trace ( "-- | End synchronic clustering at level " <> show (getLastLevel phylo)
<> " with " <> show (length $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " groups"
<> " and " <> show (length $ nub $ map _phylo_groupBranchId $ getGroupsFromLevel (getLastLevel phylo) phylo) <> " branches"
<> "\n" ) phylo
getSensibility :: Proximity -> Double
getSensibility proxi = case proxi of
WeightedLogJaccard s -> s
+ WeightedLogSim s -> s
Hamming -> undefined
----------------