!== 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