#1024354 (Fortran) No.2910 単体ホモロジー入門

• 問題: No.2910 単体ホモロジー入門
• ユーザー: osada-yum
• 提出日時: 2024-11-04 20:15:41
• 言語: Fortran (gFortran 14.2.0)
• 結果: MLE
• 実行時間: -
• コード長: 17,174 bytes
• コンパイル時間: 895 ms
• コンパイル使用メモリ: 45,152 KB
• 実行使用メモリ: 813,544 KB
• 最終ジャッジ日時: 2024-11-04 20:15:47
• 合計ジャッジ時間: 5,174 ms
• ジャッジサーバーID （参考情報）: judge3 / judge5

ファイルパターン	結果
other	AC * 34 MLE * 1 -- * 12

ソースコード

!> This file was processed by `fypp`.
!> Today's fortune: "Bad WA", really OK?
!> ランダムウォーク猿「'境界値を見る' で はっぴー.」
!> ギャンブラー猿「AtCoder はギャンブルだ.」

module merge_sort_m
  use, intrinsic :: iso_fortran_env
  !> maybe use module.
  implicit none
  private
  public :: merge_sort
  interface merge_sort
     module procedure :: merge_sort_int32
  end interface merge_sort
contains
  pure subroutine merge_sort_int32(arr, indices, reverse)
    integer(int32), 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
      integer(int32), 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_int32_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
      integer(int32), 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_int32_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_int32
  pure subroutine merge_sort_int32_merge_with_key_ascending(n, nl, arr, indices)
    integer(int32), intent(in) :: n, nl
    integer(int32), 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_int32_merge_with_key_ascending
  pure subroutine merge_sort_int32_merge_with_key_descending(n, nl, arr, indices)
    integer(int32), intent(in) :: n, nl
    integer(int32), 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_int32_merge_with_key_descending
end module merge_sort_m

module unwrapped_vector_m
  use, intrinsic :: iso_fortran_env
  !> maybe use module.
  implicit none
  private
  public :: unwrapped_vector_int32
  type :: unwrapped_vector_int32
     private
     integer(int32) :: size_ = 0, capa_ = 0
     integer(int32), allocatable, public :: arr_(:)
   contains
     procedure, pass :: init      => init_unwrapped_vector_int32
     procedure, pass :: with_capacity => with_capacity_unwrapped_vector_int32
     procedure, pass :: push_back_unwrapped_vector_int32, &
          push_back_array_unwrapped_vector_int32
     generic         :: push_back => push_back_unwrapped_vector_int32, &
          push_back_array_unwrapped_vector_int32
     procedure, pass :: pop_back  => pop_back_unwrapped_vector_int32
     procedure, pass :: back      => back_unwrapped_vector_int32
     procedure, pass :: size   => size_unwrapped_vector_int32
     procedure, pass :: resize => resize_unwrapped_vector_int32
     procedure, pass :: lower_bound => lower_bound_unwrapped_vector_int32
     procedure, pass :: upper_bound => upper_bound_unwrapped_vector_int32
  end type unwrapped_vector_int32
  interface unwrapped_vector_int32
     module procedure :: construct_unwrapped_vector_int32_by_size, &
          construct_unwrapped_vector_int32_by_arr, &
          construct_unwrapped_vector_int32_by_init_val
  end interface unwrapped_vector_int32

! #:block once_block(name = f"unwrapped_vector{getvar('UNWRAPPED_VECTOR_MODULENAME_SUFFIX', '')}")
  public :: compare, operator(<), operator(<=), operator(>), operator(>=), operator(==), operator(/=)


  interface compare
     module procedure :: compare_unwrapped_vector_int32
  end interface compare
  interface operator(<)
     module procedure :: less_unwrapped_vector_int32
  end interface operator(<)
  interface operator(<=)
     module procedure :: less_equal_unwrapped_vector_int32
  end interface operator(<=)
  interface operator(>)
     module procedure :: greater_unwrapped_vector_int32
  end interface operator(>)
  interface operator(>=)
     module procedure :: greater_equal_unwrapped_vector_int32
  end interface operator(>=)
  interface operator(==)
     module procedure :: equal_unwrapped_vector_int32
  end interface operator(==)
  interface operator(/=)
     module procedure :: not_equal_unwrapped_vector_int32
  end interface operator(/=)
contains
  pure function construct_unwrapped_vector_int32_by_size(size) result(res)
    type(unwrapped_vector_int32) :: res
    integer(int32), intent(in) :: size
    call res%init(size)
  end function construct_unwrapped_vector_int32_by_size
  pure function construct_unwrapped_vector_int32_by_arr(arr) result(res)
    type(unwrapped_vector_int32) :: res
    integer(int32), intent(in) :: arr(:)
    integer(int32) :: n
    n = size(arr)
    call res%init(n)
    res%arr_(1:n) = arr(1:n)
  end function construct_unwrapped_vector_int32_by_arr
  pure function construct_unwrapped_vector_int32_by_init_val(size, val) result(res)
    type(unwrapped_vector_int32) :: res
    integer(int32), intent(in) :: size
    integer(int32), intent(in) :: val
    call res%init(size)
    res%arr_(1:size) = val
  end function construct_unwrapped_vector_int32_by_init_val
  pure subroutine init_unwrapped_vector_int32(this, n)
    class(unwrapped_vector_int32), intent(inout) :: this
    integer(int32), intent(in) :: n
    if (.not. allocated(this%arr_)) then
       allocate(this%arr_(n))
       this%size_ = n
       this%capa_ = n
    end if
  end subroutine init_unwrapped_vector_int32
  pure subroutine with_capacity_unwrapped_vector_int32(this, n)
    class(unwrapped_vector_int32), intent(inout) :: this
    integer(int32), intent(in) :: n
    if (.not. allocated(this%arr_)) then
       allocate(this%arr_(n))
       this%size_ = 0
       this%capa_ = n
    end if
  end subroutine with_capacity_unwrapped_vector_int32
  pure subroutine push_back_unwrapped_vector_int32(this, val)
    class(unwrapped_vector_int32), intent(inout) :: this
    integer(int32), intent(in) :: val
    if (.not. allocated(this%arr_)) call this%with_capacity(1)
    if (this%size_ == this%capa_) then
       call this%resize(2*this%capa_)
    end if
    this%size_ = this%size_ + 1
    this%arr_(this%size_) = val
  end subroutine push_back_unwrapped_vector_int32
  pure subroutine push_back_array_unwrapped_vector_int32(this, arr)
    class(unwrapped_vector_int32), intent(inout) :: this
    integer(int32), intent(in) :: arr(:)
    integer(int32) :: s
    s = size(arr)
    if (.not. allocated(this%arr_)) &
         call this%with_capacity(s)
    if (this%size_ + s > this%capa_) then
       call this%resize(this%size_ + s)
    end if
    this%arr_(this%size_+1:this%size_+s) = arr(:)
    this%size_ = this%size_ + s
  end subroutine push_back_array_unwrapped_vector_int32
  pure subroutine pop_back_unwrapped_vector_int32(this)
    class(unwrapped_vector_int32), intent(inout) :: this
    this%size_ = this%size_ - 1
  end subroutine pop_back_unwrapped_vector_int32
  pure integer(int32) function back_unwrapped_vector_int32(this) result(res)
    class(unwrapped_vector_int32), intent(in) :: this
    res = this%arr_(this%size_)
  end function back_unwrapped_vector_int32
  pure integer(int32) function size_unwrapped_vector_int32(this) result(res)
    class(unwrapped_vector_int32), intent(in) :: this
    res = this%size_
  end function size_unwrapped_vector_int32
  pure subroutine resize_unwrapped_vector_int32(this, resize)
    class(unwrapped_vector_int32), intent(inout) :: this
    integer(int32), intent(in) :: resize
    integer(int32), allocatable :: tmp(:)
    if (.not. allocated(this%arr_)) then
       call this%init(resize)
       return
    end if
    if (resize < 1) then
       this%size_ = 0
       allocate(tmp(1))
       call move_alloc(from = tmp, to = this%arr_)
       this%capa_ = 1
    else
       if (this%capa_ == resize) return
       allocate(tmp(resize))
       this%size_ = min(this%size_, resize)
       tmp(1:this%size_) = this%arr_(1:this%size_)
       call move_alloc(from = tmp, to = this%arr_)
       this%capa_ = resize
    end if
  end subroutine resize_unwrapped_vector_int32
  pure integer(int32) function lower_bound_unwrapped_vector_int32(this, val) result(res)
    class(unwrapped_vector_int32), intent(in) :: this
    integer(int32), intent(in) :: val
    res = lower_bound(this%arr_(1:this%size()), val)
  contains
    pure integer(int32) function lower_bound(arr, val) result(res)
      integer(int32), intent(in) :: arr(:)
      integer(int32), intent(in) :: val
      integer(int32) :: p, q, r
      p = 1
      r = size(arr)
      if (r == 0) then
         res = r + 1; return
      else if (arr(p) >= val) then
         res = p; return
      else if (arr(r) < val) then
         res = r + 1; return
      end if
      !> invariant conditions:
      !> arr(p) < v.
      !> arr(r) >= v.
      do while (p + 1 < r)
         q = (p + r)/ 2
         if (arr(q) >= val) then
            r = q
         else !> arr(q) < val
            p = q
         end if
      end do
      res = r
    end function lower_bound
  end function lower_bound_unwrapped_vector_int32
  pure integer(int32) function upper_bound_unwrapped_vector_int32(this, val) result(res)
    class(unwrapped_vector_int32), intent(in) :: this
    integer(int32), intent(in) :: val
    res = upper_bound(this%arr_(1:this%size()), val)
  contains
    pure integer(int32) function upper_bound(arr, val) result(res)
      integer(int32), intent(in) :: arr(:)
      integer(int32), intent(in) :: val
      integer(int32) :: p, q, r
      p = 1
      r = size(arr)
      if (arr(p) > val) then
         res = p; return
      else if (arr(r) <= val) then
         res = r + 1; return
      end if
      !> invariant conditions:
      !> arr(p) <= v.
      !> arr(r) > v.
      do while (p + 1 < r)
         q = (p + r)/ 2
         if (arr(q) > val) then
            r = q
         else !> arr(q) < val
            p = q
         end if
      end do
      res = r
    end function upper_bound
  end function upper_bound_unwrapped_vector_int32
  pure integer(int32) function compare_unwrapped_vector_int32(lhs, rhs) result(res)
    type(unwrapped_vector_int32), intent(in) :: lhs, rhs
    integer(int32) :: i
    associate(ls => lhs%size(), rs => rhs%size())
      if (ls == 0 .and. rs == 0) then
         res = 0; return
      else if (ls == 0) then
         res = -1; return
      else if (rs == 0) then
         res = +1; return
      end if
      do i = 1, min(ls, rs)
         if (lhs%arr_(i) < rhs%arr_(i)) then
            res = -1; return
         else if (lhs%arr_(i) > rhs%arr_(i)) then
            res = +1; return
         end if
      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_unwrapped_vector_int32
  !> less_unwrapped_vector_int32: Compare the first elements.
  !> Compare the second elements if the first elements are same.
  pure logical function less_unwrapped_vector_int32(lhs, rhs) result(res)
    type(unwrapped_vector_int32), intent(in) :: lhs, rhs
    res = compare(lhs, rhs) < 0
  end function less_unwrapped_vector_int32
  pure logical function less_equal_unwrapped_vector_int32(lhs, rhs) result(res)
    type(unwrapped_vector_int32), intent(in) :: lhs, rhs
    res = compare(lhs, rhs) <= 0
  end function less_equal_unwrapped_vector_int32
  pure logical function greater_unwrapped_vector_int32(lhs, rhs) result(res)
    type(unwrapped_vector_int32), intent(in) :: lhs, rhs
    res = compare(lhs, rhs) > 0
  end function greater_unwrapped_vector_int32
  pure logical function greater_equal_unwrapped_vector_int32(lhs, rhs) result(res)
    type(unwrapped_vector_int32), intent(in) :: lhs, rhs
    res = compare(lhs, rhs) >= 0
  end function greater_equal_unwrapped_vector_int32
  pure logical function equal_unwrapped_vector_int32(lhs, rhs) result(res)
    type(unwrapped_vector_int32), intent(in) :: lhs, rhs
    res = compare(lhs, rhs) == 0
  end function equal_unwrapped_vector_int32
  pure logical function not_equal_unwrapped_vector_int32(lhs, rhs) result(res)
    type(unwrapped_vector_int32), intent(in) :: lhs, rhs
    res = compare(lhs, rhs) /= 0
  end function not_equal_unwrapped_vector_int32
end module unwrapped_vector_m
program f902910
  use, intrinsic :: iso_fortran_env
  !> auto use module
  use merge_sort_m
  use unwrapped_vector_m
  use merge_sort_m
  use unwrapped_vector_m, only: vec_i32 => unwrapped_vector_int32
  implicit none
  integer(int32) :: n, m
  logical, allocatable :: g(:, :)
  integer(int32) :: i
  read(input_unit, *) n, m
  allocate(g(0:n-1, 0:n-1), source = .false.)
  do i = 1, m
     block
       integer(int32) :: a, b
       read(input_unit, *) a, b
       g(a, b) = .true.
       g(b, a) = .true.
     end block
  end do
  block
    integer(int32), parameter :: nvs = 3
    integer(int32) :: vs(nvs)
    logical :: is_duplicated
    type(vec_i32) :: path
    read(input_unit, *) vs(:)
    is_duplicated = .false.
    do i = 1, nvs
       ! write(error_unit, *) i, count(vs(i) == vs(:))
       if (count(vs(i) == vs(:)) > 1) &
            & is_duplicated = .true.
    end do
    call merge_sort(vs)
    do i = 0, n - 1
       path = vec_i32()
       call search_cycle_dfs(n, g, i, i, -1, nvs, vs, path, is_duplicated)
    end do
    write(output_unit, '(a)') "No"
  end block
contains
  impure recursive subroutine search_cycle_dfs(n, g, first_v, v, p, nvs, vs, path, is_duplicated)
    integer(int32), intent(in) :: n, first_v, v, p
    integer(int32), intent(in) :: nvs, vs(nvs)
    logical, intent(in) :: g(0:n-1, 0:n-1), is_duplicated
    type(vec_i32), intent(inout) :: path
    integer(int32) :: i
    ! write(error_unit, *) v, p
    if (p /= -1 .and. first_v == v) then
       ! write(error_unit, *) nvs, vs(:)
       ! write(error_unit, *) path%size(), path%arr_(1:path%size())
       ! write(error_unit, *) is_duplicated
       if (is_duplicated) then !> 重複ありなら, 閉路がある時点で, 一致しない閉路となる.
          write(output_unit, '(a)') "Yes"
          stop
       end if
       !> .not. is_duplicated
       if (path%size() /= nvs) then !> サイズがnvでないなら一致しない.
          write(output_unit, '(a)') "Yes"
          stop
       end if
       call merge_sort(path%arr_(1:path%size()))
       if (all(vs(:) == path%arr_(1:path%size()))) return !> 一致している.
       !> path は vs と一致していない閉路.
       write(output_unit, '(a)') "Yes"
       stop
    end if
    do i = 0, n - 1
       if (.not. g(v, i)) cycle
       if (i == p) cycle
       call path%push_back(v)
       call search_cycle_dfs(n, g, first_v, i, v, nvs, vs, path, is_duplicated)
       call path%pop_back()
    end do
  end subroutine search_cycle_dfs
end program f902910