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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
{-# LANGUAGE OverloadedStrings #-}
module Db where
import System.FilePath ((<.>), splitExtension)
import Data.List (nub, sort, sortBy, isPrefixOf)
import Control.Monad
import Data.Maybe (catMaybes)
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
-- |Get number of algorithms in database
algorithmCount db = M.size $ dalgos db
split :: (Eq a) => a -> [a] -> [[a]]
split delim s = let (a, b:bs) = span (/= delim) s in a:split delim bs
-- |Get base of feature
getFeatureBase :: String -> String
getFeatureBase feature = head $ split '.' feature
minMaxPublicationYears db = (firstyear, lastyear)
where
pubyears = catMaybes $ map (lookup "year" . E.fields) $ dpublications db
firstyear = foldr min (head pubyears) (tail pubyears)
lastyear = foldr max (head pubyears) (tail pubyears)
-- |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) }
|