Haskell bit skew problem

As part of a school project, I implement some cryptographic algorithms in Haskell. As you probably know, this is due to a rather large number of bit-bits. Now I'm stuck in one routine that causes me a headache. The procedure, which is a 256-bit permutation, works as follows:

Input: 256-bit block.
Then, all even bits (0.2, ...) in the input block are considered the first 128 bits in the output block. While the odd bits are considered the 128 last bits in the output block. More specifically, the formula for the i'th bit at the output is specified as (a i is the i-th bit in the input block, and b is the output):

b i = a 2i

     

b i + 2 d-1 = a 2i + 1

for i from 0 to 2 d-1 -1, d = 8.

As an example of a toy, suppose we used a shortened version of a subroutine that worked with 16-bit blocks instead of 256 bits. Then the following bit string will be changed as follows:

1010 1010 1010 1010 → 1111 1111 0000 0000

I could not come up with a clean implementation of this function. In particular, I am trying to use a ByteString -> ByteString signature, but this makes me work on granularity like Word8. But every byte in the bytestring output is a function of the bits in all the other bytes, which requires some really messy operations.

I would be very grateful for any hints or tips on how to approach this problem.

+5
3

, , . . , . , , , .

import Data.ByteString (pack, unpack, ByteString)
import Data.Bits
import Data.Word

-- the main attraction
packString :: ByteString -> ByteString
packString = pack . packWords . unpack

-- main attraction equivalent, in [Word8]
packWords :: [Word8] -> [Word8]
packWords ws = evenPacked ++ unevenPacked
    where evenBits = map packEven ws
          unevenBits = map packUneven ws
          evenPacked = consumePairs packNibbles evenBits
          unevenPacked = consumePairs packNibbles unevenBits

-- combines 2 low nibbles (first 4 bytes) into a (high nibble, low nibble) word
-- assumes that only the low nibble of both arguments can be non-zero. 
packNibbles :: Word8 -> Word8 -> Word8
packNibbles w1 w2 = (shiftL w1 4) .|. w2 

packEven w = packBits w [0, 2, 4, 6]

packUneven w = packBits w [1, 3, 5, 7]

-- packBits 254 [0, 2, 4, 6] = 14 
-- packBits 254 [1, 3, 5, 7] = 15
packBits :: Word8 -> [Int] -> Word8
packBits w is = foldr (.|.) 0 $ map (packBit w) is

-- packBit 255 0 = 1
-- packBit 255 1 = 1
-- packBit 255 2 = 2
-- packBit 255 3 = 2
-- packBit 255 4 = 4
-- packBit 255 5 = 4
-- packBit 255 6 = 8
-- packBit 255 7 = 8
packBit :: Word8 -> Int -> Word8
packBit w i = shiftR (w .&. 2^i) ((i `div` 2) + (i `mod` 2))

-- sort of like map, but halves the list in size by consuming two elements. 
-- Is there a clearer way to write this with built-in function?
consumePairs :: (a -> a -> b) -> [a] -> [b]
consumePairs f (x : x' : xs) = f x x' : consumePairs f xs
consumePairs _ [] = []
consumePairs _ _ = error "list must contain even number of elements"
+4

:

import Data.List
import Data.Function

map fst $ sortBy (compare `on` snd) $ zip yourList $ cycle [0,1]

: sortBy , "0" "1", . , , .

+4

, . , - , , Data.Vector .

import Data.Bits
import qualified Data.Vector as V

type BitVector = V.Vector Bool

unpack :: (Bits a) => a -> BitVector
unpack w = V.generate (bitSize w) (testBit w)

pack :: (Bits a) => BitVector -> a
pack v = V.ifoldl' set 0 v
  where
    set w i True = w `setBit` i
    set w _ _    = w

mkPermutationVector :: Int -> V.Vector Int
mkPermutationVector d = V.generate (2^d) b
  where
    b i | i < 2^(d-1) = 2*i
        | otherwise   = let i' = i-2^(d-1)
                        in 2*i'+1

permute :: Int -> BitVector -> BitVector
permute d v = V.backpermute v (mkPermutationVector d)

, , . , , -twiddly-.

- ( 10):

*Main> import Data.Word
*Main Data.Word> let permute16 = pack . permute 4 . unpack :: Word16 -> Word16
*Main Data.Word> permute16 43690
65280

, , , Haskell, Num. Num ; :

plus :: BitVector -> BitVector -> BitVector
plus as bs = V.tail sums
  where
    (sums, carries) = V.unzip sumsAndCarries
    sumsAndCarries  = V.scanl' fullAdd (False, False) (V.zip as bs)
    fullAdd (_, cin) (a, b) = ((a /= b) /= cin
                              , (a && b) || (cin && (a /= b)))

Levent Erkok sbv, , , backpermute .

. , , : bit-vector.

+3

All Articles