(git:1f285aa)
qs_fb_hash_table_types.F
Go to the documentation of this file.
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
66  INTEGER :: val
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
82  INTEGER :: nmax
83  INTEGER :: prime
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  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  check_ok = fb_hash_table_has_data(hash_table)
114  cpassert(check_ok)
115  ! check hash table size, if too small rehash in a larger table
116  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  nmax=hash_table%obj%nmax*expand_factor)
120  END IF
121  ! find the right slot for the given key
122  islot = fb_hash_table_linear_probe(hash_table, key)
123  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  IF (hash_table%obj%table(islot)%key == empty_key) THEN
127  hash_table%obj%nelements = hash_table%obj%nelements + 1
128  hash_table%obj%table(islot)%key = key
129  END IF
130  hash_table%obj%table(islot)%val = val
131  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  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  check_ok = .NOT. fb_hash_table_has_data(hash_table)
149  cpassert(check_ok)
150  ALLOCATE (hash_table%obj)
151  NULLIFY (hash_table%obj%table)
152  hash_table%obj%nmax = 0
153  hash_table%obj%nelements = 0
154  hash_table%obj%prime = 2
155  my_nmax = 1
156  IF (PRESENT(nmax)) my_nmax = nmax
157  CALL fb_hash_table_init(hash_table=hash_table, &
158  nmax=my_nmax)
159 
160  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  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  check_ok = fb_hash_table_has_data(hash_table)
180  cpassert(check_ok)
181  found = .false.
182  val = 0
183  islot = fb_hash_table_linear_probe(hash_table, key)
184  IF (islot > 0) THEN
185  IF (hash_table%obj%table(islot)%key == key) THEN
186  val = hash_table%obj%table(islot)%val
187  found = .true.
188  END IF
189  END IF
190  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  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  res = ASSOCIATED(hash_table%obj)
203  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  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  check_ok = fb_hash_table_has_data(hash_table)
221  cpassert(check_ok)
222  my_nmax = hash_table%obj%nmax
223  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  power = 0
227  DO WHILE (2**power .LT. my_nmax)
228  power = power + 1
229  END DO
230  my_nmax = 2**power
231  IF (ASSOCIATED(hash_table%obj%table)) THEN
232  IF (SIZE(hash_table%obj%table) .NE. my_nmax) THEN
233  DEALLOCATE (hash_table%obj%table)
234  ALLOCATE (hash_table%obj%table(my_nmax))
235  END IF
236  ELSE
237  ALLOCATE (hash_table%obj%table(my_nmax))
238  END IF
239  hash_table%obj%nmax = my_nmax
240  hash_table%obj%prime = hash_table_matching_prime(my_nmax)
241  ! initiate element to be "empty"
242  DO ii = 1, hash_table%obj%nmax
243  hash_table%obj%table(ii)%key = empty_key
244  hash_table%obj%table(ii)%val = 0
245  END DO
246  hash_table%obj%nelements = 0
247  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  PURE SUBROUTINE fb_hash_table_nullify(hash_table)
255  TYPE(fb_hash_table_obj), INTENT(INOUT) :: hash_table
256 
257  NULLIFY (hash_table%obj)
258  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  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  DIMENSION(:) :: tmp_table
274 
275  IF (.NOT. fb_hash_table_has_data(hash_table)) THEN
276  CALL fb_hash_table_create(hash_table, nmax)
277  RETURN
278  END IF
279  IF (PRESENT(nmax)) THEN
280  my_nmax = max(nmax, hash_table%obj%nelements)
281  ELSE
282  my_nmax = hash_table%obj%nmax
283  END IF
284  ALLOCATE (tmp_table(hash_table%obj%nmax))
285  tmp_table(:) = hash_table%obj%table(:)
286  CALL fb_hash_table_release(hash_table)
287  CALL fb_hash_table_create(hash_table=hash_table, &
288  nmax=my_nmax)
289  DO ii = 1, SIZE(tmp_table)
290  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  val=tmp_table(ii)%val)
294  END IF
295  END DO
296  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  SUBROUTINE fb_hash_table_release(hash_table)
305  TYPE(fb_hash_table_obj), INTENT(INOUT) :: hash_table
306 
307  IF (ASSOCIATED(hash_table%obj)) THEN
308  IF (ASSOCIATED(hash_table%obj%table)) THEN
309  DEALLOCATE (hash_table%obj%table)
310  END IF
311  DEALLOCATE (hash_table%obj)
312  ELSE
313  NULLIFY (hash_table%obj)
314  END IF
315  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  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  check_ok = fb_hash_table_has_data(hash_table)
331  cpassert(check_ok)
332  islot = fb_hash_table_linear_probe(hash_table, key)
333  ! we are only removing an entry if the key is found
334  IF (islot > 0) THEN
335  IF (hash_table%obj%table(islot)%key == key) THEN
336  hash_table%obj%table(islot)%key = empty_key
337  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  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  nmax=hash_table%obj%nmax/shrink_factor)
344  ELSE
345  CALL fb_hash_table_rehash(hash_table=hash_table)
346  END IF
347  END IF
348  END IF
349  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  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  check_ok = fb_hash_table_has_data(hash_table)
366  cpassert(check_ok)
367  IF (PRESENT(nelements)) nelements = hash_table%obj%nelements
368  IF (PRESENT(nmax)) nmax = hash_table%obj%nmax
369  IF (PRESENT(prime)) prime = hash_table%obj%prime
370  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  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  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  DO islot = guess, hash_table%obj%nmax
395  IF ((hash_table%obj%table(islot)%key == key) .OR. &
396  (hash_table%obj%table(islot)%key == empty_key)) RETURN
397  END DO
398  ! if unsuccessful, search from 1 to guess
399  DO islot = 1, guess - 1
400  IF ((hash_table%obj%table(islot)%key == key) .OR. &
401  (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  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  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  nmax_8 = int(hash_table%obj%nmax, int_8)
423  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  hash_8 = iand(key*prime_8, nmax_8 - 1) + 1_int_8
426  hash = int(hash_8)
427  END FUNCTION fb_hash_table_hash_function
428 
429 END MODULE qs_fb_hash_table_types
hash
static unsigned int hash(const dbm_task_t task)
Private hash function based on Szudzik's elegant pairing. Using unsigned int to return a positive num...
Definition: dbm_multiply_cpu.c:57
kinds
Defines the basic variable types.
Definition: kinds.F:23
kinds::int_8
integer, parameter, public int_8
Definition: kinds.F:54
qs_fb_hash_table_types
A simple hash table of integer keys, using hash function: H(k) = (k*p) mod n + 1 where: k = key p = a...
Definition: qs_fb_hash_table_types.F:25
qs_fb_hash_table_types::fb_hash_table_has_data
pure logical function, public fb_hash_table_has_data(hash_table)
check if the object has data associated to it
Definition: qs_fb_hash_table_types.F:199
qs_fb_hash_table_types::fb_hash_table_add
recursive subroutine, public fb_hash_table_add(hash_table, key, val)
Add element to a hash table, auto resize if necessary.
Definition: qs_fb_hash_table_types.F:106
qs_fb_hash_table_types::fb_hash_table_release
subroutine, public fb_hash_table_release(hash_table)
releases given object
Definition: qs_fb_hash_table_types.F:305
qs_fb_hash_table_types::fb_hash_table_get
subroutine, public fb_hash_table_get(hash_table, key, val, found)
Retrieve value from a key from a hash table.
Definition: qs_fb_hash_table_types.F:171
qs_fb_hash_table_types::fb_hash_table_create
subroutine, public fb_hash_table_create(hash_table, nmax)
Creates and initialises an empty fb_hash_table object.
Definition: qs_fb_hash_table_types.F:142
qs_fb_hash_table_types::fb_hash_table_nullify
pure subroutine, public fb_hash_table_nullify(hash_table)
Nullifies a fb_hash_table object.
Definition: qs_fb_hash_table_types.F:255
qs_hash_table_functions
Functions which are common to different hash tables Derived from qs_fb_hash_table_types and qs_fb_has...
Definition: qs_hash_table_functions.F:12
qs_hash_table_functions::hash_table_matching_prime
pure integer function, public hash_table_matching_prime(ii)
Find a prime number equal or larger than ii.
Definition: qs_hash_table_functions.F:32