セグメント木なので競技プログラミングの話...と見せかけてFortranの抽象構造型の話をします.

セグメント木とは?

競技プログラミングで良く目にするデータ構造です.
区間に対するある種の操作と配列の値の変更ができます.

例え話

配列 [1, 2, 3, 4, 5, 6, 7, 8, 9, 10] の区間2〜8番目の和を求めるとします.
その場合, (区間2〜2の和, 区間3〜4の和, 区間5〜8の和)の和が分かれば計算できます.
つまり, あらかじめ上手い感じに選ばれた区間の和を計算しておくことで, 任意の区間の和を計算することができます.
更に, $i$ 番目の値の変更も素早くできます.
何故なら, 上手い感じに選ばれた区間 には $i$ に関する区間が少ないからです.
(上の例だと, 2番目に対応するのは 1〜16, 1〜8, 1〜4, 1〜2, 2〜2 の5個しかありません. これは $N = 16$ として, $\log(N) = 4$ くらいの値です.

詳細に知りたい場合はグーグルで検索すると図付きで解説されているページがたくさん出てきます.

条件

2項演算子がモノイド(結合則と単位元を持つ)
- 要するに, 和なら $(a + b) + c == a + (b + c)$, $a + 0 = 0 + a = a$.
- 最大値, 最小値でも似たものを作れるので試してみましょう.

だけですね.
この性質があればセグメント木に乗せられます.

Fortran で実装するには?

一応, 私の実装があります.
セグメント木の作り方は他の言語と同じなので省略します.
モノイドの実装方法は他の言語と違うと思います.

モノイドをどのように表現するか

例えば, AtCoderの実装ではtemplate によって関数と単位元を渡しています.
Fortran ではtemplateは使えないので, 他の方法を考える必要があります.
私の実装では, 抽象構造型を使っています.

抽象構造型

abstract interface (抽象引用仕様) を使うことで実装できます.

monoid_op_m.f90

monoid_op_m.f90

module monoid_op_m
  use, intrinsic :: iso_fortran_env
  implicit none
  type, abstract :: monoid_op_int32
     private
   contains
     procedure(identity_monoid_op_int32), nopass, deferred :: identity
     procedure(bin_op_monoid_op_int32), nopass, deferred :: bin_op
  end type monoid_op_int32
  abstract interface
     pure integer(int32) function identity_monoid_op_int32() result(res)
       import int32
     end function identity_monoid_op_int32
     pure integer(int32) function bin_op_monoid_op_int32(x, y) result(res)
       import int32
       integer(int32), intent(in) :: x, y
     end function bin_op_monoid_op_int32
  end interface
  public :: plus_monoid_op_int32
  type, extends(monoid_op_int32) :: plus_monoid_op_int32
     private
   contains
     procedure, nopass :: identity => identity_plus_monoid_op_int32
     procedure, nopass :: bin_op   => bin_op_plus_monoid_op_int32
  end type plus_monoid_op_int32
  public :: min_monoid_op_int32
  type, extends(monoid_op_int32) :: min_monoid_op_int32
     private
   contains
     procedure, nopass :: identity => identity_min_monoid_op_int32
     procedure, nopass :: bin_op   => bin_op_min_monoid_op_int32
  end type min_monoid_op_int32
contains
  pure integer(int32) function identity_plus_monoid_op_int32() result(res)
    res = 0_int32
  end function identity_plus_monoid_op_int32
  pure integer(int32) function bin_op_plus_monoid_op_int32(x, y) result(res)
    integer(int32), intent(in) :: x, y
    res = x + y
  end function bin_op_plus_monoid_op_int32
  pure integer(int32) function identity_min_monoid_op_int32() result(res)
    res = huge(0_int32)
  end function identity_min_monoid_op_int32
  pure integer(int32) function bin_op_min_monoid_op_int32(x, y) result(res)
    integer(int32), intent(in) :: x, y
    res = min(x, y)
  end function bin_op_min_monoid_op_int32
end module monoid_op_m

test_monoid_op.f90

test_monoid_op.f90

program test_monoid_op
  use, intrinsic :: iso_fortran_env
  use monoid_op_m
  implicit none
  class(monoid_op_int32), allocatable :: myop
  allocate(myop, source = plus_monoid_op_int32())
  write(output_unit, '(i0)') myop%identity() ! 単位元.
  write(output_unit, '(i0)') myop%bin_op(myop%identity(), 100) ! 単位元.
  write(output_unit, '(i0)') myop%bin_op(myop%bin_op(3, 4), 5) ! 結合則.
  write(output_unit, '(i0)') myop%bin_op(3, myop%bin_op(4, 5)) ! 結合則.
  deallocate(myop)
  allocate(myop, source = min_monoid_op_int32())
  write(output_unit, '(i0)') myop%identity()
  write(output_unit, '(i0)') myop%bin_op(myop%identity(), 100)
  write(output_unit, '(i0)') myop%bin_op(myop%bin_op(3, 4), 5)
  write(output_unit, '(i0)') myop%bin_op(3, myop%bin_op(4, 5))
end program test_monoid_op

実行結果

$ gfortran --version
GNU Fortran (Ubuntu 12.3.0-1ubuntu1~22.04) 12.3.0
Copyright (C) 2022 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
$ gfortran monoid_op_m.f90 test_monoid_op.f90 && ./a.out
0
100
12
12
2147483647
100
3
3

単位元や結合則を満たしているように見えます.

蛇足

char_monoid.f90

char_monoid.f90

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)
    res%size_ = n
    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

module segment_tree_m
  use, intrinsic :: iso_fortran_env
  use vec_string_m
  implicit none
  private
  public :: segment_tree_vec_string
  public :: monoid_op_vec_string
  type :: segment_tree_vec_string
     private
     integer(int32) :: arr_size_, tree_size_, depth_
     type(vec_string), allocatable :: arr_(:)
     class(monoid_op_vec_string), allocatable :: monoid_
   contains
     procedure, pass :: init   => init_segment_tree_vec_string

     procedure, pass :: update => update_segment_tree_vec_string
     procedure, pass :: query => query_segment_tree_vec_string
  end type segment_tree_vec_string
  type, abstract :: monoid_op_vec_string
     private
   contains
     procedure(identity_vec_string), nopass, deferred :: identity
     procedure(bin_op_vec_string)  , nopass, deferred :: bin_op
  end type monoid_op_vec_string
  abstract interface

     pure type(vec_string) function identity_vec_string() result(res)
  import vec_string
     end function identity_vec_string
     pure type(vec_string) function bin_op_vec_string(x, y) result(res)
  import vec_string
       type(vec_string), intent(in) :: x, y
     end function bin_op_vec_string
  end interface
contains
  !> indices rage [1:2^a-1]
  subroutine init_segment_tree_vec_string (this, num_elems, monoid_)
    class(segment_tree_vec_string), intent(inout) :: this
    integer(int32), intent(in) :: num_elems
    class(monoid_op_vec_string), intent(in) :: monoid_
    integer(int32) :: tree_size
    allocate(this%monoid_, source = monoid_)
    tree_size = 1
    this%depth_ = 1
    do while (tree_size < num_elems)
       tree_size = tree_size * 2
       this%depth_ = this%depth_ + 1
    end do
    this%tree_size_ = tree_size
    this%arr_size_ = 2 * tree_size - 1
    allocate(this%arr_(this%arr_size_), source = this%monoid_%identity())
  end subroutine init_segment_tree_vec_string

  subroutine update_segment_tree_vec_string (this, idx, val)
    class(segment_tree_vec_string), intent(inout) :: this
    integer(int32), intent(in) :: idx
    type(vec_string), intent(in) :: val
    integer(int32) :: pos
    pos = this%tree_size_ + idx - 1
    this%arr_(pos) = val
    do while (pos > 1)
       pos = pos / 2
       this%arr_(pos) = this%monoid_%bin_op(this%arr_(2 * pos), this%arr_(2 * pos + 1))
    end do
  end subroutine update_segment_tree_vec_string
  !> close interval [a, b].
  pure type(vec_string) function query_segment_tree_vec_string (this, a, b) result(res)
    class(segment_tree_vec_string), intent(in) :: this
    integer(int32), intent(in) :: a, b
    type(vec_string) res_r
    integer(int32) :: p, r
    res = this%monoid_%identity()
    res_r = this%monoid_%identity()
    if (a > b) return
    p = this%tree_size_ + a - 1
    r = this%tree_size_ + b - 1
    do while (p <= r)
       if (iand(p, b'1') == 1) then !> right child.
          res = this%monoid_%bin_op(res, this%arr_(p))
          p = p + 1
       end if
       if (iand(r, b'1') == 0) then !> left child.
          res_r = this%monoid_%bin_op(this%arr_(r), res_r)
          r = r - 1
       end if
       p = p / 2
       r = r / 2
    end do
    res = this%monoid_%bin_op(res, res_r)
  end function query_segment_tree_vec_string
end module segment_tree_m

module mymonoid_m
  use, intrinsic :: iso_fortran_env
  use segment_tree_m
  use vec_string_m
  implicit none
  public plus_op_vec_string
  type, extends(monoid_op_vec_string) :: plus_op_vec_string
     private
   contains
     procedure, nopass :: identity => identity_plus_op_vec_string
     procedure, nopass :: bin_op => bin_op_plus_op_vec_string
  end type plus_op_vec_string
contains
  pure type(vec_string) function identity_plus_op_vec_string() result(res)
    res = vec_string("")
  end function identity_plus_op_vec_string
  pure type(vec_string) function bin_op_plus_op_vec_string(x, y) result(res)
    type(vec_string), intent(in) :: x, y
    integer(int32) :: i
    do i = 1, x%size()
       call res%push_back(x%str_(i))
    end do
    do i = 1, y%size()
       call res%push_back(y%str_(i))
    end do
  end function bin_op_plus_op_vec_string
end module mymonoid_m

christmas.f90

program christmas
  use, intrinsic :: iso_fortran_env
  use vec_string_m
  use segment_tree_m
  use mymonoid_m
  implicit none
  character(len=*), parameter :: s = "abchristmashellomerry"
  type(segment_tree_vec_string) :: st
  integer(int32) :: i
  call st%init(len_trim(s), plus_op_vec_string())
  do i = 1, len_trim(s)
     call st%update(i, vec_string(s(i:i)))
  end do
  associate(res => st%query(12, len_trim(s)))
    write(output_unit, '(*(a1))') res%str_(1:res%size())
  end associate
  associate(res => st%query(3, 11))
    write(output_unit, '(*(a1))') res%str_(1:res%size())
  end associate
end program christmas

実行結果

 $ gfortran char_monoid.f90 christmas.f90 && ./a.out
hellomerry
christmas

というわけで, 文字列の結合はモノイドみたいです. (ちなみに計算量が増えているのでセグメント木に乗せる利点はありません.)
おあとがよろしいようで.

参考

セグメント木

Fortran