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 Prelude (floor)
+
import Gargantext.Prelude
import Gargantext.Core.Viz.AdaptativePhylo
import Text.Printf
-- | 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"
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
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
----------------