AtCoder を Fortranで解く (けどFortranのIOは使わない)

注意!!!

以下の内容はあまり真面目な内容ではありません!!!

オンラインプログラミングコンテストサービス AtCoder で、Fortranを使ってどんな無茶ができるのか色々試していたら面白い結果になったので紹介します!!!

普段みなさんが書かないようなコードをお見せできればいいかなと思っています。

概要

AtCoderをFortranで解きます。
ただし、Fortranの機能をできるだけ使わないようにします。(特にI/O)

問題

AtCoderの最初の最初の問題をFortranで解きます。
標準入力から、整数a, b, cと文字列sが与えられます。
a+b+cとsを標準出力に書き出せばOKです。

解法 1 scanf, printf

まず、Fortranコンパイラの多くが(※すべてではありません)
__C言語の__標準ライブラリをリンクするという事実を利用する方針で、以下のようなコードを通すことを考えました。

AtCoderの模範解答より、Cの場合のコードを参考に...

program main

    use cstdio  ! ← このmoduleの実装は後で説明します。
    use iso_c_binding, only : LF => C_NEW_LINE

    implicit none

    integer(c_int) a, b, c
    character(101,c_char) :: s
    integer(c_int) ierr

    ierr = scanf ("%d"   , a)
    ierr = scanf ("%d %d", b, c)
    ierr = scanf ("%s"   , s)
    ierr = printf("%d %s"//LF, a+b+c, s)

end program main

scanf, printfを使ったことで、Fortranのread, write文なしでIOします。
ポイントは、Fortranにはエスケープ文字\nが存在しないので、iso_c_bindingの改行文字を利用することが挙げられます。
実用上は、C_NEW_LINEだとかC_CARRIAGE_RETURNだとかC_HORIZONTAL_TABだとかは、冗長すぎるので、
LF, CR, TABなど、別名をつけるのがオススメです。(only句を使っています)

さてさて、肝心のcstdioですが、以下のように実装します。
長くなりますが、同じようなことばかり書いていますので本質はそんなに難しくありません。

module cstdio

    use iso_c_binding

    interface cscanf
        procedure :: cscanf_d, cscanf_dd, cscanf_s
    end interface cscanf

    interface scanf
        module procedure :: scanf_d, scanf_dd, scanf_s
    end interface scanf

    interface cprintf
        procedure :: cprintf_ds
    end interface cprintf

    interface printf
        procedure :: printf_ds
    end interface printf

    interface

        integer(c_int) function cscanf_d(fmt, i1) bind(C, name="scanf")
            import c_int, c_ptr
            type(c_ptr),value          :: fmt
            integer(c_int),intent(out) :: i1
        end function cscanf_d

        integer(c_int) function cscanf_dd(fmt, i1, i2) bind(C, name="scanf")
            import c_int, c_ptr
            type(c_ptr),value          :: fmt
            integer(c_int),intent(out) :: i1, i2
        end function cscanf_dd

        integer(c_int) function cscanf_s(fmt, s1) bind(C, name="scanf")
            import c_int, c_ptr
            type(c_ptr),value :: fmt
            type(c_ptr),value :: s1
        end function cscanf_s

        integer(c_int) function cprintf_ds(fmt, i1, s1) bind(C, name="printf")
            import c_int, c_ptr
            type(c_ptr),value    :: fmt
            integer(c_int),value :: i1
            type(c_ptr),value    :: s1
        end function cprintf_ds

    end interface

contains

    integer(c_int) function scanf_d(fmt, i1) result(retcode)
        character(*,c_char),intent(in)  :: fmt
        integer(c_int),intent(out)      :: i1
        character(:,c_char),allocatable,target :: fmt_withnull
        fmt_withnull = terminate(fmt)
        retcode = cscanf(c_loc(fmt_withnull), i1)
    end function scanf_d

    integer(c_int) function scanf_dd(fmt, i1, i2) result(retcode)
        character(*,c_char),intent(in)  :: fmt
        integer(c_int),intent(out)      :: i1, i2
        character(:,c_char),allocatable,target :: fmt_withnull
        fmt_withnull = terminate(fmt)
        retcode = cscanf(c_loc(fmt_withnull), i1, i2)
    end function scanf_dd

    integer(c_int) function scanf_s(fmt, s1) result(retcode)
        character(*,c_char),intent(in)         :: fmt
        character(*,c_char),intent(out),target :: s1
        character(:,c_char),allocatable,target :: fmt_withnull
        fmt_withnull = terminate(fmt)
        retcode = cscanf(c_loc(fmt_withnull), c_loc(s1))
    end function scanf_s

    integer(c_int) function printf_ds(fmt, i1, s1) result(retcode)
        character(*,c_char),intent(in)         :: fmt
        integer(c_int),intent(in)              :: i1
        character(*,c_char),intent(in),target  :: s1
        character(:,c_char),allocatable,target :: fmt_withnull
        fmt_withnull = terminate(fmt)
        retcode = cprintf(c_loc(fmt_withnull), i1, c_loc(s1))
    end function printf_ds

    function terminate(s1) result(s2)
        character(*,c_char),intent(in)  :: s1
        character(:,c_char),allocatable :: s2
        s2 = s1 // C_NULL_CHAR
    end function terminate

    function de_terminate(s1) result(s2)
        character(*,c_char),intent(in)  :: s1
        character(:,c_char),allocatable :: s2
        integer :: i

        do i = 1,len(s1)
            if (s1(i:i) == C_NULL_CHAR) then
                s2 = s1(1:i-1)
                return
            end if
        end do

        s2 = s1

    end function de_terminate

end module cstdio

Fortranのサブルーチン/関数では__任意の型__の可変長引数とすることはできませんが、
裏技として、bind(C)手続きのname属性で、Fortran側の名前とC側の名前をずらし、
C側の名前を一つの実態(今回はscanf)に重ねていくことで強引ですが合法的に解決できます。

(※optionalを用いて、省略可能な引数とすることはできますし、これは広義の可変長引数です
関連記事implicit_none様のFortranアドベントカレンダー2019/12/04)

今回は、scanfのフォーマット文字列にちなんで、整数引数にはdを、文字列引数にはsをつけて、以下の３つのFotran関数を用意します。

• cscanf_d 整数ひとつ
• cscanf_dd 整数ふたつ
• cscanf_s 文字列ひとつ

さて、ここでscanfの呼び出しで、別々の型で別々に呼び出して大丈夫なのか？と疑問に思う方がいるかもしれませんが、実はC言語の可変長引数は、呼ばれた側がスタックフレーム上の引数の値を頑張って取り出すことで実装しているので、呼ぶ側は、とにかくスタックフレームに引数を積んでいくだけでよい、もっといえば自分が渡したい引数をとにかく渡すだけで成り立ってしまいます。

こうやって作った、各パターンの引数を総称名でひとつの手続きへとまとめてやることで、programで書かれたコードだけ見ると、あたかもFortranに可変長引数が存在するように見えてしまう、というトリックでした。
今回はprintfを一回しか呼ばないので、こちらはcprintf_dsの一個で済んでいますが、こちらもFortranのインターフェースを書けば書くだけ呼べるバリエーションが増えます。(手動可変長引数)

さらにもう一点。文字列をFortranからCに渡す関数を書く場合の注意点です。Fortranでは基本的に文字列の長さは静的に決まっているか大きさ引き継ぎor形状引き継ぎ渡しで呼び出し元から暗示されるために、実際のデータに相当するバイト列はNULL終端しない仕様となっております。
これはFortranの器用なところなのですが、一方でC言語はNULL終端することが非常に重要な言語ですので、ここの齟齬をあわせないといけません。
末尾にC_NULL_CHARを付与すればいいじゃないかと思うでしょうが、len_trimなどのときNULLが空白文字扱いされないところが非常にわかりにくく、勘違いから凡ミスを連発しがちです。
そこで、そういったことをする場合は、NULL終端されたcharacter(:,c_char),allocatableを返す関数を用意しておくとパターン化できて楽です。今回はterminateと名付けました。お好みで、trimしてからNULL終端するのもアリですね。

動作確認 1

AtCoderでは1ファイルで提出する必要がありますので、module実装コードの下にprogram実装コードを並べ、main.f90として、動作確認します。

入力例2.

72
128 256
myonmyon

出力例2.

456 myonmyon

OK, 本番いきましょう。

提出 1 まさかのCE...

コンパイルエラーです。あれ、おかしいなぁ...

./Main.f08:29.41:

        integer(c_int) function cscanf_dd(fmt, i1, i2) bind(C, name="scanf")
                                         1
./Main.f08:23.40:

        integer(c_int) function cscanf_d(fmt, i1) bind(C, name="scanf")
                                        2
Error: Binding label 'scanf' in interface body at (1) collides with the global entity 'scanf' at (2)
./Main.f08:35.40:

        integer(c_int) function cscanf_s(fmt, s1) bind(C, name="scanf")
                                        1
./Main.f08:23.40:

        integer(c_int) function cscanf_d(fmt, i1) bind(C, name="scanf")
                                        2
Error: Binding label 'scanf' in interface body at (1) collides with the global entity 'scanf' at (2)

scanfに参照を重ねたことが原因みたいでした。うーんこれはこの解答の本質なのでどうしようもない...
でもなぜ、手元の環境でいけたコードが本番環境で通らないのだろう...

!!!!!と思ったら、AtCoderのgfortranのバージョンが4.8.4でした!!!!!!　　ドンマイ

解法2 systemでは？

いろいろ試したのですが、結局修正はできなかったので、違う方針を考えます。
とりあえず、標準Cライブラリ使うことで、Fortranの機能から逃れることはできるわけなので、
他のCライブラリ関数になにかいいものがないか考えたところ...

ちょっとズルいですが、system関数がありました。これは、与えた文字列をシェルで実行するというシンプル故に奥深い関数です。シェルでということなので、Pythonで書いた実装をワンライナー化した上でFortranの文字列定数にしておきます。今回は一回だけやればよいので、NULL終端は自分でします。

コードは以下の通りです。

program main

    use iso_c_binding

    interface
        integer(c_int) function system(command) result(retcode) bind(C)
            import c_int, c_ptr
            type(c_ptr),value :: command
        end function system
    end interface

    character(*,c_char),parameter :: script =  &
        "/usr/bin/env python3 -c '"         // &
        "a = int(input());"                 // &
        "b, c = map(int, input().split());" // &
        "s = input();"                      // &
        "print(a+b+c, s);"                  // &
        "'" // C_NEW_LINE // C_NULL_CHAR

    call csystem(script)

contains

    subroutine csystem(command)
        character(*,c_char),intent(in),target :: command
        integer :: ierr
        ierr = system(c_loc(command(1:1)))
    end subroutine csystem

end program main

うわ...

提出 2 AC!

一応気になったので調べてみましたが、Pythonの場合、17ms 2940 KB でしたので、
この方法の実行では もとのPythonコードと比較した場合、3ms 400 KB ほどのオーバーヘッドがかかるようです。

結論

AtCoderにおいて、3 ms 400 KB 程度マージンがあるなら、Pythonで実装しFortranからsystemで呼べばFortranで解答することは可能。