-- |
-- Module:      Data.BitStream.ContinuousMapping
-- Copyright:   (c) 2017 Andrew Lelechenko
-- Licence:     MIT
-- Maintainer:  Andrew Lelechenko <andrew.lelechenko@gmail.com>
--
-- Helpers for continuous mappings, useful to memoize
-- predicates on 'Int' (instead of 'Word' only), and
-- predicates over two, three and more arguments.
--
-- __ Example__
--
-- An infinite plain board of live and dead cells (common for cellular automatons,
-- e. g., <https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life Conway's Game of Life>)
-- can be represented as a predicate @board@ :: 'Int' -> 'Int' -> 'Bool'. Assume that
-- we want to convert it to memoized form. We cannot do it directly, because 'Data.BitStream.tabulate'
-- accepts predicates from 'Word' to 'Bool' only.
--
-- The first step is to define:
--
-- > board'' :: Int -> Int -> Bool
-- > board'' x y = board' (intToWord x) (intToWord y)
-- >
-- > board' :: Word -> Word -> Bool
-- > board' x y = board (wordToInt x) (wordToInt y)
--
-- This is better, but @board'@ is a predicate over two arguments, and we need it to be a predicate over one.
-- Conversion to Z-curve and back does the trick:
--
-- > board'' :: Int -> Int -> Bool
-- > board'' x y = board1 $ toZCurve (intToWord x) (intToWord y)
-- >
-- > board' :: Word -> Bool
-- > board' z = let (x, y) = fromZCurve z in
-- >            board (wordToInt x) (wordToInt y)
--
-- Now we are ready to insert memoizing layer:
--
-- > board'' :: Int -> Int -> Bool
-- > board'' x y = index board' $ toZCurve (intToWord x) (intToWord y)
-- >
-- > board' :: BitStream
-- > board' = tabulate $
-- >   \z -> let (x, y) = fromZCurve z in
-- >         board (wordToInt x) (wordToInt y)

{-# LANGUAGE BinaryLiterals #-}

module Data.BitStream.ContinuousMapping
  ( intToWord
  , wordToInt
  , toZCurve
  , fromZCurve
  , toZCurve3
  , fromZCurve3
  ) where

import Data.Bits
import Unsafe.Coerce

word2int :: Word -> Int
word2int :: Word -> Int
word2int = Word -> Int
forall a b. a -> b
unsafeCoerce

int2word :: Int -> Word
int2word :: Int -> Word
int2word = Int -> Word
forall a b. a -> b
unsafeCoerce

-- | Total map, which satisfies inequality
-- abs ('intToWord' x - 'intToWord' y) ≤ 2 abs(x - y).
--
-- Note that this is not the case for 'fromIntegral' :: 'Int' -> 'Word',
-- because it has a discontinuity between −1 and 0.
--
-- > > map intToWord [-5..5]
-- > [9,7,5,3,1,0,2,4,6,8,10]
intToWord :: Int -> Word
intToWord :: Int -> Word
intToWord Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0    = Int -> Word
int2word        Int
i Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
1
  | Bool
otherwise = Int -> Word
int2word (-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1

-- | Inverse for 'intToWord'.
--
-- > > map wordToInt [0..10]
-- > [0,-1,1,-2,2,-3,3,-4,4,-5,5]
wordToInt :: Word -> Int
wordToInt :: Word -> Int
wordToInt Word
w
  | Word -> Bool
forall a. Integral a => a -> Bool
even Word
w    =         Word -> Int
word2int (Word
w Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
  | Bool
otherwise = Int -> Int
forall a. Num a => a -> a
negate (Word -> Int
word2int (Word
w Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Total map from plain to line, continuous almost everywhere.
-- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.
--
-- Only lower halfs of bits of arguments are used (32 bits on 64-bit architecture).
--
-- > > [ toZCurve x y | x <- [0..3], y <- [0..3] ]
-- > [0,2,8,10,1,3,9,11,4,6,12,14,5,7,13,15]
toZCurve :: Word -> Word -> Word
toZCurve :: Word -> Word -> Word
toZCurve Word
x Word
y = Word -> Word
part1by1 Word
y Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word -> Word
part1by1 Word
x

-- | Inverse for 'toZCurve'.
-- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.
--
-- > > map fromZCurve [0..15]
-- > [(0,0),(1,0),(0,1),(1,1),(2,0),(3,0),(2,1),(3,1),(0,2),(1,2),(0,3),(1,3),(2,2),(3,2),(2,3),(3,3)]
fromZCurve :: Word -> (Word, Word)
fromZCurve :: Word -> (Word, Word)
fromZCurve Word
z = (Word -> Word
compact1by1 Word
z, Word -> Word
compact1by1 (Word
z Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
1))

-- | Total map from space to line, continuous almost everywhere.
-- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.
--
-- Only lower thirds of bits of arguments are used (21 bits on 64-bit architecture).
--
-- > > [ toZCurve3 x y z | x <- [0..3], y <- [0..3], z <- [0..3] ]
-- > [0,4,32,36,2,6,34,38,16,20,48,52,18,22,50,54,1,5,33,37,3,7,35,39,17,21,49,53,19,23,51,55,
-- >  8,12,40,44,10,14,42,46,24,28,56,60,26,30,58,62,9,13,41,45,11,15,43,47,25,29,57,61,27,31,59,63]
toZCurve3 :: Word -> Word -> Word -> Word
toZCurve3 :: Word -> Word -> Word -> Word
toZCurve3 Word
x Word
y Word
z = Word -> Word
part1by2 Word
z Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word -> Word
part1by2 Word
y Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word -> Word
part1by2 Word
x

-- | Inverse for 'toZCurve3'.
-- See <https://en.wikipedia.org/wiki/Z-order_curve Z-order curve>.
--
-- > > map fromZCurve3 [0..63]
-- > [(0,0,0),(1,0,0),(0,1,0),(1,1,0),(0,0,1),(1,0,1),(0,1,1),(1,1,1),(2,0,0),(3,0,0),(2,1,0),(3,1,0),(2,0,1),(3,0,1),(2,1,1),(3,1,1),
-- >  (0,2,0),(1,2,0),(0,3,0),(1,3,0),(0,2,1),(1,2,1),(0,3,1),(1,3,1),(2,2,0),(3,2,0),(2,3,0),(3,3,0),(2,2,1),(3,2,1),(2,3,1),(3,3,1),
-- >  (0,0,2),(1,0,2),(0,1,2),(1,1,2),(0,0,3),(1,0,3),(0,1,3),(1,1,3),(2,0,2),(3,0,2),(2,1,2),(3,1,2),(2,0,3),(3,0,3),(2,1,3),(3,1,3),
-- >  (0,2,2),(1,2,2),(0,3,2),(1,3,2),(0,2,3),(1,2,3),(0,3,3),(1,3,3),(2,2,2),(3,2,2),(2,3,2),(3,3,2),(2,2,3),(3,2,3),(2,3,3),(3,3,3)]
fromZCurve3 :: Word -> (Word, Word, Word)
fromZCurve3 :: Word -> (Word, Word, Word)
fromZCurve3 Word
z = (Word -> Word
compact1by2 Word
z, Word -> Word
compact1by2 (Word
z Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
1), Word -> Word
compact1by2 (Word
z Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
2))

-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/
part1by1 :: Word -> Word
part1by1 :: Word -> Word
part1by1 Word
x = Word
x5
  where
    x0 :: Word
x0 = Word
x                           Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0000000000000000000000000000000011111111111111111111111111111111
    x1 :: Word
x1 = (Word
x0 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x0 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0000000000000000111111111111111100000000000000001111111111111111
    x2 :: Word
x2 = (Word
x1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL`  Int
8)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0000000011111111000000001111111100000000111111110000000011111111
    x3 :: Word
x3 = (Word
x2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x2 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL`  Int
4)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0000111100001111000011110000111100001111000011110000111100001111
    x4 :: Word
x4 = (Word
x3 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x3 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL`  Int
2)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0011001100110011001100110011001100110011001100110011001100110011
    x5 :: Word
x5 = (Word
x4 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x4 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL`  Int
1)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0101010101010101010101010101010101010101010101010101010101010101

-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/
part1by2 :: Word -> Word
part1by2 :: Word -> Word
part1by2 Word
x = Word
x5
  where
    x0 :: Word
x0 = Word
x                           Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0000000000000000000000000000000011111111111111111111111111111111
    x1 :: Word
x1 = (Word
x0 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x0 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b1111111111111111000000000000000000000000000000001111111111111111
    x2 :: Word
x2 = (Word
x1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0000000011111111000000000000000011111111000000000000000011111111
    x3 :: Word
x3 = (Word
x2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x2 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL`  Int
8)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b1111000000001111000000001111000000001111000000001111000000001111
    x4 :: Word
x4 = (Word
x3 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x3 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL`  Int
4)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0011000011000011000011000011000011000011000011000011000011000011
    x5 :: Word
x5 = (Word
x4 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x4 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL`  Int
2)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0001001001001001001001001001001001001001001001001001001001001001

-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/
compact1by1 :: Word -> Word
compact1by1 :: Word -> Word
compact1by1 Word
x = Word
x5
  where
    x0 :: Word
x0 = Word
x                           Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0101010101010101010101010101010101010101010101010101010101010101
    x1 :: Word
x1 = (Word
x0 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x0 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR`  Int
1)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0011001100110011001100110011001100110011001100110011001100110011
    x2 :: Word
x2 = (Word
x1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR`  Int
2)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0000111100001111000011110000111100001111000011110000111100001111
    x3 :: Word
x3 = (Word
x2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x2 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR`  Int
4)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0000000011111111000000001111111100000000111111110000000011111111
    x4 :: Word
x4 = (Word
x3 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x3 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR`  Int
8)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0000000000000000111111111111111100000000000000001111111111111111
    x5 :: Word
x5 = (Word
x4 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x4 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
16)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0000000000000000000000000000000011111111111111111111111111111111

-- Inspired by https://fgiesen.wordpress.com/2009/12/13/decoding-morton-codes/
compact1by2 :: Word -> Word
compact1by2 :: Word -> Word
compact1by2 Word
x = Word
x5
  where
    x0 :: Word
x0 = Word
x                           Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0001001001001001001001001001001001001001001001001001001001001001
    x1 :: Word
x1 = (Word
x0 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x0 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR`  Int
2)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0011000011000011000011000011000011000011000011000011000011000011
    x2 :: Word
x2 = (Word
x1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR`  Int
4)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b1111000000001111000000001111000000001111000000001111000000001111
    x3 :: Word
x3 = (Word
x2 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x2 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR`  Int
8)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0000000011111111000000000000000011111111000000000000000011111111
    x4 :: Word
x4 = (Word
x3 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x3 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
16)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b1111111111111111000000000000000000000000000000001111111111111111
    x5 :: Word
x5 = (Word
x4 Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` (Word
x4 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
0b0000000000000000000000000000000011111111111111111111111111111111