DimensionalHash-0.1.4: Data/DimensionalHash.hs

--
-- Morton number generator
-- Can be used for n-dimensional hash

module Data.DimensionalHash  
(
  MortonNumber(..)
) where

import Data.Bits
import Data.Int
import Data.Word

import Control.Exception
import Data.Typeable

-- | recursevely compute the morton number.	
class (Bits a, Integral a) => (MortonNumber a) where	
	dimensionalHash :: (Bits a) => [a] -> a
	dimensionalHash [] = 0
	dimensionalHash list = hash list 0 (bitSize (head list))
	
	maxBitSize :: (Bits a) => [a] -> Int
	maxBitSize list = div (bitSize (head list)) (length list)
	
	maxSize :: (Bits a) => [a] -> Int
	maxSize list = 2 ^ (maxBitSize list)
	
	isHashable :: (Bits a) => [a] -> Bool
	isHashable [x] = True
	isHashable list = (length filteredList) == 0
		where
			filteredList = filter (\x -> (fromIntegral x) > (maxSize list)) list

-- Integer haven't a fixed bitsize
instance MortonNumber Integer where
	dimensionalHash list = hash list 0 32
	maxBitSize list = div 32 (length list)

-- Types that have a fixed bitsize are instance of MortonNumber
instance MortonNumber Int8
instance MortonNumber Int32
instance MortonNumber Int64

instance MortonNumber Word
instance MortonNumber Word8
instance MortonNumber Word16
instance MortonNumber Word32
instance MortonNumber Word64

hash :: (Bits a) => [a] -> Int -> Int -> a
hash list n precision
	| length list == 1 = head list
	| n < precision = (concatBits list n) .|. (hash list (n + 1) precision)
	| otherwise = 0

-- |Return a list have been shifted elements by n + index
concatBits :: (Bits a) => [a] -> Int -> a
concatBits list n = foldl (\acc x -> acc .|. x) 0 shiftedMap
	where 	
		shiftedMap = shiftElements mapList (n * ((length list) - 1))
		mapList = map (\x -> (takeBitAt x n)) list
		
-- |Return a list have shifted elements by (n + index)
shiftElements :: (Bits a) => [a] -> Int -> [a]
shiftElements [] n = []
shiftElements (x:xs) n = [(shiftL x n)] ++ (shiftElements xs (n+1))

-- |Return an element having all bits set to 0, excepting the bit at n
takeBitAt :: (Bits a) => a -> Int -> a
takeBitAt x n = x .&. (shiftL 1 n)