dc_hash.f90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright (c) 2000-2026 Gtool Development Group. All rights reserved.
!-----------------------------------------------------------------------
!>
!> @author    Youhei SASAKI, Yasuhiro MORIKAWA
!> @copyright Copyright (C) GFD Dennou Club, 2005-2026. All rights reserved. <br/>
!>            License is BSD-2-Clause. see [COPYRIGHT](@ref COPYRIGHT) in detail
!> @en
!> @brief Hash (associative array) module
!> @details
!> This module provides hash (associative array) which is familiar
!> in script languages.
!>
!> Currently, only character type can be given as "value".
!>
!> @section hash_procedures Procedures List
!>
!> | Procedure      | Description                                         |
!> |----------------|-----------------------------------------------------|
!> | DCHashPut      | Add key and value to hash                           |
!> | DCHashGet      | Get associated value from hash with key             |
!> | DCHashRewind   | Initialize for searching entire hash                |
!> | DCHashNext     | See Rewind                                          |
!> | DCHashDelete   | Delete associated value from hash with key          |
!> | DCHashNumber   | Return size of hash                                 |
!> | DCHashPutLine  | Print hash contents to stdout (for debug)           |
!>
!> @section hash_usage Usage
!>
!> @code{.f90}
!> use dc_types
!> use dc_hash
!> type(HASH):: hashv
!> character(len = STRING):: key, value
!> logical:: end
!>
!> call DCHashPut( hashv = hashv, key = 'key1', value = 'val1')
!> call DCHashPut( hashv = hashv, key = 'key2', value = 'val2')
!> call DCHashPut( hashv = hashv, key = 'key3', value = 'val3')
!>
!> call DCHashGet( hashv = hashv, key = 'key1', value = value )
!> write(*,*) 'key=' // 'key1' // ', value=' // trim(value)
!>
!> write(*,*) 'number(hashv)=', DCHashNumber( hashv )
!>
!> call DCHashDelete( hashv = hashv, key = 'key1')
!>
!> call DCHashRewind( hashv )
!> do
!>   call DCHashNext( hashv = hashv, key = key, value = value, end = end)
!>   if (end) exit
!>   write(*,*) 'key=' // trim(key) // ', value=' // trim(value)
!> enddo
!>
!> call DCHashDelete( hashv )
!> @endcode
!>
!> Output:
!>
!>     key=key1, value=val1
!>     number(hashv)= 3
!>     key=key2, value=val2
!>     key=key3, value=val3
!>
!> @enden
!>
!> @ja
!> @brief ハッシュ (連想配列) モジュール
!> @details
!> スクリプト言語ではおなじみとなっているハッシュ
!> (連想配列) を提供します.
!>
!> ただし, 現在「値」として与えられるのは文字型のみです.
!>
!> @section hash_procedures_ja 手続一覧
!>
!> | 手続名         | 説明                                                |
!> |----------------|-----------------------------------------------------|
!> | DCHashPut      | ハッシュにキーと値を付加                            |
!> | DCHashGet      | キーを与え, ハッシュ内の関連する値を取得            |
!> | DCHashRewind   | ハッシュ内全体を探査するための初期化                |
!> | DCHashNext     | Rewind 参照                                         |
!> | DCHashDelete   | キーを与え, ハッシュ内の関連する値を削除            |
!> | DCHashNumber   | ハッシュのサイズを返す                              |
!> | DCHashPutLine  | ハッシュの内容を標準出力に出力 (デバック用)         |
!>
!> @section hash_usage_ja 使用方法
!>
!> @code{.f90}
!> use dc_types
!> use dc_hash
!> type(HASH):: hashv
!> character(len = STRING):: key, value
!> logical:: end
!>
!> call DCHashPut( hashv = hashv, key = 'key1', value = 'val1')
!> call DCHashPut( hashv = hashv, key = 'key2', value = 'val2')
!> call DCHashPut( hashv = hashv, key = 'key3', value = 'val3')
!>
!> call DCHashGet( hashv = hashv, key = 'key1', value = value )
!> write(*,*) 'key=' // 'key1' // ', value=' // trim(value)
!>
!> write(*,*) 'number(hashv)=', DCHashNumber( hashv )
!>
!> call DCHashDelete( hashv = hashv, key = 'key1')
!>
!> call DCHashRewind( hashv )
!> do
!>   call DCHashNext( hashv = hashv, key = key, value = value, end = end)
!>   if (end) exit
!>   write(*,*) 'key=' // trim(key) // ', value=' // trim(value)
!> enddo
!>
!> call DCHashDelete( hashv )
!> @endcode
!>
!> 以下のように出力されます.
!>
!>     key=key1, value=val1
!>     number(hashv)= 3
!>     key=key2, value=val2
!>     key=key3, value=val3
!>
!> @note 「ハッシュ」という命名について
!>
!> スクリプト言語 Ruby では, 連想配列の内部にデータ検索
!> アルゴリズム「ハッシュ」が利用されることから,
!> そのクラス名に「Hash」という名前がついている.
!> 従ってアルゴリズムとしてハッシュを用いていないこのモジュールの名称
!> が「dc_hash」であることは本来ふさわしくないのだが,
!> 適切な英名が無い事から, このような名称となっている.
!>
!> @note 後方互換
!>
!> バージョン 20071009 以前に利用可能だった以下の手続きは,
!> 後方互換のため, しばらくは利用可能です.
!>
!> - Put, PutLine, Get, Rewind, Next, Delete, Number
!>
!> @endja
!>
 
module dc_hash
  use dc_types, only : string
  implicit none
  private
 
  public:: hash
  public:: dchashput, dchashputline, dchashget
  public:: dchashrewind, dchashnext, dchashdelete, dchashnumber
 
  !-----------------------------------------------
  ! 後方互換用
  ! For backward compatibility
  public:: put, putline, get, rewind, next, delete, number
 
  !> @en
  !> @brief Hash (associative array) derived type
  !> @details
  !> See dc_hash for usage.
  !> @enden
  !>
  !> @ja
  !> @brief ハッシュ (連想配列) 構造型
  !> @details
  !> 利用法に関しては dc_hash を参照してください.
  !> @endja
  type hash
    private
    type(HASH_INTERNAL), pointer :: hash_table(:) => null()
                              !< @en Internal hash table @enden
                              !< @ja 内部ハッシュテーブル @endja
    integer :: search_index = 0
                              !< @en Current search index @enden
                              !< @ja 現在の検索インデックス @endja
  end type hash
 
  !> @en
  !> @brief Internal type for hash entry
  !> @enden
  !> @ja
  !> @brief ハッシュエントリ用内部型
  !> @endja
  type hash_internal
    private
    character(STRING) :: key
                              !< @en Key string @enden
                              !< @ja キー文字列 @endja
    character(STRING) :: value
                              !< @en Value string @enden
                              !< @ja 値文字列 @endja
  end type hash_internal
 
  interface dchashput
    module procedure dchashput0
  end interface
 
  interface dchashnumber
    module procedure dchashnumber0
  end interface
 
  interface dchashputline
    module procedure dchashputline0
  end interface
 
  interface dchashrewind
    module procedure dchashrewind0
  end interface
 
  interface dchashnext
    module procedure dchashnext0
  end interface
 
  interface dchashget
    module procedure dchashget0
  end interface
 
  interface dchashdelete
    module procedure dchashdelete0
  end interface
 
  !-----------------------------------------------
  ! 後方互換用
  ! For backward compatibility
  interface put
    module procedure dchashput0
  end interface
 
  interface number
    module procedure dchashnumber0
  end interface
 
  interface putline
    module procedure dchashputline0
  end interface
 
  interface rewind
    module procedure dchashrewind0
  end interface
 
  interface next
    module procedure dchashnext0
  end interface
 
  interface get
    module procedure dchashget0
  end interface
 
  interface delete
    module procedure dchashdelete0
  end interface
 
contains
 
  !> @en
  !> @brief Add key and value to hash
  !> @details
  !> Associates `value` with `key` in `hashv`.
  !> If `key` already exists, the associated value is updated.
  !>
  !> @param[in,out] hashv Hash variable
  !> @param[in] key Key string
  !> @param[in] value Value string to associate with the key
  !> @enden
  !>
  !> @ja
  !> @brief ハッシュにキーと値を付加
  !> @details
  !> `hashv` のキー `key` に値 `value` を関連付けます.
  !> `key` が既に存在する場合は, 関連する値を更新します.
  !>
  !> @param[in,out] hashv ハッシュ変数
  !> @param[in] key キー文字列
  !> @param[in] value キーに関連付ける値文字列
  !> @endja
  subroutine dchashput0(hashv, key, value)
    implicit none
    type(hash), intent(inout) :: hashv
    character(*), intent(in) :: key, value
    type(hash_internal), pointer :: hash_table_tmp(:) => null()
    integer :: table_size, new_index, i
    logical :: found
    character(STRING) :: search_value
  continue
    call dchashget(hashv, key, search_value, found)
    if (.not. found) then
      table_size = dchashnumber(hashv)
      if (table_size > 0) then
        allocate(hash_table_tmp(table_size))
        hash_table_tmp = hashv % hash_table
        deallocate(hashv % hash_table)
        allocate(hashv % hash_table(table_size + 1))
        hashv % hash_table(1:table_size) = hash_table_tmp(1:table_size)
        deallocate(hash_table_tmp)
        new_index = table_size + 1
      else
        allocate(hashv % hash_table(1))
        new_index = 1
      end if
 
      hashv % hash_table(new_index) % key = key
      hashv % hash_table(new_index) % value = value
    else
      do i = 1, size(hashv % hash_table)
        if (trim(hashv % hash_table(i) % key) == trim(key)) then
          hashv % hash_table(i) % value = value
        end if
      end do
    end if
 
  end subroutine dchashput0
 
 
  !> @en
  !> @brief Return size of hash
  !> @details
  !> Returns the number of key-value pairs stored in `hashv`.
  !>
  !> @param[in] hashv Hash variable
  !> @return Number of key-value pairs in the hash
  !> @enden
  !>
  !> @ja
  !> @brief ハッシュのサイズを返す
  !> @details
  !> `hashv` に格納されているキーと値のペア数を返します.
  !>
  !> @param[in] hashv ハッシュ変数
  !> @return ハッシュ内のキーと値のペア数
  !> @endja
  function dchashnumber0(hashv) result(result)
    implicit none
    type(hash), intent(in) :: hashv
    integer :: result
  continue
    if (associated(hashv % hash_table)) then
      result = size(hashv % hash_table)
    else
      result = 0
    end if
  end function dchashnumber0
 
  !> @en
  !> @brief Initialize for searching entire hash
  !> @details
  !> Rewinds `hashv` mainly for the purpose of extracting hash contents.
  !> Combined with DCHashNext, you can obtain a list of keys and values.
  !>
  !> See the following sample source code:
  !>
  !> @code{.f90}
  !> program hash_sample
  !>   use dc_types
  !>   use dc_hash
  !>   type(HASH):: hashv
  !>   character(len = STRING):: key, value
  !>   logical:: end
  !>
  !>   call DCHashRewind( hashv ) ! (inout)
  !>   do
  !>     call DCHashNext( hashv = hashv, &        ! (inout)
  !>       & key = key, value = value, end = end) ! (out)
  !>     if (end) exit
  !>     write(*,*) 'key=' // trim(key) // ', value=' // trim(value)
  !>   enddo
  !> end program hash_sample
  !> @endcode
  !>
  !> @param[in,out] hashv Hash variable
  !> @enden
  !>
  !> @ja
  !> @brief ハッシュ内全体を探査するための初期化
  !> @details
  !> 主にハッシュの内容を取り出すことを目的として,
  !> `hashv` の巻き戻しを行います. DCHashNext との組み合わせによって
  !> キーと値のリストを取得することが可能です.
  !>
  !> 以下のサンプルソースコードを参照ください.
  !>
  !> @code{.f90}
  !> program hash_sample
  !>   use dc_types
  !>   use dc_hash
  !>   type(HASH):: hashv
  !>   character(len = STRING):: key, value
  !>   logical:: end
  !>
  !>   call DCHashRewind( hashv ) ! (inout)
  !>   do
  !>     call DCHashNext( hashv = hashv, &        ! (inout)
  !>       & key = key, value = value, end = end) ! (out)
  !>     if (end) exit
  !>     write(*,*) 'key=' // trim(key) // ', value=' // trim(value)
  !>   enddo
  !> end program hash_sample
  !> @endcode
  !>
  !> @param[in,out] hashv ハッシュ変数
  !> @endja
  subroutine dchashrewind0(hashv)
    implicit none
    type(hash), intent(inout) :: hashv
  continue
    hashv % search_index = 1
  end subroutine dchashrewind0
 
  !> @en
  !> @brief Get next key-value pair from hash
  !> @details
  !> Returns the contents of `hashv` to `key` and `value`.
  !> See DCHashRewind for details.
  !>
  !> @param[in,out] hashv Hash variable
  !> @param[out] key Key string
  !> @param[out] value Value string (optional)
  !> @param[out] end Returns .true. if all entries have been traversed
  !> @enden
  !>
  !> @ja
  !> @brief ハッシュから次のキーと値のペアを取得
  !> @details
  !> `hashv` の内容を `key` と `value` に返します.
  !> 詳しくは DCHashRewind を参照してください.
  !>
  !> @param[in,out] hashv ハッシュ変数
  !> @param[out] key キー文字列
  !> @param[out] value 値文字列 (省略可能)
  !> @param[out] end 全エントリを走査し終えた場合に .true. を返す
  !> @endja
  subroutine dchashnext0(hashv, key, value, end)
    implicit none
    type(hash), intent(inout) :: hashv
    character(*), intent(out) :: key
    character(*), intent(out), optional :: value
    logical, intent(out) :: end
    integer :: table_size
    character(STRING) :: value_tmp
  continue
    table_size = dchashnumber(hashv)
    if (table_size < hashv % search_index) then
      key = ''
      value_tmp = ''
      end = .true.
    else
      key = hashv % hash_table(hashv % search_index) % key
      value_tmp = hashv % hash_table(hashv % search_index) % value
      end = .false.
      hashv % search_index = hashv % search_index + 1
    end if
    if (present(value)) then
      value = value_tmp
    end if
 
  end subroutine dchashnext0
 
 
  !> @en
  !> @brief Print hash contents to stdout
  !> @details
  !> Displays the contents of `hashv` to standard output.
  !> This is mainly for debugging purposes.
  !>
  !> @param[in] hashv Hash variable
  !> @enden
  !>
  !> @ja
  !> @brief ハッシュの内容を標準出力に出力
  !> @details
  !> `hashv` の内容を標準出力に表示します.
  !> 主にデバッグ用途に使用します.
  !>
  !> @param[in] hashv ハッシュ変数
  !> @endja
  subroutine dchashputline0(hashv)
    use dc_types, only: string
    use dc_string, only: printf, joinchar
    implicit none
    type(hash), intent(in) :: hashv
    type(hash) :: hashv_tmp
    character(len = STRING):: key, value
    logical:: end
  continue
    hashv_tmp = hashv
 
    call printf(6, '#<HASH:: ')
    call dchashrewind(hashv_tmp)
    do
      call dchashnext(hashv_tmp, key, value, end)
      if (end) exit
      call printf(6, '         "%c" -> "%c",', &
        & c1=trim(key), c2=trim(value))
    enddo
    call printf(6, '> ')
 
  end subroutine dchashputline0
 
 
  !> @en
  !> @brief Get associated value from hash with key
  !> @details
  !> Returns the value associated with `key` in `hashv` to `value`.
  !> If no value is associated with `key`, an empty string is returned
  !> to `value`.
  !>
  !> If `found` is given, it returns `.false.` when no value associated
  !> with `key` is found.
  !>
  !> @param[in,out] hashv Hash variable
  !> @param[in] key Key string to search
  !> @param[out] value Value associated with the key
  !> @param[out] found Returns .false. if the key is not found (optional)
  !> @enden
  !>
  !> @ja
  !> @brief キーを与え, ハッシュ内の関連する値を取得
  !> @details
  !> `hashv` のキー `key` に関連する値を `value` に返します.
  !> `key` に関連する値が存在しない場合は `value` に
  !> 空文字を返します.
  !>
  !> `found` を与えると, `key` に関連する値が見つからなかった
  !> 場合に `.false.` を返します.
  !>
  !> @param[in,out] hashv ハッシュ変数
  !> @param[in] key 検索するキー文字列
  !> @param[out] value キーに関連する値
  !> @param[out] found キーが見つからない場合に .false. を返す (省略可能)
  !> @endja
  subroutine dchashget0(hashv, key, value, found)
    use dc_types, only: string
    implicit none
    type(hash), intent(inout) :: hashv
    character(*), intent(in)  :: key
    character(*), intent(out) :: value
    logical, intent(out), optional :: found
    character(STRING) :: search_key, search_value
    logical :: end
  continue
    call dchashrewind(hashv)
    do
      call dchashnext(hashv, search_key, search_value, end)
      if (end) then
        value = ''
        if (present(found)) found = .false.
        exit
      end if
 
      if (trim(search_key) == trim(key)) then
        value = search_value
        if (present(found)) found = .true.
        exit
      end if
    enddo
 
  end subroutine dchashget0
 
  !> @en
  !> @brief Delete associated value from hash with key
  !> @details
  !> Deletes `key` and its associated value from `hashv`.
  !> If `key` is not found in `hashv`, nothing is done.
  !>
  !> If `key` is omitted, all keys and values in `hashv` are deleted.
  !>
  !> @param[in,out] hashv Hash variable
  !> @param[in] key Key string to delete (optional)
  !> @enden
  !>
  !> @ja
  !> @brief キーを与え, ハッシュ内の関連する値を削除
  !> @details
  !> `hashv` のキー `key` およびその関連する値を削除します.
  !> `hashv` 内に `key` が見つからない場合には何もしません.
  !>
  !> `key` が省略される場合には `hashv` 内の全てのキーと値を
  !> 削除します.
  !>
  !> @param[in,out] hashv ハッシュ変数
  !> @param[in] key 削除するキー文字列 (省略可能)
  !> @endja
  subroutine dchashdelete0(hashv, key)
    implicit none
    type(hash), intent(inout) :: hashv
    character(*), intent(in), optional :: key
    type(hash_internal), pointer :: hash_table_tmp(:) => null()
    integer :: table_size, i, j
    logical :: found
    character(STRING) :: search_value
  continue
    if (present(key)) then
      call dchashget(hashv, key, search_value, found)
      table_size = dchashnumber(hashv)
      if (found .and. table_size > 1) then
        allocate(hash_table_tmp(table_size))
        hash_table_tmp = hashv % hash_table
        deallocate(hashv % hash_table)
        allocate(hashv % hash_table(table_size - 1))
        j = 1
        do i = 1, table_size
          if (trim(hash_table_tmp(i) % key) /= trim(key)) then
            hashv % hash_table(j) % key = hash_table_tmp(i) % key
            hashv % hash_table(j) % value = hash_table_tmp(i) % value
            j = j + 1
          end if
        end do
        
        deallocate(hash_table_tmp)
      elseif (found .and. table_size == 1) then
        deallocate(hashv % hash_table)
      end if
    else
      if (associated(hashv % hash_table)) deallocate(hashv % hash_table)
    end if
 
  end subroutine dchashdelete0
 
  !> @namespace dc_hash
end module dc_hash