Проблема с обменом битов в Haskell

Question

В рамках школьного проекта я реализую некоторые криптографические алгоритмы в Haskell. Как вы, наверное, знаете, это связано с довольно большим количеством низкоуровневых битов. Теперь я застрял на одной подпрограмме, которая вызывает у меня головную боль. Процедура, которая представляет собой перестановку на 256 бит, работает следующим образом:

Ввод: 256-битный блок.
Затем все четные биты (0,2, ...) во входном блоке считаются первыми 128 битами в выходном блоке. В то время как нечетные биты считаются 128 последними битами в выходном блоке. Более конкретно, формула для i'th бита на выходе дается как (a _i - это i'th бит в блоке ввода, и б - это выход):

b _i = a _2i

b _{i + 2 ^d-1} = a _{2i + 1}

для i от 0 до 2 ^d-1 -1, d = 8.

В качестве игрушечного примера предположим, что мы использовали сокращенную версию процедуры, которая работала с 16-битными блоками вместо 256-битных. Тогда следующая цепочка битов будет переставлена ​​следующим образом:

1010 1010 1010 1010 -> 1111 1111 0000 0000

Я не смог придумать чистую реализацию для этой функции. В частности, я пытался с подписью ByteString -> ByteString, но это заставляет меня работать над гранулярностью Word8. Но каждый байт выходной строки байтов является функцией битов во всех остальных байтах, что требует некоторых очень запутанных операций.

Буду очень благодарен за любые подсказки или советы о том, как подойти к этой проблеме.

Answer 1

Если вы хотите эффективную реализацию, я не думаю, что вы можете избежать работы с байтами. Вот пример решения. Предполагается, что в ByteString всегда есть четное число байтов. Я не очень знаком с распаковкой или настройкой строгости, но я думаю, что это будет необходимо, если вы хотите быть очень эффективным.

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"

Answer 2

это должно работать:

import Data.List
import Data.Function

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

Немного объяснений: Поскольку sortBy сохраняет исходный порядок, мы можем связать каждое значение в четной позиции «0» и каждое значение в нечетной позиции «1», тогда мы просто сортируем по второму значению пары. Таким образом, все значения в четных позициях будут размещены перед значениями в нечетных позициях, но их порядок будет сохранен.

Chris

Answer 3

Если производительность не критична, я бы рекомендовал использовать битовое векторное представление для такого проекта.Как вы обнаружили, случайный доступ к отдельным битам является чем-то вроде боли, когда они находятся в упакованном виде, но 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)

Обратите внимание, как это позволяет вам задавать перестановку путем точной расшифровки математического описания.Это существенно снижает вероятность ошибок и является более приятным для написания, чем битовый код.

Чтобы проверить с помощью вашего примера вектора (в базе 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)))

Вы также можете найти полезным пакет Левента Эркока sbv, хотя я не уверен, что он предоставляет такую ​​удобную функцию, как backpermute для вашего конкретного случая.вопрос.

Обновление : я подумал, что на этот вопрос интересно ответить, поэтому я выбрал код в виде библиотеки: bit-vector .