2014/11/28

map分配則

 プログラム運算は, プログラムの変形なので, そのための変換規則というのがありますが, そのうちの一つに, map分配則というものがあります.

 map分配則は, 次のような規則です.

map (f . g) = map f . map g

 両辺とも意味的には同じなのですが, 片方の式が実行時間が短くなります.
 さてどちらでしょうか.
 高速化(等)のためのプログラム変換なので, 上記の式の片方がプログラム中に登場した時もう片方へ書き換えることで, 高速化を図るというテクニックです.

 実行時間は 左辺 > 右辺 左辺 < 右辺となります. つまり, 上の等式の右辺のような式を見つけた時, 左辺に変換可能であり, かつ, 左辺に変換することで高速化します.

 理由は簡単で, 右辺 map f . map g は, リストを生成を二回行いますが, 左辺 map (f . g)は, mapの回数が一回なので新しいリストを一回生成するに留まります. 右辺はほとんど, 二度ループを行っているようなものですね.

 等式ついては例えば, 次のように証明できます.

mapの定義は次のものとし,
map f [] = []
map f (x:xs) = f x : map f xs

また, 合成関数は次のように定義します.
(f . g) x = f (g x)

この時, 数学的帰納法により等式の証明を試みると
i) 空リストについて, mapの定義より,
map (f . g) [] = []であり,
(map f . map g) []
= map f (map g [])
= map f [] = []で空リストについて成立するので,  成立します.

ii) あるリストxsについて, map (f . g) xs  = (map f . map g) xs が成立すると仮定する.
xsに1つ要素をconsしたリスト(x:xs)について,
map (f . g) x:xs
= (f . g) x : map (f . g) xs
= f (g x) : map (f . g) xs
= {ここで仮定より} f (g x) : (map f . map g) xs    ......①
(map f . map g) (x:xs)
= {合成関数の定義より} map f (map g (x:xs))
= map f (g x : map g xs)
= f (g x) : map f (map g xs)
= {合成関数の定義から} f (g x) : (map f . map g) xs
= {①より} map (f . g) x:xs
より, 与えられたリストがx:xsの時にも map (f . g) = map f . map gが成立.

 というわけで数学的帰納法によりmap分配速が成立する. この辺までは高校レベルの数学に登場する数学的帰納法を知っていれば, 理解できます.
※) Haskellの記法なので, 関数適用がcons演算子や関数合成の演算子よりも優先順位が高いことに注意.

 map分配則は直感的に理解できるもので, わざわざ証明するまでもないようなものですが, もう少し複雑な規則なら上記の手法を用いることで, バグを含まない健全さを手に入れることができるかもしれません.

 さて, 問題はホントに速いのかということですが, 実際にやってみました.

こんなプログラムを用意して,
import Data.Time

gettime ls = do
  start <- getCurrentTime
  print $ sum ls
  end <- getCurrentTime
  print $ "elapsed time : " ++  (show $ diffUTCTime end start)

f = (20 *)
g = (1 +)
ghci上で実際に次のように計測してみたところ,
*Main> gettime $ (map f . map g) [1..10000000]
1000000300000000
"elapsed time : 7.2572358s"
*Main> gettime $ map (f . g) [1..10000000]
1000000300000000
"elapsed time : 5.2496645s"
map (f . g)の方が高速であることが分かるかと思います.

2014/11/20

Clojure×OpenNLPに教わる英文法

 先日, 英文を読んでいたら, 文法的によくわからない一文が, むむむむ.

We remove all artificial constructs from our experiments and instead focus on running the GA the way a practitioner might.

 で, そんな時に, Google翻訳(etc)に通すのも一興ですが, 現代の機械翻訳の限界を鑑みると, 少し頼りなく感じます. そして, 構文的な繋がりだけをヒントとして表示してくれないかな, と思ってみたりします. そこで, 構文解析です.

 調べてみると, ClojureからOpenNLPが使えるようで, (OpenNLPはJavaで書かれた自然言語処理ライブラリ)少し調べてみたところ, 構文解析木を吐いてくれるモジュールclojure-opennlpがあったので, これを使って構文的な繋がりを括弧で括ってみたいと思います.

 モジュールのインストールとreplからの簡単な実行は,


に詳しいですが, 構文解析器を起動するまでの手順をピックアップすると,
  1. profile.cljの:pluginへ [clojure-opennlp "0.3.2"]を追加.
  2. OpenNLP Tool Modelsから, "en-parser-chunking.bin"をダウンロード.
  3. replを起動して, (use 'opennlp.treebank)でclojure-opennlpのパーサのライブラリをインポート.
  4. make-treebank-parserでパーサを生成.
 これで英文の構文解析ができるようになります.

 profile.cljは, ~/.leinか, Windowsなら, C:\Users\<ユーザ名>\.lein\あたりにあるleiningenの設定ファイルで, :pluginsのリストへ[clojure-opennlp "0.3.2"]を追加すると, leinの起動時に勝手にインストールしてくれます.

 replは適当な場所で起動して, こんな感じで使えます.
user> (use 'opennlp.treebank)
nil
user> (def parser (make-treebank-parser "en-parser-chunking.bin"))
#'user/parser
user> (parser ["This is a pen"])
["(TOP (S (NP (DT This)) (VP (VBZ is) (NP (DT a) (NN pen)))))"]
user> (parser ["This is a pen" "The dog is running"])
 "en-parser-chunking.bin"のところは, ダウンロードしたファイルの相対パスor絶対パスです. ダウンロードしたフォルダか保存したフォルダでreplを起動してしまうのが手っ取り早いですが.
 構文解析木は文字列として出力されるようですが, NPやSなど品詞が横に付随していています. 構文解析なので当然, 形態素解析も内包しています. 名詞だけ取り出すような作業の時にはこのような品詞付きの解析木は重宝しますが, 今回は文法的なつながりだけを見たいので, DTとかNNとかが除去された状態にしたいのでmake-treeを使います.
user> (make-tree (first (parser ["This is a pen"])))
{:tag TOP, :chunk ({:tag S, :chunk ({:tag NP, :chunk ({:tag DT, :chunk ("This")})} {:tag VP, :chunk ({:tag VBZ, :chunk ("is")} {:tag NP, :chunk ({:tag DT, :chunk ("a")} {:tag NN, :chunk ("pen")})})})})}
 Clojureの内部構造にparseされたのであとは適当なフィルターを作ればOKですね.
(use 'opennlp.treebank) ;; [clojure-opennlp "0.3.2"]

(def treebank-parser
  (make-treebank-parser "en-parser-chunking.bin"))

(defn get-chunks [tree]
  (cond
   (string? tree) tree
   (seq?    tree) (map get-chunks tree)
   (map?    tree) (get-chunks (:chunk tree))
   :else          "error"))

(defn simplify [tree]
  (cond
   (string? tree)       (symbol tree)
   (not (seq? tree))    "error"
   (empty? (rest tree)) (simplify (first tree))
   :else                (map simplify tree)))

(defn parse-en [en-text] ;; (parse-en "let me out of here !")
  (->> [en-text]
       treebank-parser first make-tree
       get-chunks
       simplify))
のようなプログラムを作成し, 括弧の関係のみが残るようにフィルタリングした結果,
user> (load-file "filter.clj")
#'user/parse-en
user> (parse-en "We remove all artificial constructs from our experiments and instead focus on running the GA the way a practitioner might .")
(We ((remove (all artificial constructs) (from (our experiments))) and (instead focus (on (running (the GA) ((the way) (a practitioner might)))))) .)
 となり, 少しは読みやすくなったかな. といった感じです.
 なお, 上記の括弧の文法的な正しさは保証できませんのであしからず.

 clojure-opennlpを弄っていて気づいたのですが, このmake-treeで生成された構文解析木を使えば, 自作の機械翻訳器ができますね. 生成されたシンタックスのパターンに沿って日本語のルールを記述していってパターンマッチすれば......

2014/11/17

Haskellのフクロウ ((.)$(.))

 Haskellのポイントフリー記法により, いくつか新発見があったようなのですが, そのうちの一つがHaskellのフクロウ・コンビネータなのだそうで.


 次のコンビネータがそれなのですが, たしかに見ようによってはフクロウの顔に見えなくもないです.
*Main> :t ((.)$(.))
((.)$(.)) :: (a -> b -> c) -> a -> (a1 -> b) -> a1 -> c
 で, 試しに型を見てみると次のような感じ.
*Main> :t ((.)$(.))
((.)$(.)) :: (a -> b -> c) -> a -> (a1 -> b) -> a1 -> c
*Main> :t ((.)(.))
((.)(.)) :: (a -> b -> c) -> a -> (a1 -> b) -> a1 -> c
*Main> :t (.)(.)
(.)(.) :: (a -> b -> c) -> a -> (a1 -> b) -> a1 -> c
 ドルマークはgroup expressionと呼ばれ, 括弧と同等のもので, $から行末, またはその前の閉じ括弧の一つ手前までを括弧でくくる演算子です. なので, フクロウコンビネータのドル記号は実は不要(あってもなくても意味は同じ)で, さらに, 外側を囲っている括弧も(上記の例では)不要(Haskellでは, applyの優先順位が一番高いため)なので, 最終的に「フクロウ」は「見下ろす目玉」まで簡略化できました. ドット記号は, 関数合成の演算子なので, これ以上小さくすることはできません.
 しかし, こんなコンビネータどこで使うんだと思っていたのですが, pointfulに書くと,
f a b c d = a b (c d)
なのだそうで, 意外と使えるかもしれないですね. mapでは引数を二つとりますが, たいてい, 二番目の引数は, ごちゃごちゃしていますから.
*Owl> ((.)$(.)) map (* 2) reverse [1..10]
[20,18,16,14,12,10,8,6,4,2]
のように使えます.

 フクロウ・コンビネータは意味的には((.)(.))の目玉二つに相当するわけですが目玉の数を増やすと様々なコンビネータが作れます.
((.))                   :: (b -> c) -> (a -> b) -> a -> c
((.)(.))                :: (a -> b -> c) -> a -> (a1 -> b) -> a1 -> c
((.)(.)(.))             :: (b -> c) -> (a -> a1 -> b) -> a -> a1 -> c
((.)(.)(.)(.))          :: (a -> a1 -> b -> c) -> a -> a1 -> (a2 -> b) -> a2 -> c
((.)(.)(.)(.)(.))       :: (b1 -> c) -> (b -> b1) -> (a -> b) -> a -> c
((.)(.)(.)(.)(.)(.))    :: (b -> b1 -> c) -> (a -> b) -> a -> (a1 -> b1) -> a1 -> c
((.)(.)(.)(.)(.)(.)(.)) :: (a -> b -> c) -> a -> (a1 -> a2 -> b) -> a1 -> a2 -> c
((.)(.)(.)(.)(.)(.)(.)(.)):: (b -> c) -> (a -> a1 -> a2 -> b) -> a -> a1 -> a2 -> c
目玉(合成関数)の数を増やしても, 生成される関数の型に一貫性がないように見えます.
 replで試してみると以下のようになります. 二番目はフクロウ・コンビネータの使い方と同じです.
*Owl> ((.)) reverse tail [1..10]
[10,9,8,7,6,5,4,3,2]
*Owl> ((.)(.)) map (* 2) reverse [1..10]
[20,18,16,14,12,10,8,6,4,2]
*Owl> ((.)(.)(.)) reverse map (* 2) [1..10]
[20,18,16,14,12,10,8,6,4,2]
*Owl> ((.)(.)(.)(.)) foldl (+) 0 tail [1..10]
54
*Owl> ((.)(.)(.)(.)(.)) reverse reverse reverse [1..10]
[10,9,8,7,6,5,4,3,2,1]
*Owl> ((.)(.)(.)(.)(.)(.)) map (+) 2 reverse [1..10]
[12,11,10,9,8,7,6,5,4,3]
 こんな感じで5つ「目」までは使えそうです. 使う関数の名前と組み合わせによっては, 括弧で直接囲うよりも見やすくなるかもしれません. とはいえ, 素直に書いた方が手っ取り早くて安全なのは言うまでもないですが.
 mapとfilterを繰り返し使いたい時と, foldlで組み合わせたい時は, 次のように書けます.

*Owl> ((.)$(.).(.)) map (+ 2) filter (< 3) [1..10]
[3,4]
*Owl> ((.)$(.)$(.).(.)) foldl (+) 0 map (* 3) [1..10]
165

2014/11/04

Haskellのポイント・フリー記法とコンビネータで暗号入門

  暗号化するターゲットは, 記号列なので, Haskellのリスト操作関数がよく似合います. 昔の情報理論の授業資料が出てきたので, Haskellのコンビネータとポイント・フリー記法で遊ぶネタに用いました. 有名どころの暗号化手法について, シーザー暗号, アフィン暗号, ヴィジュネル暗号, ポリュビオス暗号, ワンタイムパッド, フェイステル暗号(ブロック暗号), RSA暗号(公開鍵暗号)についてそれぞれ書きました.

(2014/11/16追記)今見ると, 結構pointfulな書き方が多いですね. もう少しタイトルを考えるべきでした.

注意

  • アルファベットの総数は, プログラム上では, 空白等の記号も用いたいのと簡単のため, 128にしていますが, これだと統計的にかなり偏りが出てしまうため, 暗号としては, あまりよくない(解読されやすい)ことに注意.
  • 実装では, 一部XORの代わりにシーザーシフト(シーザー暗号の変換)を使っています. これは, 文字列をbit列に変換するのが面倒だったので, 代用しているものです.
  • 間違ってたらごめんなさい.

シーザー暗号

 定番の暗号です. ジュリアス・シーザーが用いたと言われるもので, 鍵n(=1〜26 : アルファベットの総数以下)についてアルファベット順をnづつシフトして(ずらして)記述することで暗号化します. つまり, 鍵nは, シフト数を表します.

 例えば, 平文"cat"について鍵n=3を使うと, c→d→e→f, a→b→c→d, t→u→v→wで, "fdw"という暗号文ができます. 復号は, これを逆方向に3づつシフトすると, 元の平文が生成される仕組みです. zなどは, アルファベット順の末尾と先頭をつなげて, z→a→b→cとシフトします.

 鍵空間はアルファベットの総数(=26)で, 26通りなので, 総当り法で簡単に解けるものですが, 原始的ながら, 鍵と暗号化/復号化のアルゴリズムがあるという点は以降に紹介する暗号化手法と共通しています.

 Haskellでは, 一旦数値化して, 数値を足したあと, mod 128で繰り返します.
module Ceaser where
import Data.Char

ceaser key = chr . flip mod 128 . (key +) . ord

encrypt :: Int -> String -> String
encrypt key = map $ ceaser key

decrypt :: Int -> String -> String
decrypt key = map $ ceaser (- key)
 シーザーシフト(ceaser関数)は, ポイント・フリー(dot記号による関数合成)で書いています. flipは, 引数の順序を入れ替える関数で, flip f b a = apply f a bの意味です. ポイントフリー記法には欠かせません. (key +)は, 加算演算子の部分適用で一引数関数になっていて, Haskellの便利なところでもあります.

 ポイントフリーは右から処理が行われていきます. ceaser関数は, key::Intとc::Charを受け取り, ordでInt型へ変換した後, シーザーシフト(key +)を行い, mod 128で剰余を求め, 最後にchrでChar型へ変換した値を返すというふうに読みます.

 encryptとdecryptは, 暗号化/復号化の関数で, 鍵とそれぞれ平文/暗号文の2つを受け取る関数ですが, map関数への部分適用でクロージャが生成されるため, 引数は明示的には, 1つだけ記述しています. encrypt/decryptの第二引数はそのままmapの第二引数となります.

 $記号(演算子)は, HaskellにおいてGrouping Expression と呼ばれ, 括弧と同じ役割を果たします(syntax in Haskell). $演算子から文末までを括弧でくくるのと同等の意味を表します.

実行結果は以下のとおり.
Prelude> :load ceaser
[1 of 1] Compiling Ceaser           ( ceaser.hs, interpreted )
Ok, modules loaded: Ceaser.
*Ceaser> encrypt 10 "hello world!"
"rovvy*\SOHy|vn+"
*Ceaser> decrypt 10 "rovvy*\SOHy|vn+"
"hello world!"
*Ceaser> decrypt 11 (encrypt 11 "hello world!")
"hello world!"

アフィン暗号

 シーザー暗号の鍵空間がアルファベットの総数以下だったのに対し, アフィン暗号では, 2つの数値のペア(a, b)を暗号のキーにします.
 アフィン暗号のコンセプトは, ある平文のi番目の文字を表すpiに対し,

di = a * pi + b

で暗号化します. この暗号文の文字diに対して,

pi = ( di - b ) / a

で復号化できるというものです.

 加算と乗算に対応する減算と除算を行えば元の文字(値)が出現するという仕組みですが, 実際の暗号化はmod 128が入ってくるので, 暗号化と復号化はそれぞれ, 次のようになります.

di = a * pi + b (mod 128)

pi = (( di - b ) * N * 128) / a (mod 128)

 ただし, Nは, mod (( di - b ) * N * 128) a == 0となるような自然数です. また, 暗号化のためのキー(a, b)のうちaは, アルファベット総数(ここでは, 128)と素な数(gcd(a, 128) == 1)である必要があります.
module Affine where
import Data.List
import Data.Char

numeric op = chr . flip mod 128 . op . ord

encrypt :: (Int, Int) -> String -> String
encrypt (a, b) = map $ numeric $ (b +) . (a *)

decrypt :: (Int, Int) -> String -> String
decrypt (a, b) = map $ numeric $ flip div a . head . op
  where
  op c = [x | n <- [0..],let x = (c - b) + 128 * n, (mod x a) == 0] 
 リスト内包記法を使っているため, 前述した条件を満たすnを求める部分が, ジェネレータとlet式とフィルターがひとつにまとめて記述されていて, 簡潔にかけました. (b +) . (a *)のポイント・フリー記法は明らかにやり過ぎな感じですが, 面白いのでこのままにしました. decrypt のコードも極端すぎて読みにくいですね. とはいえ, 今回はこの記法で遊ぶのが目的の一部なのでこんな感じにしました.

 次のような実行になります.
*Affine> encrypt (7, 100) "affine cipher"
"\v..Cf'D\EMCt<'\STX"
*Affine> decrypt (7, 100) "\v..Cf'D\EMCt<'\STX"
"affine cipher"
 タプルのfstの要素が7というのが重要なところで, 今回はmod 128なので, 偶数だと復号に失敗します.

ヴィジュネル暗号

 シーザー暗号を周期的に切り替える手法が, ヴィジュネル暗号です. シフト数のリスト(s0, s1, ..., sn)を用意し, a番目の文字にシフト数s(i (mod n))を使い, a+1番目の文字にシフト数 s(i+1 (mod n))を使うという手法で, 周期的に切り替えることで, 符号化の難易度を高めます.

 例えば, 鍵に相当するシフト数のリスト[2, 3]について, 平文"doggy"は, シフト数2でd→e→f, シフト数3のo→p→q→r, でこれを残りの平文の文字列に対しても周期的に用いて, g→h→i, g→h→i→j, y→z→aで, 暗号文"frija"が完成します.

 暗号を解読するとき, 鍵の周期とシフト数を調べる必要があるため, 解読が難しくなります."鍵の周期の長さ" ≧ "暗号化する平文の長さ"となると, 後述するワンタイムパッドと同等になります.

  次がそのコードなのですが, 随分あっさりしてます.
module Vigenere where
import Data.List
import Data.Char

ceaser key = chr . (flip mod 128) . (key +) . ord

encrypt :: [Int] -> String -> String
encrypt keys = zipWith ceaser $ cycle keys

decrypt :: [Int] -> String -> String
decrypt keys = zipWith ceaser $ cycle $ map (0 -) keys
 周期的にシーザーシフトが変化する部分の書き方を悩んだのですが, cycleを使い, zipWithで抱き合わせてシーザーシフトさせれば上手く行きました.

 以下がその実行結果.
*Vigenere> encrypt [10, 21, 32] "cipher : Vige ne re"
"m~\DLErz\DC2*O@`~\ao5\SOo5\DC2o"
*Vigenere> decrypt [10, 21, 32] "m~\DLErz\DC2*O@`~\ao5\SOo5\DC2o"
"cipher : Vige ne re"
*Vigenere> decrypt [10, 20, 32] "m~\DLErz\DC2*O@`~\ao5\SOo5\DC2o"
"cjphfr ; Vjge!ne!re"
二回目の復号化ではわざと間違った鍵を渡していますが, 周期的に失敗していることがわかります.

ポリュビオス暗号

 アルファベットA〜Zについてそれぞれ重複しないようにランダムに別のアルファベットを割り当てます. 例えば, AにXを, BにNを, CにGを......というふうにそれぞれの割り当てを表にしたものが, 鍵となります. ポリュビオス暗号では, この表にしたがって, 文字を変換していきます. というわけでアルファベット26文字からなる文の鍵空間は, 26!になります.
 以下がHaskellのコード.
module Polybius where
import Data.List
import Data.Char
import System.Random

shuffle ls = do
  indices <- decRandInts $ (length ls)
  return $ snd $ foldl fetch (ls, []) indices
  where
  randInt :: Int -> IO Int
  randInt n = getStdRandom $ randomR (0, n - 1)
  decRandInts size = mapM randInt $ reverse [1..size]
  fetch (rest, new) i = let item = rest !! i
                        in (delete item rest, item:new)

generateKey = shuffle ([0..127]::[Int])

convert op = chr . (flip mod 128) . op . ord

encrypt :: [Int] -> String -> String
encrypt key = map $ convert (key !!)

decrypt :: [Int] -> String -> String
decrypt key = map $ convert (\x-> head $ findIndices (x ==) key)
 ヴィジュネル暗号に対して, プログラムがいきなり長くなったように感じますが, 暗号化/復号化の部分のコードサイズは, ヴィジュネル暗号とほぼ同じです. 鍵生成にコードが費やされているのですが, 原因は, shuffle関数にあります. リストの要素をランダムに並び替えるだけの関数ですがかなり行数を消費しています. HaskellにはClojureのshuffleに相当する関数がないようで, 困ったところです.

  generateKeyで適当な鍵を生成できます.

  以下が実行例.
*Polybius> key <- generateKey
*Polybius> key
[34,2,38,11,92,112,82,28,42,103,31,59,40,76,123,90,23,19,81,89,83,61,25,66,50,104,27,78,67,68,98,24,101,13,114,9,72,46,69,75,77,87,71,17,51,16,5,60,121,126,6,7,12,113,73,106,26,109,41,105,37,54,120,85,1,58,22,115,44,15,52,29,74,124,33,117,118,116,21,110,125,18,53,64,49,96,0,3,8,79,102,108,30,48,47,100,65,99,94,93,39,4,32,36,20,62,107,91,88,80,45,10,127,35,111,84,14,70,57,119,86,95,43,97,55,63,122,56]
*Polybius> encrypt key "Hello World, Polybius!!"
"J\EOTXX\ne\ETX\noX'3e}\nX_^>FT\r\r"
*Polybius> decrypt key "J\EOTXX\ne\ETX\noX'3e}\nX_^>FT\r\r"
"Hello World, Polybius!!"

ワンタイムパッド

 絶対に解読できない暗号といえば, これです. 解読が不可能(困難ではない)な割にアルゴリズムはものすごく簡単です. 暗号文は2進数としますが, ある平文に対して, その暗号文の同じ長さのランダムな二進数列が鍵になります. 平文と鍵についてXOR (排他的論理和)をとれば, 暗号文が完成します. 復号化は, やはり, 暗号文と鍵のXORでもとの平文が得られます.

  分かりやすさのために, XORの代わりにシーザー暗号を用いると, 長さnの平文P=(p1...pn)と同じ長さのシフト数のリストS=(s1...sn)を用意し, pi番目についてsi番目のシフト数でシフトするという操作と考えることもできます.  この手法は全数探索で解読することができません. 数学的にもちゃんと証明されているようですが, 直感的には, 鍵空間について全数探索を試みると, その長さで存在しうる可能なすべての平文が出現するからだと理解できます. これは, 鍵空間が大きすぎる(NP困難など)といった問題とは全き別の事柄です. 任意の鍵Sで出現した文字列が元の暗号化された平文なのかを判定できません(統計的にはもちろん直感的にもです).

  例えば, 平文"dog"について鍵[1,2,3]で暗号化すると, d→e, o→p→q, g→h→i→jで, 暗号文"eqj"ができます. これについて全数探索した時, mod 26で考えると, 鍵空間は26^3ですが, それぞれについて調べていると, 例えば鍵[2, 16, 16]についても調べます. この結果は, 平文"cat"です. また別の鍵[13, 12, 6]は平文"red"を与えますが, 果たして, 暗号の使用者がどの平文を暗号化したのか解読者の知る術は鍵のコードを直接知る以外にありません.

  というわけで, 次のHaskellのコードはシーザーシフトを用いて作られたOne Time Padのコードです.
module Onetimepad where
import Data.Char
import System.Random

randInt :: a -> IO Int
randInt n = getStdRandom $ randomR (0, 128)

generateKey ls = mapM randInt ls

ceaser key = chr . flip mod 128 . (key +) . ord

encrypt :: [Int] -> String -> String
encrypt = zipWith ceaser

decrypt :: [Int] -> String -> String
decrypt = zipWith (\k-> ceaser (- k))
 基本的にヴィジュネル暗号に近いですが, もともとのシーザー暗号を少し拡張した程度といった感じもします. ceaser関数は, シーザー暗号で使われていたものと同じものです. ポリュビオス暗号同様, 自分で鍵を作るのが大変なので, generateKey関数で平文の長さに応じた鍵が作れるようになっています.

  実行してみると次のようになります.
*Onetimepad> key <- generateKey "One Time Pad !!"
*Onetimepad> key
[102,9,52,106,31,47,21,63,52,9,36,99,80,32,41]
*Onetimepad> encrypt key "One Time Pad !!"
"5w\EM\ns\CAN\STX$TY\ENQGpAJ"
*Onetimepad> decrypt key "5w\EM\ns\CAN\STX$TY\ENQGpAJ"
"One Time Pad !!"
*Onetimepad> decrypt (98:(tail key)) "5w\EM\ns\CAN\STX$TY\ENQGpAJ"
"Sne Time Pad !!"
 ここからは少しややこしくなります....

フェイステル暗号(∈ブロック暗号)

  ワンタイムパッドは強力ですが, 鍵のサイズが物理的に持ち運ぶ必要があるなど難点があります. 解読が難しくかつ, 鍵のサイズがそこまで大きくない暗号が必要です. 軍隊のような物理的に巨大な鍵が使用できる場合を除けば, 現代で用いられている暗号は,ブロック暗号と公開鍵暗号が主流なのだそうです.  ブロック暗号は, 暗号化する平文をブロック単位に分割して, 各ブロックごとに暗号化する手法で, そのうちの一つがフェイステル暗号です.

  最初にF関数という非線形変換を行う関数を用意しておきます. この関数は, 鍵knと平文を引数にとり, 何らかの変換を行った値を返すような関数です. 平文を2つL, Rに分割します. 片方Lに, F関数を適用した後の値とRとで, XORを取り, これをR'とします. 次にR'にF関数を適用した値とLとでXORを取り, これをL'とします. そして再び片方Lに, ...... という処理をn回繰り返し, 2つの平文をくっつければ, 暗号文が出来上がります. 復号化はこの逆の処理です. F関数は非線形変換ならなんでも良いようですが, 暗号の強度はF関数の設計に依存するそうです.

以下がその実装.
module Feistel where
import Data.Char
import System.Random

generateKey n = mapM randInt [1..n]
  where
  randInt :: a -> IO Int
  randInt n = getStdRandom $ randomR (0, 128)

feistel d f key ls = rounding key l0 r0
  where
  (l0, r0) = flip splitAt ls $ div (length ls) 2
  cshift   = zipWith (\x y -> mod (d x y) 128)
  rounding [] l r     = r ++ l
  rounding (k:ks) l r = rounding ks r $ cshift l $ map (f k) r

f :: Int -> Int -> Int
f a x = a * x ^ 2

encrypt :: [Int] -> String -> String
encrypt key = map chr . feistel (+) f key . map ord

decrypt :: [Int] -> String -> String
decrypt key = map chr . feistel (-) f (reverse key)  . map ord
 暗号化/復号化の時の左右入れ替えの処理について上手く書けなかったので, 普通の関数定義として書いています. 一見すると複雑そうなアルゴリズムなので, 手間取るかと思っていたのですが, 案外簡単に実装できます. 暗号化と符号化の処理は全く逆の処理なので, プラスをマイナスに, 鍵を表すリストをひっくり返すだけでかけてしまいました.

 本来は, F関数へ通したあとの処理は, XORなのですが, ワンタイムパッドなど前述の例と同じように(そして, 同様の理由から)シーザーシフトを使っています.

 f関数にはシンプルな二次関数を使っています. 鍵を表すIntのリストはn回目のラウンドにおけるF関数の二次の係数です.

 以下がその実行例. 平文の文字数が奇数個の場合について考えていないので, 一回目の暗号化/復号化では, 最後の一文字が切れてしまっています.
*Feistel> key <- generateKey 10
*Feistel> key
[71,44,84,62,39,115,42,47,19,8]
*Feistel> encrypt key "Feistel Structure"
"\SOH@^oA@sR5\ESC{Hs\ESC\v\\"
*Feistel> decrypt key "\SOH@^oA@sR5\ESC{Hs\ESC\v\\"
"Feistel Structur"
*Feistel> encrypt key "Feistel Structure !!"
"\"\ETB\ENQHs\SOc [?\"\SUB>iS\ETB+ @k"
*Feistel> decrypt key "\"\ETB\ENQHs\SOc [?\"\SUB>iS\ETB+ @k"
"Feistel Structure !!"

RSA暗号(∈公開鍵暗号)

 モダンな暗号といえば, やはり公開鍵暗号でしょう. 復号鍵と暗号鍵が別々に存在し, 暗号鍵が公開できるという点が公開鍵暗号の素晴らしいところです. 公開鍵暗号系は, RSA暗号やElGamal暗号などあるようですが, ここではとりあえずRSA暗号を実装しました.

  私が知る中で, 公開鍵暗号の概念について最もわかりやすい解説は,
妻に公開鍵暗号を教えてみた - 西尾泰和のはてなダイアリー
です. あとは, Wikipediaなんかに色々書いてあります.

 要領としては, 適当に大きな素数p, qを選び, p-1とq-1の最小公倍数(least common multiple)を l とします(l = lcm (p-1, q-1)). 次に, 素数p, qの積を n とします(n = p * q). n 以下の l と素な自然数eを用意し(gcd(e,l) = 1, e ≦ n), (e, N)のペアを公開鍵とします. mod l の時に, e^ (-1)となるようなdを求めます(e * d (mod l) == 1). (d, N)のペアが秘密鍵です.  暗号化/復号化にはそれぞれ,
m = c^e (mod n)
c = m^d (mod n)
 を計算すれば, それぞれの値が求まります. m = m^(e*d) (mod n)のとき, e*d = 1なので, 復号化できるということのようです.
module RSA where
import Data.Char
import System.Random
import Data.Numbers.Primes -- cabal install primes

randInt :: Int -> IO Int
randInt n = getStdRandom $ randomR (100, n)

generateKeyPair a b = ((e , n), (d , n))
  where
  p = fromIntegral $ primes !! a
  q = fromIntegral $ primes !! b
  n = p * q
  l = lcm (p - 1) (q - 1)
  e = head [e | e <- [3..], gcd e l == 1]
  d = head [d | d <- [3..], mod (d * e) l == 1]

generateKey =
  do a <- randInt 200
     b <- randInt 200
     return $ generateKeyPair a b

encrypt :: Integral a => (a, a) -> String -> [a]
encrypt (e, n) = map $ (\m-> m ^ e `mod` n) . fromIntegral . ord

decrypt :: Integral a => (a, a) -> [a] -> String
decrypt (d, n) = map $ chr . fromIntegral . (\c-> c ^ d `mod` n)
 ポリュビオス暗号と同じく, 鍵生成にコードが費やされています.  HaskellのData.Numbers.Primesライブラリを使用しているので, 上記のプログラムの実行には, これをinstallする必要があります. installは, cabalから
cabal install primes
で使用できるようになりました. Data.Nubers.Primesで使用可能になる素数列primesは, [Int]型で, n番目の要素を取り出すときは, インデックスで指定して値を取得します.

 プログラム自体は, かなりシンプルですが, Intではなく, Integralを使うところがポイントです. べき乗は巨大な数になりやすいため, 通常のInt型では対応できません. HaskellのIntの範囲が大体, "at least the range [-2^29 .. 2^29-1]"(Data.Int, Hackage)なのに対して, Integralはほぼ上限なしの整数値を表現できます. きちんと, 型指定しないとInt型に勝手に読み替えられるのでその辺も注意が必要ですが, 一旦Integralを指定した後は楽ですね. 何も考えなくていいので. 

 素数のサイズは, 一般にセキュリティパラメータkに対して, k/2ビットの素数と決められているようですが, 上記の実装は適当で, そこそこ大きな素数(2から数えて, 100~200番目くらいの素数)を2つランダムに生成するように指定しました.  RSA暗号の難点の一つは暗号化/復号化に時間がかかることですが, 上記の実装でもその欠点をあますところなく再現しています. 

 実行してみると以下のようになります.
Prelude> :load rsa
[1 of 1] Compiling RSA              ( rsa.hs, interpreted )
Ok, modules loaded: RSA.
*RSA> keys <- generateKey
*RSA> keys
((7,662153),(35383,662153))
*RSA> encrypt (fst keys) "Hello RSA World!!"
[202542,581327,594739,594739,111395,619198,288526,9701,6174,619198,289750,111395,53605,594739,543959,289438,289438]
*RSA> decrypt (snd keys) [202542,581327,594739,594739,111395,619198,288526,9701,6174,619198,289750,111395,53605,594739,543959,289438,289438]
"Hello RSA World!!"
 以上です. Lispで書くのと違い, Haskellでプログラムを使うとなかなかカッコがつきませんね.