結果
| 問題 | No.2671 NUPC Decompressor |
| コンテスト | |
| ユーザー |
 osada-yum
|
| 提出日時 | 2024-03-22 10:36:50 |
| 言語 | Fortran (gFortran 14.2.0) |
| 結果 |
RE
|
| 実行時間 | - |
| コード長 | 15,568 bytes |
| 記録 | |
| コンパイル時間 | 1,173 ms |
| コンパイル使用メモリ | 44,952 KB |
| 実行使用メモリ | 6,824 KB |
| 最終ジャッジ日時 | 2024-09-30 10:32:21 |
| 合計ジャッジ時間 | 3,798 ms |
|
ジャッジサーバーID （参考情報） |
judge1 / judge3 |
（要ログイン）
| ファイルパターン | 結果 |
|---|---|
| sample | RE * 3 |
| other | RE * 13 |
ソースコード
module vec_string_m
use, intrinsic :: iso_fortran_env
implicit none
private
integer(int32), public :: vec_string_iostat
character(len=100), public :: vec_string_iomsg = ""
public vec_string
type :: vec_string
private
character, allocatable, public :: str_(:)
integer(int32) :: size_ = 0_int32, capa_ = 0_int32
contains
procedure, pass :: init => init_vec_string
procedure, pass :: with_capacity => with_capacity_vec_string
procedure, pass :: resize => resize_vec_string
procedure, pass :: push_back => push_back_vec_string
procedure, pass :: pop_back => pop_back_vec_string
procedure, pass :: back => back_vec_string
procedure, pass :: size => size_vec_string
procedure, pass, private :: assign => assign_vec_string
generic :: assignment(=) => assign
procedure, pass :: read => read_vec_string
procedure, pass, private :: formatted_read => formatted_read_vec_string
generic :: read(formatted) => formatted_read
final :: destroy_vec_string
end type vec_string
interface vec_string
module procedure :: construct_vec_string, construct_by_size_vec_string, construct_by_str_vec_string
end interface vec_string
public destroy_vec_string
public :: compare, operator(<), operator(<=), operator(>), operator(>=), operator(==), operator(/=)
interface compare
module procedure :: compare_vec_string
end interface compare
interface operator(<)
module procedure :: less_vec_string
end interface operator(<)
interface operator(<=)
module procedure :: less_equal_vec_string
end interface operator(<=)
interface operator(>)
module procedure :: greater_vec_string
end interface operator(>)
interface operator(>=)
module procedure :: greater_equal_vec_string
end interface operator(>=)
interface operator(==)
module procedure :: equal_vec_string
end interface operator(==)
interface operator(/=)
module procedure :: not_equal_vec_string
end interface operator(/=)
contains
pure type(vec_string) function construct_vec_string() result(res)
call res%with_capacity(1)
end function construct_vec_string
pure type(vec_string) function construct_by_size_vec_string(n) result(res)
integer(int32), intent(in) :: n
call res%with_capacity(n)
end function construct_by_size_vec_string
pure type(vec_string) function construct_by_str_vec_string(str) result(res)
character(len=*), intent(in) :: str
integer(int32) :: n, capa
integer(int32) :: i
n = len_trim(str)
capa = 1_int32
do while (capa < n)
capa = capa * 2
end do
call res%with_capacity(capa)
do i = 1, n
res%str_(i) = str(i:i)
end do
end function construct_by_str_vec_string
pure subroutine destroy_vec_string(this)
type(vec_string), intent(inout) :: this
if (allocated(this%str_)) &
deallocate(this%str_)
this%size_ = 0
this%capa_ = 0
end subroutine destroy_vec_string
pure subroutine assign_vec_string(lhs, rhs)
class(vec_string), intent(inout) :: lhs
class(vec_string), intent(in) :: rhs
call destroy_vec_string(lhs)
allocate(lhs%str_, source = rhs%str_(:))
lhs%size_ = rhs%size_
lhs%capa_ = rhs%capa_
end subroutine assign_vec_string
pure subroutine init_vec_string(this)
class(vec_string), intent(inout) :: this
call this%with_capacity(1)
end subroutine init_vec_string
pure subroutine with_capacity_vec_string(this, n)
class(vec_string), intent(inout) :: this
integer(int32), intent(in) :: n
character, allocatable :: tmp(:)
integer(int32) :: capa
if (n < 1) return
capa = 1_int32
do while (capa < n)
capa = capa * 2
end do
!> capa >= n.
! write(error_unit, '(a, i0, " < ", i0)') "hi", this%capa_, capa
if (this%capa_ >= capa) return
!> this%capa_ < capa
this%capa_ = capa
if (allocated(this%str_)) then
allocate(tmp(capa))
tmp(1:this%size()) = this%str_(1:this%size())
call move_alloc(from = tmp, to = this%str_)
else
allocate(this%str_(capa))
end if
end subroutine with_capacity_vec_string
pure subroutine resize_vec_string(this, n)
class(vec_string), intent(inout) :: this
integer(int32), intent(in) :: n
if (n < 0) return
call this%with_capacity(n)
this%size_ = n
end subroutine resize_vec_string
pure subroutine push_back_vec_string(this, c)
class(vec_string), intent(inout) :: this
character, intent(in) :: c
if (this%size() == this%capa_) &
call this%with_capacity(max(1, 2 * this%capa_))
this%size_ = this%size_ + 1
this%str_(this%size()) = c
end subroutine push_back_vec_string
pure subroutine pop_back_vec_string(this)
class(vec_string), intent(inout) :: this
this%size_ = this%size_ - 1
end subroutine pop_back_vec_string
pure character function back_vec_string(this) result(res)
class(vec_string), intent(in) :: this
res = this%str_(this%size())
end function back_vec_string
pure integer(int32) function size_vec_string(this) result(res)
class(vec_string), intent(in) :: this
res = this%size_
end function size_vec_string
impure subroutine read_vec_string(this, unit)
class(vec_string), intent(inout) :: this
integer(int32), intent(in) :: unit
character :: c
! write(error_unit, '(a)') this%str_(1:this%size())
call this%resize(0)
! write(error_unit, '(a)') "hi"
do
read(unit, '(a1)', advance = "no", iostat = vec_string_iostat, iomsg = vec_string_iomsg) c
! write(error_unit, *) this%size(), ": ", c, ", ", this%str_(1:this%size())
select case(vec_string_iostat)
case(iostat_end)
if (this%size() == 0) error stop "End of file in reading Symbol’s value as variable is void: vec_string."
vec_string_iomsg = "End of file in reading Symbol’s value as variable is void: vec_string."
exit
case(iostat_eor)
if (this%size() == 0) cycle
vec_string_iostat = 0
vec_string_iomsg = ""
! write(error_unit, '(a)') "End of record"
exit
case(0)
if (c == " ") then
if (this%size() == 0) cycle
exit
end if
case default
! vec_string_iomsg = "Unknown iostat in reading Symbol’s value as variable is void: vec_string."
return
end select
call this%push_back(c)
end do
! write(error_unit, '(a)') this%str_(1:this%size())
end subroutine read_vec_string
impure subroutine formatted_read_vec_string(this, unit, iotype, vlist, iostat, iomsg)
class(vec_string), intent(inout) :: this
integer(int32), intent(in) :: unit
character(len=*), intent(in) :: iotype
integer(int32), intent(in) :: vlist(:)
integer(int32), intent(out) :: iostat
character(len=*), intent(inout) :: iomsg
character :: c
associate(dummy => iotype, dummy2 => vlist)
end associate
! write(error_unit, '(a, 2(i0, 1x))') "loc: ", loc(this), loc(this%str_)
! write(error_unit, '(a, i0)') "loc: ", loc(iomsg)
! write(error_unit, '(*(a1))') "|", this%str_(1:this%size()), "|"
! call destroy_vec_string(this)
! this = vec_string(1)
! write(error_unit, '(a, *(1x, i0))') iotype, vlist(:)
call this%resize(0)
do
read(unit, '(a1)', advance = "no", iostat = iostat) c
! write(error_unit, *) this%size(), ": ", c, ", ", this%str_(1:this%size())
! write(error_unit, '(2(i0, 1x), a, i0, 1x, a)') iostat_end, iostat_eor, ", ", iostat, "|"//c//"| "//trim(iomsg)
select case(iostat)
case(iostat_end)
if (this%size() == 0) error stop "End of file in reading Symbol’s value as variable is void: vec_string."
iomsg = "End of file in reading Symbol’s value as variable is void: vec_string."
exit
case(iostat_eor)
if (this%size() == 0) cycle
! iostat = 0
iomsg = "hi"
! backspace(unit)
exit
case(0)
if (c == " ") then
if (this%size() == 0) cycle
exit
end if
case default
iomsg = "Unknown iostat in reading Symbol’s value as variable is void: vec_string."
return
end select
call this%push_back(c)
end do
end subroutine formatted_read_vec_string
pure integer(int32) function compare_vec_string(lhs, rhs) result(res)
type(vec_string), intent(in) :: lhs, rhs
integer(int32) :: i
associate(ls => lhs%size(), rs => rhs%size())
do i = 1, min(ls, rs)
associate(lc => lhs%str_(i), rc => rhs%str_(i))
if (lc == rc) cycle
if (lc < rc) then
res = -1; return
else
res = 1; return
end if
end associate
end do
if (ls == rs) then
res = 0
else if (ls < rs) then
res = -1
else
res = 1
end if
end associate
end function compare_vec_string
pure logical function less_vec_string(lhs, rhs) result(res)
type(vec_string), intent(in) :: lhs, rhs
res = compare(lhs, rhs) < 0
end function less_vec_string
pure logical function less_equal_vec_string(lhs, rhs) result(res)
type(vec_string), intent(in) :: lhs, rhs
res = compare(lhs, rhs) <= 0
end function less_equal_vec_string
pure logical function greater_vec_string(lhs, rhs) result(res)
type(vec_string), intent(in) :: lhs, rhs
res = compare(lhs, rhs) > 0
end function greater_vec_string
pure logical function greater_equal_vec_string(lhs, rhs) result(res)
type(vec_string), intent(in) :: lhs, rhs
res = compare(lhs, rhs) >= 0
end function greater_equal_vec_string
pure logical function equal_vec_string(lhs, rhs) result(res)
type(vec_string), intent(in) :: lhs, rhs
integer(int32) :: i
res = .false.
if (lhs%size() /= rhs%size()) return
do i = 1, lhs%size()
if (lhs%str_(i) /= rhs%str_(i)) return
end do
res = .true.
end function equal_vec_string
pure logical function not_equal_vec_string(lhs, rhs) result(res)
type(vec_string), intent(in) :: lhs, rhs
res = .not. (lhs == rhs)
end function not_equal_vec_string
end module vec_string_m
!> This file was processed by `fypp`.
!> Today's fortune: "Happy MLE", really OK?
module merge_sort_m
use, intrinsic :: iso_fortran_env
!> maybe use module.
use vec_string_m
implicit none
private
public :: merge_sort
interface merge_sort
module procedure :: merge_sort_vec_string
end interface merge_sort
contains
pure subroutine merge_sort_vec_string(arr, indices, reverse)
type(vec_string), intent(inout) :: arr(:)
integer(int32), intent(inout), optional :: indices(:)
logical, intent(in), optional :: reverse
integer(int32), allocatable :: idx(:)
integer(int32) :: n
integer(int32) :: i
n = size(arr)
allocate(idx, source = [(i, i = 1, n)])
if (present(reverse)) then
if (reverse) then
call merge_sort_sub_descending(n, arr, idx)
if (present(indices)) &
indices(:) = idx(:)
return
end if
end if
call merge_sort_sub_ascending(n, arr, idx)
if (present(indices)) &
indices(:) = idx(:)
return
contains
pure subroutine merge_sort_sub_ascending(n, arr, idx)
integer(int32), intent(in) :: n
type(vec_string), intent(inout) :: arr(n)
integer(int32), intent(inout) :: idx(n)
integer(int32) :: width
integer(int32) :: i, l, r
width = 2
do while (width <= 2 * n)
do i = 1, n, width
if (i + width / 2 > n) exit
l = i
r = min(n, i + width - 1)
call merge_sort_vec_string_merge_with_key_ascending(r - l + 1, width/2, arr(l:r), idx(l:r))
end do
width = width * 2
end do
end subroutine merge_sort_sub_ascending
pure subroutine merge_sort_sub_descending(n, arr, idx)
integer(int32), intent(in) :: n
type(vec_string), intent(inout) :: arr(n)
integer(int32), intent(inout) :: idx(n)
integer(int32) :: width
integer(int32) :: i, l, r
width = 2
do while (width <= 2 * n)
do i = 1, n, width
if (i + width / 2 > n) exit
l = i
r = min(n, i + width - 1)
call merge_sort_vec_string_merge_with_key_descending(r - l + 1, width/2, arr(l:r), idx(l:r))
end do
width = width * 2
end do
end subroutine merge_sort_sub_descending
end subroutine merge_sort_vec_string
pure subroutine merge_sort_vec_string_merge_with_key_ascending(n, nl, arr, indices)
integer(int32), intent(in) :: n, nl
type(vec_string), intent(inout) :: arr(n)
integer(int32), intent(inout) :: indices(n)
integer(int32) :: idx_left(1:nl), idx_right(nl + 1:n)
integer(int32) :: idx(n)
integer(int32) :: i, j, k
if (n == 1) return
idx_left(1:nl) = [(i, i = 1, nl)]
idx_right(nl + 1:n) = [(i, i = nl + 1, n)]
i = 1
j = nl + 1
do k = 1, n
if (arr(i) <= arr(j)) then
idx(k) = idx_left(i)
i = i + 1
else
idx(k) = idx_right(j)
j = j + 1
end if
if (i > nl) then
idx(k + 1:n) = idx_right(j:n)
exit
else if (j > n) then
idx(k + 1:n) = idx_left(i:nl)
exit
end if
end do
arr(:) = arr(idx)
indices(:) = indices(idx)
end subroutine merge_sort_vec_string_merge_with_key_ascending
pure subroutine merge_sort_vec_string_merge_with_key_descending(n, nl, arr, indices)
integer(int32), intent(in) :: n, nl
type(vec_string), intent(inout) :: arr(n)
integer(int32), intent(inout) :: indices(n)
integer(int32) :: idx_left(1:nl), idx_right(nl + 1:n)
integer(int32) :: idx(n)
integer(int32) :: i, j, k
if (n == 1) return
idx_left(1:nl) = [(i, i = 1, nl)]
idx_right(nl + 1:n) = [(i, i = nl + 1, n)]
i = 1
j = nl + 1
do k = 1, n
if (arr(i) >= arr(j)) then
idx(k) = idx_left(i)
i = i + 1
else
idx(k) = idx_right(j)
j = j + 1
end if
if (i > nl) then
idx(k + 1:n) = idx_right(j:n)
exit
else if (j > n) then
idx(k + 1:n) = idx_left(i:nl)
exit
end if
end do
arr(:) = arr(idx)
indices(:) = indices(idx)
end subroutine merge_sort_vec_string_merge_with_key_descending
end module merge_sort_m
program yukicoder_2671
use, intrinsic :: iso_fortran_env
use vec_string_m
use merge_sort_m
implicit none
integer(int32), parameter :: n = 4, maxi = ishft(1_int32, n)
character, parameter :: strs(n) = ["N", "U", "P", "C"]
integer(int32) :: k
type(vec_string), allocatable :: s(:)
integer(int32) :: i, j
read(input_unit, *) k
allocate(s(maxi))
do i = 0, maxi - 1
do j = 1, n
call s(i + 1)%push_back(strs(j))
if (.not. btest(i, j - 1)) cycle
block
type(vec_string) :: tmp
integer(int32) :: l
tmp = s(i + 1)
! write(error_unit, '(*(a1))') tmp%str_(1:tmp%size())
do l = 1, tmp%size()
call s(i + 1)%push_back(tmp%str_(l))
end do
end block
end do
end do
! call merge_sort(s)
! do i = 1, maxi
! write(output_unit, '(i0, 1x, *(a1))') i, s(i)%str_(1:s(i)%size())
! end do
call merge_sort(s)
write(output_unit, '(*(a1))') s(k)%str_(1:s(k)%size())
end program yukicoder_2671