AtCoder のテスト問題を解いてみた

AtCoder の Fortran Compiler が gfortran 9 になったという話を聞いたので、ひやかしにコードテスト問題を解いてみました。コードテスト問題は各言語処理系が正しく動作するか確認する目的のもののようです。問題中１０問は『AtCoder に登録したら解くべき精選過去問 10 問』と共通で、この他に難易度の高い問題が二つあります。

gfortran 9 では parameterized derived type が実装されたと聞いていたのですが、その部分はまだバグバグ状態でした。モンスターテイマーの問題は intel fortran でコンパイルできた　parameterized derived type を用いた版も示します。 

[AtCoder Language Test 202001](https://atcoder.jp/contests/language-test-202001)

前半十問にはより洗練された解法の記事があります。
[AtCoder に登録したら解くべき精選過去問 10 問を Fortran90以降で解いてみた](https://qiita.com/sage-git/items/a1f78761889812ad13f5)


# 問題と解答
AtCoder には暗黙の型を使った手抜きプログラムを提出しましたが、ここではよそゆきに着替えて implicit none を付けて変数を宣言する正則な形式に直しました。

## PracticeA: Welcome to AtCoder
問題をよく読んでいなかったので AtCoder には character(80) で出してしまいましたｗ

3 つの整数と、100文字以下の文字列を読み込んで 3 整数の和と文字列を表示します。

標準出力 print * に対応して標準入力 read * というのがあります。なお list-directed format * を使うと出力で第 1 カラムに空白が入ってしまいますが（処理系依存）AtCoder 判定では問題ないようです。 

```fortran
program PracticeA
    implicit none
    character(100) :: s
    integer :: i1, i2, i3
    read *, i1
    read *, i2, i3
    read *, s
    print *, i1 + i2 + i3, trim(s)
end program PracticeA
```

## ABC086A: Product
2 整数を読み込んでそれらの積の偶奇を判定します。

```fortran
program ABC086A
    implicit none
    integer :: i1, i2
    read *, i1, i2
    if (mod(i1 * i2, 2) == 0) then 
        print '(a)', 'Even'
    else 
        print '(a)', 'Odd'
    end if
end program ABC086A
```

## ABC081A: Placing Marbles
0 または 1 である 3 数を読み込んで 1 の数を数えます。

固定カラムのフォーマットを利用しました。

```fortran
program ABC081A
    implicit none
    integer :: m(3)
    read '(3i1)', m
    print *, sum(m)
end program ABC081A
```

## ABC081B: Shift only
複数の整数の公約数となっている 2^n のべきを求めます。

配列の全配列操作を利用しました。
問題名はビットのシフト演算を暗示していたようですが、全く気付きませんでした。

「[AtCoder に登録したら解くべき精選過去問 10 問を Fortran90以降で解いてみた](https://qiita.com/sage-git/items/a1f78761889812ad13f5)」　に二進表現を用いた簡潔な解法があります。

```fortran
program ABC081B
    implicit none
    integer, allocatable :: m(:)
    integer :: k, n
    read *, n
    allocate(m(n))
    read *, m
    k = 0
    do 
        if (any(mod(m, 2) == 1)) exit
        m = m / 2
        k = k + 1
    end do
    print *, k
end program ABC081B
```

## ABC087B: Coins
有限個の硬貨を使って、特定の金額を実現する場合の数を数える問題です。オイラーの多項式による数え上げ方が有名です。

でもめんどくさそうなので素直に計算機に数えさせることにしました。高額硬貨から出し方を変えて、あまりを少額硬貨で埋められるか見てゆきます。

```fortran
program ABC087B
    implicit none
    integer :: ia, ib, ic, ix, iy, iz, k, i1, i2, n1, n2
    read *, ia
    read *, ib
    read *, ic
    read *, ix
    k = 0
    n1 = min(ia, ix / 500)
    do i1 = 0, n1
        iy = ix - i1 * 500
        n2 = min(ib, iy / 100) 
        do i2 = 0, n2
            iz = iy - i2 * 100
            if (iz / 50 <= ic) k = k + 1
        end do
    end do
    print *, k
end program ABC087B
```

## ABC083B: Some Sums
ある整数の各桁の数字の和がある区間に入るか調べます。

内部ファイルを用いてある整数を文字列に直し、その文字列を 1 桁の数字の集まりと見て整数配列に固定カラムフォーマットで読み込みます。

```fortran
program ABC083B 
    implicit none
    character(5) :: figure
    integer :: i, j1, j2, k, n, isum, m(5)
    read *, n, j1, j2
    k = 0
    do i = 1, n
        write(figure, '(i5.5)') i
        read(figure, '(5i1)') m
        isum = sum(m)
        if (j1 <= isum .and. isum <= j2) k = k + i
    end do
    print *, k
end program ABC083B 
```

## ABC088B: Card Game for Two
降順にソートする問題です。quick sort の簡単なサブルーチン／関数が知られているのでそれを利用します。よく Haskell が紹介イントロで出してくる奴そのままの Fortran 版です。

```fortran
module qsort_m
    implicit none
contains
    recursive function qsort(m) result(res)
        integer, intent(in) :: m(:)
        integer :: res(size(m)) 
        if (size(m) <= 1) then 
            res = m
        else    
            res = [qsort( pack(m(2:), m(2:) >= m(1)) ), m(1), qsort( pack(m(2:), m(2:) < m(1)) )]
        end if
    end function qsort
end module qsort_m
 
program ABC088B
    use qsort_m
    implicit none
    integer :: n
    integer, allocatable :: m(:)
    read *, n
    allocate(m(n))
    read *, m
    m = qsort(m)
    print *, sum(m(::2)) - sum(m(2::2))
end program ABC088B
```

## ABC085B: Kagami Mochi
重複した整数の要素を省く問題です。

前の問題で使った quick sort ルーチンを少し変えると、重複した要素を取りこぼしてしまう似非 quick sort ルーチンが出来上がるのですが、これを利用するとダブりを省いて整列した値が得られます。

```fortran
module sort_m
    implicit none
contains
    recursive function pseud_sort(m) result(res)
        integer, intent(in) :: m(:)
        integer, allocatable :: res(:) 
        if (size(m) <= 1) then 
            res = m
        else    
            res = [pseud_sort( pack(m, m < m(1)) ), m(1), pseud_sort( pack(m, m > m(1)) )]
        end if
    end function pseud_sort
end module sort_m
 
program ABC085B
    use sort_m
    implicit none
    integer :: n
    integer, allocatable :: m(:)
    read *, n
    allocate(m(n))
    read *, m
    m = pseud_sort(m)
    print *, size(m)
end program ABC085B
```

## ABC085C: Otoshidama
この問題も硬貨の数え上げ問題の一種ですが、やはり計算機にひたすら数えてもらうことにします。

```fortran 
program ABC085C 
    implicit none
    integer :: i1, i2, i3, is, n, n1, n2
    read *, n, is
    is = is / 1000
    n1 = is / 10
    do i1 = 0, n1
        n2 = (is - 10 * i1) / 5 
        do i2 = 0, n2
            i3 = (is - 10 * i1 - 5 * i2) 
            if (i1 + i2 + i3 == n) then 
                print *, i1, i2, i3
                stop
            end if
        end do    
    end do
    print *, -1, -1, -1
end program ABC085C 
```

## ABC049C: 白昼夢
文字列処理の問題です。文字列の後ろから文字列マッチをさせて解くことにします。Fortran90 から index 関数はオプションで文字列の後ろからパタンマッチをしてくれるようになったのでそれを利用します。

文字配列は、全要素で共通の長さを持たなければならないので（配列だから等質）いちいち trim/len_trim をかける必要があります。

```fortran
 character(*), parameter :: words(*) = ['dream  ', 'dreamer', 'erase  ', 'eraser '] 
```
Fortran 2003 では parameter 定数の配列サイズや文字列長を * 指定にしておくと、コンパイル時にコンパイラが数えて良きに計らってくれます。ここで文字型配列は文字長が全要素で共通でなければならないので最大長の文字列に合わせて空白を入れてやる必要があります。Fortran2008 ではこの部分が改善されて、コンパイラが最大長に合わせてくれるはずなのですが、gfortran 9 ではまだ対応しておらずコンパイル時に怒られます。ここでは Fortran2003 式に書いておきました。

```fortran
program ABC049C
    implicit none
    character(*), parameter :: words(*) = ['dream  ', 'dreamer', 'erase  ', 'eraser '] 
    character(10**5):: buff
    character(:), allocatable :: text
    integer :: i, k
    logical :: ok
    read *, buff
    text = trim(buff)
    do
        ok = .false.
        do i = 1, size(words)
            k = index(text, trim(words(i)), back = .true.)
            if ( k + len_trim(words(i)) - len(text) == 1 ) then
                ok = .true.
                text = text(:k - 1)
            end if
        end do
        if (.not. ok) exit 
        if (text == '') then
            print *, 'YES'
            stop
        end if    
    end do
    print *, 'NO'
end program ABC049C

```

## ABC086C: Traveling
二次元正方格子点間の辺の距離を計算します。読み込むデータ点に、原点 (0, 0) を加えます。

```fortran
program ABC086C
    implicit none
    integer, allocatable :: m(:, :), mi(:, :), k(:)
    integer :: n
    read *, n
    allocate(mi(3, 0:n), source = 0)
    read *, mi(:, 1:)
    m = abs(mi(:, 1:) - mi(:,:n - 1))
    k = sum(m(2:, :), dim = 1)
    if (all(k <= m(1, :)) .and. all(mod(k - m(1, :), 2) == 0)) then
        print *, 'Yes'
    else
        print *, 'No'
    end if
end program ABC086C
```

## L: Interactive Sorting
ソートの問題ですが、5 要素の時 7 回以内の比較で解かねばならず、[検索して解法を調べました](https://cs.stackexchange.com/questions/44981/least-number-of-comparisons-needed-to-sort-order-5-elements)。（はじめはマージソートで行けると思いましたが最悪 8 回の比較が必要でした。）

5 要素以外の場合は、二分法を使った挿入ソートを用いました。Fortran の 配列要素の cyclic shift 関数を使うと簡単に挿入できます。 

なお interactive とは、比較の時比べたい要素を標準出力に出して標準入力から大小の情報を受け取る部分をさします。

```fortran
program Interactive_Sorting
    implicit none
    character, allocatable :: ch(:)
    integer :: i, n, l
    read *, n, l
    ch = [(achar(iachar('A') + i - 1), i = 1, n)]
    call sort(ch)
    print '(*(a))', '! ', ch
contains
    character function ans(a, b)
        character, intent(in) :: a, b
        print '(a, a, x, a)', '? ', a, b
        read *, ans
    end function ans
    
    subroutine sort(x)   
        character, intent(in out) :: x(:)
        integer :: i
        select case (size(x))
        case (:1)    
        case (2:4)
            do i = 2, size(x)
                call bisec(x, 1, i - 1, i)    
            end do  
        case (5:) !https://cs.stackexchange.com/questions/44981/least-number-of-comparisons-needed-to-sort-order-5-elements
            call bisec(x, 1, 1, 2) ! sort x(1:2)
            call bisec(x, 3, 3, 4) ! sort x(3:4)
            if (ans(x(2), x(4)) == '>') x(1:4) = cshift(x(1:4), 2) ! x(2) < x(4)
            x(3:5) = cshift(x(3:5), 1) ! [1,2,4,5,3]
            call bisec(x, 1, 3, 4)  ! sort [1,2,4,5]
            call bisec(x, 1, 3, 5)  ! sort [1,2,4,  3]
         !  
            do i = 6, size(x)
                call bisec(x, 1, i - 1, i)    
            end do    
        case default !none
        end select
    end subroutine sort  
    
    subroutine bisec(x, k0, k1, n) ! insert x(n) into x(k0:k1)
        character, intent(in out) :: x(:)
        integer, value :: k0, k1, n
        integer :: k
        k0 = k0 - 1 
        k1 = k1 + 1
        do while(k1 - k0 > 1)
            k = (k0 + k1) / 2 
            if (ans(x(k), x(n)) == '>') then
                k1 = k 
            else
                k0 = k
            end if    
        end do     ! k0 < k < k1 
        x(k1:n) = cshift(x(k1:n), -1) ! cyclic shift: 123..k1...n -> 123...nk1...n-1 
    end subroutine bisec
end program Interactive_Sorting
```

## M: モンスターテイマー
表を読み込んで、表の要素に依存する評価関数がより大きくなるように表の要素を選択します。（三万行の表を読んでそのうち千行を選んで評価値を最大にします。）

問題文が理解しにくくて、読み間違えてしまいました（国語力）。それなのに gfortran と ifort のコンパイラの挙動の違いの方に気取られて、しばらく自分が問題文を勘違いしていることに気づきませんでした（笑）。

Fortran の全配列操作関数は大抵の場合 mask をかけられるので、mask を利用して quest 表中の有効なものを選び出しました。

### やっていること
最初のターンから順々に自分のスキルが全部 10 になるまで、所持金が足りればスキル上げをし、足りなければ報酬最大のクエストを選択します。可能なクエストの最大報酬がアルバイト代未満の時はアルバイトします。

全部のスキルが 10 になったら、最終ターンからはじめて逆方向に最大報酬のクエストを選択してゆきます。これはクエスト締切ギリギリの方が報酬が高くなる評価関数になっているからです。（順方向に最大値を選択してゆくと、後からもっと報酬が高くなるクエストを早めに選択してしまう場合があります。）

### gfortran-9 版　parameterized derived type 使用せず。
parameterized derived type に bug があってコンパイルできないので、スキル数 10 を定数として決め打ちしています。 derived type を使うとファイル読み込みが１行で済みます。

```fortran
    type :: quest_t 
        sequence
        integer :: ia, ib
        integer(int64) :: ic
        integer :: is(10) !is(n)
    end type quest_t  
.....
    subroutine init_table()
        read *, nt, n, m
        allocate(quest(m))
        read *, quest
        .........
    end subroutine init_table
```
の read *, quest の部分で、

```
1000 10 30000
875 953 26936 4 0 0 0 0 0 0 2 2 3
661 665 9405 0 0 4 0 0 0 4 0 0 0
104 847 1381 0 0 0 1 0 0 4 0 0 0
......
```
こういうデータが 3 万行あるのを読み込んでいます。

```fortran
module test_m
    use, intrinsic :: iso_fortran_env
    implicit none
    integer :: nt, n, m
    type :: quest_t !(len) ! gfortran-9 bug: parameterized derived type
        sequence
       ! integer, len :: len
        integer :: ia, ib
        integer(int64) :: ic
        integer :: is(10) !is(len)
    end type quest_t    
    type(quest_t), allocatable :: quest(:) ! type(quest_t(:)), allocatable :: quest(:) 
    integer, allocatable :: my_skill(:), my_train(:)
contains
    subroutine init_table()
        read *, nt, n, m
        allocate(quest_t::quest(m)) ! allocate(quest_t(n)::quest(m))
        read *, quest
        allocate(my_skill(n), my_train(n), source = 0)
    end subroutine init_table

    pure integer(int64) function money_expected(q, it) 
        integer, intent(in) :: it
        type(quest_t), intent(in) :: q ! type(quest_t(*)), intent(in) :: q
        integer :: ifactor
        real(real64) :: x
        x = q%ic * (1 + 9 * (it - q%ia) / real(q%ib - q%ia, real64))
        ifactor = sum(max(0, q%is(:) - my_skill(:)))
        if (ifactor == 0) then 
            x = x * 10
        else
            x = x / 2.0_real64**ifactor + 1.0e-9_real64
        end if
        money_expected = floor(x, int64)
    end function money_expected
end module test_m    
    
program Monstertamer
    use test_m
    implicit none
    integer, parameter :: iwork = 1000
    integer(int64) :: my_money = 1000
    integer :: it, i, mt, k, iquest
    logical, allocatable :: mask(:), quest_ok(:)
    integer, allocatable :: quest_back(:)
    integer(int64), allocatable :: money(:)
    call init_table()
    allocate(mask(m), quest_ok(m), source = .true.)
    allocate(money(m), quest_back(m))
    do it = 1, nt
        mask = quest_ok .and. quest(:)%ia <= it .and. it <= quest(:)%ib 
        money = 0
        forall(i = 1:m, mask(i)) money(i) = money_expected(quest(i), it)
        if (maxval(money) > iwork) then
            i = minloc(my_skill, dim = 1, mask = my_skill < 10)
            k = minval(my_skill, dim = 1, mask = my_skill < 10)
            if (i /=0 .and. my_money >= 10000 * 2**(k + 1)) then
                print '(g0, x, g0)', 1, i
                if (my_train(i) < k) then
                    my_train(i) = my_train(i) + 1
                else
                    my_skill(i) = my_skill(i) + 1
                    my_train(i) = 0
                end if
                my_money = my_money - 10000 * 2**(k + 1)
            else    
                iquest = maxloc(money, 1)
                print '(g0, x, g0)', 2, iquest
                quest_ok(iquest) = .false.
                my_money = my_money + money(iquest)
            end if    
        else
            print '(g0)', 3
            my_money = my_money + iwork    
        end if    
        if (all(my_skill == 10)) exit
    end do
    mt = it + 1
    do it = nt, mt, -1 ! decide backward
        mask = quest_ok .and. quest(:)%ia <= it .and. it <= quest(:)%ib 
        money = 0
        forall(i = 1:m, mask(i)) money(i) = money_expected(quest(i), it)
        iquest = maxloc(money, 1)
        quest_back(it) = iquest
        quest_ok(iquest) = .false.
        my_money = my_money + money(iquest)
    end do
    do it = mt, nt
        print '(g0, x, g0)', 2, quest_back(it)
    end do    
end program Monstertamer
```

### ifort v.19.1 版　parameterized derived type 使用。
parameterized derived type を使用すると、実行時に可変な大きさの要素を持つ派生型の配列を動的に確保できます。

```fortran
    type :: quest_t(n) 
        integer, len :: n
        sequence
        integer :: ia, ib
        integer(int64) :: ic
        integer :: is(n) 
    end type quest_t    
    type(quest_t(:)), allocatable :: quest(:) 
...........
    allocate(quest_t(n)::quest(m))
```
の所で利用。

```fortran
module test_m
    use, intrinsic :: iso_fortran_env
    implicit none
    integer :: nt, n, m
    type :: quest_t(n) 
        integer, len :: n
        sequence
        integer :: ia, ib
        integer(int64) :: ic
        integer :: is(n) 
    end type quest_t    
    type(quest_t(:)), allocatable :: quest(:) 
    integer, allocatable :: my_skill(:), my_train(:)
contains
    subroutine init_table()
        read *, nt, n, m
        allocate(quest_t(n)::quest(m))
        read *, quest
        allocate(my_skill(n), my_train(n), source = 0)
    end subroutine init_table

    pure integer(int64) function money_expected(q, it) 
        integer, intent(in) :: it
        type(quest_t(*)), intent(in) :: q
        integer :: ifactor
        real(real64) :: x
        x = q%ic * (1 + 9 * (it - q%ia) / real(q%ib - q%ia, real64))
        ifactor = sum(max(0, q%is(:) - my_skill(:)))
        if (ifactor == 0) then 
            x = x * 10
        else
            x = x / 2.0_real64**ifactor + 1.0e-9_real64
        end if
        money_expected = floor(x, int64)
    end function money_expected
end module test_m    
    
program Monstertamer
    use test_m
    implicit none
    integer, parameter :: iwork = 1000
    integer(int64) :: my_money = 1000
    integer :: it, i, mt, k, iquest
    logical, allocatable :: mask(:), quest_ok(:)
    integer, allocatable :: quest_back(:)
    integer(int64), allocatable :: money(:)
    call init_table()
    allocate(mask(m), quest_ok(m), source = .true.)
    allocate(money(m), quest_back(m))
    do it = 1, nt
        mask = quest_ok .and. quest(:)%ia <= it .and. it <= quest(:)%ib 
        money = 0
        forall(i = 1:m, mask(i)) money(i) = money_expected(quest(i), it)
        if (maxval(money) > iwork) then
            i = minloc(my_skill, dim = 1, mask = my_skill < 10)
            k = minval(my_skill, dim = 1, mask = my_skill < 10)
            if (i /=0 .and. my_money >= 10000 * 2**(k + 1)) then
                print '(g0, x, g0)', 1, i
                if (my_train(i) < k) then
                    my_train(i) = my_train(i) + 1
                else
                    my_skill(i) = my_skill(i) + 1
                    my_train(i) = 0
                end if
                my_money = my_money - 10000 * 2**(k + 1)
            else    
                iquest = maxloc(money, 1)
                print '(g0, x, g0)', 2, iquest
                quest_ok(iquest) = .false.
                my_money = my_money + money(iquest)
            end if    
        else
            print '(g0)', 3
            my_money = my_money + iwork    
        end if    
        if (all(my_skill == 10)) exit
    end do
    mt = it + 1
    do it = nt, mt, -1 ! decide backward
        mask = quest_ok .and. quest(:)%ia <= it .and. it <= quest(:)%ib 
        money = 0
        forall(i = 1:m, mask(i)) money(i) = money_expected(quest(i), it)
        iquest = maxloc(money, 1)
        quest_back(it) = iquest
        quest_ok(iquest) = .false.
        my_money = my_money + money(iquest)
    end do
    do it = mt, nt
        print '(g0, x, g0)', 2, quest_back(it)
    end do    
!    print *, my_money
end program Monstertamer
```