Skip to content

Commit b9c9b91

Browse files
jvdp1jvdp1
authoredJun 20, 2022
Merge pull request #611 from wclodius2/hash_maps
Hash maps
·
v0.7.0v0.3.0
2 parents 3028a36 + bcf6aad commit b9c9b91

13 files changed

+6066
-2
lines changed
 

‎doc/specs/index.md

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ title: Specifications (specs)
44

55
# Fortran stdlib Specifications (specs)
66

7-
This is and index/directory of the specifications (specs) for each new module/feature as described in the
7+
This is an index/directory of the specifications (specs) for each new module/feature as described in the
88
[workflow document](../Workflow.html).
99

1010
[TOC]
@@ -16,7 +16,8 @@ This is and index/directory of the specifications (specs) for each new module/fe
1616
- [bitsets](./stdlib_bitsets.html) - Bitset data types and procedures
1717
- [error](./stdlib_error.html) - Catching and handling errors
1818
- [hash](./stdlib_hash_procedures.html) - Hashing integer
19-
vectors or character strings
19+
vectors or character strings
20+
- [hashmaps](./stdlib_hashmaps.html) - Hash maps/tables
2021
- [io](./stdlib_io.html) - Input/output helper & convenience
2122
- [kinds](./stdlib_kinds.html) - Kind parameters
2223
- [linalg](./stdlib_linalg.html) - Linear Algebra

‎doc/specs/stdlib_hashmaps.md

Lines changed: 2127 additions & 0 deletions
Large diffs are not rendered by default.

‎src/CMakeLists.txt

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -84,6 +84,10 @@ fypp_f90("${fyppFlags}" "${fppFiles}" outFiles)
8484
set(SRC
8585
stdlib_array.f90
8686
stdlib_error.f90
87+
stdlib_hashmap_wrappers.f90
88+
stdlib_hashmaps.f90
89+
stdlib_hashmap_chaining.f90
90+
stdlib_hashmap_open.f90
8791
stdlib_logger.f90
8892
stdlib_system.F90
8993
stdlib_specialfunctions.f90

‎src/stdlib_hashmap_chaining.f90

Lines changed: 849 additions & 0 deletions
Large diffs are not rendered by default.

‎src/stdlib_hashmap_open.f90

Lines changed: 879 additions & 0 deletions
Large diffs are not rendered by default.

‎src/stdlib_hashmap_wrappers.f90

Lines changed: 407 additions & 0 deletions
Large diffs are not rendered by default.

‎src/stdlib_hashmaps.f90

Lines changed: 811 additions & 0 deletions
Large diffs are not rendered by default.

‎src/tests/CMakeLists.txt

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ add_subdirectory(ascii)
2020
add_subdirectory(bitsets)
2121
add_subdirectory(hash_functions)
2222
add_subdirectory(hash_functions_perf)
23+
add_subdirectory(hashmaps)
2324
add_subdirectory(io)
2425
add_subdirectory(linalg)
2526
add_subdirectory(logger)

‎src/tests/hashmaps/CMakeLists.txt

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
### Pre-process: .fpp -> .f90 via Fypp
2+
3+
# Create a list of the files to be preprocessed
4+
set(fppFiles
5+
test_maps.fypp
6+
)
7+
8+
fypp_f90("${fyppFlags}" "${fppFiles}" outFiles)
9+
10+
ADDTEST(chaining_maps)
11+
ADDTEST(open_maps)
12+
ADDTEST(maps)
13+

‎src/tests/hashmaps/Makefile.manual

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
PROGS_SRC = test_chaining_maps.f90 \
2+
test_open_maps.f90
3+
4+
5+
include ../Makefile.manual.test.mk

‎src/tests/hashmaps/test_chaining_maps.f90

Lines changed: 294 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,294 @@
1+
program test_chaining_maps
2+
!! Test various aspects of the runtime system.
3+
!! Running this program may require increasing the stack size to above 48 MBytes
4+
!! or decreasing rand_power to 20 or less
5+
6+
use stdlib_kinds, only: &
7+
dp, &
8+
int8, &
9+
int32
10+
11+
use stdlib_hashmaps, only : chaining_hashmap_type, int_depth, int_index
12+
use stdlib_hashmap_wrappers
13+
14+
implicit none
15+
16+
type dummy_type
17+
integer(int8), allocatable :: value(:)
18+
end type dummy_type
19+
20+
integer(int32), parameter :: huge32 = huge(0_int32)
21+
real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp
22+
integer, parameter :: rand_power = 18
23+
integer, parameter :: rand_size = 2**rand_power
24+
integer, parameter :: test_size = rand_size*4
25+
integer, parameter :: test_16 = 2**4
26+
integer, parameter :: test_256 = 2**8
27+
28+
integer :: index
29+
integer :: lun
30+
type(chaining_hashmap_type) :: map
31+
real(dp) :: rand2(2)
32+
integer(int32) :: rand_object(rand_size)
33+
integer(int8) :: test_8_bits(test_size)
34+
35+
open( newunit=lun, file="test_chaining_maps.txt", access="sequential", &
36+
action="write", form="formatted", position="rewind" )
37+
write(lun, '("| ", a17, " | ", a12, " | ", a15, " | ", a10, " |")') &
38+
'Algorithm', 'Process', 'Data Set', 'Time (s)'
39+
40+
do index=1, rand_size
41+
call random_number(rand2)
42+
if (rand2(1) < 0.5_dp) then
43+
rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1
44+
else
45+
rand_object(index) = floor(rand2(2)*hugep1, int32)
46+
end if
47+
end do
48+
49+
test_8_bits(:) = transfer( rand_object, 0_int8, test_size )
50+
51+
call map % init( fnv_1_hasher, slots_bits=10 )
52+
call input_random_data( map, test_16, 'FNV-1', "16 byte words" )
53+
call test_inquire_data( map, test_16, 'FNV-1', "16 byte words" )
54+
call test_get_data( map, test_16, 'FNV-1', '16 byte words' )
55+
call report_rehash_times( map, fnv_1_hasher, 'FNV-1', '16 byte words' )
56+
call report_hash_statistics( map, 'FNV-1', '16 byte words' )
57+
call report_removal_times( map, test_16, 'FNV-1', '16 byte words' )
58+
59+
call map % init( fnv_1_hasher, slots_bits=10 )
60+
call input_random_data( map, test_256, 'FNV-1', "256 byte words" )
61+
call test_inquire_data( map, test_256, 'FNV-1', "256 byte words" )
62+
call test_get_data( map, test_256, 'FNV-1', '256 byte words' )
63+
call report_rehash_times( map, fnv_1_hasher, 'FNV-1', '256 byte words' )
64+
call report_hash_statistics( map, 'FNV-1', '256 byte words' )
65+
call report_removal_times( map, test_256, 'FNV-1', '256 byte words' )
66+
67+
call map % init( fnv_1a_hasher, slots_bits=10 )
68+
call input_random_data( map, test_16, 'FNV-1A', "16 byte words" )
69+
call test_inquire_data( map, test_16, 'FNV-1A', "16 byte words" )
70+
call test_get_data( map, test_16, 'FNV-1A', '16 byte words' )
71+
call report_rehash_times( map, fnv_1a_hasher, 'FNV-1', '16 byte words' )
72+
call report_hash_statistics( map, 'FNV-1A', '16 byte words' )
73+
call report_removal_times( map, test_16, 'FNV-1a', '16 byte words' )
74+
75+
call map % init( fnv_1a_hasher, slots_bits=10 )
76+
call input_random_data( map, test_256, 'FNV-1A', "256 byte words" )
77+
call test_inquire_data( map, test_256, 'FNV-1A', "256 byte words" )
78+
call test_get_data( map, test_256, 'FNV-1A', '256 byte words' )
79+
call report_rehash_times( map, fnv_1_hasher, 'FNV-1A', '256 byte words' )
80+
call report_hash_statistics( map, 'FNV-1A', '256 byte words' )
81+
call report_removal_times( map, test_256, 'FNV-1A', '256 byte words' )
82+
83+
call map % init( seeded_nmhash32_hasher, slots_bits=10 )
84+
call input_random_data( map, test_16, 'Seeded_Nmhash32', "16 byte words" )
85+
call test_inquire_data( map, test_16, 'Seeded_Nmhash32', "16 byte words" )
86+
call test_get_data( map, test_16, 'Seeded_Nmhash32', '16 byte words' )
87+
call report_rehash_times( map, seeded_nmhash32_hasher, 'Seeded_Nmhash32', &
88+
'16 byte words' )
89+
call report_hash_statistics( map, 'Seeded_Nmhash32', '16 byte words' )
90+
call report_removal_times( map, test_16, 'Seeded_Nmhash32', &
91+
'16 byte words' )
92+
93+
call map % init( seeded_nmhash32_hasher, slots_bits=10 )
94+
call input_random_data( map, test_256, 'Seeded_Nmhash32', "256 byte words" )
95+
call test_inquire_data( map, test_256, 'Seeded_Nmhash32', "256 byte words" )
96+
call test_get_data( map, test_256, 'Seeded_Nmhash32', '256 byte words' )
97+
call report_rehash_times( map, seeded_nmhash32_hasher, 'Seeded_Nmhash32', &
98+
'256 byte words' )
99+
call report_hash_statistics( map, 'Seeded_Nmhash32', '256 byte words' )
100+
call report_removal_times( map, test_256, 'Seeded_Nmhash32', &
101+
'256 byte words' )
102+
103+
call map % init( seeded_nmhash32x_hasher, slots_bits=10 )
104+
call input_random_data( map, test_16, 'Seeded_Nmhash32x', "16 byte words" )
105+
call test_inquire_data( map, test_16, 'Seeded_Nmhash32x', "16 byte words" )
106+
call test_get_data( map, test_16, 'Seeded_Nmhash32x', '16 byte words' )
107+
call report_rehash_times( map, seeded_nmhash32x_hasher, &
108+
'Seeded_Nmhash32x', '16 byte words' )
109+
call report_hash_statistics( map, 'Seeded_Nmhash32x', '16 byte words' )
110+
call report_removal_times( map, test_16, 'Seeded_Nmhash32x', &
111+
'16 byte words' )
112+
113+
call map % init( seeded_nmhash32x_hasher, slots_bits=10 )
114+
call input_random_data( map, test_256, 'Seeded_Nmhash32x', &
115+
"256 byte words" )
116+
call test_inquire_data( map, test_256, 'Seeded_Nmhash32x', &
117+
"256 byte words" )
118+
call test_get_data( map, test_256, 'Seeded_Nmhash32x', '256 byte words' )
119+
call report_rehash_times( map, seeded_nmhash32x_hasher, &
120+
'Seeded_Nmhash32x', '256 byte words' )
121+
call report_hash_statistics( map, 'Seeded_Nmhash32x', '256 byte words' )
122+
call report_removal_times( map, test_256, 'Seeded_Nmhash32x', &
123+
'256 byte words' )
124+
125+
call map % init( seeded_water_hasher, slots_bits=10 )
126+
call input_random_data( map, test_16, 'Seeded_Water', "16 byte words" )
127+
call test_inquire_data( map, test_16, 'Seeded_Water', "16 byte words" )
128+
call test_get_data( map, test_16, 'Seeded_Water', '16 byte words' )
129+
call report_rehash_times( map, seeded_water_hasher, &
130+
'Seeded_Water', '16 byte words' )
131+
call report_hash_statistics( map, 'Seeded_Water', '16 byte words' )
132+
call report_removal_times( map, test_16, 'Seeded_Water', &
133+
'16 byte words' )
134+
135+
call map % init( seeded_water_hasher, slots_bits=10 )
136+
call input_random_data( map, test_256, 'Seeded_Water', &
137+
"256 byte words" )
138+
call test_inquire_data( map, test_256, 'Seeded_Water', &
139+
"256 byte words" )
140+
call test_get_data( map, test_256, 'Seeded_Water', '256 byte words' )
141+
call report_rehash_times( map, seeded_water_hasher, &
142+
'Seeded_Water', '256 byte words' )
143+
call report_hash_statistics( map, 'Seeded_Water', '256 byte words' )
144+
call report_removal_times( map, test_256, 'Seeded_Water', &
145+
'256 byte words' )
146+
147+
contains
148+
149+
subroutine input_random_data( map, test_block, hash_name, size_name )
150+
type(chaining_hashmap_type), intent(inout) :: map
151+
integer(int_index), intent(in) :: test_block
152+
character(*), intent(in) :: hash_name
153+
character(*), intent(in) :: size_name
154+
class(*), allocatable :: dummy
155+
type(dummy_type) :: dummy_val
156+
integer :: index2
157+
type(key_type) :: key
158+
type(other_type) :: other
159+
real :: t1, t2, tdiff
160+
logical :: conflict
161+
162+
call cpu_time(t1)
163+
do index2=1, size(test_8_bits), test_block
164+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
165+
if (allocated(dummy)) deallocate(dummy)
166+
dummy_val % value = test_8_bits( index2:index2+test_block-1 )
167+
allocate( dummy, source=dummy_val )
168+
call set ( other, dummy )
169+
call map % map_entry( key, other, conflict )
170+
if (conflict) &
171+
error stop "Unable to map entry because of a key conflict."
172+
end do
173+
call cpu_time(t2)
174+
tdiff = t2-t1
175+
write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
176+
trim(hash_name), 'Enter data', size_name, tdiff
177+
178+
end subroutine input_random_data
179+
180+
181+
subroutine test_inquire_data( map, test_block, hash_name, size_name )
182+
type(chaining_hashmap_type), intent(inout) :: map
183+
integer(int_index), intent(in) :: test_block
184+
character(*), intent(in) :: hash_name, size_name
185+
integer :: index2
186+
logical :: present
187+
type(key_type) :: key
188+
real :: t1, t2, tdiff
189+
190+
call cpu_time(t1)
191+
do index2=1, size(test_8_bits), test_block
192+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
193+
call map % key_test( key, present )
194+
if (.not. present) &
195+
error stop "KEY not found in map KEY_TEST."
196+
end do
197+
call cpu_time(t2)
198+
tdiff = t2-t1
199+
write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
200+
trim(hash_name), 'Inquire data', size_name, tdiff
201+
202+
end subroutine test_inquire_data
203+
204+
205+
subroutine test_get_data( map, test_block, hash_name, size_name )
206+
type(chaining_hashmap_type), intent(inout) :: map
207+
integer(int_index), intent(in) :: test_block
208+
character(*), intent(in) :: hash_name, size_name
209+
integer :: index2
210+
type(key_type) :: key
211+
type(other_type) :: other
212+
logical :: exists
213+
real :: t1, t2, tdiff
214+
215+
call cpu_time(t1)
216+
do index2=1, size(test_8_bits), test_block
217+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
218+
call map % get_other_data( key, other, exists )
219+
if (.not. exists) &
220+
error stop "Unable to get data because key not found in map."
221+
end do
222+
call cpu_time(t2)
223+
tdiff = t2-t1
224+
write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
225+
trim(hash_name), 'Get data', size_name, tdiff
226+
227+
end subroutine test_get_data
228+
229+
230+
subroutine report_rehash_times( map, hasher, hash_name, size_name )
231+
type(chaining_hashmap_type), intent(inout) :: map
232+
procedure(hasher_fun) :: hasher
233+
character(*), intent(in) :: hash_name, size_name
234+
real :: t1, t2, tdiff
235+
236+
call cpu_time(t1)
237+
call map % rehash( hasher )
238+
call cpu_time(t2)
239+
tdiff = t2-t1
240+
241+
write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
242+
trim(hash_name), 'Rehash data', size_name, tdiff
243+
244+
end subroutine report_rehash_times
245+
246+
247+
subroutine report_removal_times( map, test_block, hash_name, size_name )
248+
type(chaining_hashmap_type), intent(inout) :: map
249+
integer(int_index), intent(in) :: test_block
250+
character(*), intent(in) :: hash_name, size_name
251+
real :: t1, t2, tdiff
252+
type(key_type) :: key
253+
integer(int_index) :: index2
254+
logical :: existed
255+
256+
call cpu_time(t1)
257+
do index2=1, size(test_8_bits), test_block
258+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
259+
call map % remove(key, existed)
260+
if ( .not. existed ) &
261+
error stop "Key not found in entry removal."
262+
end do
263+
call cpu_time(t2)
264+
tdiff = t2-t1
265+
266+
write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
267+
trim(hash_name), 'Remove data', size_name, tdiff
268+
flush(lun)
269+
270+
end subroutine report_removal_times
271+
272+
273+
subroutine report_hash_statistics( map, hash_name, size_name )
274+
type(chaining_hashmap_type), intent(inout) :: map
275+
character(*), intent(in) :: hash_name, size_name
276+
integer(int_depth) :: depth
277+
278+
write(lun, *)
279+
write(lun, '("Statistics for chaining hash table with ",' // &
280+
'A, " hasher on ", A, ".")' ) hash_name, size_name
281+
write(lun, '("Slots = ", I0)' ) map % num_slots()
282+
write(lun, '("Calls = ", I0)' ) map % calls()
283+
write(lun, '("Entries = ", I0)' ) map % entries()
284+
write(lun, '("Total probes = ", I0)' ) map % map_probes()
285+
write(lun, '("Loading = ", ES10.3)' ) map % loading()
286+
depth = map % total_depth()
287+
write(lun, '("Total depth = ", I0)' ) depth
288+
write(lun, '("Relative depth = ", ES10.3)') &
289+
real( depth ) / real( map % entries() )
290+
291+
end subroutine report_hash_statistics
292+
293+
294+
end program test_chaining_maps

‎src/tests/hashmaps/test_maps.fypp

Lines changed: 378 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,378 @@
1+
#:set HASH_NAME = ["fnv_1_hasher", "fnv_1a_hasher", "seeded_nmhash32_hasher", "seeded_nmhash32x_hasher", "seeded_water_hasher"]
2+
#:set SIZE_NAME = ["16", "256"]
3+
module test_stdlib_chaining_maps
4+
!! Test various aspects of the runtime system.
5+
!! Running this program may require increasing the stack size to above 48 MBytes
6+
!! or decreasing rand_power to 20 or less
7+
use testdrive, only : new_unittest, unittest_type, error_type, check
8+
use :: stdlib_kinds, only : dp, int8, int32
9+
use stdlib_hashmaps, only : chaining_hashmap_type, int_depth, int_index
10+
use stdlib_hashmap_wrappers
11+
12+
implicit none
13+
private
14+
15+
type dummy_type
16+
integer(int8), allocatable :: value(:)
17+
end type dummy_type
18+
19+
integer(int32), parameter :: huge32 = huge(0_int32)
20+
real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp
21+
integer, parameter :: rand_power = 18
22+
integer, parameter :: rand_size = 2**rand_power
23+
integer, parameter :: test_size = rand_size*4
24+
integer, parameter :: test_16 = 2**4
25+
integer, parameter :: test_256 = 2**8
26+
27+
public :: collect_stdlib_chaining_maps
28+
29+
contains
30+
31+
!> Collect all exported unit tests
32+
subroutine collect_stdlib_chaining_maps(testsuite)
33+
!> Collection of tests
34+
type(unittest_type), allocatable, intent(out) :: testsuite(:)
35+
36+
testsuite = [ &
37+
new_unittest("chaining-maps-fnv_1_hasher-16-byte-words", test_fnv_1_hasher_16_byte_words) &
38+
#:for hash_ in HASH_NAME
39+
#:for size_ in SIZE_NAME
40+
, new_unittest("chaining-maps-${hash_}$-${size_}$-byte-words", test_${hash_}$_${size_}$_byte_words) &
41+
#:endfor
42+
#:endfor
43+
]
44+
45+
end subroutine collect_stdlib_chaining_maps
46+
47+
#:for hash_ in HASH_NAME
48+
#:for size_ in SIZE_NAME
49+
subroutine test_${hash_}$_${size_}$_byte_words(error)
50+
!> Error handling
51+
type(error_type), allocatable, intent(out) :: error
52+
53+
type(chaining_hashmap_type) :: map
54+
integer(int8) :: test_8_bits(test_size)
55+
56+
call generate_vector(test_8_bits)
57+
58+
call map % init( ${hash_}$, slots_bits=10 )
59+
60+
call test_input_random_data(error, map, test_8_bits, test_${size_}$)
61+
if (allocated(error)) return
62+
63+
call test_inquire_data(error, map, test_8_bits, test_${size_}$)
64+
if (allocated(error)) return
65+
66+
call test_get_data(error, map, test_8_bits, test_${size_}$)
67+
if (allocated(error)) return
68+
69+
call test_removal(error, map, test_8_bits, test_${size_}$)
70+
if (allocated(error)) return
71+
72+
end subroutine
73+
#:endfor
74+
#:endfor
75+
76+
77+
subroutine generate_vector(test_8_bits)
78+
integer(int8), intent(out) :: test_8_bits(test_size)
79+
80+
integer :: index
81+
real(dp) :: rand2(2)
82+
integer(int32) :: rand_object(rand_size)
83+
84+
do index=1, rand_size
85+
call random_number(rand2)
86+
if (rand2(1) < 0.5_dp) then
87+
rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1
88+
else
89+
rand_object(index) = floor(rand2(2)*hugep1, int32)
90+
end if
91+
end do
92+
93+
test_8_bits(:) = transfer( rand_object, 0_int8, test_size )
94+
95+
end subroutine
96+
97+
subroutine test_input_random_data(error, map, test_8_bits, test_block)
98+
type(error_type), allocatable, intent(out) :: error
99+
type(chaining_hashmap_type), intent(inout) :: map
100+
integer(int8), intent(in) :: test_8_bits(test_size)
101+
integer(int_index), intent(in) :: test_block
102+
class(*), allocatable :: dummy
103+
type(dummy_type) :: dummy_val
104+
integer :: index2
105+
type(key_type) :: key
106+
type(other_type) :: other
107+
logical :: conflict
108+
109+
do index2=1, size(test_8_bits), test_block
110+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
111+
if (allocated(dummy)) deallocate(dummy)
112+
dummy_val % value = test_8_bits( index2:index2+test_block-1 )
113+
allocate( dummy, source=dummy_val )
114+
call set ( other, dummy )
115+
call map % map_entry( key, other, conflict )
116+
call check(error, .not.conflict, "Unable to map entry because of a key conflict.")
117+
if (allocated(error)) return
118+
end do
119+
120+
end subroutine
121+
122+
subroutine test_inquire_data(error, map, test_8_bits, test_block)
123+
type(error_type), allocatable, intent(out) :: error
124+
type(chaining_hashmap_type), intent(inout) :: map
125+
integer(int8), intent(in) :: test_8_bits(test_size)
126+
integer(int_index), intent(in) :: test_block
127+
integer :: index2
128+
logical :: present
129+
type(key_type) :: key
130+
131+
do index2=1, size(test_8_bits), test_block
132+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
133+
call map % key_test( key, present )
134+
call check(error, present, "KEY not found in map KEY_TEST.")
135+
if (allocated(error)) return
136+
end do
137+
138+
end subroutine
139+
140+
subroutine test_get_data(error, map, test_8_bits, test_block)
141+
type(error_type), allocatable, intent(out) :: error
142+
type(chaining_hashmap_type), intent(inout) :: map
143+
integer(int8), intent(in) :: test_8_bits(test_size)
144+
integer(int_index), intent(in) :: test_block
145+
integer :: index2
146+
type(key_type) :: key
147+
type(other_type) :: other
148+
logical :: exists
149+
150+
do index2=1, size(test_8_bits), test_block
151+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
152+
call map % get_other_data( key, other, exists )
153+
call check(error, exists, "Unable to get data because key not found in map.")
154+
end do
155+
156+
end subroutine
157+
158+
subroutine test_removal(error, map, test_8_bits, test_block)
159+
type(error_type), allocatable, intent(out) :: error
160+
type(chaining_hashmap_type), intent(inout) :: map
161+
integer(int8), intent(in) :: test_8_bits(test_size)
162+
integer(int_index), intent(in) :: test_block
163+
type(key_type) :: key
164+
integer(int_index) :: index2
165+
logical :: existed
166+
167+
do index2=1, size(test_8_bits), test_block
168+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
169+
call map % remove(key, existed)
170+
call check(error, existed, "Key not found in entry removal.")
171+
end do
172+
173+
end subroutine
174+
175+
end module
176+
177+
module test_stdlib_open_maps
178+
!! Test various aspects of the runtime system.
179+
!! Running this program may require increasing the stack size to above 48 MBytes
180+
!! or decreasing rand_power to 20 or less
181+
use testdrive, only : new_unittest, unittest_type, error_type, check
182+
use :: stdlib_kinds, only : dp, int8, int32
183+
use stdlib_hashmaps, only : open_hashmap_type, int_depth, int_index
184+
use stdlib_hashmap_wrappers
185+
186+
implicit none
187+
private
188+
189+
type dummy_type
190+
integer(int8), allocatable :: value(:)
191+
end type dummy_type
192+
193+
integer(int32), parameter :: huge32 = huge(0_int32)
194+
real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp
195+
integer, parameter :: rand_power = 18
196+
integer, parameter :: rand_size = 2**rand_power
197+
integer, parameter :: test_size = rand_size*4
198+
integer, parameter :: test_16 = 2**4
199+
integer, parameter :: test_256 = 2**8
200+
201+
public :: collect_stdlib_open_maps
202+
203+
contains
204+
205+
!> Collect all exported unit tests
206+
subroutine collect_stdlib_open_maps(testsuite)
207+
!> Collection of tests
208+
type(unittest_type), allocatable, intent(out) :: testsuite(:)
209+
210+
testsuite = [ &
211+
new_unittest("open-maps-fnv_1_hasher-16-byte-words", test_fnv_1_hasher_16_byte_words) &
212+
#:for hash_ in HASH_NAME
213+
#:for size_ in SIZE_NAME
214+
, new_unittest("open-maps-${hash_}$-${size_}$-byte-words", test_${hash_}$_${size_}$_byte_words) &
215+
#:endfor
216+
#:endfor
217+
]
218+
219+
end subroutine collect_stdlib_open_maps
220+
221+
#:for hash_ in HASH_NAME
222+
#:for size_ in SIZE_NAME
223+
subroutine test_${hash_}$_${size_}$_byte_words(error)
224+
!> Error handling
225+
type(error_type), allocatable, intent(out) :: error
226+
227+
type(open_hashmap_type) :: map
228+
integer(int8) :: test_8_bits(test_size)
229+
230+
call generate_vector(test_8_bits)
231+
232+
call map % init( ${hash_}$, slots_bits=10 )
233+
234+
call test_input_random_data(error, map, test_8_bits, test_${size_}$)
235+
if (allocated(error)) return
236+
237+
call test_inquire_data(error, map, test_8_bits, test_${size_}$)
238+
if (allocated(error)) return
239+
240+
call test_get_data(error, map, test_8_bits, test_${size_}$)
241+
if (allocated(error)) return
242+
243+
call test_removal(error, map, test_8_bits, test_${size_}$)
244+
if (allocated(error)) return
245+
246+
end subroutine
247+
#:endfor
248+
#:endfor
249+
250+
251+
subroutine generate_vector(test_8_bits)
252+
integer(int8), intent(out) :: test_8_bits(test_size)
253+
254+
integer :: index
255+
real(dp) :: rand2(2)
256+
integer(int32) :: rand_object(rand_size)
257+
258+
do index=1, rand_size
259+
call random_number(rand2)
260+
if (rand2(1) < 0.5_dp) then
261+
rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1
262+
else
263+
rand_object(index) = floor(rand2(2)*hugep1, int32)
264+
end if
265+
end do
266+
267+
test_8_bits(:) = transfer( rand_object, 0_int8, test_size )
268+
269+
end subroutine
270+
271+
subroutine test_input_random_data(error, map, test_8_bits, test_block)
272+
type(error_type), allocatable, intent(out) :: error
273+
type(open_hashmap_type), intent(inout) :: map
274+
integer(int8), intent(in) :: test_8_bits(test_size)
275+
integer(int_index), intent(in) :: test_block
276+
class(*), allocatable :: dummy
277+
type(dummy_type) :: dummy_val
278+
integer :: index2
279+
type(key_type) :: key
280+
type(other_type) :: other
281+
logical :: conflict
282+
283+
do index2=1, size(test_8_bits), test_block
284+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
285+
if (allocated(dummy)) deallocate(dummy)
286+
dummy_val % value = test_8_bits( index2:index2+test_block-1 )
287+
allocate( dummy, source=dummy_val )
288+
call set ( other, dummy )
289+
call map % map_entry( key, other, conflict )
290+
call check(error, .not.conflict, "Unable to map entry because of a key conflict.")
291+
if (allocated(error)) return
292+
end do
293+
294+
end subroutine
295+
296+
subroutine test_inquire_data(error, map, test_8_bits, test_block)
297+
type(error_type), allocatable, intent(out) :: error
298+
type(open_hashmap_type), intent(inout) :: map
299+
integer(int8), intent(in) :: test_8_bits(test_size)
300+
integer(int_index), intent(in) :: test_block
301+
integer :: index2
302+
logical :: present
303+
type(key_type) :: key
304+
305+
do index2=1, size(test_8_bits), test_block
306+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
307+
call map % key_test( key, present )
308+
call check(error, present, "KEY not found in map KEY_TEST.")
309+
if (allocated(error)) return
310+
end do
311+
312+
end subroutine
313+
314+
subroutine test_get_data(error, map, test_8_bits, test_block)
315+
type(error_type), allocatable, intent(out) :: error
316+
type(open_hashmap_type), intent(inout) :: map
317+
integer(int8), intent(in) :: test_8_bits(test_size)
318+
integer(int_index), intent(in) :: test_block
319+
integer :: index2
320+
type(key_type) :: key
321+
type(other_type) :: other
322+
logical :: exists
323+
324+
do index2=1, size(test_8_bits), test_block
325+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
326+
call map % get_other_data( key, other, exists )
327+
call check(error, exists, "Unable to get data because key not found in map.")
328+
end do
329+
330+
end subroutine
331+
332+
subroutine test_removal(error, map, test_8_bits, test_block)
333+
type(error_type), allocatable, intent(out) :: error
334+
type(open_hashmap_type), intent(inout) :: map
335+
integer(int8), intent(in) :: test_8_bits(test_size)
336+
integer(int_index), intent(in) :: test_block
337+
type(key_type) :: key
338+
integer(int_index) :: index2
339+
logical :: existed
340+
341+
do index2=1, size(test_8_bits), test_block
342+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
343+
call map % remove(key, existed)
344+
call check(error, existed, "Key not found in entry removal.")
345+
end do
346+
347+
end subroutine
348+
349+
end module
350+
351+
352+
program tester
353+
use, intrinsic :: iso_fortran_env, only : error_unit
354+
use testdrive, only : run_testsuite, new_testsuite, testsuite_type
355+
use test_stdlib_open_maps, only : collect_stdlib_open_maps
356+
use test_stdlib_chaining_maps, only : collect_stdlib_chaining_maps
357+
implicit none
358+
integer :: stat, is
359+
type(testsuite_type), allocatable :: testsuites(:)
360+
character(len=*), parameter :: fmt = '("#", *(1x, a))'
361+
362+
stat = 0
363+
364+
testsuites = [ &
365+
new_testsuite("stdlib-open-maps", collect_stdlib_open_maps) &
366+
, new_testsuite("stdlib-chaining-maps", collect_stdlib_chaining_maps) &
367+
]
368+
369+
do is = 1, size(testsuites)
370+
write(error_unit, fmt) "Testing:", testsuites(is)%name
371+
call run_testsuite(testsuites(is)%collect, error_unit, stat)
372+
end do
373+
374+
if (stat > 0) then
375+
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
376+
error stop
377+
end if
378+
end program

‎src/tests/hashmaps/test_open_maps.f90

Lines changed: 295 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,295 @@
1+
program test_open_maps
2+
!! Test various aspects of the runtime system.
3+
!! Running this program may require increasing the stack size to above 48 MBytes
4+
!! or decreasing rand_power to 20 or less
5+
6+
use stdlib_kinds, only: &
7+
dp, &
8+
int8, &
9+
int32
10+
11+
use stdlib_hashmaps, only : open_hashmap_type, int_depth, int_index
12+
use stdlib_hashmap_wrappers
13+
14+
implicit none
15+
16+
type dummy_type
17+
integer(int8), allocatable :: value(:)
18+
end type dummy_type
19+
20+
integer(int32), parameter :: huge32 = huge(0_int32)
21+
real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp
22+
integer, parameter :: rand_power = 18
23+
integer, parameter :: rand_size = 2**rand_power
24+
integer, parameter :: test_size = rand_size*4
25+
integer, parameter :: test_16 = 2**4
26+
integer, parameter :: test_256 = 2**8
27+
28+
integer :: index
29+
integer :: lun
30+
type(open_hashmap_type) :: map
31+
real(dp) :: rand2(2)
32+
integer(int32) :: rand_object(rand_size)
33+
integer(int8) :: test_8_bits(test_size)
34+
35+
36+
open( newunit=lun, file="test_open_maps.txt", access="sequential", &
37+
action="write", form="formatted", position="rewind" )
38+
write(lun, '("| ", a17, " | ", a12, " | ", a15, " | ", a10, " |")') &
39+
'Algorithm', 'Process', 'Data Set', 'Time (s)'
40+
41+
do index=1, rand_size
42+
call random_number(rand2)
43+
if (rand2(1) < 0.5_dp) then
44+
rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1
45+
else
46+
rand_object(index) = floor(rand2(2)*hugep1, int32)
47+
end if
48+
end do
49+
50+
test_8_bits(:) = transfer( rand_object, 0_int8, test_size )
51+
52+
call map % init( fnv_1_hasher, slots_bits=10 )
53+
call input_random_data( map, test_16, 'FNV-1', "16 byte words" )
54+
call test_inquire_data( map, test_16, 'FNV-1', "16 byte words" )
55+
call test_get_data( map, test_16, 'FNV-1', '16 byte words' )
56+
call report_rehash_times( map, fnv_1_hasher, 'FNV-1', '16 byte words' )
57+
call report_hash_statistics( map, 'FNV-1', '16 byte words' )
58+
call report_removal_times( map, test_16, 'FNV-1', '16 byte words' )
59+
60+
call map % init( fnv_1_hasher, slots_bits=10 )
61+
call input_random_data( map, test_256, 'FNV-1', "256 byte words" )
62+
call test_inquire_data( map, test_256, 'FNV-1', "256 byte words" )
63+
call test_get_data( map, test_256, 'FNV-1', '256 byte words' )
64+
call report_rehash_times( map, fnv_1_hasher, 'FNV-1', '256 byte words' )
65+
call report_hash_statistics( map, 'FNV-1', '256 byte words' )
66+
call report_removal_times( map, test_256, 'FNV-1', '256 byte words' )
67+
68+
call map % init( fnv_1a_hasher, slots_bits=10 )
69+
call input_random_data( map, test_16, 'FNV-1A', "16 byte words" )
70+
call test_inquire_data( map, test_16, 'FNV-1A', "16 byte words" )
71+
call test_get_data( map, test_16, 'FNV-1A', '16 byte words' )
72+
call report_rehash_times( map, fnv_1a_hasher, 'FNV-1', '16 byte words' )
73+
call report_hash_statistics( map, 'FNV-1A', '16 byte words' )
74+
call report_removal_times( map, test_16, 'FNV-1a', '16 byte words' )
75+
76+
call map % init( fnv_1a_hasher, slots_bits=10 )
77+
call input_random_data( map, test_256, 'FNV-1A', "256 byte words" )
78+
call test_inquire_data( map, test_256, 'FNV-1A', "256 byte words" )
79+
call test_get_data( map, test_256, 'FNV-1A', '256 byte words' )
80+
call report_rehash_times( map, fnv_1_hasher, 'FNV-1A', '256 byte words' )
81+
call report_hash_statistics( map, 'FNV-1A', '256 byte words' )
82+
call report_removal_times( map, test_256, 'FNV-1A', '256 byte words' )
83+
84+
call map % init( seeded_nmhash32_hasher, slots_bits=10 )
85+
call input_random_data( map, test_16, 'Seeded_Nmhash32', "16 byte words" )
86+
call test_inquire_data( map, test_16, 'Seeded_Nmhash32', "16 byte words" )
87+
call test_get_data( map, test_16, 'Seeded_Nmhash32', '16 byte words' )
88+
call report_rehash_times( map, seeded_nmhash32_hasher, 'Seeded_Nmhash32', &
89+
'16 byte words' )
90+
call report_hash_statistics( map, 'Seeded_Nmhash32', '16 byte words' )
91+
call report_removal_times( map, test_16, 'Seeded_Nmhash32', &
92+
'16 byte words' )
93+
94+
call map % init( seeded_nmhash32_hasher, slots_bits=10 )
95+
call input_random_data( map, test_256, 'Seeded_Nmhash32', "256 byte words" )
96+
call test_inquire_data( map, test_256, 'Seeded_Nmhash32', "256 byte words" )
97+
call test_get_data( map, test_256, 'Seeded_Nmhash32', '256 byte words' )
98+
call report_rehash_times( map, seeded_nmhash32_hasher, 'Seeded_Nmhash32', &
99+
'256 byte words' )
100+
call report_hash_statistics( map, 'Seeded_Nmhash32', '256 byte words' )
101+
call report_removal_times( map, test_256, 'Seeded_Nmhash32', &
102+
'256 byte words' )
103+
104+
call map % init( seeded_nmhash32x_hasher, slots_bits=10 )
105+
call input_random_data( map, test_16, 'Seeded_Nmhash32x', "16 byte words" )
106+
call test_inquire_data( map, test_16, 'Seeded_Nmhash32x', "16 byte words" )
107+
call test_get_data( map, test_16, 'Seeded_Nmhash32x', '16 byte words' )
108+
call report_rehash_times( map, seeded_nmhash32x_hasher, &
109+
'Seeded_Nmhash32x', '16 byte words' )
110+
call report_hash_statistics( map, 'Seeded_Nmhash32x', '16 byte words' )
111+
call report_removal_times( map, test_16, 'Seeded_Nmhash32x', &
112+
'16 byte words' )
113+
114+
call map % init( seeded_nmhash32x_hasher, slots_bits=10 )
115+
call input_random_data( map, test_256, 'Seeded_Nmhash32x', &
116+
"256 byte words" )
117+
call test_inquire_data( map, test_256, 'Seeded_Nmhash32x', &
118+
"256 byte words" )
119+
call test_get_data( map, test_256, 'Seeded_Nmhash32x', '256 byte words' )
120+
call report_rehash_times( map, seeded_nmhash32x_hasher, &
121+
'Seeded_Nmhash32x', '256 byte words' )
122+
call report_hash_statistics( map, 'Seeded_Nmhash32x', '256 byte words' )
123+
call report_removal_times( map, test_256, 'Seeded_Nmhash32x', &
124+
'256 byte words' )
125+
126+
call map % init( seeded_water_hasher, slots_bits=10 )
127+
call input_random_data( map, test_16, 'Seeded_Water', "16 byte words" )
128+
call test_inquire_data( map, test_16, 'Seeded_Water', "16 byte words" )
129+
call test_get_data( map, test_16, 'Seeded_Water', '16 byte words' )
130+
call report_rehash_times( map, seeded_water_hasher, &
131+
'Seeded_Water', '16 byte words' )
132+
call report_hash_statistics( map, 'Seeded_Water', '16 byte words' )
133+
call report_removal_times( map, test_16, 'Seeded_Water', &
134+
'16 byte words' )
135+
136+
call map % init( seeded_water_hasher, slots_bits=10 )
137+
call input_random_data( map, test_256, 'Seeded_Water', &
138+
"256 byte words" )
139+
call test_inquire_data( map, test_256, 'Seeded_Water', &
140+
"256 byte words" )
141+
call test_get_data( map, test_256, 'Seeded_Water', '256 byte words' )
142+
call report_rehash_times( map, seeded_water_hasher, &
143+
'Seeded_Water', '256 byte words' )
144+
call report_hash_statistics( map, 'Seeded_Water', '256 byte words' )
145+
call report_removal_times( map, test_256, 'Seeded_Water', &
146+
'256 byte words' )
147+
148+
contains
149+
150+
subroutine input_random_data( map, test_block, hash_name, size_name )
151+
type(open_hashmap_type), intent(inout) :: map
152+
integer(int_index), intent(in) :: test_block
153+
character(*), intent(in) :: hash_name
154+
character(*), intent(in) :: size_name
155+
class(*), allocatable :: dummy
156+
type(dummy_type) :: dummy_val
157+
integer :: index2
158+
type(key_type) :: key
159+
type(other_type) :: other
160+
real :: t1, t2, tdiff
161+
logical :: conflict
162+
163+
call cpu_time(t1)
164+
do index2=1, size(test_8_bits), test_block
165+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
166+
if (allocated(dummy)) deallocate(dummy)
167+
dummy_val % value = test_8_bits( index2:index2+test_block-1 )
168+
allocate( dummy, source=dummy_val )
169+
call set ( other, dummy )
170+
call map % map_entry( key, other, conflict )
171+
if (conflict) &
172+
error stop "Unable to map entry because of a key conflict."
173+
end do
174+
call cpu_time(t2)
175+
tdiff = t2-t1
176+
write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
177+
trim(hash_name), 'Enter data', size_name, tdiff
178+
179+
end subroutine input_random_data
180+
181+
182+
subroutine test_inquire_data( map, test_block, hash_name, size_name )
183+
type(open_hashmap_type), intent(inout) :: map
184+
integer(int_index), intent(in) :: test_block
185+
character(*), intent(in) :: hash_name, size_name
186+
integer :: index2
187+
logical :: present
188+
type(key_type) :: key
189+
real :: t1, t2, tdiff
190+
191+
call cpu_time(t1)
192+
do index2=1, size(test_8_bits), test_block
193+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
194+
call map % key_test( key, present )
195+
if (.not. present) &
196+
error stop "KEY not found in map KEY_TEST."
197+
end do
198+
call cpu_time(t2)
199+
tdiff = t2-t1
200+
write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
201+
trim(hash_name), 'Inquire data', size_name, tdiff
202+
203+
end subroutine test_inquire_data
204+
205+
206+
subroutine test_get_data( map, test_block, hash_name, size_name )
207+
type(open_hashmap_type), intent(inout) :: map
208+
integer(int_index), intent(in) :: test_block
209+
character(*), intent(in) :: hash_name, size_name
210+
integer :: index2
211+
type(key_type) :: key
212+
type(other_type) :: other
213+
logical :: exists
214+
real :: t1, t2, tdiff
215+
216+
call cpu_time(t1)
217+
do index2=1, size(test_8_bits), test_block
218+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
219+
call map % get_other_data( key, other, exists )
220+
if (.not. exists) &
221+
error stop "Unable to get data because key not found in map."
222+
end do
223+
call cpu_time(t2)
224+
tdiff = t2-t1
225+
write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
226+
trim(hash_name), 'Get data', size_name, tdiff
227+
228+
end subroutine test_get_data
229+
230+
231+
subroutine report_rehash_times( map, hasher, hash_name, size_name )
232+
type(open_hashmap_type), intent(inout) :: map
233+
procedure(hasher_fun) :: hasher
234+
character(*), intent(in) :: hash_name, size_name
235+
real :: t1, t2, tdiff
236+
237+
call cpu_time(t1)
238+
call map % rehash( hasher )
239+
call cpu_time(t2)
240+
tdiff = t2-t1
241+
242+
write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
243+
trim(hash_name), 'Rehash data', size_name, tdiff
244+
245+
end subroutine report_rehash_times
246+
247+
248+
subroutine report_removal_times( map, test_block, hash_name, size_name )
249+
type(open_hashmap_type), intent(inout) :: map
250+
integer(int_index), intent(in) :: test_block
251+
character(*), intent(in) :: hash_name, size_name
252+
real :: t1, t2, tdiff
253+
type(key_type) :: key
254+
integer(int_index) :: index2
255+
logical :: existed
256+
257+
call cpu_time(t1)
258+
do index2=1, size(test_8_bits), test_block
259+
call set( key, test_8_bits( index2:index2+test_block-1 ) )
260+
call map % remove(key, existed)
261+
if ( .not. existed ) &
262+
error stop "Key not found in entry removal."
263+
end do
264+
call cpu_time(t2)
265+
tdiff = t2-t1
266+
267+
write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') &
268+
trim(hash_name), 'Remove data', size_name, tdiff
269+
flush(lun)
270+
271+
end subroutine report_removal_times
272+
273+
274+
subroutine report_hash_statistics( map, hash_name, size_name )
275+
type(open_hashmap_type), intent(inout) :: map
276+
character(*), intent(in) :: hash_name, size_name
277+
integer(int_depth) :: depth
278+
279+
write(lun, *)
280+
write(lun, '("Statistics for open hash table with ",' // &
281+
'A, " hasher on ", A, ".")' ) hash_name, size_name
282+
write(lun, '("Slots = ", I0)' ) map % num_slots()
283+
write(lun, '("Calls = ", I0)' ) map % calls()
284+
write(lun, '("Entries = ", I0)' ) map % entries()
285+
write(lun, '("Total probes = ", I0)' ) map % map_probes()
286+
write(lun, '("Loading = ", ES10.3)' ) map % loading()
287+
depth = map % total_depth()
288+
write(lun, '("Total depth = ", I0)' ) depth
289+
write(lun, '("Relative depth = ", ES10.3)') &
290+
real( depth ) / real( map % entries() )
291+
292+
end subroutine report_hash_statistics
293+
294+
295+
end program test_open_maps

0 commit comments

Comments
 (0)
Please sign in to comment.