Commit e4d30996 authored by Quentin Lobbé's avatar Quentin Lobbé

fix

parent 7ff3a503
Pipeline #355 canceled with stage
...@@ -89,7 +89,7 @@ main = do ...@@ -89,7 +89,7 @@ main = do
let patterns = buildPatterns termList let patterns = buildPatterns termList
let corpusParsed = map ( (\(y,t) -> Document y (filter (\e -> e /= "") t)) . filterTerms patterns) corpus let corpusParsed = map ( (\(y,t) -> Document y t) . filterTerms patterns) corpus
let query = PhyloQueryBuild "cultural_evolution" "Test" 5 3 defaultFis [] [] defaultWeightedLogJaccard 3 defaultRelatedComponents let query = PhyloQueryBuild "cultural_evolution" "Test" 5 3 defaultFis [] [] defaultWeightedLogJaccard 3 defaultRelatedComponents
...@@ -97,15 +97,15 @@ main = do ...@@ -97,15 +97,15 @@ main = do
let foundations = DL.nub $ DL.concat $ map _pat_terms patterns let foundations = DL.nub $ DL.concat $ map _pat_terms patterns
let phylo = toPhylo query corpusParsed foundations tree -- let phylo = toPhylo query corpusParsed foundations tree
let queryView = PhyloQueryView 2 Merge False 1 [BranchAge] [defaultSmallBranch] [BranchPeakFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Json Flat True -- let queryView = PhyloQueryView 2 Merge False 1 [BranchAge] [defaultSmallBranch] [BranchPeakFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Json Flat True
let view = toPhyloView queryView phylo -- let view = toPhyloView queryView phylo
-- TODO Phylo here -- TODO Phylo here
P.writeFile outputPath $ dotToString $ viewToDot view -- P.writeFile outputPath $ dotToString $ viewToDot view
-- L.writeFile outputPath $ encode corpusParsed L.writeFile outputPath $ encode corpusParsed
...@@ -307,12 +307,7 @@ data Metric = BranchAge deriving (Generic, Show, Eq, Read) ...@@ -307,12 +307,7 @@ data Metric = BranchAge deriving (Generic, Show, Eq, Read)
-- | Tagger constructors -- | Tagger constructors
<<<<<<< HEAD data Tagger = BranchPeakFreq | GroupLabelCooc | GroupDynamics deriving (Show,Generic,Read)
data Tagger = BranchPeakFreq | GroupLabelCooc | GroupDynamics deriving (Show)
=======
data Tagger = BranchLabelFreq | GroupLabelCooc | GroupDynamics
deriving (Generic, Show, Read)
>>>>>>> dev
-------------- --------------
...@@ -354,7 +349,7 @@ data PhyloQueryBuild = PhyloQueryBuild ...@@ -354,7 +349,7 @@ data PhyloQueryBuild = PhyloQueryBuild
} deriving (Generic, Show, Eq) } deriving (Generic, Show, Eq)
-- | To choose the Phylo edge you want to export : --> <-- <--> <=> -- | To choose the Phylo edge you want to export : --> <-- <--> <=>
data Filiation = Ascendant | Descendant | Merge | Complete deriving (Generic, Show) data Filiation = Ascendant | Descendant | Merge | Complete deriving (Generic, Show, Read)
data EdgeType = PeriodEdge | LevelEdge deriving (Generic, Show, Eq) data EdgeType = PeriodEdge | LevelEdge deriving (Generic, Show, Eq)
------------------- -------------------
...@@ -407,6 +402,7 @@ data PhyloNode = PhyloNode ...@@ -407,6 +402,7 @@ data PhyloNode = PhyloNode
data ExportMode = Json | Dot | Svg data ExportMode = Json | Dot | Svg
deriving (Generic, Show, Read)
data DisplayMode = Flat | Nested data DisplayMode = Flat | Nested
deriving (Generic, Show, Read) deriving (Generic, Show, Read)
......
...@@ -66,6 +66,7 @@ type GetPhylo = QueryParam "listId" ListId ...@@ -66,6 +66,7 @@ type GetPhylo = QueryParam "listId" ListId
:> QueryParam "taggers" [Tagger] :> QueryParam "taggers" [Tagger]
:> QueryParam "sort" Sort :> QueryParam "sort" Sort
:> QueryParam "order" Order :> QueryParam "order" Order
:> QueryParam "export" ExportMode
:> QueryParam "display" DisplayMode :> QueryParam "display" DisplayMode
:> QueryParam "verbose" Bool :> QueryParam "verbose" Bool
:> Get '[JSON] PhyloView :> Get '[JSON] PhyloView
...@@ -74,11 +75,11 @@ type GetPhylo = QueryParam "listId" ListId ...@@ -74,11 +75,11 @@ type GetPhylo = QueryParam "listId" ListId
-- Add real text processing -- Add real text processing
-- Fix Filter parameters -- Fix Filter parameters
getPhylo :: PhyloId -> GargServer GetPhylo getPhylo :: PhyloId -> GargServer GetPhylo
getPhylo _phyloId _lId l f b l' ms x y z ts s o d b' = do getPhylo _phyloId _lId l f b l' ms x y z ts s o e d b' = do
let let
fs' = maybe (Just []) (\p -> Just [p]) $ SmallBranch <$> (SBParams <$> x <*> y <*> z) fs' = maybe (Just []) (\p -> Just [p]) $ SmallBranch <$> (SBParams <$> x <*> y <*> z)
so = (,) <$> s <*> o so = (,) <$> s <*> o
q = initPhyloQueryView l f b l' ms fs' ts so d b' q = initPhyloQueryView l f b l' ms fs' ts so e d b'
-- | TODO remove phylo for real data here -- | TODO remove phylo for real data here
pure (toPhyloView q phylo) pure (toPhyloView q phylo)
...@@ -143,7 +144,7 @@ instance ToSchema PhyloGroup ...@@ -143,7 +144,7 @@ instance ToSchema PhyloGroup
instance ToSchema PhyloLevel instance ToSchema PhyloLevel
instance ToSchema PhyloNode instance ToSchema PhyloNode
instance ToSchema PhyloParam instance ToSchema PhyloParam
instance ToSchema PhyloPeaks instance ToSchema PhyloRoots
instance ToSchema PhyloPeriod instance ToSchema PhyloPeriod
instance ToSchema PhyloQueryBuild instance ToSchema PhyloQueryBuild
instance ToSchema PhyloView instance ToSchema PhyloView
...@@ -174,6 +175,12 @@ instance FromHttpApiData DisplayMode ...@@ -174,6 +175,12 @@ instance FromHttpApiData DisplayMode
parseUrlPiece = readTextData parseUrlPiece = readTextData
instance ToParamSchema ExportMode
instance FromHttpApiData ExportMode
where
parseUrlPiece = readTextData
instance FromHttpApiData Sort instance FromHttpApiData Sort
where where
parseUrlPiece = readTextData parseUrlPiece = readTextData
......
...@@ -713,11 +713,8 @@ initWeightedLogJaccard (def 0 -> thr) (def 0.01 -> sens) = WLJParams thr sens ...@@ -713,11 +713,8 @@ initWeightedLogJaccard (def 0 -> thr) (def 0.01 -> sens) = WLJParams thr sens
-- | To initialize a PhyloQueryBuild from given and default parameters -- | To initialize a PhyloQueryBuild from given and default parameters
initPhyloQueryBuild :: Text -> Text -> Maybe Int -> Maybe Int -> Maybe Cluster -> Maybe [Metric] -> Maybe [Filter] -> Maybe Proximity -> Maybe Level -> Maybe Cluster -> PhyloQueryBuild initPhyloQueryBuild :: Text -> Text -> Maybe Int -> Maybe Int -> Maybe Cluster -> Maybe [Metric] -> Maybe [Filter] -> Maybe Proximity -> Maybe Level -> Maybe Cluster -> PhyloQueryBuild
initPhyloQueryBuild name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis -> cluster) (def [] -> metrics) (def [] -> filters) initPhyloQueryBuild name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis -> cluster) (def [] -> metrics) (def [] -> filters)
(def defaultWeightedLogJaccard -> matching') (def 2 -> nthLevel) (def defaultRelatedComponents -> nthCluster) = (def defaultWeightedLogJaccard -> matching) (def 2 -> nthLevel) (def defaultRelatedComponents -> nthCluster) =
PhyloQueryBuild name' desc' grain steps cluster metrics filters matching' nthLevel nthCluster PhyloQueryBuild name desc grain steps cluster metrics filters matching nthLevel nthCluster
where
name' = maybe "Phylo Title" identity name
desc' = maybe "Phylo Desc" identity desc
......
...@@ -138,19 +138,6 @@ addChildNodes shouldDo lvl lvlMin vb fl p v = ...@@ -138,19 +138,6 @@ addChildNodes shouldDo lvl lvlMin vb fl p v =
-- | To transform a PhyloQuery into a PhyloView -- | To transform a PhyloQuery into a PhyloView
toPhyloView' :: Maybe Level
-> Maybe Filiation
-> Maybe Bool
-> Maybe Level
-> Maybe [Metric]
-> Maybe [Filter]
-> Maybe [Tagger]
-> Maybe (Sort, Order)
-> Maybe DisplayMode
-> Maybe Bool
-> PhyloQueryView
toPhyloView' = initPhyloQueryView
toPhyloView :: PhyloQueryView -> Phylo -> PhyloView toPhyloView :: PhyloQueryView -> Phylo -> PhyloView
toPhyloView q p = processDisplay (q ^. qv_display) (q ^. qv_export) toPhyloView q p = processDisplay (q ^. qv_display) (q ^. qv_export)
$ processSort (q ^. qv_sort ) p $ processSort (q ^. qv_sort ) p
......
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