Function for computing a unique grid Id from a coordinate (and it's inverse)

uniqueGridId.hs

import Data.List

-- simple binomial coefficient function
binomial :: (Integral a) => a -> a -> a
binomial _ 0 = 1
binomial 0 _ = 0
binomial n k = (n - k + 1)*binomial n (k - 1) `div` k

fact :: (Num a, Enum a) => a -> a
fact n = product $ [1 .. n]

-- Compute a unique grid identifier from an integer coordinate
-- there is a bit of redundant computation, but it's nice and simple :)
gridId :: (Integral a) => [a] -> a
gridId [] = 0
gridId xs = binomial (sum xs + (genericLength xs) - 1) (genericLength xs) + gridId (tail xs)


{-
The reverse is a bit more complicated
-}
invGridId :: (Integral a) => a -> a -> [a]
invGridId d i = backSolve $ invGridId' d i
invGridId' 0 _ = []
invGridId' d 0 = genericReplicate d 0
invGridId' d i =  invGridId'' guessN (binomial (guessN - 1) d)
  where
    guessN = ceiling $ (fromInteger $ toInteger $ i*(fact d)) ** (1/ fromInteger (toInteger d))
    invGridId'' n lastGuess = case binomial n d of
      guess | guess > i  -> (n - d) : invGridId' (d - 1) (i - lastGuess)
      guess | guess == i -> (n - d + 1) : invGridId' (d - 1) (i - guess)
      guess              -> invGridId'' (n + 1) guess
      
      
backSolve (x1:(xs@(x2:_))) = x1 - x2 : backSolve xs
backSolve xs = xs




runTests :: (Integral a) => a -> a -> Bool
runTests d n  = testGridId && testinvGridId && testWedge
  where
    -- Test that gridId works:
    -- this tests that we have no duplicates, and we completely fill the available Id space (we don't waste numbers)
    testGridId = map gridId wedge \\ [0 .. genericLength wedge] == []
    
    -- Test that invGridId works:
    -- test identity  
    testinvGridId = map (invGridId d . gridId) wedge == wedge
    
    
    -- Test that our cartesian 'wedge' is correct
    testWedge = testWedgeSize && testWedgeUnique && testWedgeRange
    
    -- test that our cartesian wedge is the right size
    testWedgeSize = genericLength wedge == binomial (n + d) d

    -- test that our cartesian wedge has no duplicates
    testWedgeUnique = nub wedge == wedge
      
    -- test that our cartesian wedge has no numbers > n and no coordinate with a manhattan distance greater than n
    testWedgeRange  = (not $ any (any (> n)) wedge) && (not $ any ((> n) . sum) wedge)
    
    wedge = cartWedge d n 


-- a list of (non negative) cartesian coordinates a manhattan distance n from the origin
cartWedge :: (Ord b, Num b, Num a, Enum b) => a -> b -> [[b]]
cartWedge d n = filter ((<= n) . sum) $ cartProd d n

cartProd :: (Num a, Num b, Enum b) => a -> b -> [[b]]
cartProd 0 _ = return []
cartProd d n = do
  x <- [0..n]
  xs <- cartProd (d - 1) n
  return (x:xs)