PtrHashTable.f90

Go to the documentation of this file.

module ptrhashtablemodule
  use keyvaluelistmodule, only: keyvaluelisttype
  use kindmodule, only: dp, i4b, lgp
  use iteratormodule, only: iteratortype
  use ptrhashtableiteratormodule, only: ptrhashtableiteratortype
  use simmodule, only: store_warning
 
  implicit none
  private
 
  public :: ptrhashtabletype
 
  integer(I4B), parameter, private :: hash_size = 4993
  integer(I4B), parameter, private :: multiplier = 31
  integer(I4B), parameter, public :: bucket_size = 1000
 
  !> @brief HashTable that stores void pointer items.
  !!
  !<
  type ptrhashtabletype
    private
    type(keyvaluelisttype) :: buckets(bucket_size) !< the HashTable buckets
    integer(I4B) :: cnt = 0 !< the number of items in the HashTable
  contains
    procedure :: iterator
    procedure :: add
    procedure :: get
    procedure :: contains
    procedure :: count
    procedure :: clear
  end type ptrhashtabletype
 
contains
 
  !> @brief An iterator used to iterate through the HashTable
  !!
  !<
  function iterator(this) result(itr)
    class(ptrhashtabletype), target :: this
    class(iteratortype), allocatable :: itr
 
    itr = ptrhashtableiteratortype(this%buckets)
  end function
 
  !> @brief Add a void pointer to the HashTable
  !!
  !<
  subroutine add(this, key, val)
    class(ptrhashtabletype), target :: this
    character(len=*), intent(in) :: key !< key of the item to be added
    class(*), pointer, intent(in) :: val !< value to be added
    ! -- local
    type(keyvaluelisttype), pointer :: bucket !< bucket the key points to
    integer(I4B) :: hash !< hashed value of the key
 
    if (this%contains(key)) then
      call store_warning( &
        "Already existing variable being added to the HashTable -"//key)
    end if
 
    hash = compute_hash(key)
 
    bucket => this%buckets(hash)
    call bucket%add(key, val)
    this%cnt = this%cnt + 1
  end subroutine add
 
  !> @brief Get a void pointer from the HashTable using a key
  !!
  !<
  function get(this, key) result(val)
    class(ptrhashtabletype), target :: this
    character(len=*), intent(in) :: key !< key of the item to retrieve
    class(*), pointer :: val !< item associated with the key
    ! -- local
    type(keyvaluelisttype), pointer :: bucket !< bucket the key points to
    integer(I4B) :: hash !< hashed value of the key
 
    hash = compute_hash(key)
 
    bucket => this%buckets(hash)
    val => bucket%get(key)
 
  end function
 
  !> @brief Boolean indicating if an item exists in the hashtable
  !!
  !<
  function contains(this, key) result(res)
    class(ptrhashtabletype), target :: this
    character(len=*), intent(in) :: key !< key of the item to retrieve
    logical :: res !< item found
 
    ! -- local
    res = associated(this%get(key))
 
  end function
 
  !> @brief The nummer of items in the HashTable
  !!
  !<
  function count(this) result(val)
    class(ptrhashtabletype) :: this
    integer(I4B) :: val
 
    val = this%cnt
  end function
 
  !> @brief Clears the HashTable
  !!
  !! Loops over all the buckets and clears them.
  !<
  subroutine clear(this)
    class(ptrhashtabletype), target :: this
    ! -- local
    type(keyvaluelisttype), pointer :: bucket
    integer(I4B) :: bucket_index
 
    do bucket_index = 1, bucket_size
      bucket => this%buckets(bucket_index)
      call bucket%clear()
    end do
 
    this%cnt = 0
  end subroutine
 
  !> @brief Compute the hash of a key
  !!
  !! The hash produced will be in the interval 1 - BUCKET_SIZE
  !<
  function compute_hash(key) result(hash)
    character(len=*), intent(in) :: key !< the key
    integer(I4B) :: hash !< the hash
    ! -- local
    integer(I4B) :: i !< character index of the key
 
    hash = 0
    do i = 1, len_trim(key)
      hash = modulo(multiplier * hash + ichar(key(i:i)), hash_size)
    end do
    hash = 1 + modulo(hash, bucket_size)
 
  end function compute_hash
 
end module ptrhashtablemodule