Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief A simple hash table of integer keys, using hash function:
      10             : !>          H(k) = (k*p) mod n + 1
      11             : !>        where:
      12             : !>          k = key
      13             : !>          p = a prime number >= n
      14             : !>          n = size of the hash table
      15             : !>         And collision resolvation is done by open addressing with linear
      16             : !>         probing.
      17             : !>
      18             : !>         The table consists of an array of (key,val) pairs, and
      19             : !>         there are no intermediate buckets. For every new entry (k,v):
      20             : !>         We first look up slot H(k), and if it already contains an entry,
      21             : !>         then move to the next empty slot using a predefined linear probing
      22             : !>         sequence (e.g. iterate from slots H(k) to n, and then 1 to H(k)-1).
      23             : !>         When we look up, we use the same probing sequence.
      24             : ! **************************************************************************************************
      25             : MODULE qs_fb_hash_table_types
      26             : 
      27             :    USE kinds,                           ONLY: int_8
      28             :    USE qs_hash_table_functions,         ONLY: hash_table_matching_prime
      29             : #include "./base/base_uses.f90"
      30             : 
      31             :    IMPLICIT NONE
      32             : 
      33             :    PRIVATE
      34             : 
      35             : ! public types
      36             :    PUBLIC :: fb_hash_table_obj
      37             : 
      38             : ! public methods
      39             : !API
      40             :    PUBLIC :: fb_hash_table_add, &
      41             :              fb_hash_table_create, &
      42             :              fb_hash_table_get, &
      43             :              fb_hash_table_has_data, &
      44             :              fb_hash_table_nullify, &
      45             :              fb_hash_table_release
      46             : 
      47             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_fb_hash_table_types'
      48             : 
      49             : ! key value indicating an empty slot
      50             :    INTEGER(KIND=int_8), PARAMETER, PRIVATE :: EMPTY_KEY = -1_int_8
      51             : ! Parameters related to automatic resizing of the hash_table:
      52             : ! Resize by EXPAND_FACTOR if total no. slots / no. of filled slots < ENLARGE_RATIO
      53             :    INTEGER, PARAMETER, PRIVATE :: ENLARGE_RATIO = 1
      54             :    INTEGER, PARAMETER, PRIVATE :: REDUCE_RATIO = 3
      55             :    INTEGER, PARAMETER, PRIVATE :: EXPAND_FACTOR = 2
      56             :    INTEGER, PARAMETER, PRIVATE :: SHRINK_FACTOR = 2
      57             : 
      58             : ! **************************************************************************************************
      59             : !> \brief hash table entry data type
      60             : !> \param key       : key of the entry
      61             : !> \param val       : value of the entry
      62             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
      63             : ! **************************************************************************************************
      64             :    TYPE fb_hash_table_element
      65             :       INTEGER(KIND=int_8) :: key = -1_int_8
      66             :       INTEGER :: val = -1
      67             :    END TYPE fb_hash_table_element
      68             : 
      69             : ! **************************************************************************************************
      70             : !> \brief data defining a hash table using open addressing for collision
      71             : !>        resolvation. Uses simple entry structure to be memory efficient
      72             : !>        as well as small overhead
      73             : !> \param table     : hash table data area
      74             : !> \param nelements : number of non-empty slots in table
      75             : !> \param nmax      : max number of slots in table
      76             : !> \param prime     : prime number used in the hash function
      77             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
      78             : ! **************************************************************************************************
      79             :    TYPE fb_hash_table_data
      80             :       TYPE(fb_hash_table_element), DIMENSION(:), POINTER :: table => NULL()
      81             :       INTEGER :: nelements = -1
      82             :       INTEGER :: nmax = -1
      83             :       INTEGER :: prime = -1
      84             :    END TYPE fb_hash_table_data
      85             : 
      86             : ! **************************************************************************************************
      87             : !> \brief the object container which allows for the creation of an array
      88             : !>        of pointers to fb_hash_table objects
      89             : !> \param obj : pointer to the fb_hash_table object
      90             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
      91             : ! **************************************************************************************************
      92             :    TYPE fb_hash_table_obj
      93             :       TYPE(fb_hash_table_data), POINTER, PRIVATE :: obj => NULL()
      94             :    END TYPE fb_hash_table_obj
      95             : 
      96             : CONTAINS
      97             : 
      98             : ! **************************************************************************************************
      99             : !> \brief Add element to a hash table, auto resize if necessary
     100             : !> \param hash_table : the fb_hash_table object
     101             : !> \param key        : key of the element
     102             : !> \param val        : value of the element
     103             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     104             : ! **************************************************************************************************
     105        1664 :    RECURSIVE SUBROUTINE fb_hash_table_add(hash_table, key, val)
     106             :       TYPE(fb_hash_table_obj), INTENT(INOUT)             :: hash_table
     107             :       INTEGER(KIND=int_8), INTENT(IN)                    :: key
     108             :       INTEGER, INTENT(IN)                                :: val
     109             : 
     110             :       INTEGER                                            :: islot
     111             :       LOGICAL                                            :: check_ok
     112             : 
     113        1664 :       check_ok = fb_hash_table_has_data(hash_table)
     114        1664 :       CPASSERT(check_ok)
     115             :       ! check hash table size, if too small rehash in a larger table
     116        1664 :       IF (hash_table%obj%nelements*ENLARGE_RATIO .GE. &
     117             :           hash_table%obj%nmax) THEN
     118             :          CALL fb_hash_table_rehash(hash_table=hash_table, &
     119           0 :                                    nmax=hash_table%obj%nmax*EXPAND_FACTOR)
     120             :       END IF
     121             :       ! find the right slot for the given key
     122        1664 :       islot = fb_hash_table_linear_probe(hash_table, key)
     123        1664 :       CPASSERT(islot > 0)
     124             :       ! we are adding a new entry only if islot points to an empty slot,
     125             :       ! otherwise just change the val of the existing entry
     126        1664 :       IF (hash_table%obj%table(islot)%key == EMPTY_KEY) THEN
     127        1664 :          hash_table%obj%nelements = hash_table%obj%nelements + 1
     128        1664 :          hash_table%obj%table(islot)%key = key
     129             :       END IF
     130        1664 :       hash_table%obj%table(islot)%val = val
     131        1664 :    END SUBROUTINE fb_hash_table_add
     132             : 
     133             : ! **************************************************************************************************
     134             : !> \brief Creates and initialises an empty fb_hash_table object
     135             : !> \param hash_table : the fb_hash_table object, its content must be NULL
     136             : !>                     and cannot be UNDEFINED
     137             : !> \param nmax       : total size of the table, optional. If absent default
     138             : !>                     size is 1.
     139             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     140             : ! **************************************************************************************************
     141          48 :    SUBROUTINE fb_hash_table_create(hash_table, nmax)
     142             :       TYPE(fb_hash_table_obj), INTENT(INOUT)             :: hash_table
     143             :       INTEGER, INTENT(IN), OPTIONAL                      :: nmax
     144             : 
     145             :       INTEGER                                            :: my_nmax
     146             :       LOGICAL                                            :: check_ok
     147             : 
     148          48 :       check_ok = .NOT. fb_hash_table_has_data(hash_table)
     149          48 :       CPASSERT(check_ok)
     150          48 :       ALLOCATE (hash_table%obj)
     151             :       NULLIFY (hash_table%obj%table)
     152          48 :       hash_table%obj%nmax = 0
     153          48 :       hash_table%obj%nelements = 0
     154          48 :       hash_table%obj%prime = 2
     155          48 :       my_nmax = 1
     156          48 :       IF (PRESENT(nmax)) my_nmax = nmax
     157             :       CALL fb_hash_table_init(hash_table=hash_table, &
     158          48 :                               nmax=my_nmax)
     159             : 
     160          48 :    END SUBROUTINE fb_hash_table_create
     161             : 
     162             : ! **************************************************************************************************
     163             : !> \brief Retrieve value from a key from a hash table
     164             : !> \param hash_table : the fb_hash_table object
     165             : !> \param key        : input key
     166             : !> \param val        : output value, equals to 0 if key not found
     167             : !> \param found      : .TRUE. if key is found, .FALSE. otherwise
     168             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     169             : ! **************************************************************************************************
     170        6784 :    SUBROUTINE fb_hash_table_get(hash_table, key, val, found)
     171             :       TYPE(fb_hash_table_obj), INTENT(IN)                :: hash_table
     172             :       INTEGER(KIND=int_8), INTENT(IN)                    :: key
     173             :       INTEGER, INTENT(OUT)                               :: val
     174             :       LOGICAL, INTENT(OUT)                               :: found
     175             : 
     176             :       INTEGER                                            :: islot
     177             :       LOGICAL                                            :: check_ok
     178             : 
     179        6784 :       check_ok = fb_hash_table_has_data(hash_table)
     180        6784 :       CPASSERT(check_ok)
     181        6784 :       found = .FALSE.
     182        6784 :       val = 0
     183        6784 :       islot = fb_hash_table_linear_probe(hash_table, key)
     184        6784 :       IF (islot > 0) THEN
     185        6784 :          IF (hash_table%obj%table(islot)%key == key) THEN
     186        5120 :             val = hash_table%obj%table(islot)%val
     187        5120 :             found = .TRUE.
     188             :          END IF
     189             :       END IF
     190        6784 :    END SUBROUTINE fb_hash_table_get
     191             : 
     192             : ! **************************************************************************************************
     193             : !> \brief check if the object has data associated to it
     194             : !> \param hash_table : the fb_hash_table object in question
     195             : !> \return : true if hash_table%obj is associated, false otherwise
     196             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     197             : ! **************************************************************************************************
     198        8640 :    PURE FUNCTION fb_hash_table_has_data(hash_table) RESULT(res)
     199             :       TYPE(fb_hash_table_obj), INTENT(IN)                :: hash_table
     200             :       LOGICAL                                            :: res
     201             : 
     202        8640 :       res = ASSOCIATED(hash_table%obj)
     203        8640 :    END FUNCTION fb_hash_table_has_data
     204             : 
     205             : ! **************************************************************************************************
     206             : !> \brief Initialises a fb_hash_table object
     207             : !> \param hash_table : the fb_hash_table object, its content must be NULL
     208             : !>                     and cannot be UNDEFINED
     209             : !> \param nmax       : new size of the table, optional. If absent use the
     210             : !>                     old size
     211             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     212             : ! **************************************************************************************************
     213          48 :    SUBROUTINE fb_hash_table_init(hash_table, nmax)
     214             :       TYPE(fb_hash_table_obj), INTENT(INOUT)             :: hash_table
     215             :       INTEGER, INTENT(IN), OPTIONAL                      :: nmax
     216             : 
     217             :       INTEGER                                            :: ii, my_nmax, power
     218             :       LOGICAL                                            :: check_ok
     219             : 
     220          48 :       check_ok = fb_hash_table_has_data(hash_table)
     221          48 :       CPASSERT(check_ok)
     222          48 :       my_nmax = hash_table%obj%nmax
     223          48 :       IF (PRESENT(nmax)) my_nmax = nmax
     224             :       ! table length should always be power of 2. Find the least
     225             :       ! power that is greater or equal to my_nmax
     226          48 :       power = 0
     227         320 :       DO WHILE (2**power .LT. my_nmax)
     228         272 :          power = power + 1
     229             :       END DO
     230          48 :       my_nmax = 2**power
     231          48 :       IF (ASSOCIATED(hash_table%obj%table)) THEN
     232           0 :          IF (SIZE(hash_table%obj%table) .NE. my_nmax) THEN
     233           0 :             DEALLOCATE (hash_table%obj%table)
     234           0 :             ALLOCATE (hash_table%obj%table(my_nmax))
     235             :          END IF
     236             :       ELSE
     237        2704 :          ALLOCATE (hash_table%obj%table(my_nmax))
     238             :       END IF
     239          48 :       hash_table%obj%nmax = my_nmax
     240          48 :       hash_table%obj%prime = hash_table_matching_prime(my_nmax)
     241             :       ! initiate element to be "empty"
     242        2608 :       DO ii = 1, hash_table%obj%nmax
     243        2560 :          hash_table%obj%table(ii)%key = EMPTY_KEY
     244        2608 :          hash_table%obj%table(ii)%val = 0
     245             :       END DO
     246          48 :       hash_table%obj%nelements = 0
     247          48 :    END SUBROUTINE fb_hash_table_init
     248             : 
     249             : ! **************************************************************************************************
     250             : !> \brief Nullifies a fb_hash_table object
     251             : !> \param hash_table : the fb_hash_table object
     252             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     253             : ! **************************************************************************************************
     254          48 :    PURE SUBROUTINE fb_hash_table_nullify(hash_table)
     255             :       TYPE(fb_hash_table_obj), INTENT(INOUT)             :: hash_table
     256             : 
     257          48 :       NULLIFY (hash_table%obj)
     258          48 :    END SUBROUTINE fb_hash_table_nullify
     259             : 
     260             : ! **************************************************************************************************
     261             : !> \brief Rehash table. If nmax is present, then also change the table size
     262             : !>        to MAX(nmax, number_of_non_empty_elements).
     263             : !> \param hash_table      : the fb_hash_table object
     264             : !> \param nmax [OPTIONAL] : maximum size of the rehashed table
     265             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     266             : ! **************************************************************************************************
     267           0 :    RECURSIVE SUBROUTINE fb_hash_table_rehash(hash_table, nmax)
     268             :       TYPE(fb_hash_table_obj), INTENT(INOUT)             :: hash_table
     269             :       INTEGER, INTENT(IN), OPTIONAL                      :: nmax
     270             : 
     271             :       INTEGER                                            :: ii, my_nmax
     272             :       TYPE(fb_hash_table_element), ALLOCATABLE, &
     273           0 :          DIMENSION(:)                                    :: tmp_table
     274             : 
     275           0 :       IF (.NOT. fb_hash_table_has_data(hash_table)) THEN
     276           0 :          CALL fb_hash_table_create(hash_table, nmax)
     277             :          RETURN
     278             :       END IF
     279           0 :       IF (PRESENT(nmax)) THEN
     280           0 :          my_nmax = MAX(nmax, hash_table%obj%nelements)
     281             :       ELSE
     282           0 :          my_nmax = hash_table%obj%nmax
     283             :       END IF
     284           0 :       ALLOCATE (tmp_table(hash_table%obj%nmax))
     285           0 :       tmp_table(:) = hash_table%obj%table(:)
     286           0 :       CALL fb_hash_table_release(hash_table)
     287             :       CALL fb_hash_table_create(hash_table=hash_table, &
     288           0 :                                 nmax=my_nmax)
     289           0 :       DO ii = 1, SIZE(tmp_table)
     290           0 :          IF (tmp_table(ii)%key .NE. EMPTY_KEY) THEN
     291             :             CALL fb_hash_table_add(hash_table=hash_table, &
     292             :                                    key=tmp_table(ii)%key, &
     293           0 :                                    val=tmp_table(ii)%val)
     294             :          END IF
     295             :       END DO
     296           0 :       DEALLOCATE (tmp_table)
     297             :    END SUBROUTINE fb_hash_table_rehash
     298             : 
     299             : ! **************************************************************************************************
     300             : !> \brief releases given object
     301             : !> \param hash_table : the fb_hash_table object in question
     302             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     303             : ! **************************************************************************************************
     304          48 :    SUBROUTINE fb_hash_table_release(hash_table)
     305             :       TYPE(fb_hash_table_obj), INTENT(INOUT)             :: hash_table
     306             : 
     307          48 :       IF (ASSOCIATED(hash_table%obj)) THEN
     308          48 :          IF (ASSOCIATED(hash_table%obj%table)) THEN
     309          48 :             DEALLOCATE (hash_table%obj%table)
     310             :          END IF
     311          48 :          DEALLOCATE (hash_table%obj)
     312             :       ELSE
     313           0 :          NULLIFY (hash_table%obj)
     314             :       END IF
     315          48 :    END SUBROUTINE fb_hash_table_release
     316             : 
     317             : ! **************************************************************************************************
     318             : !> \brief Remove element from a table, automatic resize if necessary
     319             : !> \param hash_table : the fb_hash_table object
     320             : !> \param key        : key of the element to be removed
     321             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     322             : ! **************************************************************************************************
     323           0 :    SUBROUTINE fb_hash_table_remove(hash_table, key)
     324             :       TYPE(fb_hash_table_obj), INTENT(INOUT)             :: hash_table
     325             :       INTEGER(KIND=int_8), INTENT(IN)                    :: key
     326             : 
     327             :       INTEGER                                            :: islot
     328             :       LOGICAL                                            :: check_ok
     329             : 
     330           0 :       check_ok = fb_hash_table_has_data(hash_table)
     331           0 :       CPASSERT(check_ok)
     332           0 :       islot = fb_hash_table_linear_probe(hash_table, key)
     333             :       ! we are only removing an entry if the key is found
     334           0 :       IF (islot > 0) THEN
     335           0 :          IF (hash_table%obj%table(islot)%key == key) THEN
     336           0 :             hash_table%obj%table(islot)%key = EMPTY_KEY
     337           0 :             hash_table%obj%nelements = hash_table%obj%nelements - 1
     338             :             ! must rehash after setting a filled slot to empty, otherwise the
     339             :             ! table will not work. Automatic resize if required
     340           0 :             IF (hash_table%obj%nelements*REDUCE_RATIO .LT. &
     341             :                 hash_table%obj%nmax) THEN
     342             :                CALL fb_hash_table_rehash(hash_table=hash_table, &
     343           0 :                                          nmax=hash_table%obj%nmax/SHRINK_FACTOR)
     344             :             ELSE
     345           0 :                CALL fb_hash_table_rehash(hash_table=hash_table)
     346             :             END IF
     347             :          END IF
     348             :       END IF
     349           0 :    END SUBROUTINE fb_hash_table_remove
     350             : 
     351             : ! **************************************************************************************************
     352             : !> \brief outputs the current information about the table
     353             : !> \param hash_table : the fb_hash_table object in question
     354             : !> \param nelements  : number of non-empty slots in the table
     355             : !> \param nmax       : maximum number of slots in the table
     356             : !> \param prime      : the prime used in the hash function
     357             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     358             : ! **************************************************************************************************
     359           0 :    SUBROUTINE fb_hash_table_status(hash_table, nelements, nmax, prime)
     360             :       TYPE(fb_hash_table_obj), INTENT(INOUT)             :: hash_table
     361             :       INTEGER, INTENT(OUT), OPTIONAL                     :: nelements, nmax, prime
     362             : 
     363             :       LOGICAL                                            :: check_ok
     364             : 
     365           0 :       check_ok = fb_hash_table_has_data(hash_table)
     366           0 :       CPASSERT(check_ok)
     367           0 :       IF (PRESENT(nelements)) nelements = hash_table%obj%nelements
     368           0 :       IF (PRESENT(nmax)) nmax = hash_table%obj%nmax
     369           0 :       IF (PRESENT(prime)) prime = hash_table%obj%prime
     370           0 :    END SUBROUTINE fb_hash_table_status
     371             : 
     372             : ! **************************************************************************************************
     373             : !> \brief Linear probing algorithm for the hash table
     374             : !> \param hash_table : the fb_hash_table object
     375             : !> \param key        : key to locate
     376             : !> \return : slot location in the table correspond to key, 0 if key
     377             : !>                     not found
     378             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     379             : ! **************************************************************************************************
     380        8448 :    PURE FUNCTION fb_hash_table_linear_probe(hash_table, key) &
     381             :       RESULT(islot)
     382             :       TYPE(fb_hash_table_obj), INTENT(IN)                :: hash_table
     383             :       INTEGER(KIND=int_8), INTENT(IN)                    :: key
     384             :       INTEGER                                            :: islot
     385             : 
     386             :       INTEGER                                            :: guess
     387             : 
     388             : ! first guess is mapped by the hash_function
     389             : 
     390        8448 :       guess = fb_hash_table_hash_function(hash_table, key)
     391             :       ! then search for key and stop at first empty slot from guess to
     392             :       ! nmax.  using the same linear probe for adding and retrieving
     393             :       ! makes all non-empty keys being put before the first empty slot.
     394        9216 :       DO islot = guess, hash_table%obj%nmax
     395        9192 :          IF ((hash_table%obj%table(islot)%key == key) .OR. &
     396          24 :              (hash_table%obj%table(islot)%key == EMPTY_KEY)) RETURN
     397             :       END DO
     398             :       ! if unsuccessful, search from 1 to guess
     399          24 :       DO islot = 1, guess - 1
     400          24 :          IF ((hash_table%obj%table(islot)%key == key) .OR. &
     401           0 :              (hash_table%obj%table(islot)%key == EMPTY_KEY)) RETURN
     402             :       END DO
     403             :       ! if not found and table is full set islot to 0
     404        8448 :       islot = 0
     405             :    END FUNCTION fb_hash_table_linear_probe
     406             : 
     407             : ! **************************************************************************************************
     408             : !> \brief Hash function
     409             : !> \param hash_table : the fb_hash_table object
     410             : !> \param key        : key to locate
     411             : !> \return : slot location in the table correspond to key, 0 if key
     412             : !>                     not found
     413             : !> \author Lianheng Tong (LT) lianheng.tong@kcl.ac.uk
     414             : ! **************************************************************************************************
     415        8448 :    PURE FUNCTION fb_hash_table_hash_function(hash_table, key) RESULT(hash)
     416             :       TYPE(fb_hash_table_obj), INTENT(IN)                :: hash_table
     417             :       INTEGER(KIND=int_8), INTENT(IN)                    :: key
     418             :       INTEGER                                            :: hash
     419             : 
     420             :       INTEGER(KIND=int_8)                                :: hash_8, nmax_8, prime_8
     421             : 
     422        8448 :       nmax_8 = INT(hash_table%obj%nmax, int_8)
     423        8448 :       prime_8 = INT(hash_table%obj%prime, int_8)
     424             :       ! IAND with nmax-1 is equivalent to MOD nmax if nmax is alway a power of 2.
     425        8448 :       hash_8 = IAND(key*prime_8, nmax_8 - 1) + 1_int_8
     426        8448 :       hash = INT(hash_8)
     427        8448 :    END FUNCTION fb_hash_table_hash_function
     428             : 
     429           0 : END MODULE qs_fb_hash_table_types