Практическое применение давнишней статьи.
Давно я написал вот это: Про таблицы истинности и логику и Хаскель
А тут недавно в RU.ALGORITHMS товарищ вылез, мол, сломай мой LCG.
Я и решил применить приемы из той статьи для ломания LCG.
На именно его LCG мне терпения не хватило, а LCG поменьше я сломал.
>data LT =
> Z -- Z for zero
> | O -- O for one
> | D LT LT -- D for subdivision of logical table
> | E LT -- E for table where left part (present) is equal to right
> deriving (Eq, Ord, Show) -- default code for equality and ordering is sufficient.
>-- Логические константы:
>lfalse = Z
>ltrue = O
>
>-- Создание таблиц истинности для переменных:
>lvar n
> | n == 1 = D Z O
> | n>0 = E (lvar (n-1))
> | otherwise = error "Invalid variable number"
>-- Сперва рассмотрим вариант с разделением таблиц:
>lsimp (D a b) = case (lsimp a,lsimp b) of
> (x,y)
> | x == y ->
> -- у нас могут быть варианты с равными
> -- подтаблицами, которые можно дальше упростить,
> -- например, если подтаблицы константы 0 или 1.
> lsimp (E x)
> | otherwise -> D x y
>-- Вариант с равными подтаблицами:
>lsimp (E a) = case lsimp a of
> Z -> Z
> O -> O
> x -> E x
>-- Вот. Остались неупрощаемые варианты. Их мы охватим одной строкой:
>lsimp x = x
>-- Логическая инверсия. Эта операция не требует упрощения результата.
>lnot Z = O
>lnot O = Z
>-- А все остальное - обработаем рекурсивно:
>lnot (D a b) = D (lnot a) (lnot b)
>lnot (E a) = E (lnot a)
>
>-- Вычисление логического И. Сперва - вычисление структуры:
>land' Z _ = Z -- \"ноль\" логического И
>land' _ Z = Z
>land' O x = x -- \"единица\" логического И
>land' x O = x
>land' (D a b) (D x y) = D (land' a x) (land' b y)
>-- Напомню, что мы можем преобразовать (E a) в (D a a):
>land' (D a b) (E x) = D (land' a x) (land' b x)
>land' (E a) (D x y) = D (land' a x) (land' a y)
>land' (E a) (E x) = E (land' a x)
>
>-- Логическое И. С упрощением:
>land a b = lsimp (land' a b)
>
>-- А логическое ИЛИ мы определим через логическое И и логическое НЕ (воспользовавшись x|y = ~((~x)&(~y)):
>lor a b = lnot (land (lnot a) (lnot b))
>-- Вычисление наборов выполнимости для формулы.
>lsatsets t = lsatsets' 1 t
>
>lsatsets' var Z = []
>lsatsets' var O = [[]]
>lsatsets' var (D a b) =
> (map ((-var):) (lsatsets' (var+1) a)) ++
> (map (var:) (lsatsets' (var+1) b))
>lsatsets' var (E a) = lsatsets' (var+1) a
Отсюда идет новое:
Суммирование:
>lxor x y = lor (land x $ lnot y) (land y $ lnot x)
>lsum3 x y z = (sum,carry)
> where
> sum = lxor x y `lxor` z
> carry = lor (land x y) (lor (land y z) (land x z))
Сумма с 0x5917592375:
>inttolts 0 = []
>inttolts x = let (d,m) = divMod x 2 in (if m==1 then O else Z):inttolts d
>wordlen = 16
>toword x = let lts = inttolts x in lts++(take (wordlen-length lts) (repeat Z))
>--lcgadd = toword 0x5917592375
>lcgadd = toword 1
> -- lsum does not generate output carry.
>lsum as bs = lsum' as bs Z
> where
> lsum' [] [] _ = []
> lsum' (a:as) (b:bs) incarry = let
> (s,c) = lsum3 a b incarry
> in
> s:lsum' as bs c
>lcgsum x = lsum x lcgadd
Умножение (множители заданы младшим битом вперед):
>lmul xs ms = take (length xs) $ lmulsum xs ms zeroxs zeroxs
> where
> zeroxs = (take (length xs) (repeat Z))
> lmulsum xs [] prevsum incarry = lsum prevsum incarry
> lmulsum xs (m:ms) prevsum incarry = z:lmulsum xs ms outsum outcarry
> where
> ys = map (land m) xs
> partsums = zipWith3 lsum3 prevsum ys incarry
> outcarry = map snd partsums
> outsum = tail $ (map fst partsums++[Z])
> z = fst $ head partsums
Умножение на 0x1234567012345671:
>--lcgcoef = toword 0x1234567012345671
>lcgcoef = toword 0x5
>lcgmul xs = lmul xs lcgcoef
Схема LCG, с уже сдвинутыми на 56 бит значениями:
>lcg x = r:lcg x'
> where
> x' = lcgsum $ lcgmul x
> r = drop (wordlen-8) x'
Поиск неизвестного стартового значения:
>seedxs = map lvar $ take (length $ toword 0) [1..]
>seedlcg = lcg seedxs
>getseed randoms = lsatsets result
> where
> leq x y = lnot $ lxor x y
> equal x y = foldr land O $ zipWith leq x y
> equals xs ys = foldr land O $ zipWith equal xs ys
> result = equals randoms seedlcg
Проверка:
>test_seed_1 = toword 0x0000
>test_seed_2 = toword 0xbeef
>rseeds1 = take 8 $ lcg test_seed_1
>rseeds2 = take 8 $ lcg test_seed_2
>recover1 = getseed rseeds1
>recover2 = getseed rseeds2
Вот результаты прогона:
*Main> recover1
[[-1,-2,-3,-4,-5,-6,-7,-8,-9,-10,-11,-12,-13,-14,-15,-16]]
*Main> recover2
[[1,2,3,4,-5,6,7,8,-9,10,11,12,13,14,-15,16]]
*Main>
То есть, мы успешно получили начальные значения для двух разных последовательностей. Напомню, что первым идет младший бит, отрицательный номер бита означает 0, положительный - 1.
Второй результат получился гораздо быстрее, чем первый - это потому, что seedlcg описан, как CAF (Constant Applicative Form) и вычисляется один раз. Но долго. ;)
А тут недавно в RU.ALGORITHMS товарищ вылез, мол, сломай мой LCG.
Я и решил применить приемы из той статьи для ломания LCG.
На именно его LCG мне терпения не хватило, а LCG поменьше я сломал.
>data LT =
> Z -- Z for zero
> | O -- O for one
> | D LT LT -- D for subdivision of logical table
> | E LT -- E for table where left part (present) is equal to right
> deriving (Eq, Ord, Show) -- default code for equality and ordering is sufficient.
>-- Логические константы:
>lfalse = Z
>ltrue = O
>
>-- Создание таблиц истинности для переменных:
>lvar n
> | n == 1 = D Z O
> | n>0 = E (lvar (n-1))
> | otherwise = error "Invalid variable number"
>-- Сперва рассмотрим вариант с разделением таблиц:
>lsimp (D a b) = case (lsimp a,lsimp b) of
> (x,y)
> | x == y ->
> -- у нас могут быть варианты с равными
> -- подтаблицами, которые можно дальше упростить,
> -- например, если подтаблицы константы 0 или 1.
> lsimp (E x)
> | otherwise -> D x y
>-- Вариант с равными подтаблицами:
>lsimp (E a) = case lsimp a of
> Z -> Z
> O -> O
> x -> E x
>-- Вот. Остались неупрощаемые варианты. Их мы охватим одной строкой:
>lsimp x = x
>-- Логическая инверсия. Эта операция не требует упрощения результата.
>lnot Z = O
>lnot O = Z
>-- А все остальное - обработаем рекурсивно:
>lnot (D a b) = D (lnot a) (lnot b)
>lnot (E a) = E (lnot a)
>
>-- Вычисление логического И. Сперва - вычисление структуры:
>land' Z _ = Z -- \"ноль\" логического И
>land' _ Z = Z
>land' O x = x -- \"единица\" логического И
>land' x O = x
>land' (D a b) (D x y) = D (land' a x) (land' b y)
>-- Напомню, что мы можем преобразовать (E a) в (D a a):
>land' (D a b) (E x) = D (land' a x) (land' b x)
>land' (E a) (D x y) = D (land' a x) (land' a y)
>land' (E a) (E x) = E (land' a x)
>
>-- Логическое И. С упрощением:
>land a b = lsimp (land' a b)
>
>-- А логическое ИЛИ мы определим через логическое И и логическое НЕ (воспользовавшись x|y = ~((~x)&(~y)):
>lor a b = lnot (land (lnot a) (lnot b))
>-- Вычисление наборов выполнимости для формулы.
>lsatsets t = lsatsets' 1 t
>
>lsatsets' var Z = []
>lsatsets' var O = [[]]
>lsatsets' var (D a b) =
> (map ((-var):) (lsatsets' (var+1) a)) ++
> (map (var:) (lsatsets' (var+1) b))
>lsatsets' var (E a) = lsatsets' (var+1) a
Отсюда идет новое:
Суммирование:
>lxor x y = lor (land x $ lnot y) (land y $ lnot x)
>lsum3 x y z = (sum,carry)
> where
> sum = lxor x y `lxor` z
> carry = lor (land x y) (lor (land y z) (land x z))
Сумма с 0x5917592375:
>inttolts 0 = []
>inttolts x = let (d,m) = divMod x 2 in (if m==1 then O else Z):inttolts d
>wordlen = 16
>toword x = let lts = inttolts x in lts++(take (wordlen-length lts) (repeat Z))
>--lcgadd = toword 0x5917592375
>lcgadd = toword 1
> -- lsum does not generate output carry.
>lsum as bs = lsum' as bs Z
> where
> lsum' [] [] _ = []
> lsum' (a:as) (b:bs) incarry = let
> (s,c) = lsum3 a b incarry
> in
> s:lsum' as bs c
>lcgsum x = lsum x lcgadd
Умножение (множители заданы младшим битом вперед):
>lmul xs ms = take (length xs) $ lmulsum xs ms zeroxs zeroxs
> where
> zeroxs = (take (length xs) (repeat Z))
> lmulsum xs [] prevsum incarry = lsum prevsum incarry
> lmulsum xs (m:ms) prevsum incarry = z:lmulsum xs ms outsum outcarry
> where
> ys = map (land m) xs
> partsums = zipWith3 lsum3 prevsum ys incarry
> outcarry = map snd partsums
> outsum = tail $ (map fst partsums++[Z])
> z = fst $ head partsums
Умножение на 0x1234567012345671:
>--lcgcoef = toword 0x1234567012345671
>lcgcoef = toword 0x5
>lcgmul xs = lmul xs lcgcoef
Схема LCG, с уже сдвинутыми на 56 бит значениями:
>lcg x = r:lcg x'
> where
> x' = lcgsum $ lcgmul x
> r = drop (wordlen-8) x'
Поиск неизвестного стартового значения:
>seedxs = map lvar $ take (length $ toword 0) [1..]
>seedlcg = lcg seedxs
>getseed randoms = lsatsets result
> where
> leq x y = lnot $ lxor x y
> equal x y = foldr land O $ zipWith leq x y
> equals xs ys = foldr land O $ zipWith equal xs ys
> result = equals randoms seedlcg
Проверка:
>test_seed_1 = toword 0x0000
>test_seed_2 = toword 0xbeef
>rseeds1 = take 8 $ lcg test_seed_1
>rseeds2 = take 8 $ lcg test_seed_2
>recover1 = getseed rseeds1
>recover2 = getseed rseeds2
Вот результаты прогона:
*Main> recover1
[[-1,-2,-3,-4,-5,-6,-7,-8,-9,-10,-11,-12,-13,-14,-15,-16]]
*Main> recover2
[[1,2,3,4,-5,6,7,8,-9,10,11,12,13,14,-15,16]]
*Main>
То есть, мы успешно получили начальные значения для двух разных последовательностей. Напомню, что первым идет младший бит, отрицательный номер бита означает 0, положительный - 1.
Второй результат получился гораздо быстрее, чем первый - это потому, что seedlcg описан, как CAF (Constant Applicative Form) и вычисляется один раз. Но долго. ;)