PageRank 算法是一種經典的網頁排名算法。基本思想是，每個節點首先賦相等的初值。接下來，根據鏈接關係將值傳播到鏈接去的節點。如此迭代直到收斂。
需要特殊處理的地方是，出度爲 0 的節點需要將值保存到自己。
爲了避免自私的節點不引用別人，從而大量積累自己的值，進行平滑處理。給每一個節點乘以縮減因子 ，再將每個節點加上相等的
。注意到這種平滑不改變總值。也即任何時刻所有節點的值之和恆爲 1 。
與之相關的還有 特徵向量中心度 eigenvector centrality ，其區別是，不處理出度爲 0 的點，也不進行平滑。而在每一步進行正規化。此外，特徵向量也可以使用入度作爲標準，僅需將連接矩陣轉置即可。
這裏給出一種簡潔的三合一 Haskell 實現。不使用任何複雜的庫函數，僅用 80 行。從中可以看到 Haskell 的簡潔和抽象能力。
三種算法的核心都是不斷迭代直到收斂。將這一邏輯抽象出來得到：
converge :: Eq a => (a -> a) -> a -> a
converge f v = fst $ until theSame update (v, f v)
where
theSame (x, y) = x == y
update (x, y) = (y, f y)
這裏用到了庫函數 until :: (a -> Bool) -> (a -> a) -> a -> a 。這個函數接收一個判斷函數，一個更新函數和初值。當判斷函數返回假時，會應用更新函數。當判斷函數返回真時，返回最終值。
converge 函數實際上要構造一個流（stream），即 v : f v : f (f v) : f (f (f v)) : ... 。當流的兩個連續元素相等時，我們找到了 f 這個函數的不動點，也就是最終的收斂值。
因爲只需要比較前兩個元素，所以我們使用兩個元素的元組（tuple）作爲保存的狀態。until 的判斷函數就是兩個元素是否相等。更新函數是拋棄第一個元素，對第二個元素應用 f 。
接下來不同算法的區別，僅在更新函數不同。
對於 pageRank 來說，就是不斷乘以連接矩陣：
pageRank :: [[Value]] -> [Value] -> [Value]
pageRank a vs = head $ converge (`matmul` a') [vs]
where
a' = compensate a
其中 matmul :: (Num a) => [[a]] -> [[a]] -> [[a]] 是矩陣乘法，將在下面給出實現。
注意到，首先將初值用列表改成 (n, 1) 的行向量，因此每次迭代改爲右乘連接矩陣。最後使用 head 再轉變成一維列表 (n,) 。下面各個算法做同樣的處理。
compensate 函數實現兩個功能，對於出度不爲 0 的節點，將因子 1 平均分配到每個非零節點上；對於出度爲 0 的節點，將 1 分配到自己的位置上（矩陣對角線）。
compensate :: [[Value]] -> [[Value]]
compensate = map procOut . zip [0 ..]
where
procOut (i, l) =
if any (/= 0) l
then distribute l
else oneAt i l
distribute l =
let v = 1.0 / (sum l)
in map
(\x ->
if x == 0
then x
else v)
l
oneAt i l =
let (x, _:ys) = splitAt i l
in x ++ 1.0 : ys
平滑處理可以改爲對連接矩陣進行修改：
smooth :: Value -> [[Value]] -> [[Value]]
smooth s m = map (map interpolate) m
where
interpolate a = s * a + (1.0 - s) / fromIntegral n
n = length m
對每一個元素，都用因子 s 縮減，再加上補償。
那麼平滑後的 PageRank 算法如下：
smoothPageRank :: Value -> [[Value]] -> [Value] -> [Value]
smoothPageRank s a vs = head $ converge (`matmul` a') $ [vs]
where
a' = smooth s . compensate $ a
對於特徵向量中心性，需要實現正規化：
normalize :: (Fractional a, Ord a) => [a] -> [a]
normalize vs =
let m = maximum . (map abs) $ vs
in map (/ m) vs
即將一個行向量的每個元素除以最大值。
那麼特徵向量中心性可以實現如下：
eiginCentr :: [[Value]] -> [Value] -> [Value]
eiginCentr a vs =
head $ converge ((map normalize) . (`matmul` a)) [vs]
以上已經實現了三個算法的核心部分。接下來給出輔助函數的直觀定義。
矩陣乘法：
dot :: (Num a) => [a] -> [a] -> a
dot x y = sum $ zipWith (*) x y
matmul :: (Num a) => [[a]] -> [[a]] -> [[a]]
matmul a b = map rowMul a
where
b' = transpose b
rowMul r = map (dot r) b'
類型轉換：
type Value = Double
aFromIntegral :: (Integral a) => [[a]] -> [[Value]]
aFromIntegral = map (map fromIntegral)
生成初始平均分配值：
normalDist :: Int -> [Value]
normalDist n = replicate n $ 1.0 / fromIntegral n
圖從邊表示轉化爲連接矩陣表示：
edgeToAdj :: (Integral a) => [(a, a)] -> [[a]]
edgeToAdj es = [[query i j | j <- [0 .. upper]] | i <- [0 .. upper]]
where
(ls, rs) = unzip es
vs = ls ++ rs
upper = maximum vs -- lower bound = 0
query i j =
if elem (i, j) es
then 1
else 0
其實這裏使用 ST monad 更好一點，僅需要 的時間複雜度。這裏用的是直接搜索，需要
的時間複雜度。
以上代碼實現了所有三個算法的功能，僅用了 80 行代碼。完整代碼見 gist 。
使用下圖進行測試：
-- Test Graph 2
tg2e =
[ (0, 8)
, (1, 6)
, (1, 10)
, (1, 11)
, (2, 1)
, (2, 10)
, (2, 11)
, (3, 15)
, (3, 17)
, (4, 1)
, (4, 6)
, (4, 15)
, (5, 7)
, (5, 8)
, (5, 16)
, (6, 5)
, (6, 8)
, (6, 16)
, (7, 5)
, (7, 13)
, (7, 15)
, (8, 16)
, (8, 5)
, (8, 6)
, (9, 11)
, (9, 10)
, (9, 2)
, (10, 9)
, (10, 11)
, (10, 13)
, (11, 9)
, (11, 10)
, (11, 15)
, (12, 13)
, (12, 15)
, (12, 16)
, (13, 14)
, (13, 15)
, (13, 16)
, (14, 13)
, (14, 12)
, (14, 15)
, (15, 1)
, (15, 9)
, (15, 11)
, (16, 7)
, (16, 8)
, (16, 13)
]
tg2 = edgeToAdj tg2e
tg2spr = smoothPageRank 0.8 (aFromIntegral tg2) (normalDist . length $ tg2)
printTg2spr :: IO ()
printTg2spr = mapM_ (printf "%.3f\n") tg2spr
測試結果如下：
$ stack ghci
λ> :load pagerank.hs
[1 of 1] Compiling Main ( pagerank.hs, interpreted )
Ok, one module loaded.
λ> printTg2spr
0.011
0.049
0.034
0.011
0.011
0.054
0.045
0.048
0.069
0.087
0.084
0.104
0.020
0.083
0.033
0.095
0.083
0.078
λ>
符合預期。
連矩陣乘法都從頭開始寫，到整個算法完成，僅需要 80 行代碼。核心就是 converge 函數的抽象。這個例子很好地體現了 Haskell 作爲函數式語言的優點。