Skip to content

Commit b2e08d5

Browse files
committed
hashmap-init-update
Includes code updates, doc, test and example updates for initialize update.
1 parent 2bdc50e commit b2e08d5

21 files changed

+86
-63
lines changed

doc/specs/stdlib_hashmaps.md

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -763,7 +763,7 @@ type. Each of these types are described below.
763763

764764
The `hashmap_type` abstract type serves as the parent type for the two
765765
types `chaining_hashmap_type` and `open_hashmap_type`. It defines
766-
seven private components:
766+
eight private components:
767767

768768
* `call_count` - the number of procedure calls on the map;
769769

@@ -782,6 +782,8 @@ seven private components:
782782

783783
* `hasher` - a pointer to the hash function used by the map.
784784

785+
* `initialized` - track if map has been initialized
786+
785787
It also defines five non-overridable procedures:
786788

787789
* `calls` - returns the number of procedure calls on the map;
@@ -1074,7 +1076,7 @@ are listed below.
10741076

10751077
Procedure to initialize a chaining hash map:
10761078

1077-
* `map % init( hasher[, slots_bits, status] )` - Routine
1079+
* `map % init( [hasher, slots_bits, status] )` - Routine
10781080
to initialize a chaining hash map.
10791081

10801082
Procedure to modify the structure of a map:
@@ -1295,7 +1297,7 @@ Initializes a `hashmap_type` object.
12951297

12961298
##### Syntax
12971299

1298-
`call map % ` [[hashmap_type(type):init(bound)]] `( hasher [, slots_bits, status ] )`
1300+
`call map % ` [[hashmap_type(type):init(bound)]] `( [hasher, slots_bits, status ] )`
12991301

13001302
##### Class
13011303

@@ -1308,9 +1310,10 @@ Subroutine
13081310
`intent(out)` argument. It will
13091311
be a hash map used to store and access the entries.
13101312

1311-
`hasher`: shall be a procedure with interface `hash_fun`.
1313+
`hasher`: (optional): shall be a procedure with interface `hash_fun`.
13121314
It is an `intent(in)` argument. It is the procedure to be used to
1313-
generate the hashes for the table from the keys of the entries.
1315+
generate the hashes for the table from the keys of the entries.
1316+
Defaults to fnv_1_hasher if not provided.
13141317

13151318
`slots_bits` (optional): shall be a scalar default integer
13161319
expression. It is an `intent(in)` argument. The initial number of
Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,9 @@
11
program example_calls
22
use stdlib_hashmaps, only: chaining_hashmap_type, int_calls
3-
use stdlib_hashmap_wrappers, only: fnv_1_hasher
43
implicit none
54
type(chaining_hashmap_type) :: map
65
integer(int_calls) :: initial_calls
7-
call map%init(fnv_1_hasher)
6+
call map%init()
87
initial_calls = map%calls()
98
print *, "INITIAL_CALLS = ", initial_calls
109
end program example_calls
Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,9 @@
11
program example_entries
22
use stdlib_hashmaps, only: open_hashmap_type, int_index
3-
use stdlib_hashmap_wrappers, only: fnv_1_hasher
43
implicit none
54
type(open_hashmap_type) :: map
65
integer(int_index) :: initial_entries
7-
call map%init(fnv_1_hasher)
6+
call map%init()
87
initial_entries = map%entries()
98
print *, "INITIAL_ENTRIES = ", initial_entries
109
end program example_entries

example/hashmaps/example_hashmaps_get_all_keys.f90

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
program example_hashmaps_get_all_keys
22
use stdlib_kinds, only: int32
33
use stdlib_hashmaps, only: chaining_hashmap_type
4-
use stdlib_hashmap_wrappers, only: fnv_1_hasher, get, &
4+
use stdlib_hashmap_wrappers, only: get, &
55
key_type, set
66
implicit none
77
type(chaining_hashmap_type) :: map
@@ -12,8 +12,6 @@ program example_hashmaps_get_all_keys
1212

1313
character(:), allocatable :: str
1414

15-
call map%init(fnv_1_hasher)
16-
1715
! adding key-value pairs to the map
1816
call set(key, "initial key")
1917
call map%map_entry(key, "value 1")

example/hashmaps/example_hashmaps_get_other_data.f90

Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
program example_get_other_data
22
use stdlib_kinds, only: int8, int64
33
use stdlib_hashmaps, only: chaining_hashmap_type, int_index
4-
use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, set, get
4+
use stdlib_hashmap_wrappers, only: key_type, set
55
implicit none
66
logical :: conflict
77
type(key_type) :: key
@@ -14,9 +14,6 @@ program example_get_other_data
1414
integer(int8), allocatable :: key_array(:)
1515
integer :: int_scalar
1616

17-
! Initialize hashmap
18-
call map%init(fnv_1_hasher)
19-
2017
! Hashmap functions are setup to store scalar value types (other). Use a dervied
2118
! type wrapper to store arrays.
2219
dummy%value = [4, 3, 2, 1]
Lines changed: 21 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,26 @@
11
program example_init
2-
use stdlib_hashmaps, only: chaining_hashmap_type
2+
use stdlib_hashmaps, only: chaining_hashmap_type, open_hashmap_type
33
use stdlib_hashmap_wrappers, only: fnv_1_hasher
44
implicit none
55
type(chaining_hashmap_type) :: map
6-
call map%init(fnv_1_hasher, slots_bits=10)
6+
logical :: present
7+
8+
9+
!If default values are used, then init can be typically be skipped as the first map_entry call will initialize the map using default values.
10+
call map%map_entry('key', 'value')
11+
call map%key_test('key', present)
12+
print *, "Key exists without explicit init call = ", present
13+
14+
! Init can be called to clear all items in a map.
15+
call map%init()
16+
call map%key_test('key', present)
17+
print *, "Key exists after re-initalization = ", present
18+
19+
! User can optional specify hasher type and slots_bits instead of using default values.
20+
! Number of slots in the hashmap will initially equal 2**slots_bits.
21+
! The hashmap will autmoatically re-size as needed, however for better performance, a rule of thumb is to size so that number of slots is ~2X expected number of entries.
22+
! In this example with slots_bits=10, there will initially be 1024 slots in the map.
23+
call map%init(hasher=fnv_1_hasher, slots_bits=10)
24+
call map%map_entry('key', 'value')
25+
726
end program example_init
Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,15 @@
11
program example_key_test
22
use stdlib_kinds, only: int8
33
use stdlib_hashmaps, only: chaining_hashmap_type
4-
use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, set
4+
use stdlib_hashmap_wrappers, only: key_type, set
55
implicit none
66
type(chaining_hashmap_type) :: map
77
type(key_type) :: key
88
logical :: present
9-
call map%init(fnv_1_hasher)
9+
10+
call map%init()
1011
call set(key, [0_int8, 1_int8])
1112
call map%key_test(key, present)
1213
print *, "Initial key of 10 present for empty map = ", present
14+
1315
end program example_key_test
Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,9 @@
11
program example_loading
22
use stdlib_hashmaps, only: open_hashmap_type
3-
use stdlib_hashmap_wrappers, only: fnv_1_hasher
43
implicit none
54
type(open_hashmap_type) :: map
65
real :: ratio
7-
call map%init(fnv_1_hasher)
6+
call map%init()
87
ratio = map%loading()
98
print *, "Initial loading = ", ratio
109
end program example_loading

example/hashmaps/example_hashmaps_map_entry.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
program example_map_entry
22
use, intrinsic:: iso_fortran_env, only: int8, int64
33
use stdlib_hashmaps, only: chaining_hashmap_type
4-
use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, set
4+
use stdlib_hashmap_wrappers, only: key_type, set
55
implicit none
66
type(chaining_hashmap_type) :: map
77
type(key_type) :: key
@@ -16,7 +16,7 @@ program example_map_entry
1616

1717
! Initialize hashmap with 2^10 slots.
1818
! Hashmap will dynamically increase size if needed.
19-
call map%init(fnv_1_hasher, slots_bits=10)
19+
call map%init(slots_bits=10)
2020

2121
! Explicitly set key using set function
2222
call set(key, [1, 2, 3])
Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,9 @@
11
program example_num_slots
22
use stdlib_hashmaps, only: chaining_hashmap_type, int_index
3-
use stdlib_hashmap_wrappers, only: fnv_1_hasher
43
implicit none
54
type(chaining_hashmap_type) :: map
65
integer(int_index) :: initial_slots
7-
call map%init(fnv_1_hasher)
6+
call map%init()
87
initial_slots = map%num_slots()
98
print *, "Initial slots = ", initial_slots
109
end program example_num_slots

0 commit comments

Comments
 (0)