Poorman's PageRank and eigenvector centrality

poorman-pagerank.hs

import Control.Monad
import Data.List (transpose)
import Text.Printf

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)

type Value = Double

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

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'

aFromIntegral :: (Integral a) => [[a]] -> [[Value]]
aFromIntegral = map (map fromIntegral)

normalize :: (Fractional a, Ord a) => [a] -> [a]
normalize vs =
  let m = maximum . (map abs) $ vs
   in map (/ m) vs

normalDist :: Int -> [Value]
normalDist n = replicate n $ 1.0 / fromIntegral n

eiginCentr :: [[Value]] -> [Value] -> [Value]
eiginCentr a vs =
  head $ converge ((map normalize) . (`matmul` a)) [vs]

pageRank :: [[Value]] -> [Value] -> [Value]
pageRank a vs = head $ converge (`matmul` a') [vs]
  where
    a' = compensate a

smooth :: Value -> [[Value]] -> [[Value]]
smooth s m = map (map interpolate) m
  where
    interpolate a = s * a + (1.0 - s) / fromIntegral n
    n = length m

smoothPageRank :: Value -> [[Value]] -> [Value] -> [Value]
smoothPageRank s a vs = head $ converge (`matmul` a') $ [vs]
  where
    a' = smooth s . compensate $ a

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