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