sparse-0.9.2: A playground of sparse linear algebra primitives using Morton ordering

Copyright(C) 2013 Edward Kmett
LicenseBSD-style (see the file LICENSE)
MaintainerEdward Kmett <ekmett@gmail.com>
Stabilityexperimental
Portabilitynon-portable
Safe HaskellNone
LanguageHaskell98

Sparse.Matrix.Internal.Key

Contents

Description

Keys in Morton order

This module provides combinators for shuffling together the bits of two key components to get a key that is based on their interleaved bits.

See http://en.wikipedia.org/wiki/Z-order_curve for more information about Morton order.

How to perform the comparison without interleaving is described in

https://www.fpcomplete.com/user/edwardk/revisiting-matrix-multiplication/part-2

Synopsis

Keys in Morton order

data Key Source

Key i j logically orders the keys as if the bits of the keys i and j were interleaved. This is equivalent to storing the keys in "Morton Order".

>>> Key 100 200 ^. _1
100
>>> Key 100 200 ^. _2
200

Constructors

Key !Word !Word 

swap :: Key -> Key Source

Swaps the key components around

>>> swap (Key 100 200)
Key 200 100

Most significant bit comparisons

compares :: Word -> Word -> Ordering Source

compare the position of the most significant bit of two words

>>> compares 4 7
EQ
>>> compares 7 9
LT
>>> compares 9 7
GT

lts :: Word -> Word -> Bool Source

lts a b returns True when the position of the most significant bit of a is less than the position of the most signficant bit of b.

>>> lts 4 10
True
>>> lts 4 7
False
>>> lts 7 8
True

les :: Word -> Word -> Bool Source

les a b returns True when the position of the most significant bit of a is less than or equal to the position of the most signficant bit of b.

>>> les 4 10
True
>>> les 4 7
True
>>> les 7 4
True
>>> les 10 4
False

eqs :: Word -> Word -> Bool Source

eqs a b returns True when the position of the most significant bit of a is equal to the position of the most signficant bit of b.

>>> eqs 4 7
True
>>> eqs 4 8
False
>>> eqs 7 4
True
>>> eqs 8 4
False

nes :: Word -> Word -> Bool Source

nes a b returns True when the position of the most significant bit of a is not equal to the position of the most signficant bit of b.

>>> nes 4 7
False
>>> nes 4 8
True
>>> nes 7 4
False
>>> nes 8 4
True

ges :: Word -> Word -> Bool Source

gts a b returns True when the position of the most significant bit of a is greater than or equal to the position of the most signficant bit of b.

>>> ges 4 10
False
>>> ges 4 7
True
>>> ges 7 4
True
>>> ges 10 4
True

gts :: Word -> Word -> Bool Source

gts a b returns True when the position of the most significant bit of a is greater than to the position of the most signficant bit of b.

>>> gts 4 10
False
>>> gts 4 7
False
>>> gts 7 4
False
>>> gts 10 4
True

Unboxed vector constructors

data family MVector s a

Instances

MVector MVector Bool 
MVector MVector Char 
MVector MVector Double 
MVector MVector Float 
MVector MVector Int 
MVector MVector Int8 
MVector MVector Int16 
MVector MVector Int32 
MVector MVector Int64 
MVector MVector Word 
MVector MVector Word8 
MVector MVector Word16 
MVector MVector Word32 
MVector MVector Word64 
MVector MVector () 
MVector MVector Key 
(RealFloat a, Unbox a) => MVector MVector (Complex a) 
(Unbox a, Unbox b) => MVector MVector (a, b) 
(Unbox a, Unbox b, Unbox c) => MVector MVector (a, b, c) 
(Unbox a, Unbox b, Unbox c, Unbox d) => MVector MVector (a, b, c, d) 
(Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => MVector MVector (a, b, c, d, e) 
(Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => MVector MVector (a, b, c, d, e, f) 
NFData (MVector s a) 
Typeable (* -> * -> *) MVector 
data MVector s Key = MV_Key !Int !(MVector s Word) !(MVector s Word) 
data MVector s Bool = MV_Bool (MVector s Word8) 
data MVector s Char = MV_Char (MVector s Char) 
data MVector s Double = MV_Double (MVector s Double) 
data MVector s Float = MV_Float (MVector s Float) 
data MVector s Word64 = MV_Word64 (MVector s Word64) 
data MVector s Word32 = MV_Word32 (MVector s Word32) 
data MVector s Word16 = MV_Word16 (MVector s Word16) 
data MVector s Word8 = MV_Word8 (MVector s Word8) 
data MVector s Word = MV_Word (MVector s Word) 
data MVector s Int64 = MV_Int64 (MVector s Int64) 
data MVector s Int32 = MV_Int32 (MVector s Int32) 
data MVector s Int16 = MV_Int16 (MVector s Int16) 
data MVector s Int8 = MV_Int8 (MVector s Int8) 
data MVector s Int = MV_Int (MVector s Int) 
data MVector s () = MV_Unit Int 
data MVector s (Complex a) = MV_Complex (MVector s (a, a)) 
data MVector s (a, b) = MV_2 !Int !(MVector s a) !(MVector s b) 
data MVector s (a, b, c) = MV_3 !Int !(MVector s a) !(MVector s b) !(MVector s c) 
data MVector s (a, b, c, d) = MV_4 !Int !(MVector s a) !(MVector s b) !(MVector s c) !(MVector s d) 
data MVector s (a, b, c, d, e) = MV_5 !Int !(MVector s a) !(MVector s b) !(MVector s c) !(MVector s d) !(MVector s e) 
data MVector s (a, b, c, d, e, f) = MV_6 !Int !(MVector s a) !(MVector s b) !(MVector s c) !(MVector s d) !(MVector s e) !(MVector s f) 

data family Vector a

Instances

Vector Vector Bool 
Vector Vector Char 
Vector Vector Double 
Vector Vector Float 
Vector Vector Int 
Vector Vector Int8 
Vector Vector Int16 
Vector Vector Int32 
Vector Vector Int64 
Vector Vector Word 
Vector Vector Word8 
Vector Vector Word16 
Vector Vector Word32 
Vector Vector Word64 
Vector Vector () 
Vector Vector Key 
(RealFloat a, Unbox a) => Vector Vector (Complex a) 
(Unbox a, Unbox b) => Vector Vector (a, b) 
(Unbox a, Unbox b, Unbox c) => Vector Vector (a, b, c) 
(Unbox a, Unbox b, Unbox c, Unbox d) => Vector Vector (a, b, c, d) 
(Unbox a, Unbox b, Unbox c, Unbox d, Unbox e) => Vector Vector (a, b, c, d, e) 
(Unbox a, Unbox b, Unbox c, Unbox d, Unbox e, Unbox f) => Vector Vector (a, b, c, d, e, f) 
Unbox e => IsList (Vector e) 
(Unbox a, Eq a) => Eq (Vector a) 
(Data a, Unbox a) => Data (Vector a) 
(Unbox a, Ord a) => Ord (Vector a) 
(Read a, Unbox a) => Read (Vector a) 
(Show a, Unbox a) => Show (Vector a) 
Unbox a => Monoid (Vector a) 
NFData (Vector a) 
Unbox a => Ixed (Vector a) 
Unbox a => Wrapped (Vector a) 
(Unbox a, (~) * t (Vector a')) => Rewrapped (Vector a) t 
(Unbox a, Unbox b) => Each (Vector a) (Vector b) a b
each :: (Unbox a, Unbox b) => Traversal (Vector a) (Vector b) a b
Typeable (* -> *) Vector 
data Vector Bool = V_Bool (Vector Word8) 
data Vector Char = V_Char (Vector Char) 
data Vector Double = V_Double (Vector Double) 
data Vector Float = V_Float (Vector Float) 
data Vector Int = V_Int (Vector Int) 
data Vector Int8 = V_Int8 (Vector Int8) 
data Vector Int16 = V_Int16 (Vector Int16) 
data Vector Int32 = V_Int32 (Vector Int32) 
data Vector Int64 = V_Int64 (Vector Int64) 
data Vector Word = V_Word (Vector Word) 
data Vector Word8 = V_Word8 (Vector Word8) 
data Vector Word16 = V_Word16 (Vector Word16) 
data Vector Word32 = V_Word32 (Vector Word32) 
data Vector Word64 = V_Word64 (Vector Word64) 
data Vector () = V_Unit Int 
data Vector Key = V_Key !Int !(Vector Word) !(Vector Word) 
type Mutable Vector = MVector 
type Item (Vector e) = e 
data Vector (Complex a) = V_Complex (Vector (a, a)) 
type Index (Vector a) = Int 
type IxValue (Vector a) = a 
type Unwrapped (Vector a) = [a] 
data Vector (a, b) = V_2 !Int !(Vector a) !(Vector b) 
data Vector (a, b, c) = V_3 !Int !(Vector a) !(Vector b) !(Vector c) 
data Vector (a, b, c, d) = V_4 !Int !(Vector a) !(Vector b) !(Vector c) !(Vector d) 
data Vector (a, b, c, d, e) = V_5 !Int !(Vector a) !(Vector b) !(Vector c) !(Vector d) !(Vector e) 
data Vector (a, b, c, d, e, f) = V_6 !Int !(Vector a) !(Vector b) !(Vector c) !(Vector d) !(Vector e) !(Vector f)