AtCoder の Fortran Compiler が gfortran 9 になったという話を聞いたので、ひやかしにコードテスト問題を解いてみました。コードテスト問題は各言語処理系が正しく動作するか確認する目的のもののようです。問題中１０問は『AtCoder に登録したら解くべき精選過去問 10 問』と共通で、この他に難易度の高い問題が二つあります。
gfortran 9 では parameterized derived type が実装されたと聞いていたのですが、その部分はまだバグバグ状態でした。モンスターテイマーの問題は intel fortran でコンパイルできた parameterized derived type を用いた版も示します。
前半十問にはより洗練された解法の記事があります。
AtCoder に登録したら解くべき精選過去問 10 問を Fortran90以降で解いてみた
問題と解答
AtCoder には暗黙の型を使った手抜きプログラムを提出しましたが、ここではよそゆきに着替えて implicit none を付けて変数を宣言する正則な形式に直しました。
PracticeA: Welcome to AtCoder
問題をよく読んでいなかったので AtCoder には character(80) で出してしまいましたｗ
3 つの整数と、100文字以下の文字列を読み込んで 3 整数の和と文字列を表示します。
標準出力 print * に対応して標準入力 read * というのがあります。なお list-directed format * を使うと出力で第 1 カラムに空白が入ってしまいますが（処理系依存）AtCoder 判定では問題ないようです。
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 整数を読み込んでそれらの積の偶奇を判定します。
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 の数を数えます。
固定カラムのフォーマットを利用しました。
program ABC081A
implicit none
integer :: m(3)
read '(3i1)', m
print *, sum(m)
end program ABC081A
ABC081B: Shift only
複数の整数の公約数となっている 2^n のべきを求めます。
配列の全配列操作を利用しました。
問題名はビットのシフト演算を暗示していたようですが、全く気付きませんでした。
「AtCoder に登録したら解くべき精選過去問 10 問を Fortran90以降で解いてみた」 に二進表現を用いた簡潔な解法があります。
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
有限個の硬貨を使って、特定の金額を実現する場合の数を数える問題です。オイラーの多項式による数え上げ方が有名です。
でもめんどくさそうなので素直に計算機に数えさせることにしました。高額硬貨から出し方を変えて、あまりを少額硬貨で埋められるか見てゆきます。
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 桁の数字の集まりと見て整数配列に固定カラムフォーマットで読み込みます。
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 版です。
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 ルーチンが出来上がるのですが、これを利用するとダブりを省いて整列した値が得られます。
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
この問題も硬貨の数え上げ問題の一種ですが、やはり計算機にひたすら数えてもらうことにします。
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 をかける必要があります。
character(*), parameter :: words(*) = ['dream ', 'dreamer', 'erase ', 'eraser ']
Fortran 2003 では parameter 定数の配列サイズや文字列長を * 指定にしておくと、コンパイル時にコンパイラが数えて良きに計らってくれます。ここで文字型配列は文字長が全要素で共通でなければならないので最大長の文字列に合わせて空白を入れてやる必要があります。Fortran2008 ではこの部分が改善されて、コンパイラが最大長に合わせてくれるはずなのですが、gfortran 9 ではまだ対応しておらずコンパイル時に怒られます。ここでは Fortran2003 式に書いておきました。
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) を加えます。
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 回以内の比較で解かねばならず、検索して解法を調べました。（はじめはマージソートで行けると思いましたが最悪 8 回の比較が必要でした。）
5 要素以外の場合は、二分法を使った挿入ソートを用いました。Fortran の 配列要素の cyclic shift 関数を使うと簡単に挿入できます。
なお interactive とは、比較の時比べたい要素を標準出力に出して標準入力から大小の情報を受け取る部分をさします。
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 を使うとファイル読み込みが１行で済みます。
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 万行あるのを読み込んでいます。
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 を使用すると、実行時に可変な大きさの要素を持つ派生型の配列を動的に確保できます。
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))
の所で利用。
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