diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 99a132574..92de955c4 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -763,7 +763,7 @@ type. Each of these types are described below. The `hashmap_type` abstract type serves as the parent type for the two types `chaining_hashmap_type` and `open_hashmap_type`. It defines -seven private components: +eight private components: * `call_count` - the number of procedure calls on the map; @@ -782,6 +782,8 @@ seven private components: * `hasher` - a pointer to the hash function used by the map. +* `initialized` - track if map has been initialized + It also defines five non-overridable procedures: * `calls` - returns the number of procedure calls on the map; @@ -1074,7 +1076,7 @@ are listed below. Procedure to initialize a chaining hash map: -* `map % init( hasher[, slots_bits, status] )` - Routine +* `map % init( [hasher, slots_bits, status] )` - Routine to initialize a chaining hash map. Procedure to modify the structure of a map: @@ -1295,7 +1297,7 @@ Initializes a `hashmap_type` object. ##### Syntax -`call map % ` [[hashmap_type(type):init(bound)]] `( hasher [, slots_bits, status ] )` +`call map % ` [[hashmap_type(type):init(bound)]] `( [hasher, slots_bits, status ] )` ##### Class @@ -1308,9 +1310,10 @@ Subroutine `intent(out)` argument. It will be a hash map used to store and access the entries. -`hasher`: shall be a procedure with interface `hash_fun`. +`hasher`: (optional): shall be a procedure with interface `hash_fun`. It is an `intent(in)` argument. It is the procedure to be used to - generate the hashes for the table from the keys of the entries. + generate the hashes for the table from the keys of the entries. + Defaults to fnv_1_hasher if not provided. `slots_bits` (optional): shall be a scalar default integer expression. It is an `intent(in)` argument. The initial number of diff --git a/example/hashmaps/example_hashmaps_calls.f90 b/example/hashmaps/example_hashmaps_calls.f90 index 2e8306675..328f49cec 100644 --- a/example/hashmaps/example_hashmaps_calls.f90 +++ b/example/hashmaps/example_hashmaps_calls.f90 @@ -1,10 +1,9 @@ program example_calls use stdlib_hashmaps, only: chaining_hashmap_type, int_calls - use stdlib_hashmap_wrappers, only: fnv_1_hasher implicit none type(chaining_hashmap_type) :: map integer(int_calls) :: initial_calls - call map%init(fnv_1_hasher) + call map%init() initial_calls = map%calls() print *, "INITIAL_CALLS = ", initial_calls end program example_calls diff --git a/example/hashmaps/example_hashmaps_entries.f90 b/example/hashmaps/example_hashmaps_entries.f90 index 2e5e5ea4e..fcb57983f 100644 --- a/example/hashmaps/example_hashmaps_entries.f90 +++ b/example/hashmaps/example_hashmaps_entries.f90 @@ -1,10 +1,9 @@ program example_entries use stdlib_hashmaps, only: open_hashmap_type, int_index - use stdlib_hashmap_wrappers, only: fnv_1_hasher implicit none type(open_hashmap_type) :: map integer(int_index) :: initial_entries - call map%init(fnv_1_hasher) + call map%init() initial_entries = map%entries() print *, "INITIAL_ENTRIES = ", initial_entries end program example_entries diff --git a/example/hashmaps/example_hashmaps_get_all_keys.f90 b/example/hashmaps/example_hashmaps_get_all_keys.f90 index f101c3808..14db2a714 100644 --- a/example/hashmaps/example_hashmaps_get_all_keys.f90 +++ b/example/hashmaps/example_hashmaps_get_all_keys.f90 @@ -1,8 +1,7 @@ program example_hashmaps_get_all_keys use stdlib_kinds, only: int32 use stdlib_hashmaps, only: chaining_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher, get, & - key_type, set + use stdlib_hashmap_wrappers, only: get, key_type, set implicit none type(chaining_hashmap_type) :: map type(key_type) :: key @@ -12,8 +11,6 @@ program example_hashmaps_get_all_keys character(:), allocatable :: str - call map%init(fnv_1_hasher) - ! adding key-value pairs to the map call set(key, "initial key") call map%map_entry(key, "value 1") diff --git a/example/hashmaps/example_hashmaps_get_other_data.f90 b/example/hashmaps/example_hashmaps_get_other_data.f90 index 32815e189..cab1271ee 100644 --- a/example/hashmaps/example_hashmaps_get_other_data.f90 +++ b/example/hashmaps/example_hashmaps_get_other_data.f90 @@ -1,7 +1,7 @@ program example_get_other_data use stdlib_kinds, only: int8, int64 use stdlib_hashmaps, only: chaining_hashmap_type, int_index - use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, set, get + use stdlib_hashmap_wrappers, only: key_type, set implicit none logical :: conflict type(key_type) :: key @@ -14,9 +14,6 @@ program example_get_other_data integer(int8), allocatable :: key_array(:) integer :: int_scalar - ! Initialize hashmap - call map%init(fnv_1_hasher) - ! Hashmap functions are setup to store scalar value types (other). Use a dervied ! type wrapper to store arrays. dummy%value = [4, 3, 2, 1] diff --git a/example/hashmaps/example_hashmaps_init.f90 b/example/hashmaps/example_hashmaps_init.f90 index ef2d85b54..ea55f9339 100644 --- a/example/hashmaps/example_hashmaps_init.f90 +++ b/example/hashmaps/example_hashmaps_init.f90 @@ -1,7 +1,26 @@ program example_init - use stdlib_hashmaps, only: chaining_hashmap_type + use stdlib_hashmaps, only: chaining_hashmap_type, open_hashmap_type use stdlib_hashmap_wrappers, only: fnv_1_hasher implicit none type(chaining_hashmap_type) :: map - call map%init(fnv_1_hasher, slots_bits=10) + logical :: present + + + !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. + call map%map_entry('key', 'value') + call map%key_test('key', present) + print *, "Key exists without explicit init call = ", present + + ! Init can be called to clear all items in a map. + call map%init() + call map%key_test('key', present) + print *, "Key exists after re-initalization = ", present + + ! User can optional specify hasher type and slots_bits instead of using default values. + ! Number of slots in the hashmap will initially equal 2**slots_bits. + ! The hashmap will automatically 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. + ! In this example with slots_bits=10, there will initially be 1024 slots in the map. + call map%init(hasher=fnv_1_hasher, slots_bits=10) + call map%map_entry('key', 'value') + end program example_init diff --git a/example/hashmaps/example_hashmaps_key_test.f90 b/example/hashmaps/example_hashmaps_key_test.f90 index c3248b5c8..43b3d92cc 100644 --- a/example/hashmaps/example_hashmaps_key_test.f90 +++ b/example/hashmaps/example_hashmaps_key_test.f90 @@ -1,13 +1,15 @@ program example_key_test use stdlib_kinds, only: int8 use stdlib_hashmaps, only: chaining_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, set + use stdlib_hashmap_wrappers, only: key_type, set implicit none type(chaining_hashmap_type) :: map type(key_type) :: key logical :: present - call map%init(fnv_1_hasher) + + call map%init() call set(key, [0_int8, 1_int8]) call map%key_test(key, present) print *, "Initial key of 10 present for empty map = ", present + end program example_key_test diff --git a/example/hashmaps/example_hashmaps_loading.f90 b/example/hashmaps/example_hashmaps_loading.f90 index 33e1e43ec..8fc8483d3 100644 --- a/example/hashmaps/example_hashmaps_loading.f90 +++ b/example/hashmaps/example_hashmaps_loading.f90 @@ -1,10 +1,9 @@ program example_loading use stdlib_hashmaps, only: open_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher implicit none type(open_hashmap_type) :: map real :: ratio - call map%init(fnv_1_hasher) + call map%init() ratio = map%loading() print *, "Initial loading = ", ratio end program example_loading diff --git a/example/hashmaps/example_hashmaps_map_entry.f90 b/example/hashmaps/example_hashmaps_map_entry.f90 index 78d499d17..706da77cc 100644 --- a/example/hashmaps/example_hashmaps_map_entry.f90 +++ b/example/hashmaps/example_hashmaps_map_entry.f90 @@ -1,7 +1,7 @@ program example_map_entry use, intrinsic:: iso_fortran_env, only: int8, int64 use stdlib_hashmaps, only: chaining_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, set + use stdlib_hashmap_wrappers, only: key_type, set implicit none type(chaining_hashmap_type) :: map type(key_type) :: key @@ -16,7 +16,7 @@ program example_map_entry ! Initialize hashmap with 2^10 slots. ! Hashmap will dynamically increase size if needed. - call map%init(fnv_1_hasher, slots_bits=10) + call map%init(slots_bits=10) ! Explicitly set key using set function call set(key, [1, 2, 3]) diff --git a/example/hashmaps/example_hashmaps_num_slots.f90 b/example/hashmaps/example_hashmaps_num_slots.f90 index 64fc900b4..5570d5512 100644 --- a/example/hashmaps/example_hashmaps_num_slots.f90 +++ b/example/hashmaps/example_hashmaps_num_slots.f90 @@ -1,10 +1,9 @@ program example_num_slots use stdlib_hashmaps, only: chaining_hashmap_type, int_index - use stdlib_hashmap_wrappers, only: fnv_1_hasher implicit none type(chaining_hashmap_type) :: map integer(int_index) :: initial_slots - call map%init(fnv_1_hasher) + call map%init() initial_slots = map%num_slots() print *, "Initial slots = ", initial_slots end program example_num_slots diff --git a/example/hashmaps/example_hashmaps_probes.f90 b/example/hashmaps/example_hashmaps_probes.f90 index b279a7983..0b315e7e9 100644 --- a/example/hashmaps/example_hashmaps_probes.f90 +++ b/example/hashmaps/example_hashmaps_probes.f90 @@ -1,10 +1,9 @@ program example_probes use stdlib_hashmaps, only: chaining_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher implicit none type(chaining_hashmap_type) :: map integer :: nprobes - call map%init(fnv_1_hasher) + call map%init() nprobes = map%map_probes() print *, "Initial probes = ", nprobes end program example_probes diff --git a/example/hashmaps/example_hashmaps_rehash.f90 b/example/hashmaps/example_hashmaps_rehash.f90 index fa2d2bb4b..b6755cefa 100644 --- a/example/hashmaps/example_hashmaps_rehash.f90 +++ b/example/hashmaps/example_hashmaps_rehash.f90 @@ -1,12 +1,12 @@ program example_rehash use stdlib_kinds, only: int8 use stdlib_hashmaps, only: open_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher, fnv_1a_hasher, & + use stdlib_hashmap_wrappers, only: fnv_1a_hasher, & key_type, set implicit none type(open_hashmap_type) :: map type(key_type) :: key - call map%init(fnv_1_hasher, slots_bits=10) + call map%init(slots_bits=10) call set(key, [5_int8, 7_int8, 4_int8, 13_int8]) call map%map_entry(key, 'A value') call map%rehash(fnv_1a_hasher) diff --git a/example/hashmaps/example_hashmaps_remove.f90 b/example/hashmaps/example_hashmaps_remove.f90 index 602e9d9ad..33f9b4ef7 100644 --- a/example/hashmaps/example_hashmaps_remove.f90 +++ b/example/hashmaps/example_hashmaps_remove.f90 @@ -1,8 +1,7 @@ program example_remove use stdlib_kinds, only: int8, int64 use stdlib_hashmaps, only: open_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher, & - fnv_1a_hasher, key_type, set + use stdlib_hashmap_wrappers, only: key_type, set implicit none type(open_hashmap_type) :: map type(key_type) :: key @@ -11,7 +10,7 @@ program example_remove ! Initialize hashmap with 2^10 slots. ! Hashmap will dynamically increase size if needed. - call map%init(fnv_1_hasher, slots_bits=10) + call map%init(slots_bits=10) ! Explicitly set key type using set function call set(key, [1, 2, 3]) call map%map_entry(key, 4.0) diff --git a/example/hashmaps/example_hashmaps_set_other_data.f90 b/example/hashmaps/example_hashmaps_set_other_data.f90 index 7b9f217d7..9b66febea 100644 --- a/example/hashmaps/example_hashmaps_set_other_data.f90 +++ b/example/hashmaps/example_hashmaps_set_other_data.f90 @@ -1,7 +1,7 @@ program example_set_other_data use stdlib_kinds, only: int8 use stdlib_hashmaps, only: open_hashmap_type, chaining_hashmap_type - use stdlib_hashmap_wrappers, only: key_type, set, fnv_1_hasher + use stdlib_hashmap_wrappers, only: key_type, set implicit none logical :: exists @@ -11,7 +11,7 @@ program example_set_other_data ! Initialize hashmap with 2^10 slots. ! Hashmap will dynamically increase size if needed. - call map%init(fnv_1_hasher, slots_bits=10) + call map%init(slots_bits=10) call set(key, [5, 7, 4, 13]) diff --git a/example/hashmaps/example_hashmaps_slots_bits.f90 b/example/hashmaps/example_hashmaps_slots_bits.f90 index 141eb62fe..9afa46775 100644 --- a/example/hashmaps/example_hashmaps_slots_bits.f90 +++ b/example/hashmaps/example_hashmaps_slots_bits.f90 @@ -1,10 +1,9 @@ program example_slots_bits use stdlib_hashmaps, only: chaining_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher implicit none type(chaining_hashmap_type) :: map integer :: bits - call map%init(fnv_1_hasher) + call map%init() bits = map%slots_bits() print *, "Initial slot bits = ", bits end program example_slots_bits diff --git a/example/hashmaps/example_hashmaps_total_depth.f90 b/example/hashmaps/example_hashmaps_total_depth.f90 index 51a15929e..cfdc2d1f1 100644 --- a/example/hashmaps/example_hashmaps_total_depth.f90 +++ b/example/hashmaps/example_hashmaps_total_depth.f90 @@ -1,10 +1,9 @@ program example_total_depth use stdlib_hashmaps, only: chaining_hashmap_type, int_depth - use stdlib_hashmap_wrappers, only: fnv_1_hasher implicit none type(chaining_hashmap_type) :: map integer(int_depth) :: initial_depth - call map%init(fnv_1_hasher) + call map%init() initial_depth = map%total_depth() print *, "Initial total depth = ", initial_depth end program example_total_depth diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 897964b53..7b5ab805f 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -434,7 +434,7 @@ module subroutine init_chaining_map( map, & !! greater than max_bits ! class(chaining_hashmap_type), intent(out) :: map - procedure(hasher_fun) :: hasher + procedure(hasher_fun), optional :: hasher integer, intent(in), optional :: slots_bits integer(int32), intent(out), optional :: status @@ -448,8 +448,9 @@ module subroutine init_chaining_map( map, & map % probe_count = 0 map % total_probes = 0 - map % hasher => hasher - + ! Check if user has specified a hasher other than the default hasher. + if (present(hasher)) map % hasher => hasher + call free_chaining_map( map ) if ( present(slots_bits) ) then @@ -502,6 +503,8 @@ module subroutine init_chaining_map( map, & call extend_map_entry_pool(map) + map % initialized = .true. + if (present(status) ) status = success end subroutine init_chaining_map @@ -545,6 +548,9 @@ module subroutine map_chain_entry(map, key, other, conflict) type(chaining_map_entry_type), pointer :: gentry, pentry, sentry character(*), parameter :: procedure = 'MAP_ENTRY' + ! Check that map is initialized. + if (.not. map % initialized) call init_chaining_map( map ) + hash_val = map % hasher( key ) if ( map % probe_count > map_probe_factor * map % call_count ) then diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index fe569fb1e..f8e654942 100644 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -410,7 +410,7 @@ module subroutine init_open_map( map, & !! greater than max_bits class(open_hashmap_type), intent(out) :: map - procedure(hasher_fun) :: hasher + procedure(hasher_fun), optional :: hasher integer, intent(in), optional :: slots_bits integer(int32), intent(out), optional :: status @@ -424,8 +424,9 @@ module subroutine init_open_map( map, & map % call_count = 0 map % probe_count = 0 map % total_probes = 0 - - map % hasher => hasher + + ! Check if user has specified a hasher other than the default hasher. + if (present(hasher)) map % hasher => hasher if ( present(slots_bits) ) then if ( slots_bits < default_bits .OR. & @@ -491,6 +492,8 @@ module subroutine init_open_map( map, & end do call extend_map_entry_pool(map % cache) + + map % initialized = .true. if (present(status) ) status = success @@ -533,7 +536,10 @@ module subroutine map_open_entry(map, key, other, conflict) integer(int_hash) :: hash_val integer(int_index) :: inmap, offset, test_slot character(*), parameter :: procedure = 'MAP_ENTRY' - + + ! Check that map is initialized. + if (.not. map % initialized) call init_open_map( map ) + hash_val = map % hasher( key ) if ( map % probe_count > map_probe_factor * map % call_count .or. & diff --git a/src/stdlib_hashmaps.f90 b/src/stdlib_hashmaps.f90 index 5bc310c32..d8afb23ec 100644 --- a/src/stdlib_hashmaps.f90 +++ b/src/stdlib_hashmaps.f90 @@ -19,15 +19,9 @@ module stdlib_hashmaps use stdlib_hashmap_wrappers, only: & copy_key, & fibonacci_hash, & - fnv_1_hasher, & - fnv_1a_hasher, & - free_key, & - get, & + default_hasher => fnv_1_hasher, & hasher_fun, & operator(==), & - seeded_nmhash32_hasher, & - seeded_nmhash32x_hasher, & - seeded_water_hasher, & set, & key_type, & int_hash @@ -39,7 +33,6 @@ module stdlib_hashmaps !! Public data_types public :: & chaining_hashmap_type, & - hashmap_type, & open_hashmap_type !! Values that parameterize David Chase's empirical SLOT expansion code @@ -98,9 +91,10 @@ module stdlib_hashmaps !! Number of elements in the free_list integer(int32) :: nbits = default_bits !! Number of bits used to address the slots - procedure(hasher_fun), pointer, nopass :: hasher => fnv_1_hasher + procedure(hasher_fun), pointer, nopass :: hasher => default_hasher !! Hash function - + logical :: initialized = .false. + contains procedure, non_overridable, pass(map) :: calls procedure, non_overridable, pass(map) :: entries @@ -209,7 +203,7 @@ subroutine init_map( map, & ! import hashmap_type, hasher_fun, int32 class(hashmap_type), intent(out) :: map - procedure(hasher_fun) :: hasher + procedure(hasher_fun), optional :: hasher integer, intent(in), optional :: slots_bits integer(int32), intent(out), optional :: status end subroutine init_map @@ -456,7 +450,7 @@ module subroutine init_chaining_map( map, & !! greater than max_bits ! class(chaining_hashmap_type), intent(out) :: map - procedure(hasher_fun) :: hasher + procedure(hasher_fun), optional :: hasher integer, intent(in), optional :: slots_bits integer(int32), intent(out), optional :: status end subroutine init_chaining_map @@ -706,7 +700,7 @@ module subroutine init_open_map( map, & !! greater than max_bits class(open_hashmap_type), intent(out) :: map - procedure(hasher_fun) :: hasher + procedure(hasher_fun), optional :: hasher integer, intent(in), optional :: slots_bits integer(int32), intent(out), optional :: status end subroutine init_open_map diff --git a/test/hashmaps/test_chaining_maps.f90 b/test/hashmaps/test_chaining_maps.f90 index 48a0f9f1e..7f00114c4 100755 --- a/test/hashmaps/test_chaining_maps.f90 +++ b/test/hashmaps/test_chaining_maps.f90 @@ -48,7 +48,7 @@ program test_chaining_maps test_8_bits(:) = transfer( rand_object, 0_int8, test_size ) - call map % init( fnv_1_hasher, slots_bits=10 ) + ! Test implicit initalization by skipping init call for first test. call input_random_data( map, test_16, 'FNV-1', "16 byte words" ) call test_inquire_data( map, test_16, 'FNV-1', "16 byte words" ) call test_get_all_keys( map, test_16, 'FNV-1', '16 byte words' ) @@ -57,7 +57,7 @@ program test_chaining_maps call report_hash_statistics( map, 'FNV-1', '16 byte words' ) call report_removal_times( map, test_16, 'FNV-1', '16 byte words' ) - call map % init( fnv_1_hasher, slots_bits=10 ) + call map % init() ! Test default options call input_random_data( map, test_256, 'FNV-1', "256 byte words" ) call test_inquire_data( map, test_256, 'FNV-1', "256 byte words" ) call test_get_data( map, test_256, 'FNV-1', '256 byte words' ) diff --git a/test/hashmaps/test_open_maps.f90 b/test/hashmaps/test_open_maps.f90 index 869c5fdeb..d93bff61c 100755 --- a/test/hashmaps/test_open_maps.f90 +++ b/test/hashmaps/test_open_maps.f90 @@ -49,7 +49,7 @@ program test_open_maps test_8_bits(:) = transfer( rand_object, 0_int8, test_size ) - call map % init( fnv_1_hasher, slots_bits=10 ) + ! Test implicit initalization by skipping init call for first test. call input_random_data( map, test_16, 'FNV-1', "16 byte words" ) call test_inquire_data( map, test_16, 'FNV-1', "16 byte words" ) call test_get_data( map, test_16, 'FNV-1', '16 byte words' ) @@ -58,7 +58,7 @@ program test_open_maps call report_hash_statistics( map, 'FNV-1', '16 byte words' ) call report_removal_times( map, test_16, 'FNV-1', '16 byte words' ) - call map % init( fnv_1_hasher, slots_bits=10 ) + call map % init() ! Test default options call input_random_data( map, test_256, 'FNV-1', "256 byte words" ) call test_inquire_data( map, test_256, 'FNV-1', "256 byte words" ) call test_get_data( map, test_256, 'FNV-1', '256 byte words' )