結果

問題 No.2671 NUPC Decompressor
ユーザー osada-yumosada-yum
提出日時 2024-03-22 10:36:50
言語 Fortran
(gFortran 13.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
このコードへのチャレンジ
(要ログイン)

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 RE -
testcase_01 RE -
testcase_02 RE -
testcase_03 RE -
testcase_04 RE -
testcase_05 RE -
testcase_06 RE -
testcase_07 RE -
testcase_08 RE -
testcase_09 RE -
testcase_10 RE -
testcase_11 RE -
testcase_12 RE -
testcase_13 RE -
testcase_14 RE -
testcase_15 RE -
権限があれば一括ダウンロードができます

ソースコード

diff #

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
0