dc_hash.f90

Go to the documentation of this file.

!== Hash module
!
! Authors::   Yasuhiro MORIKAWA
! Version::   $Id: dc_hash.f90,v 1.1 2009-03-20 09:09:53 morikawa Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!

module dc_hash
  !
  !== Overview
  !
  ! スクリプト言語ではおなじみとなっているハッシュ
  ! (連想配列) を提供します. 
  !
  ! ただし, 現在「値」として与えられるのは文字型のみです.
  !
  !== List
  !
  ! DCHashPut      :: ハッシュにキーと値を付加
  ! DCHashGet      :: キーを与え, ハッシュ内の関連する値を取得
  ! DCHashRewind   :: ハッシュ内全体を探査するための初期化
  ! DCHashNext     :: Rewind 参照
  ! DCHashDelete   :: キーを与え, ハッシュ内の関連する値を削除
  ! DCHashNumber   :: ハッシュのサイズを返す
  ! DCHashPutLine  :: ハッシュの内容を標準出力に出力 (デバック用)
  !
  !
  !== Usage
  !
  !      use dc_types
  !      use dc_hash
  !      type(HASH):: hashv
  !      character(len = STRING):: key, value
  !      logical:: end
  !
  !      call DCHashPut( hashv = hashv, &  ! (out)
  !        & key = 'key1', value = 'val1') ! (in)
  !      call DCHashPut( hashv = hashv, &  ! (inout)
  !        & key = 'key2', value = 'val2') ! (in)
  !      call DCHashPut( hashv = hashv, &  ! (inout)
  !        & key = 'key3', value = 'val3') ! (in)
  !
  !      call DCHashGet( hashv = hashv, & ! (inout)
  !        & key = 'key1', &              ! (in)
  !        & value = value )              ! (out)
  !      write(*,*) 'key=' // 'key1' // ', value=' // trim(value)
  !
  !      write(*,*) 'number(hashv)=', DCHashNumber( hashv )
  !
  !      call DCHashDelete( hashv = hashv, & ! (inout)
  !        & key = 'key1')                   ! (in)
  !
  !      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
  !
  !      call DCHashDelete( hashv ) ! (inout)
  !
  ! 以下のように出力されます.
  !
  !      key=key1, value=val1
  !      number(hashv)= 3
  !      key=key2, value=val2
  !      key=key3, value=val3
  !
  !== Note
  !
  !=== 「ハッシュ」という命名について
  !
  ! スクリプト言語 Ruby では, 連想配列の内部にデータ検索
  ! アルゴリズム「ハッシュ」が利用されることから, 
  ! そのクラス名に「Hash」という名前がついている. 
  ! 従ってアルゴリズムとしてハッシュを用いていないこのモジュールの名称
  ! が「dc_hash」であることは本来ふさわしくないのだが, 
  ! 適切な英名が無い事から, このような名称となっている. 
  !
  !=== 後方互換
  !
  ! バージョン 20071009 以前に利用可能だった以下の手続きは, 
  ! 後方互換のため, しばらくは利用可能です. 
  ! 
  ! * Put, PutLine, Get, Rewind, Next, Delete, Number
  !
  !
  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

  type hash
    !
    ! 利用法に関しては dc_hash を参照してください.
    !
    private
    type(hash_internal), pointer :: hash_table(:) => null()
    integer :: search_index = 0
  end type hash

  type hash_internal
    private
    character(STRING) :: key
    character(STRING) :: value
  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

  subroutine dchashput0(hashv, key, value)
    !
    ! *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


  function dchashnumber0(hashv) result(result)
    !
    ! *hashv* のサイズを返します.
    !
    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

  subroutine dchashrewind0(hashv)
    !
    ! 主にハッシュの内容を取り出すことを目的として, 
    ! *hashv* の巻き戻しを行います. DCHashNext との組み合わせによって
    ! キーと値のリストを取得すること可能です.
    !
    ! 以下のサンプルソースコードを参照ください.
    !
    !    program hash_sample
    !      use dc_type
    !      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
    !
    implicit none
    type(hash), intent(inout) :: hashv
  continue
    hashv % search_index = 1
  end subroutine dchashrewind0

  subroutine dchashnext0(hashv, key, value, end)
    !

    ! *hashv* の内容を *key* と *value* に返します.
    ! 詳しくは DCHashRewind を参照してください.
    !
    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


  subroutine dchashputline0(hashv)
    !
    ! *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


  subroutine dchashget0(hashv, key, value, found)
    !
    ! *hashv* のキー *key* に関連する値を *value* に返します.
    ! *key* に関連する値が存在しない場合は *value* に
    ! 空文字を返します.
    !
    ! *found* を与えると, *key* に関連する値が見つからなかった
    ! 場合に .false. を返します.
    !
    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

  subroutine dchashdelete0(hashv, key)
    !
    ! *hashv* のキー *key* およびその関連する値を削除します.
    ! *hashv* 内に *key* が見つからない場合には何もしません.
    !
    ! *key* が省略される場合には *hashv* 内の全てのキーと値を
    ! 削除します.
    !
    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

end module dc_hash