LINUX.ORG.RU
Форум — Development  

Лабораторная на Haskell.


0

0 

Развлекался на паре по криптографии освоением Haskell. Граждане, имеющие к нему отношение, гляньте, пожалуйста - может я чушь написал? Насколько грамотен такой подход?

Задачка простенькая - шифр Цезаря. С условиями, чтоб буквы кодировались с учетом регистра, а все, что не буквы - оставалось прежним.


import Char

-- Получить ascii-код начала алфавита для строчных и прописных букв
getDiff x =
	if isLower x
		then ord 'a'
	else if isUpper x
		then ord 'A'
	else 
		0		

-- разбить ascii код на пару чисел: номер в алфавите и ascii-смещение алфавита
splitAscii x =
	(ord x - getDiff x, getDiff x)
	
-- сформировать ascii-символ из пары чисел
formAscii pair =
	chr (fst pair + snd pair)

-- циклический сдвиг на n позиций
cycle_shift n pair = 
	let 
		abc_length = ord 'z' - ord 'a' + 1
	in
		if snd pair == 0
			then pair
		else
			(mod (fst pair+n) abc_length, snd pair)

-- Процедура шифрации/дешифрации
caesar n msg =
	map formAscii $ map (cycle_shift n) $ map splitAscii msg
	

-- врапперы к caesar, они же точки входа
encode n msg =
	caesar n msg
	
decode n msg =
	caesar (-n) msg


getDiff x | isLower x = ord 'a'
          | isUpper x = ord 'A'
          | otherwise = 0

formAscii = chr . uncurry (+)

cycle_shift n p@(x,y) | y == 0 = p
                      | otherwise = (mod (x + n) l, y)
    where l = ord 'z' - ord 'a' + 1

caesar n = map (formAscii . (cycle_shift n) . splitAscii)

encode = caesar	
decode = caesar . negate

Begemoth ★★★★★
()
Ответ на: комментарий от devnull-physicist

Я просто поправил стиль на тот, что мне больше нравится :-) А tutorial'ы читать надо.

Begemoth ★★★★★
() 

caesar n msg = map (caesar' n) msg where
    caesar' n c = maybe c id $ lookup c $ [['a'..'z'],['A'..'Z']] >>= shiftBy n
    shiftBy n lst = zip lst $ drop (n `mod` length lst) $ cycle lst

Miguel ★★★★★
()
Ответ на: комментарий от devnull-physicist

Спасибо. А теперь более подробно:

Итак, идея состоит в том, чтобы по имеющемуся сдвигу n построить словарь. Скажем, если n=2, словарь должен выглядеть так:

[('a','c'),('b','d'),...,('z','b'),('A','C'),...] - идея, думаю, ясна.

Допустим, что такой словарь у нас есть. Как нам его использовать? Нам нужно перекодировать каждый символ в строке - явно следует использовать функцию map, передав ей в качестве аргумента функцию перекодирования одного символа. Как перекодировать символ? Ну, очевидно, нужно поискать символ среди первых элементов пар в словаре. Смотрим в документацию - ура, функция lookup из Data.List делает практически это. Её тип - (Eq a) => a -> [(a,b)] -> Maybe b. То есть: коль скоро мы умеем сравнивать ключи словаря (Eq a) и у нас есть некоторый ключ (a) и словарь ([(a,b)]) мы можем получить значение из словаря; однако, так как ключ в словаре может отсутствовать, мы получаем не само значение, а Maybe от него.

Что такое Maybe? Это либо Nothing - нифига не найдено, либо Just x, где x - найденный элемент. Если ключ (который мы обозначим буквой c - от "character") не найден, функция lookup вернёт Nothing, а нам нужно c. Если же он найден, lookup вернёт Just x, а нам нужно x. В Data.Maybe есть подходящая функция - maybe :: a -> (b -> a) -> Maybe b -> a, которая устроена так: maybe x f Nothing = x, maybe x f (Just z) = f z. Иначе говоря, эта функция позволяет а) указать, что нужно вернуть, если нифига не найдено, и как нужно обработать результат, если что-то таки найдено.

Собираем воедино:

caesar n msg = map (caesar' n) msg -- кстати, можно проще: caesar n = map $ caesar' n caesar' n c = maybe c {- если c отсутствует в словаре -} id {- если найдено значение, вернуть именно его -} $ lookup c $ словарь

Осталось получить словарь. Попробуем для начала получить словарь для строчных букв. В этом словаре первые компоненты (т.е., ключи) - последовательные буквы от 'a' до 'z'. Значит, можно представить его в виде "zip ['a'..'z'] что-то". Это "что-то" должно быть длиной не меньше 26 (можно больше, лишний хвост будет отброшен функцией zip), причём первые элементы - те же ['a'..'z'], только циклически сдвинутые. Идея: сделать "что-то" вида ['c','d',...,'z','a','b','c','d',...] - бесконечный список. Такой список делается просто: повторяем циклически список ['a'..'z'] - для чего есть функция cycle - а потом отрезаем первые n элементов функцией drop:

zip ['a'..'z'] $ drop n $ cycle ['a'..'z']

Облом: если n отрицательно, drop n не добавит элементов (что естественно). Поэтому заменим n на непременно положительное n `mod` 26.

Так как то же самое нужно сделать и с ['A'..'Z'], оформим это дело в функцию:

shiftBy n lst = zip lst $ drop (n `mod` length lst) $ cycle lst

Теперь, чтобы построить словарь, нужно только применить shiftBy n к ДВУМ спискам - ['a'..'z'] и ['A'..'Z'] - и слить результаты воедино. Можно написать так: concat $ map (shiftBy n) [['a'..'z'],['A'..'Z']]. Но тут всплывает в памяти, что монада [] устроена именно так: там операция >>= определена именно как concat $ map ... - а отсюда окончательная запись

[['a'..'z'],['A'..'Z']] >>= shiftBy n

Собираем воедино - ура.

Miguel ★★★★★
()
Ответ на: комментарий от Miguel

Блин. Форматирование в одном месте сбилось.

caesar n msg = map (caesar' n) msg -- кстати, можно проще: caesar n = map $ caesar' n

caesar' n c = maybe c {- если c отсутствует в словаре -} id {- если найдено значение, вернуть именно его -} $ lookup c $ словарь

Miguel ★★★★★
()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.
Development