12

26

[Haskell] ROT13 暗号をいろいろなアルゴリズムで解く

2012.12.26(07:08)

社内学習会の演習問題として出題されたので、
HaskellでROT13暗号
http://ja.wikipedia.org/wiki/ROT13
をいろいろなアルゴリズムで解いてみた。あわせてHUnit、QuickCheckも実施してみた。


{-# OPTIONS -Wall -Werror #-}

module Rot13 where
import Test.HUnit
import Test.QuickCheck

-- | (変換元,変換先)となる('a','m')を作る
tpls1,tpls2,tpls3 :: [(Char,Char)]

tpls1 = zip left right ++ zip right left
        where left  = ['a'..'m'] ++ ['A'..'M']
              right = ['n'..'z'] ++ ['N'..'Z']

tpls2 = string2tupple small ++ string2tupple large
        where string2tupple s = zip s (drop 13 s++s)
              small = ['a'..'z']; large = ['A'..'Z']

tpls3 = let string2tupple s = zip s (drop 13 s++s)
            small = ['a'..'z']; large = ['A'..'Z']
        in string2tupple small ++ string2tupple large

-- | ('a','m')を使って、'a'を'm'に変換する
rot1,rot2,rot3,rot4,rot5 :: Char->Char

rot1 c = if not $ null result then head result
                              else c
            where result = [v | (k,v) <- tpls1, k==c]

rot2 c = let result = [v | (k,v) <- tpls2, k==c]
         in case result of []    -> c
                           (x:_) -> x

rot3 c = case [v | (k,v) <- tpls3, k==c] of []    -> c
                                            (x:_) -> x

rot4 c = lookUpTpls tpls3 c
         where  lookUpTpls :: [(Char,Char)]->Char->Char
                lookUpTpls     [] ch = ch 
                lookUpTpls (t:ts) ch = if fst t == ch then snd t 
                                                      else lookUpTpls ts ch
rot5 c = lookUpTpls tpls3 c
         where lookUpTpls     [] ch = ch 
               lookUpTpls (t:ts) ch = if k == ch then v 
                                                 else (lookUpTpls ts ch)
                                      where (k,v) = t

-- | ('a','m')を使って、'a'を'm'に、'm'を'a'に変換する
rot6 :: Char->Char
rot6 c = case rotated of []    -> c
                         (x:_) -> x
              where
                    left  = ['a'..'m'] ++ ['A'..'M']
                    right = ['n'..'z'] ++ ['N'..'Z']
                    kvTpls = zip left right
                    another d a b = if d == a then b else a
                    rotated = [another c k v | (k,v)<-kvTpls, k==c || v==c]

-- | ord'とchr'を使って文字を整数に変換して変換する。
ord' :: Char->Int
ord' c = head [v | (k,v) <- zip [minBound::Char ..] [0..], k==c]

chr' :: Int->Char
chr' n = head [k | (k,v) <- zip [minBound::Char ..] [0..], v==n]

rot7,rot8 :: Char->Char
rot7 cc = case cc of c
                        | elem c ['a'..'m'] -> (chr' $ ord' c + 13)
                        | elem c ['n'..'z'] -> (chr' $ ord' c - 13)
                        | elem c ['A'..'M'] -> (chr' $ ord' c + 13)
                        | elem c ['N'..'Z'] -> (chr' $ ord' c - 13)
                        | otherwise         -> c

rot8 = chr' . conv . ord'
    where 
        conv :: Int -> Int -- この型宣言はなくてもよい
        conv i
          | (i >= ord' 'a') && (i <= ord' 'm') = i + 13
          | (i >= ord' 'n') && (i <= ord' 'z') = i - 13
          | (i >= ord' 'A') && (i <= ord' 'M') = i + 13
          | (i >= ord' 'N') && (i <= ord' 'Z') = i - 13
          | otherwise                          = i

-- | 大文字だったら[c..'Z'] ++ ['A'..c]を使って、先頭から13個削った先頭
-- | 小文字だったら[c..'z'] ++ ['a'..c]を使って、先頭から13個削った先頭
rot9 :: Char->Char
rot9 c
        | (c `elem` ['A'..'Z']) = head (drop 13 ([c..'Z'] ++ ['A'..c]))
        | (c `elem` ['a'..'z']) = head (drop 13 ([c..'z'] ++ ['a'..c]))
        | otherwise = c

rot13 :: String->String
rot13 s = map rot1 s

rotMap :: [(Char->Char)]->String->String
rotMap     [] s = s
rotMap (f:fs) s = rotMap fs (map f s)

isLower, isUpper, isAlpha :: Char->Bool
isLower c = 'a' <= c && c <= 'z'
isUpper c = 'A' <= c && c <= 'Z'
isAlpha c = isLower c || isUpper c
alphas,nonAlphas :: [Char]
alphas    = [c|c<-['\x00'..'\xff'], isAlpha c]
nonAlphas = [c|c<-['\x00'..'\xff'], not $ isAlpha c]

rot13Test :: Test
rot13Test = test [
    "test1" ~: (and [ a /= rot1 a | a<-alphas ])    ~=? True,
    "test2" ~: (and [ a == rot1 a | a<-nonAlphas ]) ~=? True,
               (rot1 'c',rot1 'p') ~=? ('p','c'),
               rot13 msg   ~=? "Uryyb Jbeyq 2012",
               (rot13 $ rot13 msg)  ~=? msg,
               (rot13 $ rot13 msg2) ~=? msg2,
               rotMap [rot1,rot2,rot3,rot4,rot5,rot6,rot7,rot8] msg  ~=? msg,
               rotMap [rot1,rot2,rot3,rot4,rot5,rot6,rot7,rot8] msg2 ~=? msg2,
               True ~=? True
    ] where msg = "Hello World 2012"; msg2 = ['\x00'..'\xff']

-- | rot1からrot8まで同じ変換をやる
prop_rot2,prop_rot3 :: Char->Bool
prop_rot2 c = rot1 c == rot2 c
prop_rot3 c = and [f c == rot1 c | f <- [rot2,rot3,rot4,rot5,rot6,rot7,rot8]]

-- | rot1からrot8まで適用すると元に戻る
prop_rot4 :: String->Bool
prop_rot4 s = rotMap [rot1,rot2,rot3,rot4,rot5,rot6,rot7,rot8] s == s

main2 :: IO ()
main2 = do 
   _ <- runTestTT rot13Test
   quickCheck prop_rot2
   quickCheck prop_rot3
   quickCheck prop_rot4

-- | ひとつの(Char->Char)をいろいろテストするユニットテスト
testOneRot :: (Char->Char) -> Test
testOneRot rot = test [
    (and [ a /= rot a | a<-alphas ])    ~=? True,
    (and [ a == rot a | a<-nonAlphas ]) ~=? True,
    (rot 'c',rot 'p') ~=? ('p','c'),
    map rot nonAlphas  ~=? nonAlphas,
    map rot ['a'..'m'] ~?= ['n'..'z'],
    map rot ['A'..'M'] ~?= ['N'..'Z'],
    (map rot $ map rot ['\x00'..'\xff']) ~?= ['\x00'..'\xff'],
    rot ' ' ~?= ' ',
    True ~?= True
  ]

rots :: [(Char->Char)]
rots = [rot1,rot2,rot3,rot4,rot5,rot6,rot7,rot8,rot9]

-- | リストに入った(Char->Char)に順番にユニットテストを適用する
testRots :: [(Char->Char)]->IO ()
testRots [] = return ()
testRots (x:xs) = do
   _ <- runTestTT $ testOneRot x
   testRots xs

main :: IO ()
main = do
  main2
  testRots rots
  return ()


実行結果
> :main

Cases: 9  Tried: 0  Errors: 0  Failures: 0
Cases: 9  Tried: 1  Errors: 0  Failures: 0
Cases: 9  Tried: 2  Errors: 0  Failures: 0
Cases: 9  Tried: 3  Errors: 0  Failures: 0
Cases: 9  Tried: 4  Errors: 0  Failures: 0
Cases: 9  Tried: 5  Errors: 0  Failures: 0
Cases: 9  Tried: 6  Errors: 0  Failures: 0
Cases: 9  Tried: 7  Errors: 0  Failures: 0
Cases: 9  Tried: 8  Errors: 0  Failures: 0
                                          
Cases: 9  Tried: 9  Errors: 0  Failures: 0
+++ OK, passed 100 tests.
+++ OK, passed 100 tests.
+++ OK, passed 100 tests.
it :: ()
以下略
ユニットテストに引数で高階関数を渡し、同じテストを複数のアルゴリズムに実行できるところは関数型プログラミングらしいと思うな。Strategyパターンだ。
プロフィール

島敏博

Shima Toshihiro 島敏博
信州アルプスハイランド在住。HaskellとElixirが好き。組み込みソフトウェアアーキテクト、C++プログラマ、山歩き、美術館巡り、和食食べ歩き、日本赤十字社救急法指導員、インデックス投資、クラシック音楽、SESSAME会員、状態マシン設計、モデル駆動開発、ソフトウェアプロダクトライン、Rubyist、実践ビジネス英語

■ ツイッター
http://twitter.com/saltheads
■ Facebook
http://www.facebook.com/saltheads
■ Qiita
http://qiita.com/saltheads

印刷する場合は、ブラウザの印刷メニューではなく、このページの上から3cmくらいの青いところにある、「印刷」を押してみてください。少しうまく印刷できます。まだ完全ではないのですが、これで勘弁してください。


カテゴリ
最新記事
月別アーカイブ
最新コメント
検索フォーム
リンク
sessame
RSSリンクの表示