Graph distance algorithm

GraphDistance.hs

module GraphDistance where
import Data.Map
import LazyNatural

distance :: (Ord a) => a -> Map a [a] -> Map a (Maybe Int)
distance a m = Data.Map.map (limit $ size m) m' 
  where m' = mapWithKey d m
        d a' as = if a == a' then zero else succ $ minimum (Prelude.map (m'!) as)
        

LazyInteger.hs

module LazyInteger where
import LazyNatural

data LazyInteger = LI { unLI :: (Bool,LazyNatural) }

constrain :: Int -> Int -> LazyInteger -> Maybe Int
constrain lo hi i = if toEnum lo <= i && i <= toEnum hi then Just $ fromEnum i else Nothing

inf :: LazyInteger
inf = LI (True, (LN $ repeat ()))

instance Num LazyInteger where
  (LI (True,n)) + (LI (False,n')) = LI $ minus n n'
  (LI (False,n)) + (LI (True,n')) = negate . LI $ minus n n'
  (LI (b,n)) + (LI (_,n')) = LI (b, plus n n')
  abs (LI (_,n)) = LI (True,n)
  negate (LI (b,n)) = LI (not b, n)
  signum (LI (_,LN [])) = 0
  signum (LI (b,_)) = LI (b, LN [()])
  fromInteger = toEnum . fromInteger
  (LI (True,n)) - (LI (False,n')) = LI $ (True, plus n n')
  (LI (False,n)) - (LI (True,n')) = LI $ (False, plus n n')
  (LI (b,n)) - (LI (_,n')) = (if b then id else negate) . LI $ minus n n'
  (LI (b,n)) * (LI (b',n')) = LI (b && b' || not (b || b'), times n n')

instance Show LazyInteger where
  show = show . fromEnum

instance Eq LazyInteger where
  (LI (_,LN [])) == (LI (_,LN [])) = True
  (LI p) == (LI p') = p == p'

instance Ord LazyInteger where
  compare n n' = case signum (n - n') of
                   -1 -> LT
                   0 -> EQ
                   1 -> GT

instance Real LazyInteger where
  toRational = toRational . fromEnum

instance Enum LazyInteger where
  succ (LI (False, LN (():n))) = LI (null n, LN n)
  succ (LI (_, n)) = LI (True, succ n)
  pred (LI (True, LN (():n))) = LI (True, LN n)
  pred (LI (_, n)) = LI (False, succ n)
  toEnum i
    | i >= 0 = LI (True, toEnum i)
    | i <  0 = LI (False, toEnum $ negate i)
  fromEnum (LI (b, n)) = (if b then id else negate) $ fromEnum n
  enumFrom = iterate succ

LazyNatural.hs

module LazyNatural where

data LazyNatural = LN { unLN :: [()] } deriving (Eq, Ord)

limit :: Int -> LazyNatural -> Maybe Int
limit hi i@(LN n) = if null (drop hi n) then Just $ fromEnum i else Nothing

zero :: LazyNatural
zero = LN []

plus :: LazyNatural -> LazyNatural -> LazyNatural
plus n (LN []) = n
plus (LN []) n = n
plus (LN (_:n)) (LN (_:n')) = LN $ () : () : unLN (plus (LN n) (LN n'))

times :: LazyNatural -> LazyNatural -> LazyNatural
times (LN n) (LN []) = LN []
times (LN []) (LN n) = LN []
times (LN n) (LN n') = LN $ concatMap (const n) n'

minus :: LazyNatural -> LazyNatural -> (Bool,LazyNatural)
minus n (LN []) = (True, n)
minus (LN []) n = (False, n)
minus (LN (_:n)) (LN (_:n')) = minus (LN n) (LN n')

instance Show LazyNatural where
  show = show . fromEnum

instance Enum LazyNatural where
  succ (LN n) = LN $ () : n
  pred (LN []) = LN []
  pred (LN (() : n)) = LN n
  toEnum i
    | i <= 0 = LN []
    | i >  0 = LN $ replicate i ()
  fromEnum (LN n) = length n
  enumFrom = iterate succ