正月休みにHaskellの本を斜め読みしていたのですが、その中のシーザー式暗号解読プログラムが面白かったのでFortranで書いてみました。大体はFortran95の範囲内で、配列生成子の記号に(/.../)ではなく[...]を使うところだけFortran2003規格を使いました。
グレアム・ハットンの『プログラミング Haskell』の第５章にある例題をほぼそのまま移植しました。
基本的にELEMENTAL(要素毎)な関数を用いることでMAPにあたる作用をさせています。
厄介なのは、Fortranでの文字列は１文字毎の配列ではないことで、ELEMENTALな関数を適用させるためにTRANSFER関数で、有限長の文字列と１文字要素の配列を変換しています。
その他
数学科と情報学科での自然数は０から始まるのですが、自然科学の分野では自然数は１から始まるのでFortranも１を基点とする自然数系になっていて、その辺もちょっとズレがでます。
１次元配列の配列長をMINLOC関数で求めた場合、１要素の配列として値が帰ってきて、単純にスカラー引数に渡せないところが、昔から面倒に感じていたのですが、MINLOC(a, 1) のように次元指定の第２引数を用いれば、スカラーで値が帰ってくるという小技を最近他人のソースから学びました。
実行結果
ソース
追記 H22.1.28 文字列と文字配列の入れ替えにdummy変数を使っていたの修正。
MODULE m_caesar IMPLICIT NONE REAL, PARAMETER :: table(26) = & [ 8.2, 1.5, 2.8, 4.3, 12.7, 2.2, 2.0, 6.1, 7.0, 0.2, 0.8, 4.0, 2.4, & 6.7, 7.5, 1.9, 0.1, 6.0, 6.3, 9.1, 2.8, 1.0, 2.4, 0.2, 2.0, 0.1 ] CONTAINS !-------------------------------------------------------------- ELEMENTAL INTEGER FUNCTION let2int(c) CHARACTER, INTENT(IN) :: c let2int = IACHAR(c) - IACHAR('a') RETURN END FUNCTION let2int !-------------------------------------------------------------- ELEMENTAL CHARACTER FUNCTION int2let(i) INTEGER, INTENT(IN) :: i int2let = ACHAR(i + IACHAR('a')) RETURN END FUNCTION int2let !-------------------------------------------------------------- ELEMENTAL LOGICAL FUNCTION isLower(c) CHARACTER, INTENT(IN) :: c isLower = (c >= 'a') .AND. (c <= 'z') RETURN END FUNCTION isLower !-------------------------------------------------------------- ELEMENTAL CHARACTER FUNCTION shift(n, c) INTEGER , INTENT(IN) :: n CHARACTER, INTENT(IN) :: c IF ( isLower(c) ) THEN shift = int2let( MODULO( let2int(c) + n, 26 ) ) ELSE shift = c END IF RETURN END FUNCTION shift !-------------------------------------------------------------- PURE FUNCTION encoder(n, text) RESULT(res) INTEGER , INTENT(IN) :: n CHARACTER(*), INTENT(IN) :: text CHARACTER(LEN(text)) :: res res = TRANSFER( shift(n, TRANSFER(text, ' ', LEN(text)) ), text ) RETURN END FUNCTION encoder !-------------------------------------------------------------- ELEMENTAL REAL FUNCTION percent(n, m) INTEGER, INTENT(IN) :: n, m percent = REAL(n) / REAL(m) * 100.0 RETURN END FUNCTION percent !-------------------------------------------------------------- PURE INTEGER FUNCTION lowers(text) CHARACTER(*), INTENT(IN) :: text lowers = COUNT(isLower( TRANSFER(text, ' ', LEN(text) ) )) RETURN END FUNCTION lowers !-------------------------------------------------------------- PURE FUNCTION freqs(text) RESULT(res) CHARACTER(*), INTENT(IN) :: text REAL :: res(26) INTEGER :: i, n n = lowers(text) DO i = IACHAR('a'), IACHAR('z') res(i + 1 - IACHAR('a')) = percent(COUNT( TRANSFER(text, ' ', LEN(TEXT)) == ACHAR(i) ), n) END DO RETURN END FUNCTION freqs !-------------------------------------------------------------- PURE REAL FUNCTION chisqr(os, es) REAL, INTENT(IN) :: os(:), es(:) chisqr = SUM( (os - es)**2 / es ) RETURN END FUNCTION chisqr !-------------------------------------------------------------- PURE FUNCTION crack(text) RESULT(res) CHARACTER(*), INTENT(IN) :: text CHARACTER(LEN(text)) :: res INTEGER :: i, n n = MINLOC( [(chisqr( CSHIFT(freqs(text), i), table ), i = 0, 25)], 1 ) res = encoder(-n + 1, text) RETURN END FUNCTION crack !-------------------------------------------------------------- END MODULE m_caesar !============================================================================ PROGRAM test USE m_caesar IMPLICIT NONE CHARACTER (255) :: text INTEGER :: i PRINT *, let2int('a'), int2let(0), isLower('a'), isLower('D'), isLower('2') PRINT *, shift(3, 'a'), shift(3, 'z'), shift(-3, 'c'), shift(3, ' ') PRINT *, lowers("Haskell"), lowers("Fortran2003"), COUNT('s' == TRANSFER('Mississippi', [(' ', i = 1, LEN('Mississippi'))] ) ) PRINT *, encoder( 3, "haskell is fun") PRINT *, encoder(-3, "kdvnhoo lv ixq") PRINT '(13f5.1)', freqs("abbcccddddeeeee") PRINT *, crack( "kdvnhoo lv ixq" ) PRINT '(9f8.1)', [(chisqr( CSHIFT(freqs("kdvnhoo lv ixq"), i), table ), i = 0, 25)] text = encoder(3, "list comprehensions are useful" ) PRINT *, TRIM(text) PRINT *, crack( TRIM(text) ) PRINT *, crack( encoder(3, "a cunning fox slyly jumped over a lazy dog") ) PRINT '(a)', crack( encoder(3, "Fortran continues to be the premier language used in scientific and engineering computing & &since its introduction in the 1950s.") ) PRINT '(a)', crack( encoder(3, "Fortran 2003 is the latest standard version and has many excellent modern features that & &assist programmers in writing efficient, portable and maintainable programs that are useful & &for everything from ‘hard science’ to text processing.") ) STOP END PROGRAM test
