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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
{-
Copyright 2015–2018 comatose contributors
Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in
the Software without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
of the Software, and to permit persons to whom the Software is furnished to do
so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
-}
{-# LANGUAGE OverloadedStrings #-}
module Db where
import System.FilePath ((<.>), splitExtension)
import Data.List (nub, sort, sortBy, isPrefixOf, group)
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
-- |Get all publication years for all protocols
publicationYears :: Database -> [Int]
publicationYears db = catMaybes $ map publicationYear $ dpublications db
-- |Get earliest year for one publication
publicationYear :: E.T -> Maybe Int
publicationYear e = (lookup "date" $ E.fields e) >>= return . extractYear
where
-- simple iso year extraction
extractYear = read . takeWhile (/= '-')
-- |Get number of publications by year
publicationYearHist :: Database -> [(Int, Int)]
publicationYearHist db = map (\(x:xs) -> (x, length (x:xs))) $ group years
where years = sort $ publicationYears db
minMaxPublicationYears db = (firstyear, lastyear)
where
pubyears = publicationYears 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) }
|
