1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
{-# LANGUAGE OverloadedStrings #-}
module Db where
import System.FilePath ((<.>), splitExtension)
import Data.List (nub, sort, sortBy, isPrefixOf)
import Control.Monad
import Data.Yaml
import Text.Parsec.Error
import Text.ParserCombinators.Parsec.Prim
import Text.BibTeX.Parse
import Text.BibTeX.Entry as E
import qualified Data.Aeson as A
import qualified Data.Map as M
import Util
-- |A MAC protocol/algorithm
data Protocol = Protocol {
-- |Short protocol name, usually its abbreviation
pname :: String
-- |Long protocol name
, plongname :: Maybe String
-- |Free-text protocol description
, pdescription :: Maybe String
-- |List of publication references describing this protocol
, pref :: [String]
-- |Feature references of this protocol
, pfeatures :: M.Map String (Maybe String)
-- |List of references to other protocols, usually from the paper’s
-- “related work” section
, prelated :: [String]
-- |Relevance of this protocol, calculated (pun intended)
, prank :: Float
} deriving Show
-- |A MAC protocol feature
data Feature = Feature {
-- |Referenceable name
fname :: String
-- |Its description
, fdescription :: Maybe String
} deriving Show
-- |The whole database
data Database = Database {
-- |Key-value pair for each protocol
dalgos :: M.Map String Protocol
-- |Global list of available features
, dfeatures :: M.Map String Feature
-- |Global list of available publications
, dpublications :: [T]
} deriving Show
instance FromJSON Protocol where
parseJSON (Object v) = Protocol
<$> v .: "name"
<*> v .:? "longname"
<*> v .:? "description"
<*> v .:? "ref" .!= []
<*> v .:? "features" .!= M.empty
<*> v .:? "related" .!= []
<*> return 0
parseJSON _ = mzero
instance FromJSON Feature where
parseJSON (Object v) = Feature
<$> v .: "name"
<*> v .:? "description"
parseJSON _ = mzero
instance FromJSON Database where
parseJSON (Object v) = Database
<$> v .: "algos"
<*> v .: "features"
<*> pure []
parseJSON _ = mzero
-- |Find publication with identifier `ident`
findPublication db ident = safeHead $ filter (\x -> ident == E.identifier x) $ dpublications db
-- |Get a list of all publications referenced by proto @p@
protoPublications db p = map (findPublication db) (pref p)
-- |Find all referenced features’ names
referencedFeatures db = nub $ sort $ concat $ map (M.keys . pfeatures) $ M.elems $ dalgos db
-- |Get all features at `level`, starting with 0
getFeaturesByLevel db level = M.filterWithKey (\k v -> countDots k == level) $ dfeatures db
where
countDots = length . filter ((==) '.')
-- |Get features by `base` feature
getFeaturesByBase db base = M.filterWithKey (\k v -> (base ++ ".") `isPrefixOf` k) $ dfeatures db
-- |Read protocol and bib database from file
readDb :: String -> IO Database
readDb f = do
yamlres <- decodeFileEither f
--print yamlres
let
(Right yamldb) = yamlres
(basename, _) = splitExtension f
bibres <- parseFromFile file (basename <.> "bib")
--print bibres
let (Right bibdb) = bibres
return $ calcRank $ yamldb { dpublications = bibdb }
-- |Protocol rank/popularity, uses the pagerank algorithm
calcRank db =
let
initalgos = M.mapWithKey initial $ dalgos db
n = fromIntegral $ M.size $ dalgos db
d = 0.85
initial ident p = p { prank = 1.0/n }
-- Get all incoming references
pincoming algos ident = filter (\(_, x) -> ident `elem` prelated x) $ M.toList algos
-- Calculate new rank for p
modify algos ident p = p { prank = (1-d)/n + d*sum (map inrank (pincoming algos ident)) }
-- Incoming rank for p
inrank (_, p) = prank p / fromIntegral (length (prelated p))
absdiff :: M.Map String Protocol -> (String, Protocol) -> Float
absdiff b (ident, p) = abs (prank (b M.! ident) - prank p)
rankdiff :: M.Map String Protocol -> M.Map String Protocol -> Float
rankdiff a b = 1/n * M.foldlWithKey (\x ident p -> x + absdiff b (ident, p)) 0 a
iterateUntil fiter fcmp a = let b = fiter a in if fcmp a b then iterateUntil fiter fcmp b else b
run algos = M.mapWithKey (modify algos) algos
stop prevalgos algos = rankdiff prevalgos algos > 0.00001
in db { dalgos = (iterateUntil run stop initalgos) }
|
