Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 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 >= &
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 < 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) /= 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 /= 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 < &
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
|
