Commit 09038c19 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[PROTOLUDE] cleaning map and imports.

parent 79f3c204
{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext.Database.User where module Gargantext.Database.User where
import Prelude
import Gargantext.Prelude import Gargantext.Prelude
import GHC.Show(Show(..))
import Data.Eq(Eq(..))
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Data.Text (Text) import Data.Text (Text)
import Data.Maybe (Maybe) import Data.Maybe (Maybe)
...@@ -120,4 +122,4 @@ users = do ...@@ -120,4 +122,4 @@ users = do
usersLight :: IO [UserLight] usersLight :: IO [UserLight]
usersLight = do usersLight = do
conn <- PGS.connect infoGargandb conn <- PGS.connect infoGargandb
pm toUserLight <$> runQuery conn queryUserTable map toUserLight <$> runQuery conn queryUserTable
...@@ -2,6 +2,7 @@ ...@@ -2,6 +2,7 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext.Ngrams.CoreNLP where module Gargantext.Ngrams.CoreNLP where
...@@ -9,6 +10,7 @@ import Data.Aeson ...@@ -9,6 +10,7 @@ import Data.Aeson
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
import GHC.Generics import GHC.Generics
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import GHC.Show (Show(..))
import Gargantext.Types.Main (Language(..)) import Gargantext.Types.Main (Language(..))
import Gargantext.Prelude import Gargantext.Prelude
...@@ -69,7 +71,7 @@ instance FromJSON Sentences ...@@ -69,7 +71,7 @@ instance FromJSON Sentences
-- --
corenlpPretty :: String -> IO () corenlpPretty :: Text -> IO ()
corenlpPretty txt = do corenlpPretty txt = do
url <- parseRequest "POST http://localhost:9000/?properties={\"annotators\": \"tokenize,ssplit,pos,ner\", \"outputFormat\": \"json\"}" url <- parseRequest "POST http://localhost:9000/?properties={\"annotators\": \"tokenize,ssplit,pos,ner\", \"outputFormat\": \"json\"}"
let request = setRequestBodyJSON txt url let request = setRequestBodyJSON txt url
...@@ -80,7 +82,7 @@ corenlpPretty txt = do ...@@ -80,7 +82,7 @@ corenlpPretty txt = do
-- print $ getResponseHeader "Content-Type" response -- print $ getResponseHeader "Content-Type" response
S8.putStrLn $ Yaml.encode (getResponseBody response :: Sentences) S8.putStrLn $ Yaml.encode (getResponseBody response :: Sentences)
corenlp :: Language -> String -> IO Sentences corenlp :: Language -> Text -> IO Sentences
corenlp lang txt = do corenlp lang txt = do
let properties = case lang of let properties = case lang of
EN -> "{\"annotators\": \"tokenize,ssplit,pos,ner\", \"outputFormat\": \"json\"}" EN -> "{\"annotators\": \"tokenize,ssplit,pos,ner\", \"outputFormat\": \"json\"}"
...@@ -99,8 +101,8 @@ corenlp lang txt = do ...@@ -99,8 +101,8 @@ corenlp lang txt = do
-- Named Entity Recognition example -- Named Entity Recognition example
-- parseWith _tokenNer "Hello world of Peter." -- parseWith _tokenNer "Hello world of Peter."
-- [[("``","O"),("Hello","O"),("world","O"),("of","O"),("Peter","PERSON"),(".","O"),("''","O")]] -- [[("``","O"),("Hello","O"),("world","O"),("of","O"),("Peter","PERSON"),(".","O"),("''","O")]]
tokenWith :: (Token -> t) -> Language -> String -> IO [[(Text, t)]] tokenWith :: (Token -> t) -> Language -> Text -> IO [[(Text, t)]]
tokenWith f lang s = pm (pm (\t -> (_tokenWord t, f t))) <$> pm _sentenceTokens <$> sentences <$> corenlp lang s tokenWith f lang s = map (map (\t -> (_tokenWord t, f t))) <$> map _sentenceTokens <$> sentences <$> corenlp lang s
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext.Ngrams.Parser where module Gargantext.Ngrams.Parser where
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Ngrams.CoreNLP import Gargantext.Ngrams.CoreNLP
import Data.Text hiding (map)
import Gargantext.Types.Main (Language(..), Ngrams) import Gargantext.Types.Main (Language(..), Ngrams)
import qualified Gargantext.Ngrams.Lang.En as En import qualified Gargantext.Ngrams.Lang.En as En
...@@ -30,13 +31,13 @@ import qualified Gargantext.Ngrams.Lang.Fr as Fr ...@@ -30,13 +31,13 @@ import qualified Gargantext.Ngrams.Lang.Fr as Fr
-- TODO for scientific papers: add maesures -- TODO for scientific papers: add maesures
-- TODO add the p score regex -- TODO add the p score regex
extractNgrams :: Language -> String -> IO [[Ngrams]] extractNgrams :: Language -> Text -> IO [[Ngrams]]
extractNgrams lang s = pm (groupNgrams lang) <$> extractNgrams' lang s extractNgrams lang s = map (groupNgrams lang) <$> extractNgrams' lang s
extractNgrams' :: Language -> String -> IO [[Ngrams]] extractNgrams' :: Language -> Text -> IO [[Ngrams]]
extractNgrams' lang t = pm (pm token2text) extractNgrams' lang t = map (map token2text)
<$> pm _sentenceTokens <$> map _sentenceTokens
<$> sentences <$> sentences
<$> corenlp lang t <$> corenlp lang t
......
...@@ -15,6 +15,7 @@ DGP.parseDate1 DGP.FR "12 avril 2010" == "2010-04-12T00:00:00.000+00:00" ...@@ -15,6 +15,7 @@ DGP.parseDate1 DGP.FR "12 avril 2010" == "2010-04-12T00:00:00.000+00:00"
-} -}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Gargantext.Parsers.Date (parseDate1, Lang(FR, EN), parseDate) where module Gargantext.Parsers.Date (parseDate1, Lang(FR, EN), parseDate) where
...@@ -33,7 +34,7 @@ import Duckling.Types (jsonValue, Entity) ...@@ -33,7 +34,7 @@ import Duckling.Types (jsonValue, Entity)
import Duckling.Api (analyze, parse) import Duckling.Api (analyze, parse)
import qualified Data.HashSet as HashSet import qualified Data.HashSet as HashSet
import qualified Data.Aeson as Json import qualified Data.Aeson as Json
import Data.HashMap.Strict as HM import Data.HashMap.Strict as HM hiding (map)
import Data.Text (Text) import Data.Text (Text)
-- import Duckling.Engine (parseAndResolve) -- import Duckling.Engine (parseAndResolve)
...@@ -59,13 +60,13 @@ import Safe (headMay) ...@@ -59,13 +60,13 @@ import Safe (headMay)
-- parseDate1 :: Context -> Text -> SomeErrorHandling Text -- parseDate1 :: Context -> Text -> SomeErrorHandling Text
parseDate1 :: Lang -> Text -> IO Text parseDate1 :: Lang -> Text -> IO Text
parseDate1 lang text = do parseDate1 lang text = do
maybeJson <- pm jsonValue <$> parseDateWithDuckling lang text maybeJson <- map jsonValue <$> parseDateWithDuckling lang text
case headMay maybeJson of case headMay maybeJson of
Just (Json.Object object) -> case HM.lookup "value" object of Just (Json.Object object) -> case HM.lookup "value" object of
Just (Json.String date) -> pure date Just (Json.String date) -> pure date
Just _ -> error "ParseDate ERROR: should be a json String" Just _ -> panic "ParseDate ERROR: should be a json String"
Nothing -> error "ParseDate ERROR: no date found" Nothing -> panic "ParseDate ERROR: no date found"
_ -> error "ParseDate ERROR: type error" _ -> panic "ParseDate ERROR: type error"
......
...@@ -14,7 +14,9 @@ module Gargantext.Prelude ...@@ -14,7 +14,9 @@ module Gargantext.Prelude
where where
import Protolude ( Bool(True, False), Int, Double, Integer import Protolude ( Bool(True, False), Int, Double, Integer
, Fractional, Num, Maybe, Floating, Char , Fractional, Num, Maybe(Just,Nothing)
, Floating, Char, IO
, pure, (<$>), panic
, Ord, Integral, Foldable, RealFrac, Monad, filter , Ord, Integral, Foldable, RealFrac, Monad, filter
, reverse, map, zip, drop, take, zipWith , reverse, map, zip, drop, take, zipWith
, sum, fromIntegral, length, fmap , sum, fromIntegral, length, fmap
...@@ -33,18 +35,17 @@ import qualified Data.Map as Map ...@@ -33,18 +35,17 @@ import qualified Data.Map as Map
import qualified Data.Vector as V import qualified Data.Vector as V
import Safe (headMay) import Safe (headMay)
pf :: (a -> Bool) -> [a] -> [a] pf :: (a -> Bool) -> [a] -> [a]
pf = filter pf = filter
pr :: [a] -> [a] pr :: [a] -> [a]
pr = reverse pr = reverse
pm :: (a -> b) -> [a] -> [b] --pm :: (a -> b) -> [a] -> [b]
pm = map --pm = map
pm2 :: (t -> b) -> [[t]] -> [[b]] pm2 :: (t -> b) -> [[t]] -> [[b]]
pm2 fun = pm (pm fun) pm2 fun = map (map fun)
pz :: [a] -> [b] -> [(a, b)] pz :: [a] -> [b] -> [(a, b)]
pz = zip pz = zip
...@@ -73,14 +74,14 @@ sumMaybe :: Num a => [Maybe a] -> Maybe a ...@@ -73,14 +74,14 @@ sumMaybe :: Num a => [Maybe a] -> Maybe a
sumMaybe = fmap sum . M.sequence sumMaybe = fmap sum . M.sequence
variance :: Floating a => [a] -> a variance :: Floating a => [a] -> a
variance xs = mean $ pm (\x -> (x - m) ** 2) xs where variance xs = mean $ map (\x -> (x - m) ** 2) xs where
m = mean xs m = mean xs
deviation :: [Double] -> Double deviation :: [Double] -> Double
deviation = sqrt . variance deviation = sqrt . variance
movingAverage :: Fractional b => Int -> [b] -> [b] movingAverage :: Fractional b => Int -> [b] -> [b]
movingAverage steps xs = pm mean $ chunkAlong steps 1 xs movingAverage steps xs = map mean $ chunkAlong steps 1 xs
ma :: [Double] -> [Double] ma :: [Double] -> [Double]
ma = movingAverage 3 ma = movingAverage 3
...@@ -90,7 +91,7 @@ ma = movingAverage 3 ...@@ -90,7 +91,7 @@ ma = movingAverage 3
chunkAlong :: Int -> Int -> [a] -> [[a]] chunkAlong :: Int -> Int -> [a] -> [[a]]
chunkAlong a b l = only (while dropAlong) chunkAlong a b l = only (while dropAlong)
where where
only = pm (take a) only = map (take a)
while = takeWhile (\x -> length x >= a) while = takeWhile (\x -> length x >= a)
dropAlong = L.scanl (\x _y -> drop b x) l ([1..] :: [Integer]) dropAlong = L.scanl (\x _y -> drop b x) l ([1..] :: [Integer])
...@@ -172,18 +173,18 @@ scale :: [Double] -> [Double] ...@@ -172,18 +173,18 @@ scale :: [Double] -> [Double]
scale = scaleMinMax scale = scaleMinMax
scaleMinMax :: [Double] -> [Double] scaleMinMax :: [Double] -> [Double]
scaleMinMax xs = pm (\x -> (x - mi / (ma - mi + 1) )) xs' scaleMinMax xs = map (\x -> (x - mi / (ma - mi + 1) )) xs'
where where
ma = maximum xs' ma = maximum xs'
mi = minimum xs' mi = minimum xs'
xs' = pm abs xs xs' = map abs xs
scaleNormalize :: [Double] -> [Double] scaleNormalize :: [Double] -> [Double]
scaleNormalize xs = pm (\x -> (x - v / (m + 1))) xs' scaleNormalize xs = map (\x -> (x - v / (m + 1))) xs'
where where
v = variance xs' v = variance xs'
m = mean xs' m = mean xs'
xs' = pm abs xs xs' = map abs xs
...@@ -191,9 +192,9 @@ normalize :: [Double] -> [Double] ...@@ -191,9 +192,9 @@ normalize :: [Double] -> [Double]
normalize as = normalizeWith identity as normalize as = normalizeWith identity as
normalizeWith :: Fractional b => (a -> b) -> [a] -> [b] normalizeWith :: Fractional b => (a -> b) -> [a] -> [b]
normalizeWith extract bs = pm (\x -> x/(sum bs')) bs' normalizeWith extract bs = map (\x -> x/(sum bs')) bs'
where where
bs' = pm extract bs bs' = map extract bs
-- Zip functions to add -- Zip functions to add
zipFst :: ([b] -> [a]) -> [b] -> [(a, b)] zipFst :: ([b] -> [a]) -> [b] -> [(a, b)]
......
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