From 24e3fbb552fc4d13bd07905f636185f8b60f3e14 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 27 Dec 2021 12:19:08 -0700 Subject: [PATCH 01/77] Started creation of the stdlib_hash_maps PR Created the doc/specs/stdlib_hash_maps.md markdown documentation for the OR. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 3162 +++++++++++++++++++++++++++++++++ 1 file changed, 3162 insertions(+) create mode 100755 doc/specs/stdlib_hash_maps.md diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md new file mode 100755 index 000000000..0e597b49f --- /dev/null +++ b/doc/specs/stdlib_hash_maps.md @@ -0,0 +1,3162 @@ +--- +title: Hash maps +--- + +# The `stdlib_32_bit_key_data_wrapper`, `stdlib_chaining_hash_map` and `stdlib_open_hash_map` modules + +(TOC) + +## Overview of hash maps + +The comparison of lexical entities or other objects for equality +can be computationally expensive. +This cost is often reduced by computing a near unique integer value, +termed a hash code, from the structure of the object using a procedure +termed a hash function. +Equality of hash codes is a necessary, but not sufficient, condition +for the original objects to be equal. +As integer comparisons are very efficient, performing an initial +comparison of hash codes and then performing a detailed comparison +only if the hash codes are equal can improve performance. +The hash codes, in turn, can be mapped to a smaller set of integers, +that can be used as an index, termed a hash index, to a rank one +array, often termed a hash table or hash map. +This document discusses the hash maps in the library. + +## Licensing + +The Fortran Standard Library is distributed under the MIT License. +However components of the library should be evaluated as to whether +they are compatible with the MTI License. +The current hash maps were inspired by an +[implementation](http://chasewoerner.org/src/hasht/) of David +Chase. While the code has been greatly modified from his +implementation, he has give permission for the unrestricted use of +his code. + + +## The hash map modules + +The Fortran Standard Library provides three modules for the +implementation of simple hash maps. These maps only accept hash +functions with a single argument, the key, and that yield a 32 bit +hash code, The modules will need to be modified to use hash functions +with a different API. There are three modules: +`stdlib_32_bit_key_data_wrapper`, `stdlib_chaining_hash_map` and +`stdlib_open_hash_map`, corresponding to the files: +`stdlib_32_bit_key_data_wrapper.f90`, `stdlib_chaining_hash_map.f90`, +and `stdlib_open_hash_map.f90`. The module +`stdlib_32_bit_key_data_wrapper` providess an interface to the 32 bit +hash functions of the Standard Library module, +`stdlib_32_bit_hash_functions`, providing wrappers to some of the +hash functions so that they no longer need to be supplied seeds. The +module `stdlib_chaining_hash_map` defines a datatype, +`chaining_hash_map_type`, implementing a simple separate chaining hash +map noted more for its diagnotics than its performance. Finally the +module, `stdlib_open_hash_map` defines a datatype, +`open_hash_map_type`, implementing a simple open addressing hash +map noted more for its diagnotics than its performance. + +These maps use separate chaining with linked lists and linear open +addressing, respectively, to deal with hash index collisions, and are +largely defined in the separated modules, `stdlib_chaining_hash_maps` +and `stdlib_open_hash_maps`, respectively. +In `chaining_hash_map_type` the colliding indices are handled by using +linked lists with their roots at the hash index. +In `open_hash_map_type`, the colliding indices are handled by searching +from the initial hash index in increasing +steps of one (modulo the hash map size) for an open map bin. + +The maps share many attributes in common. The two types share a +common Application Programers Interface (API). The maps use powers of +two for their slot sizes, so that the function, `fibonacci_hash`, can +be used to map the hash codes to indices in the map. This is +expected to be more efficient than prime number mapping using a +modulo operation, and reduces the requirement that the hash +function need to do a good job randomizing its lower order bits. +This requires a good randomizing hash method for good performance. +Both adjust the map size to reduce collisions, based on +the ratio of the number of hash map probes to the number of subroutine +calls. +The maps make extensive use of pointers internally, but a private +finalization subroutine avoids memory leaks. +The maps can take entry keys of type `key_type`. +Both maps allow the addition and lookup of entries, and the inclusion +of data in addition to the entry key. +The `chaining_hash_map_type` also allows the selective removal of +entries. + +## The `stdlib_32_bit_key_data_wrapper` module + +The `stdlib_32_bit_key_data_wrapper` module provides data types to +represent keys and associated data stored in a module, but is also, a +wrapper for the `stdlib_32_bit_hash_functions` module. It allows +direct access to the `stdlib_32_bit_hash_functions` procedures: +`fibonacci_hash`, `fnv_1_hasher`, `fnv_1a_hasher`; and provides +wrapper functions, `seeded_nmhash32_hasher`, +`seeded_nmhash32x_hasher`, and `seeded_water_hasher` to the hashing +functions: `nmhash32`, `nmhash32x`, and `water_hash`, respectively. It +defines an interface, `hasher_fun`, compatible with the hash functions +that take a `non-scalar key`. It defines one integer constant used +as a kind value,`int_hash`. It also defines two types, `key_type` and +`other_type`, and associated procedures, for storing and manipulating +keys and their associated data. + +### The `stdlib_32_bit_key_data_wrapper` constant, `INT_HASH` + +The constant `INT_HASH` is used to define the integer kind value for +the returned hash codes and variables used to access them. It +currently has the value, `INT32`. + +### The `stdlib_32_bit_key_data_wrapper` module derived types + +The `stdlib_32_bit_key_data_wrapper` module defines two derived types: +`key_type`, and `other_type`. The `key_type` is intended to be used +for the search keys of hash tables. The `other_type` is intended to +store additional data associated with a key. Both types are +opaque. Their current representations are as follows + +```fortran + type :: key_type + private + integer(int8), allocatable :: value(:) + end type key_type + + type :: other_type + private + integer(int8), allocatable :: value(:) + end type other_type +``` + +The module also defines seven procedures for those types: `copy_key`, +`copy_other`, `free_key`, `free_other`, `get`, `key_test`, and `set` +for use by the hash maps to manipulate or inquire of components of +those types. + +### Table of `stdlib_32_bit_key_data_wrapper` procedures + +The `stdlib_32_bit_key_data_wrapper` module provides procedures in +several categories: procedures to mamipulate data of the `key_type`; +procedures to manipulate data of the `other_type`, and 32 bit hash +functions for keys. The procedures in each category are listed below. + +Procedures to manipulate `key_type` data: + +* `copy_key( key_in, key_out )` - Copies the contents of the key, + key_in, to the key, key_out. + +* `get( key, value )` - extracts the content of key into value. + +* `free_key( key )` - frees the memory in key. + +* `set( key, value )` - sets the content of key to value. + +* `key_test( key1, key2 )` - compares two keys for equality. + +Procedures to manipulate `other_type` data: + +* `copy_other( other_in, other_out )` - Copies the contents of the + other data in, other_in, to the other data, other_out. + +* `get( other, value )` - extracts the content of other into value. + +* `set( other, value )` - sets to content of other to value. + +* `free_other( other )` - frees the memory in other. + +Procedures to hash keys to 32 bit integers: + +* `fnv_1_hasher( key )` - hashes a key using the FNV-1 algorithm. + +* `fnv_1a_hasher( key )` - hashes a key using the FNV-1a algorithm. + +* `seeded_nmhash32_hasher( key )` - hashes a key using the nmhash32 + algorithm. + +* `seeded_nmhash32x_hasher( key )` - hashes a key using the nmhash32x + algorithm. + +* `seeded_water_hasher( key )` - hashes a key using the waterhash + algorithm. + +### Specifications of the `stdlib_32_bit_key_data_wrapper` procedures + +#### `copy_key` - Returns a copy of the key + +##### Status + +Experimental + +##### Description + +Returns a copy of an input of type `key_type` + +##### Syntax + +`call [[stdlib_32_bit_key_data_wrapper:copy_key]]( key_in, key_out )` + +##### Class + +Subroutine. + +##### Arguments + +`key_in`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. + +`key_out`: shall be a scalar variable of type `key_type`. It +is an `intent(out)` argument. + +##### Example + +```fortran + program demo_copy_key + use stdlib_32_bit_key_data_wrapper, only: & + copy_key, key_test, key_type + use iso_fortran_env, only: int8 + implicit none + integer(int8), allocatable :: value(:) + type(key_type) :: key_in, key_out + integer(int_8) :: i + allocate( value(1:15) ) + do i=1, 15 + value(i) = i + end do + call set( key, value ) + call copy_key( key_in, key_out ) + print *, "key_in == key_out = ", key_test( key_in, key_out ) + end program demo_copy_key +``` + +#### `copy_other` - Returns a copy of the other data + +##### Status + +Experimental + +##### Description + +Returns a copy of an input of type `other_type` + +##### Syntax + +`call [[stdlib_32_bit_key_data_wrapper:copy_other]]( other_in, other_out )` + +##### Class + +Subroutine. + +##### Arguments + +`other_in`: shall be a scalar expression of type `other_type`. It +is an `intent(in)` argument. + +`other_out`: shall be a scalar variable of type `other_type`. It +is an `intent(out)` argument. + +##### Example + +```fortran + program demo_copy_other + use stdlib_32_bit_key_data_wrapper, only: & + copy_other, get, other_type, set + use iso_fortran_env, only: int8 + implicit none + integer(int8), allocatable :: value1(:), value2(:) + type(other_type) :: other_in, other_out + integer(int_8) :: i + allocate( value1(1:15) ) + do i=1, 15 + value1(i) = i + end do + call set( other_in, value1 ) + call copy_other( other_in, other_out ) + call get( other_out, value2 ) + print *, "other_in == other_out = ", & + all( value1 == value2 ) + end program demo_copy_other +``` + + +#### `FIBONACCI_HASH` - maps an integer to a smaller number of bits + +##### Status + +Experimental + +##### Description + +Calculates an `nbits` hash code from a 32 bit integer. + +##### Syntax + +`code = [[stdlib_32_bit_key_data_wrapper:fibonacci_hash]]( key, nbits )` + +##### Class + +Pure function + +##### Arguments + +`key`: Shall be a scalar integer expression of kind `INT32`. It is an +`intent(in)` argument. + +`nbits` Shall be a scalar default integer expression with `0 < nbits < +32`. It is an `intent(in)` argument. + +##### Result character + +The result is an integer of kind `INT32`. + +##### Result value + +The result has at most the lowest `nbits` nonzero so it can serve as +an index into the hash slots. + +##### Note + +`FIBONACCI_HASH` is an implementation of the Fibonacci Hash of Donald +E. Knuth. It multiplies the `KEY` by the odd valued approximation to +`2**32/phi`, where `phi` is the golden ratio 1.618..., and returns the +`NBITS` upper bits of the product as the lowest bits of the result. + + +##### Example + +```fortran + program demo_fibonacci_hash + use stdlib_32_bit_key_data_wrapper, only: & + fibonacci_hash + use iso_fortran_env, only: int32 + implicit none + integer, allocatable :: array1(:) + integer(int32) :: hash, source + type(key_type) :: key + allocate( array1(0:2**4-1) ) + array1(:) = 0 + source = int(Z'1FFFFFF', int32) + hash = fibonacci_hash(source, 4) + azray1(hash) = source + print *, hash + print *, array + end program demo_fibonacci_hash +``` + + +#### `FNV_1_HASHER`- calculates a hash code from a key + +##### Status + +Experimental + +##### Description + +Calculates a 32 bit hash code from an input of type `key_type`. + +##### Syntax + +`code = [[stdlib_32_bit_key_data_wrapper:fnv_1_hasher]]( key )` + +##### Class + +Pure function + +##### Argument + +`key`: Shall be a scalar expression of type `key_type`. +It is an `intent(in)` argument. + +##### Result character + +The result is a scalar integer of kind `INT32`. + +##### Result value + +The result is a hash code created using the FNV-1 algorithm. + +##### Note + +`FNV_1_HASHER` is an implementation of the original FNV-1 hash code of +Glenn Fowler, Landon Curt Noll, and Phong Vo. +This code is relatively fast on short keys, and is small enough that +it will often be retained in the instruction cache if hashing is +intermitent. +As a result it should give good performance for typical hash map +applications. +This code does not pass any of the SMHasher tests, but the resulting +degradation in performance due to its larger number of collisions is +expected to be minor compared to its faster hashing rate. + + +##### Example + +```fortran + program demo_fnv_1_hasher + use stdlib_32_bit_key_data_wrapper, only: & + fnv_1_hasher, key_type, set + use iso_fortran_env, only: int32 + implicit none + integer(int8), allocatable :: array1(:) + integer(int32) :: hash + type(key_type) :: key + array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] + call set( key, array1 ) + hash = fnv_1_hasher(key) + print *, hash + end program demo_fnv_1_hasher +``` + + +#### `FNV_1A_HASHER`- calculates a hash code from a key + +##### Status + +Experimental + +##### Description + +Calculates a 32 bit hash code from an input of type `key_type`. + +##### Syntax + +`code = [[stdlib_32_bit_key_data_wrapper:fnv_1a_hasher]]( key )` + +##### Class + +Pure function + +##### Argument + +`key`: Shall be a scalar expression of type `key_type`. +It is an `intent(in)` argument. + +##### Result character + +The result is a scalar integer of kind `INT32`. + +##### Result value + +The result is a hash code created using the FNV-1a algorithm. + +##### Note + +`FNV_1A_HASHER` is an implementation of the original FNV-1A hash code +of Glenn Fowler, Landon Curt Noll, and Phong Vo. +This code is relatively fast on short keys, and is small enough that +it will often be retained in the instruction cache if hashing is +intermitent. +As a result it should give good performance for typical hash map +applications. +This code does not pass any of the SMHasher tests, but the resulting +degradation in performance due to its larger number of collisions is +expected to be minor compared to its faster hashing rate. + + +##### Example + +```fortran + program demo_fnv_1a_hasher + use stdlib_32_bit_key_data_wrapper, only: & + fnv_1a_hasher, key_type, set + use iso_fortran_env, only: int32 + implicit none + integer(int8), allocatable :: array1(:) + integer(int32) :: hash + type(key_type) :: key + array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] + call set( key, array1 ) + hash = fnv_1a_hasher(key) + print *, hash + end program demo_fnv_1a_hasher +``` + +#### `free_key` - frees the memory associated with a key + +##### Status + +Experimental + +##### Description + +Deallocates the memory associated with an variable of type +`key_type`. + +##### Syntax + +`call [[stdlib_32_bit_key_data_wrapper:free_key]]( key )` + +##### Class + +Subroutine. + +##### Argument + +`key`: shall be a scalar variable of type `key_type`. It +is an `intent(out)` argument. + +##### Example + +```fortran + program demo_free_key + use stdlib_32_bit_key_data_wrapper, only: & + copy_key, free_key, key_type, set + use iso_fortran_env, only: int8 + implicit none + integer(int8), allocatable :: value(:) + type(key_type) :: key_in, key_out + integer(int_8) :: i + allocate( value(1:15) ) + do i=1, 15 + value(i) = i + end do + call set( key_in, value ) + call copy_key( key_in, key_out ) + call free_key( key_out ) + end program demo_free_key +``` + +#### `free_other` - frees the memory associated with other data + +##### Status + +Experimental + +##### Description + +Deallocates the memory associated with an variable of type +`other_type`. + +##### Syntax + +`call [[stdlib_32_bit_key_data_wrapper:free_other]]( other )` + +##### Class + +Subroutine. + +##### Argument + +`other`: shall be a scalar variable of type `other_type`. It +is an `intent(out)` argument. + +##### Example + +```fortran + program demo_free_other + use stdlib_32_bit_key_data_wrapper, only: & + copy_other, free_other, other_type, set + use iso_fortran_env, only: int8 + implicit none + integer(int8), allocatable :: value(:) + type(key_type) :: other_in, other_out + integer(int_8) :: i + allocate( value(1:15) ) + do i=1, 15 + value(i) = i + end do + call set( other_in, value ) + call copy_other( other_in, other_out ) + call free_other( other_out ) + end program demo_free_other +``` + + +#### `get` - extracts the data from a derived type + +##### Status + +Experimental + +##### Description + +Extracts the data from a `key_type` or an `other_type` and stores it +in the variable `value`.. + +##### Syntax + +`call [[stdlib_32_bit_key_data_wrapper:get]]( key, value )` + +or + +`call [[stdlib_32_bit_key_data_wrapper:get]]( other, value )` + + +##### Class + +Subroutine. + +##### Argument + +`key`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. + +`other`: shall be a scalar expression of type `other_type`. It +is an `intent(in)` argument. + +`value`: shall be an allocatable default character string variabl, or +an allocatable vector variable of type integer and kind `INT8`. It is +an `intent(out)` argument. + +##### Example + +```fortran + program demo_get + use stdlib_32_bit_key_data_wrapper, only: & + get, key_type, set + use iso_fortran_env, only: int8 + implicit none + integer(int8), allocatable :: value(:), result(:) + type(key_type) :: key + integer(int_8) :: i + allocate( value(1:15) ) + do i=1, 15 + value(i) = i + end do + call set( key, value ) + call get( key, result ) + print *, `RESULT == VALUE = ', all( value == result ) + end program demo_get +``` + + +#### `HASHER_FUN`- serves aa function prototype. + +##### Status + +Experimental + +##### Description + +Serves as a prototype for hashing functions with a single, `key`, +argument returning an `INT322` hash value. + +##### Syntax + +`type([[stdlib_32_bit_key_data_wrapper:hasher_fun]]), pointer :: fun_pointer` + +##### Class + +Pure function prototype + +##### Argument + +`key`: Shall be a rank one array expression of type `INTEGER(INT8)`. +It is an `intent(in)` argument. + +##### Result character + +The result is a scalar integer of kind `INT32`. + +##### Result value + +The result is a hash code. + +##### Note + +`HASHER_FUN` is a prototype for defining dummy arguments and function +pointers intended for use + +##### Example + +```fortran + program demo_hasher_fun + use stdlib_32_bit_key_data_wrapper, only: & + fnv_1a_hasher, hasher_fun, set + use iso_fortran_env, only: int8, int32 + implicit none + type(hasher_fun), pointer :: hasher_pointer + integer(int8), allocatable :: array1(:) + integer(int32) :: hash + type(key_type) :: key + hasher_pointer => fnv_1a_hasher + array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] + call set( key, array1 ) + hash = hassher_pointer(key) + print *, hash + end program demo_hasher_fun +``` + +#### `key_test` - Compares two keys for equality + +##### Status + +Experimental + +##### Description + +Returns `.true.` if two keys are equal, and false otherwise. + +##### Syntax + +`test = [[stdlib_32_bit_key_data_wrapper:key_test]]( key1, key2 )` + +##### Class + +Pure function. + +##### Arguments + +`key1`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. + +`key2`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. + +##### Result character + +The result is a value of type default `LOGICAL`. + +##### Result value + +The result is `.TRUE.` if the keys are equal, otherwise `.FALSS`. + +##### Example + +```fortran + program demo_key_test + use stdlib_32_bit_key_data_wrapper, only: & + copy_key, key_test, key_type, set + use iso_fortran_env, only: int8 + implicit none + integer(int8), allocatable :: value(:) + type(key_type) :: key_in, key_out + integer(int_8) :: i + allocate( value(1:15) ) + do i=1, 15 + value(i) = i + end do + call set( key_in, value ) + call copy_key( key_in, key_out ) + print *, "key_in == key_out = ", key_test( key_in, key_out ) + end program demo_key_test +``` + +#### `SEEDED_NMHASH32_HASHER`- calculates a hash code from a key + +##### Status + +Experimental + +##### Description + +Calculates a 32 bit hash code from an input of type `key_type`. + +##### Syntax + +`code = [[stdlib_32_bit_key_data_wrapper:seeded_nmhash32_hasher]]( key )` + +##### Class + +Pure function + +##### Argument + +`key`: Shall be a scalar expression of type `key_type`. +It is an `intent(in)` argument. + +##### Result character + +The result is a scalar integer of kind `INT32`. + +##### Result value + +The result is a hash code created using the `nmhash32` algorithm. + +##### Note + +`SEEDED_NMHASH32_HASHER` is a wrapper to the `NMHASH32_HASH` of the +module `stdlib_32_bit_hash_functions`, which supplies a fixed seed +to the wrapped function. `NMHASH32` is an implementation of the +`nmhash32` hash code of James Z. M. Gao. +This code has good, but not great, performance on long keys, poorer +performance on short keys. +As a result it should give fair performance for typical hash map +applications. +This code passes the SMHasher tests. +As a result it should give good performance for typical hash map +applications. + + +##### Example + +```fortran + program demo_seeded_nmhash32_hasher + use stdlib_32_bit_key_data_wrapper, only: & + seeded_nmhash32_hasher, key_type, set + use iso_fortran_env, only: int32 + implicit none + integer(int8), allocatable :: array1(:) + integer(int32) :: hash + type(key_type) :: key + array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] + call set( key, array1 ) + hash = seeded_nmhash32_hasher (key) + print *, hash + end program demo_seeded_nmhash32_hasher +``` + +#### `SEEDED_NMHASH32X_HASHER`- calculates a hash code from a key + +##### Status + +Experimental + +##### Description + +Calculates a 32 bit hash code from an input of type `key_type`. + +##### Syntax + +`code = [[stdlib_32_bit_key_data_wrapper:seeded_nmhash32x_hasher]]( key )` + +##### Class + +Pure function + +##### Argument + +`key`: Shall be a scalar expression of type `key_type`. +It is an `intent(in)` argument. + +##### Result character + +The result is a scalar integer of kind `INT32`. + +##### Result value + +The result is a hash code created using the `nmhash32x` algorithm. + +##### Note + +`SEEDED_NMHASH32X_HASHER` is a wrapper to the `NMHASH32X_HASH` of the +module `stdlib_32_bit_hash_functions`, which supplies a fixed seed +to the wrapped function. `NMHASH32X` is an implementation of the +`nmhash32x` hash code of James Z. M. Gao. +This code has good, but not great, performance on long keys, poorer +performance on short keys. +As a result it should give fair performance for typical hash map +applications. +This code passes the SMHasher tests. +As a result it should give good performance for typical hash map +applications. + +##### Example + +```fortran + program demo_seeded_nmhash32x_hasher + use stdlib_32_bit_key_data_wrapper, only: & + seeded_nmhash32x_hasher, key_type, set + use iso_fortran_env, only: int32 + implicit none + integer(int8), allocatable :: array1(:) + integer(int32) :: hash + type(key_type) :: key + array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] + call set( key, array1 ) + hash = seeded_nmhash32x_hasher (key) + print *, hash + end program demo_seeded_nmhash32x_hasher +``` + +#### `SEEDED_WATER_HASHER`- calculates a hash code from a key + +##### Status + +Experimental + +##### Description + +Calculates a 32 bit hash code from an input of type `key_type`. + +##### Syntax + +`code = [[stdlib_32_bit_key_data_wrapper:seeded_water_hasher]]( key )` + +##### Class + +Pure function + +##### Argument + +`key`: Shall be a scalar expression of type `key_type`. +It is an `intent(in)` argument. + +##### Result character + +The result is a scalar integer of kind `INT32`. + +##### Result value + +The result is a hash code created using the `waterhash` algorithm. + +##### Note + +`SEEDED_WATER_HASHER` is a wrapper to the `WATER_HASH` of the +module `stdlib_32_bit_hash_functions`, which supplies a fixed seed +to the wrapped function. `WATER_HASH` is an implementation of the +`waterhash` hash code of Tommy Ettinger. +This code has excellent performance on long keys, and good performance +on short keys. +As a result it should give reasonable performance for typical hash +table applications. +This code passes the SMHasher tests. +As a result it should give good performance for typical hash map +applications. + + +##### Example + +```fortran + program demo_seeded_water_hasher + use stdlib_32_bit_key_data_wrapper, only: & + seeded_water_hasher, key_type, set + use iso_fortran_env, only: int32 + implicit none + integer(int8), allocatable :: array1(:) + integer(int32) :: hash + type(key_type) :: key + array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] + call set( key, array1 ) + hash = seeded_water_hasher (key) + print *, hash + end program demo_seeded_water_hasher +``` + + +#### `set` - places the data in a derived type + +##### Status + +Experimental + +##### Description + +Places the data from `value` in a `key_type` or an `other_type`. + +##### Syntax + +`call [[stdlib_32_bit_key_data_wrapper:set]]( key, value )` + +or + +`call [[stdlib_32_bit_key_data_wrapper:set]]( other, value )` + + +##### Class + +Subroutine. + +##### Argument + +`key`: shall be a scalar variable of type `key_type`. It +is an `intent(out)` argument. + +`other`: shall be a scalar variable of type `other_type`. It +is an `intent(out)` argument. + +`value`: shall be a default character string expression, or a +vector expression of type integer and kind `INT8`. It is an +`intent(in)` argument. + +##### Example + +```fortran + program demo_set + use stdlib_32_bit_key_data_wrapper, only: & + get, key_type, set + use iso_fortran_env, only: int8 + implicit none + integer(int8), allocatable :: value(:), result(:) + type(key_type) :: key + integer(int_8) :: i + allocate( value(1:15) ) + do i=1, 15 + value(i) = i + end do + call set( key, value ) + call get( key, result ) + print *, `RESULT == VALUE = ', all( value == result ) + end program demo_set +``` + + +## The `stdlib_chaining_hash_map` module + +The `stdlib_chaining_hash_map` module provides access to all the +public entities of the `stdlib_32_bit_key_data_wrapper` module. It +also defines a public data type and associated procedures and +constants that implement a simple hash map using +separate chaining hashing. The derived type is +`chaining_hash_map_type`. It provides +procedures to manipulate the structure of the hash map: +`init_map`, `map_entry`, `rehash_map`, `remove_entry`, and +`set_other_data`. It provides procedures to inquire about entries in +the hash map: `get_other_data`, `in_map`, `unmap`.and `valid_index`. +Finally it provides procedures to inquire about the overall +structure and performance of the table:`calls`, `entries`, +`get_other_data`, `loading`, `slots`, and `total_depth`. The module +also defines a number of public constants: `inmap_probe_factor`, +`map_probe_factor`, `default_max_bits`, `default_bits`, +`strict_max_bits`, `int_calls`, `int_depth`, `int_index`, +`int_probes`, `success`, `alloc_fault`, and `array_size_error`. + +### The `stdlib_chaining_hash_map` module's public constants + +The module defines several categories of public constants. Some are +used to parameterize the empirical slot expansion code. Others +parameterize the slots table size, Some are used to define +integer kind values for different applications. Finally, some are used +to report errors or success. + +The constants `inmap_probe_factor`, and `map_probe_factor` are used to +parameterize the slot expansion code used to determine when in a +`inchain_map_call` the number +of slots need to be increased to decrease the lengths of the linked +lists. The constant `inmap_probe_factor` is used to determine when +the ratio of the number of map probes to map calls is too large and +the slots need expansion. The constant `map_probe_factor` is used to +determine when inserting a new entry the ratio of the number of map +probes to map calls is too large and the slots need expansion. + +The constants `default_bits`, `default_max_bits`, and +`strict_max_bits` are used to parameterize the table's slots size. The +`default_bits` constant defines the default initial number of slots +with a current value of 6 resulting in an initial `2**6 == 64` +slots. This may optionally be overridden on hash map creation. The +`default_max_bits` is the default value for the table's `max_bits` +component that sets the maximum table size as `2**max_bits`. This may +also be overridden on table creation. Finally, `strict_max_bits` +defines the maximum value for `default_max_bits`. This cannot be +overridden on hash map creation. Because signed 32 bit integers are +used for the hash code, `strict_max_bits` must be no greater than 31, +but as probably large values of `max_bits` benefit from a 64 bit hash +code, `strict_max_size` is currently set to 24, so the current table +is assumed to be useful only for tables up to size `2**24` slots. As +chaining is used for this table the number of entries can be +significantly larger than the number of slots. + +The constants `int_calls`, `int_depth`, `int_index`, and `int_probes` +are used to define integer kind values for various contexts. The +number of calls are reported and stored in entities of kind +`int_calls`. Currently `int_calls` has the value of `INT64`. The +total depth, the number of inquiries needed to access all elements +of the table, is reported and stored in entities of kind +`int_depth`. Currently `int_depth` has the value of `INT64`. The +number of entries in the table, is reported and stored in entities of +kind `int_index`. Currently `int_index` has the value of `INT32`. +The number of probes, hash map enquiries, are reported and stored in +entities of kind `int_probes`. Currently `int_probes` has the value of +`INT64`. + +Finally the error codes `success`, `alloc_fault`, and +`array_size_error` are used to report the error status of certain +procedure calla. The `succes` code indicates that no problems were +found. The `alloc_fault` code indicates that a memory allocation +failed. Finally the `array_size_error` indicates that on table +creation `slots_bits` or `max_bits` are less than `default_bits` or +greater than `strict_max_bits`, respectively. + +### The `stdlib_chaining_hash_map` module's derived types + +The `stdlib_chaining_hash_map` module defines several derived +types. The only public type is the `chaining_hash_map_type`. There are +three other private derived types used in the implementation of the +public type: `chaining_map_entry_type`, `chaining_map_entry_ptr`, and +`chaining_map_entry_pool`. Each of these are described below. + +#### The `chaining_map_entry_type` derived type + +Entities of the type `chaining_map_entry_type` are used to define +a linked list structure that stores the +key, its other data, the hash of the key, and the resulting index into +the inverse table. The type's definition is below: + +```fortran + type :: chaining_map_entry_type ! Chaining hash map entry type + private + integer(int_hash) :: hash_val ! Full hash value + type(key_type) :: key ! The entry's key + type(other_type) :: other ! Other entry data + integer(int_index) :: index ! Index into inverse table + type(chaining_map_entry_type), pointer :: & + next => null() ! Next bucket + end type chaining_map_entry_type +``` +Currently the `INT_HASH` and `INT_INDEX` have the value of `INT32`. + +#### The `chaining_map_entry_ptr` derived type + +The type `chaining_map_entry_ptr` are used to define the elements of +the hash map that are either empty or link to the linked lists +containing the elements of the table. The type's definition is below: + +```fortran + type chaining_map_entry_ptr ! Wrapper for a pointer to a chaining + ! map entry type object + type(chaining_map_entry_type), pointer :: target => null() + end type chaining_map_entry_ptr +``` + +#### The `chaining_map_entry_pool` derived type + +The type `chaining_map_entry_pool` is used to implement a pool of +allocated `chaining_map_entry_type` elements to save on allocation +costs. The type's definition is below: + +```fortran + type :: chaining_map_entry_pool + ! Type inplementing a pool of allocated + ! `chaining_map_entry_type` objects + private + ! Index of next bucket + integer(int_index) :: next = 0 + type(chaining_map_entry_type), allocatable :: more_map_entries(:) + type(chaining_map_entry_pool), pointer :: lastpool => null() + end type chaining_map_entry_pool +``` + + +#### The `chaining_hash_map_type` derived type + +The `chaining_hash_map_type` derived type implements a separate +chaining hash map. It provides the elements `calls`, `probes`, +`total_probes`, `entries`, `slots_bits`, and `max_bits` to keep track +of the hash map's usage. The array element `slots` serves as the +table proper. The array element `inverse` maps integers to +entries. The linked list entry, `free_list`, keeps track of freed +elements of type `chaining_map_entry_type`. The list element, `cache`, +stores pools of `chaining_map_entry_type` elements for reuse. The +component `hasher` is a pointer to the hash function. Finally the +type-bound procedure, `free_chaining_map`, serves as a finalizer for +objects of the type, `chaining_hash_map_type`. + +```fortran + type :: chaining_hash_map_type + private + integer(int_calls) :: calls = 0 + ! Number of calls + integer(int_calls) :: probes = 0 + ! Number of probes since last expansion + integer(int_calls) :: total_probes = 0 + ! Cumulative number of probes +` integer(int_index) :: entries = 0 + ! Number of entries + integer(int32) :: slots_bits = default_bits + ! Bits used for slots size + integer(int32) :: max_bits = default_max_bits + ! Maximum value of slots_bits + type(chaining_map_entry_ptr), allocatable :: slots(:) + ! Array of bucket lists Note # slots=size(slots) + type(chaining_map_entry_ptr), allocatable :: inverse(:) + ! Array of bucket lists (inverses) Note max_elts=size(inverse) + type(chaining_map_entry_type), pointer :: free_list => null() + ! free list of map entries + type(chaining_map_entry_pool), pointer :: cache => null() + ! Pool of allocated chaining_map_entry_type objects + procedure(hasher_fun), pointer, nopass :: hasher => fnv_1_hasher + ! Hash function + contains + final :: free_chaining_map + end type chaining_hash_map_type +``` + +### Table of `stdlib_chaining_hash_map` procedures + +The `stdlib_chaining_hash_map` module provides procedures in +several categories: a procedure to initialize the map; a procedure to +modify the structure of a map; procedures to modify the content of a +map; procedures to report on the content of a map; and procedures +to report on the structure of the map. The procedures in each category +are listed below. + +Procedure to initialize a chaining hash map: + +* `init_map( map, hasher[, slots_bits, max_bits, status] )` - Routine + to initialize a chaining hash map. + +Procedure to modify the structure of a map: + +* `rehash_map( map, hasher )` - Routine to change the hash function + for a map. + +Procedures to modify the content of a map: + +* `map_entry( map, inmap, key, other )` - Inserts an entry innto the + hash map. + +* `remove_entry(map, inmap)` - Remove the entry, if any, at map % + inverse(inmap). + +* `set_other_data( map, inmap, other )` - Change the other data + associated with the entry. + +Procedures to report the content of a map: + +* `get_other_data( map, inmap, other )` - Returns the other data + associated with the inverse table index + +* `in_map( map, inmap, key )` - Returns the index into the INVERSE + array associated with the KEY + +* `unmap( map, inmap, key )` - Returns a copy of the key associated +with an index to the inverse table. + +* `valid_index(map, inmap)` - Returns a flag indicating whether INMAP + is a valid index. + +Procedures to report on the structure of the map: + +* `calls( map )` - the number of subroutine calls on the hash map. + +* `entries( map )`- the number of entries in a hash map. + +* `loading( map )` - the number of entries relative to slots in a hash + map. + +* `map_probes( map )` - the total number of table probes on a hash + map. + +* `slots( map )` - Returns the number of allocated slots in a hash + map. + +* `total_depth( map )` - Returns the total number of one's based +offsets of slot entries from their slot index + +### Specifications of the `stdlib_chaining_hash_map` procedures + +#### `calls` - Returns the number of calls on a hash map + +##### Status + +Experimental + +##### Description + +Returns the number of procedure calls on a hash map. + +##### Syntax + +`value = [[stdlib_chaining_hash_map:calls]]( map )` + +##### Class + +Pure function + +##### Argument + +`map` - shall be an expression of type `chaining_hash_map_type`. +It is an `intent(in)` argument. + +##### Result character + +The result will be an integer of kind `INT_CALLS`. + +##### Result value + +The result will be the number of procedure calls on the hash map. + +##### Example + +```fortran + program demo_calls + use stdlib_chaining_hash_map, only: & + chaining_hash_map_type, calls, init_map, int_calls, & + fnv_1_hasher + implicit none + type(chaining_hash_map_type) :: map + type(int_calls) :: initial_calls + call init_map( map, fnv_1_hasher ) + initisl_calls = calls (map) + print *, "INITIAL_CALLS = ", initial_calls + end program demo_calls +``` + + +#### `entries` - Returns the number of entries in a hash map + +##### Status + +Experimental + +##### Description + +Returns the number of entries in a hash map. + +##### Syntax + +`value = [[stdlib_chaining_hash_map:entries]]( map )` + +##### Class + +Pure function + +##### Argument + +`map` - shall be an expression of type `chaining_hash_map_type`. +It is an `intent(in)` argument. + +##### Result character + +The result will be an integer of kind `INT_INDEX`. + +##### Result value + +The result will be the number of entries in the hash map. + +##### Example + +```fortran + program demo_entries + use stdlib_chaining_hash_map, only: & + chaining_hash_map_type, entries, init_map, int_index, & + fnv_1_hasher + implicit none + type(chaining_hash_map_type) :: map + type(int_index) :: initial_entries + call init_map( map, fnv_1_hasher ) + initisl_entries = entries (map) + print *, "INITIAL_ENTRIES = ", initial_entries + end program demo_entries +``` + + +#### `get_other_data` - Returns other data belonging to the inverse table index + +##### Status + +Experimental + +##### Description + +Returns the other data associated with the inverse table index, + +##### Syntax + +`value = [[stdlib_chaining_hash_map:get_other_data)]]( map, inmap, other )` + +##### Class + +Subroutine + +##### Arguments + +`map`: shall be a scalar expression of type + `chaining_hash_map_type`. It is an `intent(in)` argument. It will be + the hash map used to store and access the other data. + +`inmap`: shall be a scalar integer expression of kind `int_index`. It + is an `intent(in)` argument. It should be the `inmap` returned by the + procedure `in_map` or `map_entry`. + +`other`: shall be a variable of type `other_data`. + It is an `intent(out)` argument. It is the other data associated + with the `inmap` index. + +* The following is an example of the retrieval of other data + associated with an inverse table index: + +##### Example + +```Fortran + program demo_get_other_data + use, intrinsic:: iso_fortran_env, only: & + int8 + use stdlib_chaining_hash_map, only: & + chaining_hash_map_type, fnv_1_hasher, get, get_other_data, & + int_index, key_type, map_entry, other_type, set + integer(int_index) :: inmap + type(key_type) :: key + type(other_type) :: other + type(chaining_hash_map_type) :: map + integer(int8), allocatable :: data(:) + call init_map( map, fnv_1_hasher ) + call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) + call set( other, [ 4_int8, 3_int8, 2_int8, 1_int8 ] ) + call map_entry( map, inmap, key, other ) + if ( inmap /= 0 ) then + call get_other_data( map, inmap, other ) + else + stop 'Invalid inmap' + end if + call get( other, data ) + print *, 'Other data = ', data + end program demo_get_other_data +``` + + +#### `in_map` - searches a map for the presence of a key + +##### Status + +Experimental + +##### Description + +Searches a hash map for the presence of a key and returns the +associated index into the inverse table. + +##### Syntax + +`call [[stdlib_chaining_hash_map:in_map]]( map, inmap, key )` + +##### Class + +Subroutine + +##### Arguments + +`map`: shall be a scalar variable of type `chaining_hash_map_type`. It + is an `intent(inout)` argument. It will be the hash map used to + store and access the entries. + +`inmap`: shall be a scalar integer variable of kind `INT_INDEX`. It is + an `intent(out)` argument. It will be 0 if `key` is not found, + otherwise it will be the one's based index to the location of `key` + in the hash map's inverse array. + +`key`: shall be a scalar expression of type `key_type`. + It is an `intent(in)` argument. It is the entry's key to be searched + for in the hash map. + +* The following is an example of the retrieval of other data associated with + a key: + +##### Example + +```Fortran + program demo_in_map + use, intrinsic:: iso_fortran_env, only: & + int8 + use stdlib_chaining_hash_map, only: & + chaining_hash_map_type, fnv_1_hasher, in_map, & + int_index, key_type, map_entry, other_type, set + integer(int_index) :: inmap + type(key_type) :: key + type(other_type) :: other + type(chaining_hash_map_type) :: map + call init_map( map, fnv_1_hasher ) + call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) + call set( other, [ 4_int8, 3_int8, 2_int8, 1_int8 ] ) + call map_entry( map, inmap, key, other ) + if ( inmap /= 0 ) then + call in_map( map, inmap, key + if ( inmap \= 0 ) then + print *, 'INMAP = ', inmap + else + stop 'Invalid inmap from in_map call' + else + stop 'Invalid inmap from map_entry call' + end if + end program demo_in_map +``` + +#### init_map - initializes a hash map + +##### Status + +Experimental + +##### Description + +Initializes a `chaining_hash_map_type` object. + +##### Syntax + +`call [[stdlib_chaining_hash_map:init_map]]( map, hasher [, slots_bits, max_bits, status ] ] )` + +####@# Class + +Subroutine + +##### Arguments + +`map`): shall be a scalar variable of type + `chaining_hash_map_type`. It is an `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`. + 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. + +`slots_bits` (optional): shall be a scalar default integer + expression. It is an `intent(in)` argument. The initial number of + slots in the table will be `2**slots_bits`. + +* `slots_bits` shall be a positive default integer less than + `max_slots_bits`, otherwise processing stops with an informative + error code. + +* If `slots_bits` is absent then the effective value for `slots_bits` + is `default_slots_bits`. + +`max_bits` (optional): shall be a scalar default integer + expression. It is an `intent(in)` argument. The number of slots + cannot exceed `2**max_bits`. + +* `max_bits` shall be a positive integer no greater than + `strict_max_bits`, otherwise processing stops with an informative + stop code. + +* If `maw_bits` is absent then the effective value for +`max_bits` is `default_max_bits`. + +`status` (optional): shall be a scalar integer variable of kind +`int32`. It is an `intent(out)` argument. On return if present it +shall have an error code value. + +* If map was successfully initialized then `status` has the value +`success`. + +* If allocation of memory for the `map` arrays fails then `status` +has the value `alloc_fault`. + +* If `max_bits < 6` or `max_bits > strict_max_bits` then `status` has + the value of `array_size_error`. + +* If `slot_bits < 6` or `slots_bits > map % max_bits` then `status` + has the value of `array_size_error`. + +* If `status` is absent, but `status` would have a value other than +`success`, then processing stops with an informative stop code. + +##### Example + + program demo_init_map + use stdlib_hash_tables, only: & + chaining_map_type, fnv_1_hasher & + init_map + type(fnv_1a_type) :: fnv_1 + type(chaining_map_type) :: map + call init_map( init_map, & + fnv_1a, & + slots_power=10, & + max_power=20 ) + end program demo_init_map + + + +#### `loading` - Returns the ratio of entries to slots + +##### Status + +Experimental + +##### Description + +Returns the ratio of the number of entries relative to the number of +slots in a hash map. + +##### Syntax + +`value = [[stdlib_chaining_hash_map:loading]]( map )` + +##### Class + +Pure function + +##### Argument + +`map` - shall be an expression of type `chaining_hash_map_type`. +It is an `intent(in)` argument. + +##### Result character + +The result will be a default real. + +##### Result value + +The result will be the ratio of the number of entries relative to the +number of slots in the hash map.? + +##### Example + +```fortran + program demo_loading + use stdlib_chaining_hash_map, only: & + chaining_hash_map_type, init_map, int_index, & + fnv_1_hasher, loading + implicit none + type(chaining_hash_map_type) :: map + real :: ratio + call init_map( map, fnv_1_hasher ) + ratio = loading (map) + print *, "Initial loading = ", ratio + end program demo_loading +``` + +#### `map_entry` - inserts an entry into the hash map + +##### Status + +Experimental + +##### Description + +Inserts an entry into the hash map if it is not already present. + +##### Syntax + +`call [[stdlib_chaining_hash_map:map_entry]]( map, inmap, key[, other ])` + + +##### Class + +Subroutine + +##### Arguments + +`map`: shall be a scalar variable of type `chaining_hash_map_type`. It +is an `intent(inout)` argument. It is the hash map to receive the +entry. + +`inmap`: shall be a integer scalar variable of kind `int_index`. It is + an `intent(out)` argument. It is the index to the table's inverse array + associated with the `key`. + +`key`: shall be either a scalar expression of type `key_type`. + It is an `intent(in)` argument. It is the key for the entry to be + placed in the table. + +`other` (optional): shall be a scalazr expression of type `other_type`. + It is an `intent(in)` argument. If present it is the other data to be + associated with the `key`. + +* If `key` is already present in `map` then the presence of `other` +is ignored. + +##### Example + + program demo_map_entry + use, intrinsic:: iso_fortran_env, only: & + int8 + use stdlib_chaining_hash_map, only: & + chaining_hash_map_type, fnv_1_hasher, init_map, & + int_index, key_type, map_entry, other_type, set + type(chaining_hash_map_type) :: map + type(key_type) :: key + type(other_type) :: other + integer(int_index) :: inmap + call init_map( map, & + fnv_1_hasher, & + slots_power=10, & + max_power=20 ) + call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) + call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) + call map_entry( map, inmap, key, other ) + print *, 'INMAP = ', inmap + end program demo_map_entry + + +#### `map_probes` - returns the number of hash map probes + +##### Status + +Experimental + +##### Description + +Returns the total number of table probes on a hash map + +##### Syntax + +`Result = [[stdlib_chaining_hash_map:map_probes]]( map )` + +##### Class + +Pure function + +##### Argument + +`map`: shall be a scalar integer expression of type +`chaining_hash_map_type`. It is an `intent(in)` argument. It is the +hash map of interest. + +##### Result character + +The result is a scalar integer of kind `int_probes`. + +##### Result value + +The result is the number of probes of `map`. + +##### Example + +```fortran + program demo_probes + use stdlib_chaining_hash_map, only: & + chaining_hash_map_type, init_map, int_index, & + fnv_1_hasher, probes + implicit none + type(chaining_hash_map_type) :: map + real :: ratio + call init_map( map, fnv_1_hasher ) + ratio = probes (map) + print *, "Initial probes = ", ratio + end program demo_probes +``` + + +#### rehash - changes the hashing function + +##### Status + +Experimental + +##### Description + +Changes the hashing function for the table entries to that of `hasher`. + +##### Syntax + +`call [[stdlib_chaining_hash_map:rehash]]( map, hasher )` + +##### Class + +Subroutine + +##### Arguments + +`map` : shall be a scalar variable of type `chaining_hash_map_type`. +It is an `intent(inout)` argument. It is the hash map whose hashing +method is to be changed. + +`hasher`: shall be a function of interface `hasher_fun`. +It is the hash method to be used by `map`. + +##### Example + + program demo_rehash_map + use stdlib_chaining_hash_map, only: & + chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& + init_map, int_index, key_type, map_entry, other_type, & + rehash_map, set + type(chaining_hash_map_type) :: map + type(key_type) :: key + type(other_type) :: other + integer(int_index) :: inmap + call init_map( map, & + fnv_1_hasher, & + slots_power=10, & + max_power=20 ) + call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) + call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) + call map_entry( map, inmap, key, other ) + call rehash_map( map, fnv_1a_hasher ) + end program demo_rehash_map + + +#### `remove_entry` - removes an entry from the hash map + +##### Status + +Experimental + +##### Description + +Removes an entry from a hash map, `map`. + +##### Syntax + +`call [[stdlib_chaining_hash_map:remove_entry]]( map, inmap )` + +##### Class + +Subroutine + +##### Arguments + +`map`: shall be a scalar variable of type `chaining_hash_map_type`. +It is an `intent(inout)` argument. It is the hash map with the element +to be removed. + +`inmap`: shall be a scalar integer expression of kind `int_index`. It +is an `intent(in)` argument. It is the index to the inverse table +identifying the entry to be removed. + +##### Example + + program demo_remove_entry + use stdlib_chaining_hash_map, only: & + chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& + init_map, int_index, key_type, map_entry, other_type, & + remove_entry, set + type(chaining_hash_map_type) :: map + type(key_type) :: key + type(other_type) :: other + integer(int_index) :: inmap + call init_map( map, & + fnv_1_hasher, & + slots_power=10, & + max_power=20 ) + call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) + call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) + call map_entry( map, inmap, key, other ) + call remove_entry( map, inmap ) + end program demo_remove_entry + + +#### `set_other_data` - replaces the other dataa for an entry + +##### Status + +Experimental + +##### Description + +Replaces the other data for the entry at index `inmap` in the +inverse table. + +##### Syntax + +`call [[stdlib_chaining_hash_map:set_other_data]]( map, inmap, other )` + +##### Class + +Subroutine + +##### Arguments + +`map`: shall be a scalar variable of type `chaining_hash_map_type`. It +is an `intent(inout)` argument. It will be a hash map used to store +and access the entry's data. + +`inmap`: shall be a scalar integer expression of kind `int_index`. It +is an `intent(in)` argument. It is the index in the inverse table to +the entry of interest. + +`other`: shall be a scalar expression of type `other_type`. +It is an `intent(in)` argument. It is the data to be stored as +the other data for the entry at the `inmap` index. + +* If unable to set the other data associated with `inmap`, either + because `inmap` is not associated with a valid entry or because of + allocation problems, then processing will stop with an informative + stop code. + +##### Example + + program demo_set_other_data + use stdlib_chaining_hash_map, only: & + chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& + init_map, int_index, key_type, map_entry, other_type, & + set, set_other_data + type(chaining_hash_map_type) :: map + type(key_type) :: key + type(other_type) :: other + integer(int_index) :: inmap + call init_map( map, & + fnv_1_hasher, & + slots_power=10, & + max_power=20 ) + call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) + Call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) + call map_entry( map, inmap, key, other ) + call set( other, [ 17_int8, 5_int8, 6_int8, 15_int8, 40_int8 ] ) + call set_other_data( map, inmap, other ) + end program demo_set_other_data + + +#### `slots` - returns the number of hash map probes + +##### Status + +Experimental + +##### Description + +Returns the total number of slots on a hash map + +##### Syntax + +`Result = [[stdlib_chaining_hash_map:slots]]( map )` + +##### Class + +Pure function + +##### Argument + +`map`: shall be a scalar expression of type +`chaining_hash_map_type`. It is an `intent(in)` argument. It is the +hash map of interest. + +##### Result character + +The result is a scalar integer of kind `int_index`. + +##### Result value + +The result is the number of slots in `map`. + +##### Example + +```fortran + program demo_probes + use stdlib_chaining_hash_map, only: & + chaining_hash_map_type, init_map, int_index, & + fnv_1_hasher, slots + implicit none + type(chaining_hash_map_type) :: map + integer(int_index) :: initial_slots + call init_map( map, fnv_1_hasher ) + initial_slots = slots (map) + print *, "Initial slots = ", initial_slots + end program demo_probes +``` + + +#### `total_depth` - returns the total depth of the hash map entries + +##### Status + +Experimental + +##### Description + +Returns the total number of one's based offsets of slot entries from +their slot index for a hash map + +##### Syntax + +`Result = [[stdlib_chaining_hash_map:total_depth]]( map )` + +##### Class + +Pure function + +##### Argument + +`map`: shall be a scalar expression of type +`chaining_hash_map_type`. It is an `intent(in)` argument. It is the +hash map of interest. + +##### Result character + +The result is a scalar integer of kind `int_depth`. + +##### Result value + +The result is the total number of one's based offsets of slot entries +from their slot index the map. + +##### Example + +```fortran + program demo_probes + use stdlib_chaining_hash_map, only: & + chaining_hash_map_type, init_map, int_index, & + fnv_1_hasher, total_depth + implicit none + type(chaining_hash_map_type) :: map + integer(int_depth) :: initial_depth + call init_map( map, fnv_1_hasher ) + initial_depth = total_depth (map) + print *, "Initial total depth = ", initial_depth + end program demo_probes +``` + + +#### `unmap` - returns a copy of the key + +##### Status + +Experimental + +##### Description + +Returns a copy of the key associated with an index to the +inverse table. + +##### Syntax + +`call [[stdlib_chaining_hash_map:unmap]]( map, inmap, key )` + +##### Class + +Subroutine + +##### Arguments + +`map`: shall be a scalar expression of type `chaining_hash_map_type. +It is an `intent(in)` argument. It is the hash map whose entry +is unmapped. + +`inmap`: shall be a scalar integer expression of kind `int_index`. It +is an `intent(in)` argument. It is the index to the inverse table +identifying the unmapped entry. + +`key`: shall be a variable of type `key_type` +`INT8`, or an allocatable length default character. It is an +`intent(out)` argument. It is the `key` associated with the entry at +index `inmap` in the inverse table. + +##### Example + + program demo_unmap + use stdlib_chaining_hash_map, only: & + chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& + init_map, int_index, key_type, map_entry, other_type, & + set, unmap + type(chaining_hash_map_type) :: map + type(key_type) :: key + type(other_type) :: other + integer(int_index) :: inmap + call init_map( map, & + fnv_1_hasher, & + slots_power=10, & + max_power=20 ) + call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) + call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) + call map_entry( map, inmap, key, other ) + call unmap( map, inmap, key ) + end program demo_unmap + + +#### `valid_index` - indicates whether `inmap` is a valid index + +##### Status + +Experimental + +##### Description + +Returns a flag indicating whether `inmap` is a valid index in the +inverse table. + +##### Syntax + +`result = [[stdlib_chaining_hash_map:valid_index]]( map, inmap )` + +##### Class + +Pure function. + +##### Arguments + +`map`: shall be a scalar expression of type `chaining_hash_map_type`. +It is an `intent(in)` argument. It is the hash map whose inverse +table is examined. + +`inmap`: shall be a scalar integer expression of kind `int_index`. It +is an `intent(in)` argument. It is the index to the inverse table whose +validity is being examined. + +##### Result character + +The result is a default logical scalar. + +##### Result value + +The result is `.true.` if `inmap` is a valid index to the inverse +table of `map` and `.false.` otherwise. + +##### Example + +```fortran + program demo_valid_index + use stdlib_chaining_hash_map, only: & + chaining_hash_map_type, init_map, int_index, & + fnv_1_hasher, valid_index + implicit none + type(chaining_hash_map_type) :: map + integer(int_index) :: inmap + logocal :: valid + call init_map( map, fnv_1_hasher ) + inmap = 10 + valid = valid_index (map, inmap) + print *, "Initial index of 10 valid for empty map = ", valid + end program demo_valid_index +``` + + +## The `stdlib_open_hash_map` module + +The `stdlib_open_hash_map` module provides access to all the +public entities of the `stdlib_32_bit_key_data_wrapper` module. It +also defines a public data type and associated procedures and +constants that implement a simple hash map using +linear open addressing hashing. The derived type is +`open_hash_map_type`. It provides +procedures to manipulate the structure of the hash map: +`init_map`, `map_entry`, `rehash_map`, and `set_other_data`. It +provides procedures to inquire about entries in the hash map: +`get_other_data`, `in_map`, `unmap`.and `valid_index`. Finally it +provides procedures to inquire about the overall structure and +performance of the table:`calls`, `entries`, `get_other_data`, +`load_factor`, `loading`, `slots`, and `total_depth`. The module +also defines a number of public constants: `inmap_probe_factor`, +`map_probe_factor`, `default_load_factor`, `default_max_bits`, +`default_bits`, `strict_max_bits`, `int_calls`, `int_depth`, +`int_index`, `int_probes`, `success`, `alloc_fault`, +`array_size_error`, and `real_value_error`. + +### The `stdlib_open_hash_map` module's public constants + +The module defines several categories of public constants. Some are +used to parameterize the empirical slot expansion code. Others +parameterize the slots table size, Some are used to define +integer kind values for different applications. Finally, some are used +to report errors or success. + +The constants `inmap_probe_factor`, `map_probe_factor`, and +`default_load_factor` are used to parameterize the slot expansion code +used to determine when in a `inchain_map_call` the number +of slots need to be increased to decrease the lengths of the linked +lists. The constant `inmap_probe_factor` is used to determine when +the ratio of the number of map probes to map calls is too large and +the slots need expansion. The constant `map_probe_factor` is used to +determine when inserting a new entry the ratio of the number of map +probes to map calls is too large and the slots need expansion. + +The constants `default_bits`, `default_max_bits`, and +`strict_max_bits` are used to parameterize the table's slots size. The +`default_bits` constant defines the default initial number of slots +with a current value of 6 resulting in an initial `2**6 == 64` +slots. This may optionally be overridden on hash map creation. The +`default_max_bits` is the default value for the table's `max_bits` +component that sets the maximum table size as `2**max_bits`. This may +also be overridden on table creation. Then `strict_max_bits` +defines the maximum value for `default_max_bits`. This cannot be +overridden on hash map creation. Because signed 32 bit integers are +used for the hash code, `strict_max_bits` must be no greater than 31, +but as probably large values of `max_bits` benefit from a 64 bit hash +code, `strict_max_size` is currently set to 24, so the current table +is assumed to be useful only for tables up to size `2**24` slots. As +open is used for this table the number of entries can be +significantly larger than the number of slots. Finally, +`default_load_factor` provides a default value for `load_factor`. The +`load_factor` determines the maximum number of entries allowed +relative to the number of slots prior to automatically resizing the +table upon entry insertion. The `load_factor` is a tradeoff between +runtime performance and memory usage, with smaller values of +`load_factor` having the best runtime performance and larger.values +the smaller memory footprint, with common choices being `0.5 <= +load_factor <= 0.75`. The `default_load_factor` currently has a value +of `0.25`. This default can be overridden at table +creation, with initialization allowing values `0.375 <= load_factor +<= 0.75`. + +The constants `int_calls`, `int_depth`, `int_index`, and `int_probes` +are used to define integer kind values for various contexts. The +number of calls are reported and stored in entities of kind +`int_calls`. Currently `int_calls` has the value of `INT64`. The +total depth, the number of inquiries needed to access all elements +of the table, is reported and stored in entities of kind +`int_depth`. Currently `int_depth` has the value of `INT64`. The +number of entries in the table, is reported and stored in entities of +kind `int_index`. Currently `int_index` has the value of `INT32`. +The number of probes, hash map enquiries, are reported and stored in +entities of kind `int_probes`. Currently `int_probes` has the value of +`INT64`. + +Finally the error codes `success`, `alloc_fault`, and +`array_size_error` are used to report the error status of certain +procedure calla. The `succes` code indicates that no problems were +found. The `alloc_fault` code indicates that a memory allocation +failed. The `array_size_error` indicates that on table +creation `slots_bits` or `max_bits` are less than `default_bits` or +greater than `strict_max_bits`, respectively. Finally, on table +creation `real_value_error` indicates that the `load_factor` exceeds +the range `0.375 <= load_factor <= 0.75`. + +### The `stdlib_open_hash_map` module's derived types + +The `stdlib_open_hash_map` module defines several derived +types. The only public type is the `open_hash_map_type`. There are +three other private derived types used in the implementation of the +public type: `open_map_entry_type`, and `open_map_entry_ptr`. + +#### The `open_map_entry_type` derived type + +Entities of the type `open_map_entry_type` are used to define +a linked list structure that stores the +key, its other data, the hash of the key, and the resulting index into +the inverse table. The type's definition is below: + +```fortran + type :: open_map_entry_type ! Open hash map entry type + private + integer(int_hash) :: hash_val ! Full hash value + type(key_type) :: key ! The entry's key + type(other_type) :: other ! Other entry data + integer(int_index) :: index ! Index into inverse table + end type open_map_entry_type +``` +Currently the `INT_HASH` and `INT_INDEX` have the value of `INT32`. + +#### The `open_map_entry_ptr` derived type + +The type `open_map_entry_ptr` are used to define the elements of +the hash map that are either empty or link to the linked lists +containing the elements of the table. The type's definition is below: + +```fortran + type open_map_entry_ptr ! Wrapper for a pointer to a open + ! map entry type object + type(open_map_entry_type), pointer :: target => null() + end type open_map_entry_ptr +``` + +#### The `open_hash_map_type` derived type + +The `open_hash_map_type` derived type implements a separate +open hash map. It provides the elements `calls`, `probes`, +`total_probes`, `entries`, `slots_bits`, and `max_bits` to keep track +of the hash map's usage. The array element `slots` serves as the +table proper. The array element `inverse` maps integers to +entries. The linked list entry, `free_list`, keeps track of freed +elements of type `open_map_entry_type`. The list element, `cache`, +stores pools of `open_map_entry_type` elements for reuse. The +component `hasher` is a pointer to the hash function. Finally the +type-bound procedure, `free_open_map`, serves as a finalizer for +objects of the type, `open_hash_map_type`. + +```fortran + type :: open_hash_map_type + private + integer(int_calls) :: calls = 0 + ! Number of calls + integer(int_calls) :: probes = 0 + ! Number of probes since last expansion + integer(int_calls) :: total_probes = 0 + ! Cumulative number of probes +` integer(int_index) :: entries = 0 + ! Number of entries + integer(int_index) :: index_mask = 2_int_index**default_bits-1 + ! Mask used in linear addressing + integer(int32) :: slots_bits = default_bits + ! Bits used for slots size + integer(int32) :: max_bits = default_max_bits + ! Maximum value of slots_bits + type(open_map_entry_ptr), allocatable :: slots(:) + ! Array of bucket lists Note # slots=size(slots) + type(open_map_entry_ptr), allocatable :: inverse(:) + ! Array of bucket lists (inverses) Note max_elts=size(inverse) + procedure(hasher_fun), pointer, nopass :: hasher => fnv_1_hasher + ! Hash function + contains + final :: free_open_map + end type open_hash_map_type +``` + +### Table of `stdlib_open_ehash_map` procedures + +The `stdlib_open_hash_map` module provides procedures in +several categories: a procedure to initialize the map; a procedure to +modify the structure of a map; procedures to modify the content of a +map; procedures to report on the content of a map; and procedures +to report on the structure of the map. The procedures in each category +are listed below. + +Procedure to initialize a chaining hash map: + +* `init_map( map, hasher[, slots_bits, max_bits, load_factor, status] + )` - Routine to initialize a chaining hash map. + +Procedure to modify the structure of a map: + +* `rehash_map( map, hasher )` - Routine to change the hash function + for a map. + +Procedures to modify the content of a map: + +* `map_entry( map, inmap, key, other )` - Inserts an entry innto the + hash map. + +* `set_other_data( map, inmap, other )` - Change the other data + associated with the entry. + +Procedures to report the content of a map: + +* `get_other_data( map, inmap, other )` - Returns the other data + associated with the inverse table index + +* `in_map( map, inmap, key )` - Returns the index into the INVERSE + array associated with the KEY + +* `unmap( map, inmap, key )` - Returns a copy of the key associated +with an index to the inverse table. + +* `valid_index(map, inmap)` - Returns a flag indicating whether INMAP + is a valid index. + +Procedures to report on the structure of the map: + +* `calls( map )` - the number of subroutine calls on the hash map. + +* `entries( map )`- the number of entries in a hash map. + +* `load_factor( mP )` - Returns the maximum number of entries relative + to slots in a open addressing hash map + +* `loading( map )` - the number of entries relative to slots in a hash + map. + +* `map_probes( map )` - the total number of table probes on a hash + map. + +* `slots( map )` - Returns the number of allocated slots in a hash + map. + +* `total_depth( map )` - Returns the total number of one's based +offsets of slot entries from their slot index + + +### Specifications of the `stdlib_open_hash_map` procedures + +#### `calls` - Returns the number of calls on a hash map + +##### Status + +Experimental + +##### Description + +Returns the number of procedure calls on a hash map. + +##### Syntax + +`value = [[stdlib_open_hash_map:calls]]( map )` + +##### Class + +Pure function + +##### Argument + +`map` - shall be an expression of type `open_hash_map_type`. +It is an `intent(in)` argument. + +##### Result character + +The result will be an integer of kind `INT_CALLS`. + +##### Result value + +The result will be the number of procedure calls on the hash map. + +##### Example + +```fortran + program demo_calls + use stdlib_open_hash_map, only: & + open_hash_map_type, calls, init_map, int_calls, & + fnv_1_hasher + implicit none + type(open_hash_map_type) :: map + type(int_calls) :: initial_calls + call init_map( map, fnv_1_hasher ) + initisl_calls = calls (map) + print *, "INITIAL_CALLS = ", initial_calls + end program demo_calls +``` + + +#### `entries` - Returns the number of entries in a hash map + +##### Status + +Experimental + +##### Description + +Returns the number of entries in a hash map. + +##### Syntax + +`value = [[stdlib_open_hash_map:entries]]( map )` + +##### Class + +Pure function + +##### Argument + +`map` - shall be an expression of type `open_hash_map_type`. +It is an `intent(in)` argument. + +##### Result character + +The result will be an integer of kind `INT_INDEX`. + +##### Result value + +The result will be the number of entries in the hash map. + +##### Example + +```fortran + program demo_entries + use stdlib_open_hash_map, only: & + open_hash_map_type, entries, init_map, int_index, & + fnv_1_hasher + implicit none + type(open_hash_map_type) :: map + type(int_index) :: initial_entries + call init_map( map, fnv_1_hasher ) + initisl_entries = entries (map) + print *, "INITIAL_ENTRIES = ", initial_entries + end program demo_entries +``` + + +#### `get_other_data` - Returns other data belonging to the inverse table index + +##### Status + +Experimental + +##### Description + +Returns the other data associated with the inverse table index, + +##### Syntax + +`value = [[stdlib_open_hash_map:get_other_data)]]( map, inmap, other )` + +##### Class + +Subroutine + +##### Arguments + +`map`: shall be a scalar expression of type + `open_hash_map_type`. It is an `intent(in)` argument. It will be + the hash map used to store and access the other data. + +`inmap`: shall be a scalar integer expression of kind `int_index`. It + is an `intent(in)` argument. It should be the `inmap` returned by the + procedure `in_map` or `map_entry`. + +`other`: shall be a variable of type `other_data`. + It is an `intent(out)` argument. It is the other data associated + with the `inmap` index. + +* The following is an example of the retrieval of other data + associated with an inverse table index: + +##### Example + +```Fortran + program demo_get_other_data + use, intrinsic:: iso_fortran_env, only: & + int8 + use stdlib_open_hash_map, only: & + open_hash_map_type, fnv_1_hasher, get, get_other_data, & + int_index, key_type, map_entry, other_type, set + integer(int_index) :: inmap + type(key_type) :: key + type(other_type) :: other + type(open_hash_map_type) :: map + integer(int8), allocatable :: data(:) + call init_map( map, fnv_1_hasher ) + call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) + call set( other, [ 4_int8, 3_int8, 2_int8, 1_int8 ] ) + call map_entry( map, inmap, key, other ) + if ( inmap /= 0 ) then + call get_other_data( map, inmap, other ) + else + stop 'Invalid inmap' + end if + call get( other, data ) + print *, 'Other data = ', data + end program demo_get_other_data +``` + + +#### `in_map` - searches a map for the presence of a key + +##### Status + +Experimental + +##### Description + +Searches a hash map for the presence of a key and returns the +associated index into the inverse table. + +##### Syntax + +`call [[stdlib_open_hash_map:in_map]]( map, inmap, key )` + +##### Class + +Subroutine + +##### Arguments + +`map`: shall be a scalar variable of type `open_hash_map_type`. It + is an `intent(inout)` argument. It will be the hash map used to + store and access the entries. + +`inmap`: shall be a scalar integer variable of kind `INT_INDEX`. It is + an `intent(out)` argument. It will be 0 if `key` is not found, + otherwise it will be the one's based index to the location of `key` + in the hash map's inverse array. + +`key`: shall be a scalar expression of type `key_type`. + It is an `intent(in)` argument. It is the entry's key to be searched + for in the hash map. + +* The following is an example of the retrieval of other data associated with + a key: + +##### Example + +```Fortran + program demo_in_map + use, intrinsic:: iso_fortran_env, only: & + int8 + use stdlib_open_hash_map, only: & + open_hash_map_type, fnv_1_hasher, in_map, & + int_index, key_type, map_entry, other_type, set + integer(int_index) :: inmap + type(key_type) :: key + type(other_type) :: other + type(open_hash_map_type) :: map + call init_map( map, fnv_1_hasher ) + call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) + call set( other, [ 4_int8, 3_int8, 2_int8, 1_int8 ] ) + call map_entry( map, inmap, key, other ) + if ( inmap /= 0 ) then + call in_map( map, inmap, key + if ( inmap \= 0 ) then + print *, 'INMAP = ', inmap + else + stop 'Invalid inmap from in_map call' + else + stop 'Invalid inmap from map_entry call' + end if + end program demo_in_map +``` + +#### init_map - initializes a hash map + +##### Status + +Experimental + +##### Description + +Initializes a `open_hash_map_type` object. + +##### Syntax + +`call [[stdlib_open_hash_map:init_map]]( map, hasher[, slots_bits, max_bits, load_factor, status ] ] )` + +####@# Class + +Subroutine + +##### Arguments + +`map`): shall be a scalar variable of type + `open_hash_map_type`. It is an `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`. + 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. + +`slots_bits` (optional): shall be a scalar default integer + expression. It is an `intent(in)` argument. The initial number of + slots in the table will be `2**slots_bits`. + +* `slots_bits` shall be a positive default integer less than + `max_slots_bits`, otherwise processing stops with an informative + error code. + +* If `slots_bits` is absent then the effective value for `slots_bits` + is `default_slots_bits`. + +`max_bits` (optional): shall be a scalar default integer + expression. It is an `intent(in)` argument. The number of slots + cannot exceed `2**max_bits`. + +* `max_bits` shall be a positive integer no greater than + `strict_max_bits`, otherwise processing stops with an informative + stop code. + +* If `maw_bits` is absent then the effective value for +`max_bits` is `default_max_bits`. + +`load_factor` (optional): shall be a scalar default real expression. +it is an `intent(in) argument. + +* `load_factor` shall be a positive real such that `0.375 <= + load_factor <= 0.75`, otherwise processing stops with an informative + stop code. + +`status` (optional): shall be a scalar integer variable of kind +`int32`. It is an `intent(out)` argument. On return if present it +shall have an error code value. + +* If map was successfully initialized then `status` has the value +`success`. + +* If allocation of memory for the `map` arrays fails then `status` +has the value `alloc_fault`. + +* If `max_bits < 6` or `max_bits > strict_max_bits` then `status` has + the value of `array_size_error`. + +* If `slot_bits < 6` or `slots_bits > map % max_bits` then `status` + has the value of `array_size_error`. + +* If `load_factor < 0.375` or `load_factor > 0.75` then `status` + has the value of `real_value_error`. + +* If `status` is absent, but `status` would have a value other than +`success`, then processing stops with an informative stop code. + +##### Example + + program demo_init_map + use stdlib_hash_tables, only: & + open_map_type, fnv_1_hasher & + init_map + type(fnv_1a_type) :: fnv_1 + type(open_map_type) :: map + call init_map( init_map, & + fnv_1a, & + slots_power=10, & + max_power=20, & + load)_factor=0.5 ) + end program demo_init_map + + + +#### `load_factor` - Returns the load_factor of a hash map + +##### Status + +Experimental + +##### Description + +Returns the maximum number of entries relative to slots in a hash +map. + +##### Syntax + +`value = [[stdlib_open_hash_map:load_factor]]( map )` + +##### Class + +Pure function + +##### Argument + +`map` - shall be an expression of type `open_hash_map_type`. +It is an `intent(in)` argument. + +##### Result character + +The result will be a default `REAL`. + +##### Result value + +The result will be the maximum number of entries relative to slots in +the open addressing hash map. + +##### Example + +```fortran + program demo_load_factor + use stdlib_open_hash_map, only: & + open_hash_map_type, init_map, int_index, & + fnv_1_hasher, load_factor + implicit none + type(open_hash_map_type) :: map + real :: initial_factor + call init_map( map, fnv_1_hasher ) + initisl_factor = load_factor (map) + print *, "Initial load_factor = ", initial_factor + end program demo_load_factor +``` + + +#### `loading` - Returns the ratio of entries to slots + +##### Status + +Experimental + +##### Description + +Returns the ratio of the number of entries relative to the number of +slots in a hash map. + +##### Syntax + +`value = [[stdlib_open_hash_map:loading]]( map )` + +##### Class + +Pure function + +##### Argument + +`map` - shall be an expression of type `open_hash_map_type`. +It is an `intent(in)` argument. + +##### Result character + +The result will be a default real. + +##### Result value + +The result will be the ratio of the number of entries relative to the +number of slots in the hash map.? + +##### Example + +```fortran + program demo_loading + use stdlib_open_hash_map, only: & + open_hash_map_type, init_map, int_index, & + fnv_1_hasher, loading + implicit none + type(open_hash_map_type) :: map + real :: ratio + call init_map( map, fnv_1_hasher ) + ratio = loading (map) + print *, "Initial loading = ", ratio + end program demo_loading +``` + +#### `map_entry` - inserts an entry into the hash map + +##### Status + +Experimental + +##### Description + +Inserts an entry into the hash map if it is not already present. + +##### Syntax + +`call [[stdlib_open_hash_map:map_entry]]( map, inmap, key[, other ])` + + +##### Class + +Subroutine + +##### Arguments + +`map`: shall be a scalar variable of type `open_hash_map_type`. It +is an `intent(inout)` argument. It is the hash map to receive the +entry. + +`inmap`: shall be a integer scalar variable of kind `int_index`. It is + an `intent(out)` argument. It is the index to the table's inverse array + associated with the `key`. + +`key`: shall be either a scalar expression of type `key_type`. + It is an `intent(in)` argument. It is the key for the entry to be + placed in the table. + +`other` (optional): shall be a scalazr expression of type `other_type`. + It is an `intent(in)` argument. If present it is the other data to be + associated with the `key`. + +* If `key` is already present in `map` then the presence of `other` +is ignored. + +##### Example + + program demo_map_entry + use, intrinsic:: iso_fortran_env, only: & + int8 + use stdlib_open_hash_map, only: & + open_hash_map_type, fnv_1_hasher, init_map, & + int_index, key_type, map_entry, other_type, set + type(open_hash_map_type) :: map + type(key_type) :: key + type(other_type) :: other + integer(int_index) :: inmap + call init_map( map, & + fnv_1_hasher, & + slots_power=10, & + max_power=20 ) + call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) + call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) + call map_entry( map, inmap, key, other ) + print *, 'INMAP = ', inmap + end program demo_map_entry + + +#### `map_probes` - returns the number of hash map probes + +##### Status + +Experimental + +##### Description + +Returns the total number of table probes on a hash map + +##### Syntax + +`Result = [[stdlib_open_hash_map:map_probes]]( map )` + +##### Class + +Pure function + +##### Argument + +`map`: shall be a scalar integer expression of type +`open_hash_map_type`. It is an `intent(in)` argument. It is the +hash map of interest. + +##### Result character + +The result is a scalar integer of kind `int_probes`. + +##### Result value + +The result is the number of probes of `map`. + +##### Example + +```fortran + program demo_probes + use stdlib_open_hash_map, only: & + open_hash_map_type, init_map, int_index, & + fnv_1_hasher, probes + implicit none + type(open_hash_map_type) :: map + real :: ratio + call init_map( map, fnv_1_hasher ) + ratio = probes (map) + print *, "Initial probes = ", ratio + end program demo_probes +``` + + +#### rehash - changes the hashing function + +##### Status + +Experimental + +##### Description + +Changes the hashing function for the table entries to that of `hasher`. + +##### Syntax + +`call [[stdlib_open_hash_map:rehash]]( map, hasher )` + +##### Class + +Subroutine + +##### Arguments + +`map` : shall be a scalar variable of type `open_hash_map_type`. +It is an `intent(inout)` argument. It is the hash map whose hashing +method is to be changed. + +`hasher`: shall be a function of interface `hasher_fun`. +It is the hash method to be used by `map`. + +##### Example + + program demo_rehash_map + use stdlib_open_hash_map, only: & + open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& + init_map, int_index, key_type, map_entry, other_type, & + rehash_map, set + type(open_hash_map_type) :: map + type(key_type) :: key + type(other_type) :: other + integer(int_index) :: inmap + call init_map( map, & + fnv_1_hasher, & + slots_power=10, & + max_power=20 ) + call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) + call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) + call map_entry( map, inmap, key, other ) + call rehash_map( map, fnv_1a_hasher ) + end program demo_rehash_map + + +#### `set_other_data` - replaces the other dataa for an entry + +##### Status + +Experimental + +##### Description + +Replaces the other data for the entry at index `inmap` in the +inverse table. + +##### Syntax + +`call [[stdlib_open_hash_map:set_other_data]]( map, inmap, other )` + +##### Class + +Subroutine + +##### Arguments + +`map`: shall be a scalar variable of type `open_hash_map_type`. It +is an `intent(inout)` argument. It will be a hash map used to store +and access the entry's data. + +`inmap`: shall be a scalar integer expression of kind `int_index`. It +is an `intent(in)` argument. It is the index in the inverse table to +the entry of interest. + +`other`: shall be a scalar expression of type `other_type`. +It is an `intent(in)` argument. It is the data to be stored as +the other data for the entry at the `inmap` index. + +* If unable to set the other data associated with `inmap`, either + because `inmap` is not associated with a valid entry or because of + allocation problems, then processing will stop with an informative + stop code. + +##### Example + + program demo_set_other_data + use stdlib_open_hash_map, only: & + open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& + init_map, int_index, key_type, map_entry, other_type, & + set, set_other_data + type(open_hash_map_type) :: map + type(key_type) :: key + type(other_type) :: other + integer(int_index) :: inmap + call init_map( map, & + fnv_1_hasher, & + slots_power=10, & + max_power=20 ) + call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) + call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) + call map_entry( map, inmap, key, other ) + call set( other, [ 17_int8, 5_int8, 6_int8, 15_int8, 40_int8 ] + call set_other_data( map, inmap, other ) + end program demo_set_other_data + + +#### `slots` - returns the number of hash map probes + +##### Status + +Experimental + +##### Description + +Returns the total number of slots on a hash map + +##### Syntax + +`Result = [[stdlib_open_hash_map:slots]]( map )` + +##### Class + +Pure function + +##### Argument + +`map`: shall be a scalar expression of type +`open_hash_map_type`. It is an `intent(in)` argument. It is the +hash map of interest. + +##### Result character + +The result is a scalar integer of kind `int_index`. + +##### Result value + +The result is the number of slots in `map`. + +##### Example + +```fortran + program demo_probes + use stdlib_open_hash_map, only: & + open_hash_map_type, init_map, int_index, & + fnv_1_hasher, slots + implicit none + type(open_hash_map_type) :: map + integer(int_index) :: initial_slots + call init_map( map, fnv_1_hasher ) + initial_slots = slots (map) + print *, "Initial slots = ", initial_slots + end program demo_probes +``` + + +#### `total_depth` - returns the total depth of the hash map entries + +##### Status + +Experimental + +##### Description + +Returns the total number of one's based offsets of slot entries from +their slot index for a hash map + +##### Syntax + +`Result = [[stdlib_open_hash_map:total_depth]]( map )` + +##### Class + +Pure function + +##### Argument + +`map`: shall be a scalar expression of type +`open_hash_map_type`. It is an `intent(in)` argument. It is the +hash map of interest. + +##### Result character + +The result is a scalar integer of kind `int_depth`. + +##### Result value + +The result is the total number of one's based offsets of slot entries +from their slot index the map. + +##### Example + +```fortran + program demo_probes + use stdlib_open_hash_map, only: & + open_hash_map_type, init_map, int_index, & + fnv_1_hasher, total_depth + implicit none + type(open_hash_map_type) :: map + integer(int_depth) :: initial_depth + call init_map( map, fnv_1_hasher ) + initial_depth = total_depth (map) + print *, "Initial total depth = ", initial_depth + end program demo_probes +``` + + +#### `unmap` - returns a copy of the key + +##### Status + +Experimental + +##### Description + +Returns a copy of the key associated with an index to the +inverse table. + +##### Syntax + +`call [[stdlib_open_hash_map:unmap]]( map, inmap, key )` + +##### Class + +Subroutine + +##### Arguments + +`map`: shall be a scalar expression of type `open_hash_map_type. +It is an `intent(in)` argument. It is the hash map whose entry +is unmapped. + +`inmap`: shall be a scalar integer expression of kind `int_index`. It +is an `intent(in)` argument. It is the index to the inverse table +identifying the unmapped entry. + +`key`: shall be a variable of type `key_type` +`INT8`, or an allocatable length default character. It is an +`intent(out)` argument. It is the `key` associated with the entry at +index `inmap` in the inverse table. + +##### Example + + program demo_unmap + use stdlib_open_hash_map, only: & + open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& + init_map, int_index, key_type, map_entry, other_type, & + unmap + type(open_hash_map_type) :: map + type(key_type) :: key + type(other_type) :: other + integer(int_index) :: inmap + call init_map( map, & + fnv_1_hasher, & + slots_power=10, & + max_power=20 ) + call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) + call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) + call map_entry( map, inmap, key, other ) + call unmap( map, inmap, key ) + end program demo_unmap + + +#### `valid_index` - indicates whether `inmap` is a valid index + +##### Status + +Experimental + +##### Description + +Returns a flag indicating whether `inmap` is a valid index in the +inverse table. + +##### Syntax + +`result = [[stdlib_open_hash_map:valid_index]]( map, inmap )` + +##### Class + +Pure function. + +##### Arguments + +`map`: shall be a scalar expression of type `open_hash_map_type`. +It is an `intent(in)` argument. It is the hash map whose inverse +table is examined. + +`inmap`: shall be a scalar integer expression of kind `int_index`. It +is an `intent(in)` argument. It is the index to the inverse table whose +validity is being examined. + +##### Result character + +The result is a default logical scalar. + +##### Result value + +The result is `.true.` if `inmap` is a valid index to the inverse +table of `map` and `.false.` otherwise. + + +##### Example + +```fortran + program demo_valid_index + use stdlib_open_hash_map, only: & + open_hash_map_type, init_map, int_index, & + fnv_1_hasher, valid_index + implicit none + type(open_hash_map_type) :: map + integer(int_index) :: inmap + logocal :: valid + call init_map( map, fnv_1_hasher ) + inmap = 10 + valid = valid_index (map, inmap) + print *, "Initial index of 10 valid for empty map = ", valid + end program demo_valid_index +``` + From e0339c6316d2b762c772c373b43fa396b567aaf3 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 27 Dec 2021 12:54:57 -0700 Subject: [PATCH 02/77] Fixed typos Fixedd typos in stdlib_hash_maps.md [ticket: X] --- doc/specs/stdlib_hash_maps.md | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 0e597b49f..d94b72735 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -46,16 +46,16 @@ with a different API. There are three modules: `stdlib_open_hash_map`, corresponding to the files: `stdlib_32_bit_key_data_wrapper.f90`, `stdlib_chaining_hash_map.f90`, and `stdlib_open_hash_map.f90`. The module -`stdlib_32_bit_key_data_wrapper` providess an interface to the 32 bit +`stdlib_32_bit_key_data_wrapper` provides an interface to the 32 bit hash functions of the Standard Library module, `stdlib_32_bit_hash_functions`, providing wrappers to some of the hash functions so that they no longer need to be supplied seeds. The module `stdlib_chaining_hash_map` defines a datatype, `chaining_hash_map_type`, implementing a simple separate chaining hash -map noted more for its diagnotics than its performance. Finally the +map noted more for its diagnostics than its performance. Finally the module, `stdlib_open_hash_map` defines a datatype, `open_hash_map_type`, implementing a simple open addressing hash -map noted more for its diagnotics than its performance. +map noted more for its diagnostics than its performance. These maps use separate chaining with linked lists and linear open addressing, respectively, to deal with hash index collisions, and are @@ -67,7 +67,7 @@ In `open_hash_map_type`, the colliding indices are handled by searching from the initial hash index in increasing steps of one (modulo the hash map size) for an open map bin. -The maps share many attributes in common. The two types share a +The maps share many attributes in common. The two types share a common Application Programers Interface (API). The maps use powers of two for their slot sizes, so that the function, `fibonacci_hash`, can be used to map the hash codes to indices in the map. This is @@ -136,7 +136,7 @@ those types. ### Table of `stdlib_32_bit_key_data_wrapper` procedures The `stdlib_32_bit_key_data_wrapper` module provides procedures in -several categories: procedures to mamipulate data of the `key_type`; +several categories: procedures to manipulate data of the `key_type`; procedures to manipulate data of the `other_type`, and 32 bit hash functions for keys. The procedures in each category are listed below. @@ -593,7 +593,7 @@ is an `intent(in)` argument. `other`: shall be a scalar expression of type `other_type`. It is an `intent(in)` argument. -`value`: shall be an allocatable default character string variabl, or +`value`: shall be an allocatable default character string variable, or an allocatable vector variable of type integer and kind `INT8`. It is an `intent(out)` argument. @@ -983,7 +983,7 @@ vector expression of type integer and kind `INT8`. It is an ## The `stdlib_chaining_hash_map` module The `stdlib_chaining_hash_map` module provides access to all the -public entities of the `stdlib_32_bit_key_data_wrapper` module. It +public entities in the `stdlib_32_bit_key_data_wrapper` module. It also defines a public data type and associated procedures and constants that implement a simple hash map using separate chaining hashing. The derived type is @@ -1609,7 +1609,7 @@ Subroutine is an `intent(inout)` argument. It is the hash map to receive the entry. -`inmap`: shall be a integer scalar variable of kind `int_index`. It is +`inmap`: shall be an integer scalar variable of kind `int_index`. It is an `intent(out)` argument. It is the index to the table's inverse array associated with the `key`. @@ -1617,7 +1617,7 @@ entry. It is an `intent(in)` argument. It is the key for the entry to be placed in the table. -`other` (optional): shall be a scalazr expression of type `other_type`. +`other` (optional): shall be a scalar expression of type `other_type`. It is an `intent(in)` argument. If present it is the other data to be associated with the `key`. @@ -2072,7 +2072,7 @@ table of `map` and `.false.` otherwise. ## The `stdlib_open_hash_map` module The `stdlib_open_hash_map` module provides access to all the -public entities of the `stdlib_32_bit_key_data_wrapper` module. It +public entities in the `stdlib_32_bit_key_data_wrapper` module. It also defines a public data type and associated procedures and constants that implement a simple hash map using linear open addressing hashing. The derived type is @@ -2750,7 +2750,7 @@ Subroutine is an `intent(inout)` argument. It is the hash map to receive the entry. -`inmap`: shall be a integer scalar variable of kind `int_index`. It is +`inmap`: shall be an integer scalar variable of kind `int_index`. It is an `intent(out)` argument. It is the index to the table's inverse array associated with the `key`. @@ -2758,7 +2758,7 @@ entry. It is an `intent(in)` argument. It is the key for the entry to be placed in the table. -`other` (optional): shall be a scalazr expression of type `other_type`. +`other` (optional): shall be a scalar expression of type `other_type`. It is an `intent(in)` argument. If present it is the other data to be associated with the `key`. From bf97fed1d1049011719044094f04483abb477783 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 27 Dec 2021 14:13:49 -0700 Subject: [PATCH 03/77] Simplified hash maps Removed `max_bits` and `load_factor` from the hash map data types and transformed them into module constants. Removed `load_factor` function from `stdlib_open_hash_map` and added `relative_loading` function. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 262 +++++++++++++--------------------- 1 file changed, 99 insertions(+), 163 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index d94b72735..0de22b5e4 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -301,8 +301,8 @@ Pure function `key`: Shall be a scalar integer expression of kind `INT32`. It is an `intent(in)` argument. -`nbits` Shall be a scalar default integer expression with `0 < nbits < -32`. It is an `intent(in)` argument. +`nbits` Shall be a scalar default integer expression with +`0 < nbits < 32`. It is an `intent(in)` argument. ##### Result character @@ -996,8 +996,8 @@ Finally it provides procedures to inquire about the overall structure and performance of the table:`calls`, `entries`, `get_other_data`, `loading`, `slots`, and `total_depth`. The module also defines a number of public constants: `inmap_probe_factor`, -`map_probe_factor`, `default_max_bits`, `default_bits`, -`strict_max_bits`, `int_calls`, `int_depth`, `int_index`, +`map_probe_factor`, `default_bits`, +`max_bits`, `int_calls`, `int_depth`, `int_index`, `int_probes`, `success`, `alloc_fault`, and `array_size_error`. ### The `stdlib_chaining_hash_map` module's public constants @@ -1018,22 +1018,14 @@ the slots need expansion. The constant `map_probe_factor` is used to determine when inserting a new entry the ratio of the number of map probes to map calls is too large and the slots need expansion. -The constants `default_bits`, `default_max_bits`, and -`strict_max_bits` are used to parameterize the table's slots size. The +The constants `default_bits`, and +`max_bits` are used to parameterize the table's slots size. The `default_bits` constant defines the default initial number of slots with a current value of 6 resulting in an initial `2**6 == 64` slots. This may optionally be overridden on hash map creation. The -`default_max_bits` is the default value for the table's `max_bits` -component that sets the maximum table size as `2**max_bits`. This may -also be overridden on table creation. Finally, `strict_max_bits` -defines the maximum value for `default_max_bits`. This cannot be -overridden on hash map creation. Because signed 32 bit integers are -used for the hash code, `strict_max_bits` must be no greater than 31, -but as probably large values of `max_bits` benefit from a 64 bit hash -code, `strict_max_size` is currently set to 24, so the current table -is assumed to be useful only for tables up to size `2**24` slots. As -chaining is used for this table the number of entries can be -significantly larger than the number of slots. +`max_bits` parameter sets the maximum table size as `2**max_bits` with +a default value for `max_bits` of 30. The table will not work for a +slots size greater than `2**30`. The constants `int_calls`, `int_depth`, `int_index`, and `int_probes` are used to define integer kind values for various contexts. The @@ -1053,8 +1045,8 @@ Finally the error codes `success`, `alloc_fault`, and procedure calla. The `succes` code indicates that no problems were found. The `alloc_fault` code indicates that a memory allocation failed. Finally the `array_size_error` indicates that on table -creation `slots_bits` or `max_bits` are less than `default_bits` or -greater than `strict_max_bits`, respectively. +creation `slots_bits` is less than `default_bits` or +greater than `max_bits`. ### The `stdlib_chaining_hash_map` module's derived types @@ -1119,8 +1111,8 @@ costs. The type's definition is below: #### The `chaining_hash_map_type` derived type The `chaining_hash_map_type` derived type implements a separate -chaining hash map. It provides the elements `calls`, `probes`, -`total_probes`, `entries`, `slots_bits`, and `max_bits` to keep track +chaining hash map. It provides the components `calls`, `probes`, +`total_probes`, `entries`, and `slots_bits` to keep track of the hash map's usage. The array element `slots` serves as the table proper. The array element `inverse` maps integers to entries. The linked list entry, `free_list`, keeps track of freed @@ -1143,8 +1135,6 @@ objects of the type, `chaining_hash_map_type`. ! Number of entries integer(int32) :: slots_bits = default_bits ! Bits used for slots size - integer(int32) :: max_bits = default_max_bits - ! Maximum value of slots_bits type(chaining_map_entry_ptr), allocatable :: slots(:) ! Array of bucket lists Note # slots=size(slots) type(chaining_map_entry_ptr), allocatable :: inverse(:) @@ -1181,7 +1171,7 @@ Procedure to modify the structure of a map: Procedures to modify the content of a map: -* `map_entry( map, inmap, key, other )` - Inserts an entry innto the +* `map_entry( map, inmap, key, other )` - Inserts an entry into the hash map. * `remove_entry(map, inmap)` - Remove the entry, if any, at map % @@ -1462,7 +1452,7 @@ Initializes a `chaining_hash_map_type` object. ##### Syntax -`call [[stdlib_chaining_hash_map:init_map]]( map, hasher [, slots_bits, max_bits, status ] ] )` +`call [[stdlib_chaining_hash_map:init_map]]( map, hasher [, slots_bits, status ] ] )` ####@# Class @@ -1483,23 +1473,12 @@ Subroutine slots in the table will be `2**slots_bits`. * `slots_bits` shall be a positive default integer less than - `max_slots_bits`, otherwise processing stops with an informative + `max_bits`, otherwise processing stops with an informative error code. * If `slots_bits` is absent then the effective value for `slots_bits` is `default_slots_bits`. -`max_bits` (optional): shall be a scalar default integer - expression. It is an `intent(in)` argument. The number of slots - cannot exceed `2**max_bits`. - -* `max_bits` shall be a positive integer no greater than - `strict_max_bits`, otherwise processing stops with an informative - stop code. - -* If `maw_bits` is absent then the effective value for -`max_bits` is `default_max_bits`. - `status` (optional): shall be a scalar integer variable of kind `int32`. It is an `intent(out)` argument. On return if present it shall have an error code value. @@ -1510,10 +1489,7 @@ shall have an error code value. * If allocation of memory for the `map` arrays fails then `status` has the value `alloc_fault`. -* If `max_bits < 6` or `max_bits > strict_max_bits` then `status` has - the value of `array_size_error`. - -* If `slot_bits < 6` or `slots_bits > map % max_bits` then `status` +* If `slot_bits < 6` or `slots_bits > max_bits` then `status` has the value of `array_size_error`. * If `status` is absent, but `status` would have a value other than @@ -2083,12 +2059,11 @@ provides procedures to inquire about entries in the hash map: `get_other_data`, `in_map`, `unmap`.and `valid_index`. Finally it provides procedures to inquire about the overall structure and performance of the table:`calls`, `entries`, `get_other_data`, -`load_factor`, `loading`, `slots`, and `total_depth`. The module +`loading`, `relative_loading`, `slots`, and `total_depth`. The module also defines a number of public constants: `inmap_probe_factor`, -`map_probe_factor`, `default_load_factor`, `default_max_bits`, -`default_bits`, `strict_max_bits`, `int_calls`, `int_depth`, -`int_index`, `int_probes`, `success`, `alloc_fault`, -`array_size_error`, and `real_value_error`. +`map_probe_factor`, `default_bits`, `max_bits`, `int_calls`, +`int_depth`, `int_index`, `int_probes`, `load_factor`, `success`, +`alloc_fault`, `array_size_error`, and `real_value_error`. ### The `stdlib_open_hash_map` module's public constants @@ -2099,42 +2074,32 @@ integer kind values for different applications. Finally, some are used to report errors or success. The constants `inmap_probe_factor`, `map_probe_factor`, and -`default_load_factor` are used to parameterize the slot expansion code -used to determine when in a `inchain_map_call` the number -of slots need to be increased to decrease the lengths of the linked -lists. The constant `inmap_probe_factor` is used to determine when +`load_factor` are used to parameterize the slot expansion code +used to determine when in a call on the map the number +of slots need to be increased to decrease the search lengths. +The constant `inmap_probe_factor` is used to determine when the ratio of the number of map probes to map calls is too large and the slots need expansion. The constant `map_probe_factor` is used to determine when inserting a new entry the ratio of the number of map probes to map calls is too large and the slots need expansion. - -The constants `default_bits`, `default_max_bits`, and -`strict_max_bits` are used to parameterize the table's slots size. The +Finally, the +`load_factor` determines the maximum number of entries allowed +relative to the number of slots prior to automatically resizing the +table upon entry insertion. The `load_factor` is a tradeoff between +runtime performance and memory usage, with smaller values of +`load_factor` having the best runtime performance and larger.values +the smaller memory footprint, with common choices being `0.575 <= +load_factor <= 0.75`. The `load_factor` currently has a value +of `0.5625`. + +The constants `default_bits`, and +`max_bits` are used to parameterize the table's slots size. The `default_bits` constant defines the default initial number of slots with a current value of 6 resulting in an initial `2**6 == 64` slots. This may optionally be overridden on hash map creation. The -`default_max_bits` is the default value for the table's `max_bits` -component that sets the maximum table size as `2**max_bits`. This may -also be overridden on table creation. Then `strict_max_bits` -defines the maximum value for `default_max_bits`. This cannot be -overridden on hash map creation. Because signed 32 bit integers are -used for the hash code, `strict_max_bits` must be no greater than 31, -but as probably large values of `max_bits` benefit from a 64 bit hash -code, `strict_max_size` is currently set to 24, so the current table -is assumed to be useful only for tables up to size `2**24` slots. As -open is used for this table the number of entries can be -significantly larger than the number of slots. Finally, -`default_load_factor` provides a default value for `load_factor`. The -`load_factor` determines the maximum number of entries allowed -relative to the number of slots prior to automatically resizing the -table upon entry insertion. The `load_factor` is a tradeoff between -runtime performance and memory usage, with smaller values of -`load_factor` having the best runtime performance and larger.values -the smaller memory footprint, with common choices being `0.5 <= -load_factor <= 0.75`. The `default_load_factor` currently has a value -of `0.25`. This default can be overridden at table -creation, with initialization allowing values `0.375 <= load_factor -<= 0.75`. +`max_bits` sets the maximum table size as `2**max_bits`. The current +value of `max_bits` is 3o and the table will not work properly if that +value is exceeded. The constants `int_calls`, `int_depth`, `int_index`, and `int_probes` are used to define integer kind values for various contexts. The @@ -2154,10 +2119,8 @@ Finally the error codes `success`, `alloc_fault`, and procedure calla. The `succes` code indicates that no problems were found. The `alloc_fault` code indicates that a memory allocation failed. The `array_size_error` indicates that on table -creation `slots_bits` or `max_bits` are less than `default_bits` or -greater than `strict_max_bits`, respectively. Finally, on table -creation `real_value_error` indicates that the `load_factor` exceeds -the range `0.375 <= load_factor <= 0.75`. +creation `slots_bits` is less than `default_bits` or +greater than `max_bits`. ### The `stdlib_open_hash_map` module's derived types @@ -2201,7 +2164,7 @@ containing the elements of the table. The type's definition is below: The `open_hash_map_type` derived type implements a separate open hash map. It provides the elements `calls`, `probes`, -`total_probes`, `entries`, `slots_bits`, and `max_bits` to keep track +`total_probes`, `entries`, and `slots_bits` to keep track of the hash map's usage. The array element `slots` serves as the table proper. The array element `inverse` maps integers to entries. The linked list entry, `free_list`, keeps track of freed @@ -2226,8 +2189,6 @@ objects of the type, `open_hash_map_type`. ! Mask used in linear addressing integer(int32) :: slots_bits = default_bits ! Bits used for slots size - integer(int32) :: max_bits = default_max_bits - ! Maximum value of slots_bits type(open_map_entry_ptr), allocatable :: slots(:) ! Array of bucket lists Note # slots=size(slots) type(open_map_entry_ptr), allocatable :: inverse(:) @@ -2250,7 +2211,7 @@ are listed below. Procedure to initialize a chaining hash map: -* `init_map( map, hasher[, slots_bits, max_bits, load_factor, status] +* `init_map( map, hasher[, slots_bits, status] )` - Routine to initialize a chaining hash map. Procedure to modify the structure of a map: @@ -2286,15 +2247,15 @@ Procedures to report on the structure of the map: * `entries( map )`- the number of entries in a hash map. -* `load_factor( mP )` - Returns the maximum number of entries relative - to slots in a open addressing hash map - * `loading( map )` - the number of entries relative to slots in a hash map. * `map_probes( map )` - the total number of table probes on a hash map. +* `relative_loading` - the ratio of the map's loading to its + `load_factor`. + * `slots( map )` - Returns the number of allocated slots in a hash map. @@ -2542,7 +2503,7 @@ Initializes a `open_hash_map_type` object. ##### Syntax -`call [[stdlib_open_hash_map:init_map]]( map, hasher[, slots_bits, max_bits, load_factor, status ] ] )` +`call [[stdlib_open_hash_map:init_map]]( map, hasher[, slots_bits, status ] ] )` ####@# Class @@ -2569,24 +2530,6 @@ Subroutine * If `slots_bits` is absent then the effective value for `slots_bits` is `default_slots_bits`. -`max_bits` (optional): shall be a scalar default integer - expression. It is an `intent(in)` argument. The number of slots - cannot exceed `2**max_bits`. - -* `max_bits` shall be a positive integer no greater than - `strict_max_bits`, otherwise processing stops with an informative - stop code. - -* If `maw_bits` is absent then the effective value for -`max_bits` is `default_max_bits`. - -`load_factor` (optional): shall be a scalar default real expression. -it is an `intent(in) argument. - -* `load_factor` shall be a positive real such that `0.375 <= - load_factor <= 0.75`, otherwise processing stops with an informative - stop code. - `status` (optional): shall be a scalar integer variable of kind `int32`. It is an `intent(out)` argument. On return if present it shall have an error code value. @@ -2597,15 +2540,9 @@ shall have an error code value. * If allocation of memory for the `map` arrays fails then `status` has the value `alloc_fault`. -* If `max_bits < 6` or `max_bits > strict_max_bits` then `status` has - the value of `array_size_error`. - -* If `slot_bits < 6` or `slots_bits > map % max_bits` then `status` +* If `slot_bits < 6` or `slots_bits > max_bits` then `status` has the value of `array_size_error`. -* If `load_factor < 0.375` or `load_factor > 0.75` then `status` - has the value of `real_value_error`. - * If `status` is absent, but `status` would have a value other than `success`, then processing stops with an informative stop code. @@ -2625,57 +2562,6 @@ has the value `alloc_fault`. end program demo_init_map - -#### `load_factor` - Returns the load_factor of a hash map - -##### Status - -Experimental - -##### Description - -Returns the maximum number of entries relative to slots in a hash -map. - -##### Syntax - -`value = [[stdlib_open_hash_map:load_factor]]( map )` - -##### Class - -Pure function - -##### Argument - -`map` - shall be an expression of type `open_hash_map_type`. -It is an `intent(in)` argument. - -##### Result character - -The result will be a default `REAL`. - -##### Result value - -The result will be the maximum number of entries relative to slots in -the open addressing hash map. - -##### Example - -```fortran - program demo_load_factor - use stdlib_open_hash_map, only: & - open_hash_map_type, init_map, int_index, & - fnv_1_hasher, load_factor - implicit none - type(open_hash_map_type) :: map - real :: initial_factor - call init_map( map, fnv_1_hasher ) - initisl_factor = load_factor (map) - print *, "Initial load_factor = ", initial_factor - end program demo_load_factor -``` - - #### `loading` - Returns the ratio of entries to slots ##### Status @@ -2886,6 +2772,56 @@ It is the hash method to be used by `map`. end program demo_rehash_map +#### `relative_loading` - Returns the ratio of `loading` to `load_factor` + +##### Status + +Experimental + +##### Description + +Returns the ratio of the loadings relative to the open hash map's +`load_factor`. + +##### Syntax + +`value = [[stdlib_open_hash_map:relative_loading]]( map )` + +##### Class + +Pure function + +##### Argument + +`map` - shall be an expression of type `open_hash_map_type`. +It is an `intent(in)` argument. + +##### Result character + +The result will be a default real. + +##### Result value + +The result will be the ratio of the number of entries relative to the +number of slots in the hash map relative to the `load_factor`. + +##### Example + +```fortran + program demo_relative_loading + use stdlib_open_hash_map, only: & + open_hash_map_type, init_map, int_index, & + fnv_1_hasher, loading + implicit none + type(open_hash_map_type) :: map + real :: ratio + call init_map( map, fnv_1_hasher ) + ratio = relative loading (map) + print *, "Initial relative loading = ", ratio + end program demo_relative_loading +``` + + #### `set_other_data` - replaces the other dataa for an entry ##### Status From fade537aee4c20278d052e437c08254cecc9d570 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Tue, 28 Dec 2021 08:02:07 -0700 Subject: [PATCH 04/77] Extensive rewrite Extensive rewrite reconciling two different versions of stdlib_hash_maps.md. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 228 ++++++++++++++++------------------ 1 file changed, 109 insertions(+), 119 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 0de22b5e4..cc16d31ba 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -48,7 +48,7 @@ with a different API. There are three modules: and `stdlib_open_hash_map.f90`. The module `stdlib_32_bit_key_data_wrapper` provides an interface to the 32 bit hash functions of the Standard Library module, -`stdlib_32_bit_hash_functions`, providing wrappers to some of the +`stdlib_32_bit_hash_functions`, and provides wrappers to some of the hash functions so that they no longer need to be supplied seeds. The module `stdlib_chaining_hash_map` defines a datatype, `chaining_hash_map_type`, implementing a simple separate chaining hash @@ -59,7 +59,7 @@ map noted more for its diagnostics than its performance. These maps use separate chaining with linked lists and linear open addressing, respectively, to deal with hash index collisions, and are -largely defined in the separated modules, `stdlib_chaining_hash_maps` +largely defined in the separated submodules, `stdlib_chaining_hash_maps` and `stdlib_open_hash_maps`, respectively. In `chaining_hash_map_type` the colliding indices are handled by using linked lists with their roots at the hash index. @@ -301,8 +301,8 @@ Pure function `key`: Shall be a scalar integer expression of kind `INT32`. It is an `intent(in)` argument. -`nbits` Shall be a scalar default integer expression with -`0 < nbits < 32`. It is an `intent(in)` argument. +`nbits` Shall be a scalar default integer expression with `0 < nbits < +32`. It is an `intent(in)` argument. ##### Result character @@ -989,7 +989,7 @@ constants that implement a simple hash map using separate chaining hashing. The derived type is `chaining_hash_map_type`. It provides procedures to manipulate the structure of the hash map: -`init_map`, `map_entry`, `rehash_map`, `remove_entry`, and +`init`, `map_entry`, `rehash`, `remove_entry`, and `set_other_data`. It provides procedures to inquire about entries in the hash map: `get_other_data`, `in_map`, `unmap`.and `valid_index`. Finally it provides procedures to inquire about the overall @@ -1054,7 +1054,7 @@ The `stdlib_chaining_hash_map` module defines several derived types. The only public type is the `chaining_hash_map_type`. There are three other private derived types used in the implementation of the public type: `chaining_map_entry_type`, `chaining_map_entry_ptr`, and -`chaining_map_entry_pool`. Each of these are described below. +`chaining_map_entry_pool`. Each of these is described below. #### The `chaining_map_entry_type` derived type @@ -1161,12 +1161,12 @@ are listed below. Procedure to initialize a chaining hash map: -* `init_map( map, hasher[, slots_bits, max_bits, status] )` - Routine +* `init( map, hasher[, slots_bits, status] )` - Routine to initialize a chaining hash map. Procedure to modify the structure of a map: -* `rehash_map( map, hasher )` - Routine to change the hash function +* `rehash( map, hasher )` - Routine to change the hash function for a map. Procedures to modify the content of a map: @@ -1200,8 +1200,8 @@ Procedures to report on the structure of the map: * `entries( map )`- the number of entries in a hash map. -* `loading( map )` - the number of entries relative to slots in a hash - map. +* `loading( map )` - the number of entries relative to the number of + slots in a hash map. * `map_probes( map )` - the total number of table probes on a hash map. @@ -1250,12 +1250,12 @@ The result will be the number of procedure calls on the hash map. ```fortran program demo_calls use stdlib_chaining_hash_map, only: & - chaining_hash_map_type, calls, init_map, int_calls, & + chaining_hash_map_type, calls, init, int_calls, & fnv_1_hasher implicit none type(chaining_hash_map_type) :: map type(int_calls) :: initial_calls - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) initisl_calls = calls (map) print *, "INITIAL_CALLS = ", initial_calls end program demo_calls @@ -1298,12 +1298,12 @@ The result will be the number of entries in the hash map. ```fortran program demo_entries use stdlib_chaining_hash_map, only: & - chaining_hash_map_type, entries, init_map, int_index, & + chaining_hash_map_type, entries, init, int_index, & fnv_1_hasher implicit none type(chaining_hash_map_type) :: map type(int_index) :: initial_entries - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) initisl_entries = entries (map) print *, "INITIAL_ENTRIES = ", initial_entries end program demo_entries @@ -1359,7 +1359,7 @@ Subroutine type(other_type) :: other type(chaining_hash_map_type) :: map integer(int8), allocatable :: data(:) - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) call set( other, [ 4_int8, 3_int8, 2_int8, 1_int8 ] ) call map_entry( map, inmap, key, other ) @@ -1424,7 +1424,7 @@ Subroutine type(key_type) :: key type(other_type) :: other type(chaining_hash_map_type) :: map - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) call set( other, [ 4_int8, 3_int8, 2_int8, 1_int8 ] ) call map_entry( map, inmap, key, other ) @@ -1440,7 +1440,7 @@ Subroutine end program demo_in_map ``` -#### init_map - initializes a hash map +#### init - initializes a hash map ##### Status @@ -1452,7 +1452,7 @@ Initializes a `chaining_hash_map_type` object. ##### Syntax -`call [[stdlib_chaining_hash_map:init_map]]( map, hasher [, slots_bits, status ] ] )` +`call [[stdlib_chaining_hash_map:init]]( map, hasher [, slots_bits, status ] ] )` ####@# Class @@ -1497,17 +1497,16 @@ has the value `alloc_fault`. ##### Example - program demo_init_map + program demo_init use stdlib_hash_tables, only: & chaining_map_type, fnv_1_hasher & - init_map + init type(fnv_1a_type) :: fnv_1 type(chaining_map_type) :: map - call init_map( init_map, & - fnv_1a, & - slots_power=10, & - max_power=20 ) - end program demo_init_map + call init( map, & + fnv_1a, & + slots_bits=10 ) + end program demo_init @@ -1549,12 +1548,12 @@ number of slots in the hash map.? ```fortran program demo_loading use stdlib_chaining_hash_map, only: & - chaining_hash_map_type, init_map, int_index, & + chaining_hash_map_type, init, int_index, & fnv_1_hasher, loading implicit none type(chaining_hash_map_type) :: map real :: ratio - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) ratio = loading (map) print *, "Initial loading = ", ratio end program demo_loading @@ -1606,16 +1605,15 @@ is ignored. use, intrinsic:: iso_fortran_env, only: & int8 use stdlib_chaining_hash_map, only: & - chaining_hash_map_type, fnv_1_hasher, init_map, & + chaining_hash_map_type, fnv_1_hasher, init, & int_index, key_type, map_entry, other_type, set type(chaining_hash_map_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap - call init_map( map, & - fnv_1_hasher, & - slots_power=10, & - max_power=20 ) + call init( map, & + fnv_1_hasher, & + slots_bits=10 ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) call map_entry( map, inmap, key, other ) @@ -1660,12 +1658,12 @@ The result is the number of probes of `map`. ```fortran program demo_probes use stdlib_chaining_hash_map, only: & - chaining_hash_map_type, init_map, int_index, & + chaining_hash_map_type, init, int_index, & fnv_1_hasher, probes implicit none type(chaining_hash_map_type) :: map real :: ratio - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) ratio = probes (map) print *, "Initial probes = ", ratio end program demo_probes @@ -1701,24 +1699,23 @@ It is the hash method to be used by `map`. ##### Example - program demo_rehash_map + program demo_rehash use stdlib_chaining_hash_map, only: & chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& - init_map, int_index, key_type, map_entry, other_type, & - rehash_map, set + init, int_index, key_type, map_entry, other_type, & + rehash, set type(chaining_hash_map_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap - call init_map( map, & - fnv_1_hasher, & - slots_power=10, & - max_power=20 ) + call init( map, & + fnv_1_hasher, & + slots_bits=10 ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) call map_entry( map, inmap, key, other ) - call rehash_map( map, fnv_1a_hasher ) - end program demo_rehash_map + call rehash( map, fnv_1a_hasher ) + end program demo_rehash #### `remove_entry` - removes an entry from the hash map @@ -1754,16 +1751,15 @@ identifying the entry to be removed. program demo_remove_entry use stdlib_chaining_hash_map, only: & chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& - init_map, int_index, key_type, map_entry, other_type, & + init, int_index, key_type, map_entry, other_type, & remove_entry, set type(chaining_hash_map_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap - call init_map( map, & - fnv_1_hasher, & - slots_power=10, & - max_power=20 ) + call init( map, & + fnv_1_hasher, & + slots_bits=10 ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) call map_entry( map, inmap, key, other ) @@ -1814,16 +1810,15 @@ the other data for the entry at the `inmap` index. program demo_set_other_data use stdlib_chaining_hash_map, only: & chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& - init_map, int_index, key_type, map_entry, other_type, & + init, int_index, key_type, map_entry, other_type, & set, set_other_data type(chaining_hash_map_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap - call init_map( map, & - fnv_1_hasher, & - slots_power=10, & - max_power=20 ) + call init( map, & + fnv_1_hasher, & + slots_bits=10 ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) Call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) call map_entry( map, inmap, key, other ) @@ -1869,12 +1864,12 @@ The result is the number of slots in `map`. ```fortran program demo_probes use stdlib_chaining_hash_map, only: & - chaining_hash_map_type, init_map, int_index, & + chaining_hash_map_type, init, int_index, & fnv_1_hasher, slots implicit none type(chaining_hash_map_type) :: map integer(int_index) :: initial_slots - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) initial_slots = slots (map) print *, "Initial slots = ", initial_slots end program demo_probes @@ -1920,12 +1915,12 @@ from their slot index the map. ```fortran program demo_probes use stdlib_chaining_hash_map, only: & - chaining_hash_map_type, init_map, int_index, & + chaining_hash_map_type, init, int_index, & fnv_1_hasher, total_depth implicit none type(chaining_hash_map_type) :: map integer(int_depth) :: initial_depth - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) initial_depth = total_depth (map) print *, "Initial total depth = ", initial_depth end program demo_probes @@ -1971,16 +1966,15 @@ index `inmap` in the inverse table. program demo_unmap use stdlib_chaining_hash_map, only: & chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& - init_map, int_index, key_type, map_entry, other_type, & + init, int_index, key_type, map_entry, other_type, & set, unmap type(chaining_hash_map_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap - call init_map( map, & - fnv_1_hasher, & - slots_power=10, & - max_power=20 ) + call init( map, & + fnv_1_hasher, & + slots_bits=10 ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) call map_entry( map, inmap, key, other ) @@ -2031,13 +2025,13 @@ table of `map` and `.false.` otherwise. ```fortran program demo_valid_index use stdlib_chaining_hash_map, only: & - chaining_hash_map_type, init_map, int_index, & + chaining_hash_map_type, init, int_index, & fnv_1_hasher, valid_index implicit none type(chaining_hash_map_type) :: map integer(int_index) :: inmap logocal :: valid - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) inmap = 10 valid = valid_index (map, inmap) print *, "Initial index of 10 valid for empty map = ", valid @@ -2054,7 +2048,7 @@ constants that implement a simple hash map using linear open addressing hashing. The derived type is `open_hash_map_type`. It provides procedures to manipulate the structure of the hash map: -`init_map`, `map_entry`, `rehash_map`, and `set_other_data`. It +`init`, `map_entry`, `rehash`, and `set_other_data`. It provides procedures to inquire about entries in the hash map: `get_other_data`, `in_map`, `unmap`.and `valid_index`. Finally it provides procedures to inquire about the overall structure and @@ -2216,7 +2210,7 @@ Procedure to initialize a chaining hash map: Procedure to modify the structure of a map: -* `rehash_map( map, hasher )` - Routine to change the hash function +* `rehash( map, hasher )` - Routine to change the hash function for a map. Procedures to modify the content of a map: @@ -2301,12 +2295,12 @@ The result will be the number of procedure calls on the hash map. ```fortran program demo_calls use stdlib_open_hash_map, only: & - open_hash_map_type, calls, init_map, int_calls, & + open_hash_map_type, calls, init, int_calls, & fnv_1_hasher implicit none type(open_hash_map_type) :: map type(int_calls) :: initial_calls - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) initisl_calls = calls (map) print *, "INITIAL_CALLS = ", initial_calls end program demo_calls @@ -2349,12 +2343,12 @@ The result will be the number of entries in the hash map. ```fortran program demo_entries use stdlib_open_hash_map, only: & - open_hash_map_type, entries, init_map, int_index, & + open_hash_map_type, entries, init, int_index, & fnv_1_hasher implicit none type(open_hash_map_type) :: map type(int_index) :: initial_entries - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) initisl_entries = entries (map) print *, "INITIAL_ENTRIES = ", initial_entries end program demo_entries @@ -2410,7 +2404,7 @@ Subroutine type(other_type) :: other type(open_hash_map_type) :: map integer(int8), allocatable :: data(:) - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) call set( other, [ 4_int8, 3_int8, 2_int8, 1_int8 ] ) call map_entry( map, inmap, key, other ) @@ -2475,7 +2469,7 @@ Subroutine type(key_type) :: key type(other_type) :: other type(open_hash_map_type) :: map - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) call set( other, [ 4_int8, 3_int8, 2_int8, 1_int8 ] ) call map_entry( map, inmap, key, other ) @@ -2491,7 +2485,7 @@ Subroutine end program demo_in_map ``` -#### init_map - initializes a hash map +#### init - initializes a hash map ##### Status @@ -2503,7 +2497,7 @@ Initializes a `open_hash_map_type` object. ##### Syntax -`call [[stdlib_open_hash_map:init_map]]( map, hasher[, slots_bits, status ] ] )` +`call [[stdlib_open_hash_map:init]]( map, hasher[, slots_bits, status ] ]` ####@# Class @@ -2531,7 +2525,7 @@ Subroutine is `default_slots_bits`. `status` (optional): shall be a scalar integer variable of kind -`int32`. It is an `intent(out)` argument. On return if present it +`int32`. It is an `intent(out)` argument. On return, if present, it shall have an error code value. * If map was successfully initialized then `status` has the value @@ -2548,18 +2542,18 @@ has the value `alloc_fault`. ##### Example - program demo_init_map + program demo_init use stdlib_hash_tables, only: & open_map_type, fnv_1_hasher & - init_map + init type(fnv_1a_type) :: fnv_1 type(open_map_type) :: map - call init_map( init_map, & - fnv_1a, & - slots_power=10, & - max_power=20, & - load)_factor=0.5 ) - end program demo_init_map + call init( map, & + fnv_1a, & + slots_bits=10 ) + end program demo_init + + #### `loading` - Returns the ratio of entries to slots @@ -2600,12 +2594,12 @@ number of slots in the hash map.? ```fortran program demo_loading use stdlib_open_hash_map, only: & - open_hash_map_type, init_map, int_index, & + open_hash_map_type, init, int_index, & fnv_1_hasher, loading implicit none type(open_hash_map_type) :: map real :: ratio - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) ratio = loading (map) print *, "Initial loading = ", ratio end program demo_loading @@ -2657,16 +2651,15 @@ is ignored. use, intrinsic:: iso_fortran_env, only: & int8 use stdlib_open_hash_map, only: & - open_hash_map_type, fnv_1_hasher, init_map, & + open_hash_map_type, fnv_1_hasher, init, & int_index, key_type, map_entry, other_type, set type(open_hash_map_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap - call init_map( map, & - fnv_1_hasher, & - slots_power=10, & - max_power=20 ) + call init( map, & + fnv_1_hasher, & + slots_bits=10 ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) call map_entry( map, inmap, key, other ) @@ -2711,12 +2704,12 @@ The result is the number of probes of `map`. ```fortran program demo_probes use stdlib_open_hash_map, only: & - open_hash_map_type, init_map, int_index, & + open_hash_map_type, init, int_index, & fnv_1_hasher, probes implicit none type(open_hash_map_type) :: map real :: ratio - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) ratio = probes (map) print *, "Initial probes = ", ratio end program demo_probes @@ -2752,24 +2745,23 @@ It is the hash method to be used by `map`. ##### Example - program demo_rehash_map + program demo_rehash use stdlib_open_hash_map, only: & open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& - init_map, int_index, key_type, map_entry, other_type, & - rehash_map, set + init, int_index, key_type, map_entry, other_type, & + rehash, set type(open_hash_map_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap - call init_map( map, & - fnv_1_hasher, & - slots_power=10, & - max_power=20 ) + call init( map, & + fnv_1_hasher, & + slots_bits=10 ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) call map_entry( map, inmap, key, other ) - call rehash_map( map, fnv_1a_hasher ) - end program demo_rehash_map + call rehash( map, fnv_1a_hasher ) + end program demo_rehash #### `relative_loading` - Returns the ratio of `loading` to `load_factor` @@ -2810,12 +2802,12 @@ number of slots in the hash map relative to the `load_factor`. ```fortran program demo_relative_loading use stdlib_open_hash_map, only: & - open_hash_map_type, init_map, int_index, & + open_hash_map_type, init, int_index, & fnv_1_hasher, loading implicit none type(open_hash_map_type) :: map real :: ratio - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) ratio = relative loading (map) print *, "Initial relative loading = ", ratio end program demo_relative_loading @@ -2865,16 +2857,15 @@ the other data for the entry at the `inmap` index. program demo_set_other_data use stdlib_open_hash_map, only: & open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& - init_map, int_index, key_type, map_entry, other_type, & + init, int_index, key_type, map_entry, other_type, & set, set_other_data type(open_hash_map_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap - call init_map( map, & - fnv_1_hasher, & - slots_power=10, & - max_power=20 ) + call init( map, & + fnv_1_hasher, & + slots_bits=10 ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) call map_entry( map, inmap, key, other ) @@ -2920,12 +2911,12 @@ The result is the number of slots in `map`. ```fortran program demo_probes use stdlib_open_hash_map, only: & - open_hash_map_type, init_map, int_index, & + open_hash_map_type, init, int_index, & fnv_1_hasher, slots implicit none type(open_hash_map_type) :: map integer(int_index) :: initial_slots - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) initial_slots = slots (map) print *, "Initial slots = ", initial_slots end program demo_probes @@ -2971,12 +2962,12 @@ from their slot index the map. ```fortran program demo_probes use stdlib_open_hash_map, only: & - open_hash_map_type, init_map, int_index, & + open_hash_map_type, init, int_index, & fnv_1_hasher, total_depth implicit none type(open_hash_map_type) :: map integer(int_depth) :: initial_depth - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) initial_depth = total_depth (map) print *, "Initial total depth = ", initial_depth end program demo_probes @@ -3022,16 +3013,15 @@ index `inmap` in the inverse table. program demo_unmap use stdlib_open_hash_map, only: & open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& - init_map, int_index, key_type, map_entry, other_type, & + init, int_index, key_type, map_entry, other_type, & unmap type(open_hash_map_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap - call init_map( map, & - fnv_1_hasher, & - slots_power=10, & - max_power=20 ) + call init( map, & + fnv_1_hasher, & + slots_bits=10 ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) call map_entry( map, inmap, key, other ) @@ -3083,13 +3073,13 @@ table of `map` and `.false.` otherwise. ```fortran program demo_valid_index use stdlib_open_hash_map, only: & - open_hash_map_type, init_map, int_index, & + open_hash_map_type, init, int_index, & fnv_1_hasher, valid_index implicit none type(open_hash_map_type) :: map integer(int_index) :: inmap logocal :: valid - call init_map( map, fnv_1_hasher ) + call init( map, fnv_1_hasher ) inmap = 10 valid = valid_index (map, inmap) print *, "Initial index of 10 valid for empty map = ", valid From ab8b302746489714aa83e8ff02d605f857bd9dc6 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Tue, 28 Dec 2021 20:51:25 -0700 Subject: [PATCH 05/77] Changed the names of three modules in documentation Changed `stdlib_32_bit_key_data_wrapper` to `stdlib_hashmap_wrappers` `stdlib_chaining_hash_map` to `stdlib_hashmap_chaining` and `stdlib_open_hash_map` to `stdlib_hashmap_open` and the corresponding file names. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 246 +++++++++++++++++----------------- 1 file changed, 123 insertions(+), 123 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index cc16d31ba..63e75af49 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -2,7 +2,7 @@ title: Hash maps --- -# The `stdlib_32_bit_key_data_wrapper`, `stdlib_chaining_hash_map` and `stdlib_open_hash_map` modules +# The `stdlib_hashmap_wrappers`, `stdlib_hashmap_chaining` and `stdlib_hashmap_open` modules (TOC) @@ -42,25 +42,25 @@ implementation of simple hash maps. These maps only accept hash functions with a single argument, the key, and that yield a 32 bit hash code, The modules will need to be modified to use hash functions with a different API. There are three modules: -`stdlib_32_bit_key_data_wrapper`, `stdlib_chaining_hash_map` and -`stdlib_open_hash_map`, corresponding to the files: -`stdlib_32_bit_key_data_wrapper.f90`, `stdlib_chaining_hash_map.f90`, -and `stdlib_open_hash_map.f90`. The module -`stdlib_32_bit_key_data_wrapper` provides an interface to the 32 bit +`stdlib_hashmap_wrappers`, `stdlib_hashmap_chaining` and +`stdlib_hashmap_open`, corresponding to the files: +`stdlib_hashmap_wrappers.f90`, `stdlib_hashmap_chaining.f90`, +and `stdlib_hashmap_open.f90`. The module +`stdlib_hashmap_wrappers` provides an interface to the 32 bit hash functions of the Standard Library module, `stdlib_32_bit_hash_functions`, and provides wrappers to some of the hash functions so that they no longer need to be supplied seeds. The -module `stdlib_chaining_hash_map` defines a datatype, +module `stdlib_hashmap_chaining` defines a datatype, `chaining_hash_map_type`, implementing a simple separate chaining hash map noted more for its diagnostics than its performance. Finally the -module, `stdlib_open_hash_map` defines a datatype, +module, `stdlib_hashmap_open` defines a datatype, `open_hash_map_type`, implementing a simple open addressing hash map noted more for its diagnostics than its performance. These maps use separate chaining with linked lists and linear open addressing, respectively, to deal with hash index collisions, and are -largely defined in the separated submodules, `stdlib_chaining_hash_maps` -and `stdlib_open_hash_maps`, respectively. +largely defined in the separated submodules, `stdlib_hashmap_chainings` +and `stdlib_hashmap_opens`, respectively. In `chaining_hash_map_type` the colliding indices are handled by using linked lists with their roots at the hash index. In `open_hash_map_type`, the colliding indices are handled by searching @@ -86,9 +86,9 @@ of data in addition to the entry key. The `chaining_hash_map_type` also allows the selective removal of entries. -## The `stdlib_32_bit_key_data_wrapper` module +## The `stdlib_hashmap_wrappers` module -The `stdlib_32_bit_key_data_wrapper` module provides data types to +The `stdlib_hashmap_wrappers` module provides data types to represent keys and associated data stored in a module, but is also, a wrapper for the `stdlib_32_bit_hash_functions` module. It allows direct access to the `stdlib_32_bit_hash_functions` procedures: @@ -102,15 +102,15 @@ as a kind value,`int_hash`. It also defines two types, `key_type` and `other_type`, and associated procedures, for storing and manipulating keys and their associated data. -### The `stdlib_32_bit_key_data_wrapper` constant, `INT_HASH` +### The `stdlib_hashmap_wrappers` constant, `INT_HASH` The constant `INT_HASH` is used to define the integer kind value for the returned hash codes and variables used to access them. It currently has the value, `INT32`. -### The `stdlib_32_bit_key_data_wrapper` module derived types +### The `stdlib_hashmap_wrappers` module derived types -The `stdlib_32_bit_key_data_wrapper` module defines two derived types: +The `stdlib_hashmap_wrappers` module defines two derived types: `key_type`, and `other_type`. The `key_type` is intended to be used for the search keys of hash tables. The `other_type` is intended to store additional data associated with a key. Both types are @@ -133,9 +133,9 @@ The module also defines seven procedures for those types: `copy_key`, for use by the hash maps to manipulate or inquire of components of those types. -### Table of `stdlib_32_bit_key_data_wrapper` procedures +### Table of `stdlib_hashmap_wrappers` procedures -The `stdlib_32_bit_key_data_wrapper` module provides procedures in +The `stdlib_hashmap_wrappers` module provides procedures in several categories: procedures to manipulate data of the `key_type`; procedures to manipulate data of the `other_type`, and 32 bit hash functions for keys. The procedures in each category are listed below. @@ -179,7 +179,7 @@ Procedures to hash keys to 32 bit integers: * `seeded_water_hasher( key )` - hashes a key using the waterhash algorithm. -### Specifications of the `stdlib_32_bit_key_data_wrapper` procedures +### Specifications of the `stdlib_hashmap_wrappers` procedures #### `copy_key` - Returns a copy of the key @@ -193,7 +193,7 @@ Returns a copy of an input of type `key_type` ##### Syntax -`call [[stdlib_32_bit_key_data_wrapper:copy_key]]( key_in, key_out )` +`call [[stdlib_hashmap_wrappers:copy_key]]( key_in, key_out )` ##### Class @@ -211,7 +211,7 @@ is an `intent(out)` argument. ```fortran program demo_copy_key - use stdlib_32_bit_key_data_wrapper, only: & + use stdlib_hashmap_wrappers, only: & copy_key, key_test, key_type use iso_fortran_env, only: int8 implicit none @@ -240,7 +240,7 @@ Returns a copy of an input of type `other_type` ##### Syntax -`call [[stdlib_32_bit_key_data_wrapper:copy_other]]( other_in, other_out )` +`call [[stdlib_hashmap_wrappers:copy_other]]( other_in, other_out )` ##### Class @@ -258,7 +258,7 @@ is an `intent(out)` argument. ```fortran program demo_copy_other - use stdlib_32_bit_key_data_wrapper, only: & + use stdlib_hashmap_wrappers, only: & copy_other, get, other_type, set use iso_fortran_env, only: int8 implicit none @@ -290,7 +290,7 @@ Calculates an `nbits` hash code from a 32 bit integer. ##### Syntax -`code = [[stdlib_32_bit_key_data_wrapper:fibonacci_hash]]( key, nbits )` +`code = [[stdlib_hashmap_wrappers:fibonacci_hash]]( key, nbits )` ##### Class @@ -325,7 +325,7 @@ E. Knuth. It multiplies the `KEY` by the odd valued approximation to ```fortran program demo_fibonacci_hash - use stdlib_32_bit_key_data_wrapper, only: & + use stdlib_hashmap_wrappers, only: & fibonacci_hash use iso_fortran_env, only: int32 implicit none @@ -355,7 +355,7 @@ Calculates a 32 bit hash code from an input of type `key_type`. ##### Syntax -`code = [[stdlib_32_bit_key_data_wrapper:fnv_1_hasher]]( key )` +`code = [[stdlib_hashmap_wrappers:fnv_1_hasher]]( key )` ##### Class @@ -392,7 +392,7 @@ expected to be minor compared to its faster hashing rate. ```fortran program demo_fnv_1_hasher - use stdlib_32_bit_key_data_wrapper, only: & + use stdlib_hashmap_wrappers, only: & fnv_1_hasher, key_type, set use iso_fortran_env, only: int32 implicit none @@ -419,7 +419,7 @@ Calculates a 32 bit hash code from an input of type `key_type`. ##### Syntax -`code = [[stdlib_32_bit_key_data_wrapper:fnv_1a_hasher]]( key )` +`code = [[stdlib_hashmap_wrappers:fnv_1a_hasher]]( key )` ##### Class @@ -456,7 +456,7 @@ expected to be minor compared to its faster hashing rate. ```fortran program demo_fnv_1a_hasher - use stdlib_32_bit_key_data_wrapper, only: & + use stdlib_hashmap_wrappers, only: & fnv_1a_hasher, key_type, set use iso_fortran_env, only: int32 implicit none @@ -483,7 +483,7 @@ Deallocates the memory associated with an variable of type ##### Syntax -`call [[stdlib_32_bit_key_data_wrapper:free_key]]( key )` +`call [[stdlib_hashmap_wrappers:free_key]]( key )` ##### Class @@ -498,7 +498,7 @@ is an `intent(out)` argument. ```fortran program demo_free_key - use stdlib_32_bit_key_data_wrapper, only: & + use stdlib_hashmap_wrappers, only: & copy_key, free_key, key_type, set use iso_fortran_env, only: int8 implicit none @@ -528,7 +528,7 @@ Deallocates the memory associated with an variable of type ##### Syntax -`call [[stdlib_32_bit_key_data_wrapper:free_other]]( other )` +`call [[stdlib_hashmap_wrappers:free_other]]( other )` ##### Class @@ -543,7 +543,7 @@ is an `intent(out)` argument. ```fortran program demo_free_other - use stdlib_32_bit_key_data_wrapper, only: & + use stdlib_hashmap_wrappers, only: & copy_other, free_other, other_type, set use iso_fortran_env, only: int8 implicit none @@ -574,11 +574,11 @@ in the variable `value`.. ##### Syntax -`call [[stdlib_32_bit_key_data_wrapper:get]]( key, value )` +`call [[stdlib_hashmap_wrappers:get]]( key, value )` or -`call [[stdlib_32_bit_key_data_wrapper:get]]( other, value )` +`call [[stdlib_hashmap_wrappers:get]]( other, value )` ##### Class @@ -601,7 +601,7 @@ an `intent(out)` argument. ```fortran program demo_get - use stdlib_32_bit_key_data_wrapper, only: & + use stdlib_hashmap_wrappers, only: & get, key_type, set use iso_fortran_env, only: int8 implicit none @@ -632,7 +632,7 @@ argument returning an `INT322` hash value. ##### Syntax -`type([[stdlib_32_bit_key_data_wrapper:hasher_fun]]), pointer :: fun_pointer` +`type([[stdlib_hashmap_wrappers:hasher_fun]]), pointer :: fun_pointer` ##### Class @@ -660,7 +660,7 @@ pointers intended for use ```fortran program demo_hasher_fun - use stdlib_32_bit_key_data_wrapper, only: & + use stdlib_hashmap_wrappers, only: & fnv_1a_hasher, hasher_fun, set use iso_fortran_env, only: int8, int32 implicit none @@ -688,7 +688,7 @@ Returns `.true.` if two keys are equal, and false otherwise. ##### Syntax -`test = [[stdlib_32_bit_key_data_wrapper:key_test]]( key1, key2 )` +`test = [[stdlib_hashmap_wrappers:key_test]]( key1, key2 )` ##### Class @@ -714,7 +714,7 @@ The result is `.TRUE.` if the keys are equal, otherwise `.FALSS`. ```fortran program demo_key_test - use stdlib_32_bit_key_data_wrapper, only: & + use stdlib_hashmap_wrappers, only: & copy_key, key_test, key_type, set use iso_fortran_env, only: int8 implicit none @@ -743,7 +743,7 @@ Calculates a 32 bit hash code from an input of type `key_type`. ##### Syntax -`code = [[stdlib_32_bit_key_data_wrapper:seeded_nmhash32_hasher]]( key )` +`code = [[stdlib_hashmap_wrappers:seeded_nmhash32_hasher]]( key )` ##### Class @@ -781,7 +781,7 @@ applications. ```fortran program demo_seeded_nmhash32_hasher - use stdlib_32_bit_key_data_wrapper, only: & + use stdlib_hashmap_wrappers, only: & seeded_nmhash32_hasher, key_type, set use iso_fortran_env, only: int32 implicit none @@ -807,7 +807,7 @@ Calculates a 32 bit hash code from an input of type `key_type`. ##### Syntax -`code = [[stdlib_32_bit_key_data_wrapper:seeded_nmhash32x_hasher]]( key )` +`code = [[stdlib_hashmap_wrappers:seeded_nmhash32x_hasher]]( key )` ##### Class @@ -844,7 +844,7 @@ applications. ```fortran program demo_seeded_nmhash32x_hasher - use stdlib_32_bit_key_data_wrapper, only: & + use stdlib_hashmap_wrappers, only: & seeded_nmhash32x_hasher, key_type, set use iso_fortran_env, only: int32 implicit none @@ -870,7 +870,7 @@ Calculates a 32 bit hash code from an input of type `key_type`. ##### Syntax -`code = [[stdlib_32_bit_key_data_wrapper:seeded_water_hasher]]( key )` +`code = [[stdlib_hashmap_wrappers:seeded_water_hasher]]( key )` ##### Class @@ -908,7 +908,7 @@ applications. ```fortran program demo_seeded_water_hasher - use stdlib_32_bit_key_data_wrapper, only: & + use stdlib_hashmap_wrappers, only: & seeded_water_hasher, key_type, set use iso_fortran_env, only: int32 implicit none @@ -935,11 +935,11 @@ Places the data from `value` in a `key_type` or an `other_type`. ##### Syntax -`call [[stdlib_32_bit_key_data_wrapper:set]]( key, value )` +`call [[stdlib_hashmap_wrappers:set]]( key, value )` or -`call [[stdlib_32_bit_key_data_wrapper:set]]( other, value )` +`call [[stdlib_hashmap_wrappers:set]]( other, value )` ##### Class @@ -962,7 +962,7 @@ vector expression of type integer and kind `INT8`. It is an ```fortran program demo_set - use stdlib_32_bit_key_data_wrapper, only: & + use stdlib_hashmap_wrappers, only: & get, key_type, set use iso_fortran_env, only: int8 implicit none @@ -980,10 +980,10 @@ vector expression of type integer and kind `INT8`. It is an ``` -## The `stdlib_chaining_hash_map` module +## The `stdlib_hashmap_chaining` module -The `stdlib_chaining_hash_map` module provides access to all the -public entities in the `stdlib_32_bit_key_data_wrapper` module. It +The `stdlib_hashmap_chaining` module provides access to all the +public entities in the `stdlib_hashmap_wrappers` module. It also defines a public data type and associated procedures and constants that implement a simple hash map using separate chaining hashing. The derived type is @@ -1000,7 +1000,7 @@ also defines a number of public constants: `inmap_probe_factor`, `max_bits`, `int_calls`, `int_depth`, `int_index`, `int_probes`, `success`, `alloc_fault`, and `array_size_error`. -### The `stdlib_chaining_hash_map` module's public constants +### The `stdlib_hashmap_chaining` module's public constants The module defines several categories of public constants. Some are used to parameterize the empirical slot expansion code. Others @@ -1048,9 +1048,9 @@ failed. Finally the `array_size_error` indicates that on table creation `slots_bits` is less than `default_bits` or greater than `max_bits`. -### The `stdlib_chaining_hash_map` module's derived types +### The `stdlib_hashmap_chaining` module's derived types -The `stdlib_chaining_hash_map` module defines several derived +The `stdlib_hashmap_chaining` module defines several derived types. The only public type is the `chaining_hash_map_type`. There are three other private derived types used in the implementation of the public type: `chaining_map_entry_type`, `chaining_map_entry_ptr`, and @@ -1150,9 +1150,9 @@ objects of the type, `chaining_hash_map_type`. end type chaining_hash_map_type ``` -### Table of `stdlib_chaining_hash_map` procedures +### Table of `stdlib_hashmap_chaining` procedures -The `stdlib_chaining_hash_map` module provides procedures in +The `stdlib_hashmap_chaining` module provides procedures in several categories: a procedure to initialize the map; a procedure to modify the structure of a map; procedures to modify the content of a map; procedures to report on the content of a map; and procedures @@ -1212,7 +1212,7 @@ Procedures to report on the structure of the map: * `total_depth( map )` - Returns the total number of one's based offsets of slot entries from their slot index -### Specifications of the `stdlib_chaining_hash_map` procedures +### Specifications of the `stdlib_hashmap_chaining` procedures #### `calls` - Returns the number of calls on a hash map @@ -1226,7 +1226,7 @@ Returns the number of procedure calls on a hash map. ##### Syntax -`value = [[stdlib_chaining_hash_map:calls]]( map )` +`value = [[stdlib_hashmap_chaining:calls]]( map )` ##### Class @@ -1249,7 +1249,7 @@ The result will be the number of procedure calls on the hash map. ```fortran program demo_calls - use stdlib_chaining_hash_map, only: & + use stdlib_hashmap_chaining, only: & chaining_hash_map_type, calls, init, int_calls, & fnv_1_hasher implicit none @@ -1274,7 +1274,7 @@ Returns the number of entries in a hash map. ##### Syntax -`value = [[stdlib_chaining_hash_map:entries]]( map )` +`value = [[stdlib_hashmap_chaining:entries]]( map )` ##### Class @@ -1297,7 +1297,7 @@ The result will be the number of entries in the hash map. ```fortran program demo_entries - use stdlib_chaining_hash_map, only: & + use stdlib_hashmap_chaining, only: & chaining_hash_map_type, entries, init, int_index, & fnv_1_hasher implicit none @@ -1322,7 +1322,7 @@ Returns the other data associated with the inverse table index, ##### Syntax -`value = [[stdlib_chaining_hash_map:get_other_data)]]( map, inmap, other )` +`value = [[stdlib_hashmap_chaining:get_other_data)]]( map, inmap, other )` ##### Class @@ -1351,7 +1351,7 @@ Subroutine program demo_get_other_data use, intrinsic:: iso_fortran_env, only: & int8 - use stdlib_chaining_hash_map, only: & + use stdlib_hashmap_chaining, only: & chaining_hash_map_type, fnv_1_hasher, get, get_other_data, & int_index, key_type, map_entry, other_type, set integer(int_index) :: inmap @@ -1387,7 +1387,7 @@ associated index into the inverse table. ##### Syntax -`call [[stdlib_chaining_hash_map:in_map]]( map, inmap, key )` +`call [[stdlib_hashmap_chaining:in_map]]( map, inmap, key )` ##### Class @@ -1417,7 +1417,7 @@ Subroutine program demo_in_map use, intrinsic:: iso_fortran_env, only: & int8 - use stdlib_chaining_hash_map, only: & + use stdlib_hashmap_chaining, only: & chaining_hash_map_type, fnv_1_hasher, in_map, & int_index, key_type, map_entry, other_type, set integer(int_index) :: inmap @@ -1452,7 +1452,7 @@ Initializes a `chaining_hash_map_type` object. ##### Syntax -`call [[stdlib_chaining_hash_map:init]]( map, hasher [, slots_bits, status ] ] )` +`call [[stdlib_hashmap_chaining:init]]( map, hasher [, slots_bits, status ] ] )` ####@# Class @@ -1523,7 +1523,7 @@ slots in a hash map. ##### Syntax -`value = [[stdlib_chaining_hash_map:loading]]( map )` +`value = [[stdlib_hashmap_chaining:loading]]( map )` ##### Class @@ -1547,7 +1547,7 @@ number of slots in the hash map.? ```fortran program demo_loading - use stdlib_chaining_hash_map, only: & + use stdlib_hashmap_chaining, only: & chaining_hash_map_type, init, int_index, & fnv_1_hasher, loading implicit none @@ -1571,7 +1571,7 @@ Inserts an entry into the hash map if it is not already present. ##### Syntax -`call [[stdlib_chaining_hash_map:map_entry]]( map, inmap, key[, other ])` +`call [[stdlib_hashmap_chaining:map_entry]]( map, inmap, key[, other ])` ##### Class @@ -1604,7 +1604,7 @@ is ignored. program demo_map_entry use, intrinsic:: iso_fortran_env, only: & int8 - use stdlib_chaining_hash_map, only: & + use stdlib_hashmap_chaining, only: & chaining_hash_map_type, fnv_1_hasher, init, & int_index, key_type, map_entry, other_type, set type(chaining_hash_map_type) :: map @@ -1633,7 +1633,7 @@ Returns the total number of table probes on a hash map ##### Syntax -`Result = [[stdlib_chaining_hash_map:map_probes]]( map )` +`Result = [[stdlib_hashmap_chaining:map_probes]]( map )` ##### Class @@ -1657,7 +1657,7 @@ The result is the number of probes of `map`. ```fortran program demo_probes - use stdlib_chaining_hash_map, only: & + use stdlib_hashmap_chaining, only: & chaining_hash_map_type, init, int_index, & fnv_1_hasher, probes implicit none @@ -1682,7 +1682,7 @@ Changes the hashing function for the table entries to that of `hasher`. ##### Syntax -`call [[stdlib_chaining_hash_map:rehash]]( map, hasher )` +`call [[stdlib_hashmap_chaining:rehash]]( map, hasher )` ##### Class @@ -1700,7 +1700,7 @@ It is the hash method to be used by `map`. ##### Example program demo_rehash - use stdlib_chaining_hash_map, only: & + use stdlib_hashmap_chaining, only: & chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& init, int_index, key_type, map_entry, other_type, & rehash, set @@ -1730,7 +1730,7 @@ Removes an entry from a hash map, `map`. ##### Syntax -`call [[stdlib_chaining_hash_map:remove_entry]]( map, inmap )` +`call [[stdlib_hashmap_chaining:remove_entry]]( map, inmap )` ##### Class @@ -1749,7 +1749,7 @@ identifying the entry to be removed. ##### Example program demo_remove_entry - use stdlib_chaining_hash_map, only: & + use stdlib_hashmap_chaining, only: & chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& init, int_index, key_type, map_entry, other_type, & remove_entry, set @@ -1780,7 +1780,7 @@ inverse table. ##### Syntax -`call [[stdlib_chaining_hash_map:set_other_data]]( map, inmap, other )` +`call [[stdlib_hashmap_chaining:set_other_data]]( map, inmap, other )` ##### Class @@ -1808,7 +1808,7 @@ the other data for the entry at the `inmap` index. ##### Example program demo_set_other_data - use stdlib_chaining_hash_map, only: & + use stdlib_hashmap_chaining, only: & chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& init, int_index, key_type, map_entry, other_type, & set, set_other_data @@ -1839,7 +1839,7 @@ Returns the total number of slots on a hash map ##### Syntax -`Result = [[stdlib_chaining_hash_map:slots]]( map )` +`Result = [[stdlib_hashmap_chaining:slots]]( map )` ##### Class @@ -1863,7 +1863,7 @@ The result is the number of slots in `map`. ```fortran program demo_probes - use stdlib_chaining_hash_map, only: & + use stdlib_hashmap_chaining, only: & chaining_hash_map_type, init, int_index, & fnv_1_hasher, slots implicit none @@ -1889,7 +1889,7 @@ their slot index for a hash map ##### Syntax -`Result = [[stdlib_chaining_hash_map:total_depth]]( map )` +`Result = [[stdlib_hashmap_chaining:total_depth]]( map )` ##### Class @@ -1914,7 +1914,7 @@ from their slot index the map. ```fortran program demo_probes - use stdlib_chaining_hash_map, only: & + use stdlib_hashmap_chaining, only: & chaining_hash_map_type, init, int_index, & fnv_1_hasher, total_depth implicit none @@ -1940,7 +1940,7 @@ inverse table. ##### Syntax -`call [[stdlib_chaining_hash_map:unmap]]( map, inmap, key )` +`call [[stdlib_hashmap_chaining:unmap]]( map, inmap, key )` ##### Class @@ -1964,7 +1964,7 @@ index `inmap` in the inverse table. ##### Example program demo_unmap - use stdlib_chaining_hash_map, only: & + use stdlib_hashmap_chaining, only: & chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& init, int_index, key_type, map_entry, other_type, & set, unmap @@ -1995,7 +1995,7 @@ inverse table. ##### Syntax -`result = [[stdlib_chaining_hash_map:valid_index]]( map, inmap )` +`result = [[stdlib_hashmap_chaining:valid_index]]( map, inmap )` ##### Class @@ -2024,7 +2024,7 @@ table of `map` and `.false.` otherwise. ```fortran program demo_valid_index - use stdlib_chaining_hash_map, only: & + use stdlib_hashmap_chaining, only: & chaining_hash_map_type, init, int_index, & fnv_1_hasher, valid_index implicit none @@ -2039,10 +2039,10 @@ table of `map` and `.false.` otherwise. ``` -## The `stdlib_open_hash_map` module +## The `stdlib_hashmap_open` module -The `stdlib_open_hash_map` module provides access to all the -public entities in the `stdlib_32_bit_key_data_wrapper` module. It +The `stdlib_hashmap_open` module provides access to all the +public entities in the `stdlib_hashmap_wrappers` module. It also defines a public data type and associated procedures and constants that implement a simple hash map using linear open addressing hashing. The derived type is @@ -2059,7 +2059,7 @@ also defines a number of public constants: `inmap_probe_factor`, `int_depth`, `int_index`, `int_probes`, `load_factor`, `success`, `alloc_fault`, `array_size_error`, and `real_value_error`. -### The `stdlib_open_hash_map` module's public constants +### The `stdlib_hashmap_open` module's public constants The module defines several categories of public constants. Some are used to parameterize the empirical slot expansion code. Others @@ -2116,9 +2116,9 @@ failed. The `array_size_error` indicates that on table creation `slots_bits` is less than `default_bits` or greater than `max_bits`. -### The `stdlib_open_hash_map` module's derived types +### The `stdlib_hashmap_open` module's derived types -The `stdlib_open_hash_map` module defines several derived +The `stdlib_hashmap_open` module defines several derived types. The only public type is the `open_hash_map_type`. There are three other private derived types used in the implementation of the public type: `open_map_entry_type`, and `open_map_entry_ptr`. @@ -2196,7 +2196,7 @@ objects of the type, `open_hash_map_type`. ### Table of `stdlib_open_ehash_map` procedures -The `stdlib_open_hash_map` module provides procedures in +The `stdlib_hashmap_open` module provides procedures in several categories: a procedure to initialize the map; a procedure to modify the structure of a map; procedures to modify the content of a map; procedures to report on the content of a map; and procedures @@ -2257,7 +2257,7 @@ Procedures to report on the structure of the map: offsets of slot entries from their slot index -### Specifications of the `stdlib_open_hash_map` procedures +### Specifications of the `stdlib_hashmap_open` procedures #### `calls` - Returns the number of calls on a hash map @@ -2271,7 +2271,7 @@ Returns the number of procedure calls on a hash map. ##### Syntax -`value = [[stdlib_open_hash_map:calls]]( map )` +`value = [[stdlib_hashmap_open:calls]]( map )` ##### Class @@ -2294,7 +2294,7 @@ The result will be the number of procedure calls on the hash map. ```fortran program demo_calls - use stdlib_open_hash_map, only: & + use stdlib_hashmap_open, only: & open_hash_map_type, calls, init, int_calls, & fnv_1_hasher implicit none @@ -2319,7 +2319,7 @@ Returns the number of entries in a hash map. ##### Syntax -`value = [[stdlib_open_hash_map:entries]]( map )` +`value = [[stdlib_hashmap_open:entries]]( map )` ##### Class @@ -2342,7 +2342,7 @@ The result will be the number of entries in the hash map. ```fortran program demo_entries - use stdlib_open_hash_map, only: & + use stdlib_hashmap_open, only: & open_hash_map_type, entries, init, int_index, & fnv_1_hasher implicit none @@ -2367,7 +2367,7 @@ Returns the other data associated with the inverse table index, ##### Syntax -`value = [[stdlib_open_hash_map:get_other_data)]]( map, inmap, other )` +`value = [[stdlib_hashmap_open:get_other_data)]]( map, inmap, other )` ##### Class @@ -2396,7 +2396,7 @@ Subroutine program demo_get_other_data use, intrinsic:: iso_fortran_env, only: & int8 - use stdlib_open_hash_map, only: & + use stdlib_hashmap_open, only: & open_hash_map_type, fnv_1_hasher, get, get_other_data, & int_index, key_type, map_entry, other_type, set integer(int_index) :: inmap @@ -2432,7 +2432,7 @@ associated index into the inverse table. ##### Syntax -`call [[stdlib_open_hash_map:in_map]]( map, inmap, key )` +`call [[stdlib_hashmap_open:in_map]]( map, inmap, key )` ##### Class @@ -2462,7 +2462,7 @@ Subroutine program demo_in_map use, intrinsic:: iso_fortran_env, only: & int8 - use stdlib_open_hash_map, only: & + use stdlib_hashmap_open, only: & open_hash_map_type, fnv_1_hasher, in_map, & int_index, key_type, map_entry, other_type, set integer(int_index) :: inmap @@ -2497,7 +2497,7 @@ Initializes a `open_hash_map_type` object. ##### Syntax -`call [[stdlib_open_hash_map:init]]( map, hasher[, slots_bits, status ] ]` +`call [[stdlib_hashmap_open:init]]( map, hasher[, slots_bits, status ] ]` ####@# Class @@ -2569,7 +2569,7 @@ slots in a hash map. ##### Syntax -`value = [[stdlib_open_hash_map:loading]]( map )` +`value = [[stdlib_hashmap_open:loading]]( map )` ##### Class @@ -2593,7 +2593,7 @@ number of slots in the hash map.? ```fortran program demo_loading - use stdlib_open_hash_map, only: & + use stdlib_hashmap_open, only: & open_hash_map_type, init, int_index, & fnv_1_hasher, loading implicit none @@ -2617,7 +2617,7 @@ Inserts an entry into the hash map if it is not already present. ##### Syntax -`call [[stdlib_open_hash_map:map_entry]]( map, inmap, key[, other ])` +`call [[stdlib_hashmap_open:map_entry]]( map, inmap, key[, other ])` ##### Class @@ -2650,7 +2650,7 @@ is ignored. program demo_map_entry use, intrinsic:: iso_fortran_env, only: & int8 - use stdlib_open_hash_map, only: & + use stdlib_hashmap_open, only: & open_hash_map_type, fnv_1_hasher, init, & int_index, key_type, map_entry, other_type, set type(open_hash_map_type) :: map @@ -2679,7 +2679,7 @@ Returns the total number of table probes on a hash map ##### Syntax -`Result = [[stdlib_open_hash_map:map_probes]]( map )` +`Result = [[stdlib_hashmap_open:map_probes]]( map )` ##### Class @@ -2703,7 +2703,7 @@ The result is the number of probes of `map`. ```fortran program demo_probes - use stdlib_open_hash_map, only: & + use stdlib_hashmap_open, only: & open_hash_map_type, init, int_index, & fnv_1_hasher, probes implicit none @@ -2728,7 +2728,7 @@ Changes the hashing function for the table entries to that of `hasher`. ##### Syntax -`call [[stdlib_open_hash_map:rehash]]( map, hasher )` +`call [[stdlib_hashmap_open:rehash]]( map, hasher )` ##### Class @@ -2746,7 +2746,7 @@ It is the hash method to be used by `map`. ##### Example program demo_rehash - use stdlib_open_hash_map, only: & + use stdlib_hashmap_open, only: & open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& init, int_index, key_type, map_entry, other_type, & rehash, set @@ -2777,7 +2777,7 @@ Returns the ratio of the loadings relative to the open hash map's ##### Syntax -`value = [[stdlib_open_hash_map:relative_loading]]( map )` +`value = [[stdlib_hashmap_open:relative_loading]]( map )` ##### Class @@ -2801,7 +2801,7 @@ number of slots in the hash map relative to the `load_factor`. ```fortran program demo_relative_loading - use stdlib_open_hash_map, only: & + use stdlib_hashmap_open, only: & open_hash_map_type, init, int_index, & fnv_1_hasher, loading implicit none @@ -2827,7 +2827,7 @@ inverse table. ##### Syntax -`call [[stdlib_open_hash_map:set_other_data]]( map, inmap, other )` +`call [[stdlib_hashmap_open:set_other_data]]( map, inmap, other )` ##### Class @@ -2855,7 +2855,7 @@ the other data for the entry at the `inmap` index. ##### Example program demo_set_other_data - use stdlib_open_hash_map, only: & + use stdlib_hashmap_open, only: & open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& init, int_index, key_type, map_entry, other_type, & set, set_other_data @@ -2886,7 +2886,7 @@ Returns the total number of slots on a hash map ##### Syntax -`Result = [[stdlib_open_hash_map:slots]]( map )` +`Result = [[stdlib_hashmap_open:slots]]( map )` ##### Class @@ -2910,7 +2910,7 @@ The result is the number of slots in `map`. ```fortran program demo_probes - use stdlib_open_hash_map, only: & + use stdlib_hashmap_open, only: & open_hash_map_type, init, int_index, & fnv_1_hasher, slots implicit none @@ -2936,7 +2936,7 @@ their slot index for a hash map ##### Syntax -`Result = [[stdlib_open_hash_map:total_depth]]( map )` +`Result = [[stdlib_hashmap_open:total_depth]]( map )` ##### Class @@ -2961,7 +2961,7 @@ from their slot index the map. ```fortran program demo_probes - use stdlib_open_hash_map, only: & + use stdlib_hashmap_open, only: & open_hash_map_type, init, int_index, & fnv_1_hasher, total_depth implicit none @@ -2987,7 +2987,7 @@ inverse table. ##### Syntax -`call [[stdlib_open_hash_map:unmap]]( map, inmap, key )` +`call [[stdlib_hashmap_open:unmap]]( map, inmap, key )` ##### Class @@ -3011,7 +3011,7 @@ index `inmap` in the inverse table. ##### Example program demo_unmap - use stdlib_open_hash_map, only: & + use stdlib_hashmap_open, only: & open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& init, int_index, key_type, map_entry, other_type, & unmap @@ -3042,7 +3042,7 @@ inverse table. ##### Syntax -`result = [[stdlib_open_hash_map:valid_index]]( map, inmap )` +`result = [[stdlib_hashmap_open:valid_index]]( map, inmap )` ##### Class @@ -3072,7 +3072,7 @@ table of `map` and `.false.` otherwise. ```fortran program demo_valid_index - use stdlib_open_hash_map, only: & + use stdlib_hashmap_open, only: & open_hash_map_type, init, int_index, & fnv_1_hasher, valid_index implicit none From f0bc292de90fdd3d4bd7694a533e9858a1d0f314 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Tue, 28 Dec 2021 21:33:23 -0700 Subject: [PATCH 06/77] Revised first paragraph Revised the first paragraph of stdlib_hash_maps.md so it focusses more on hash maps than on hash functions. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 63e75af49..d71659e72 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -8,20 +8,14 @@ title: Hash maps ## Overview of hash maps -The comparison of lexical entities or other objects for equality -can be computationally expensive. -This cost is often reduced by computing a near unique integer value, -termed a hash code, from the structure of the object using a procedure -termed a hash function. -Equality of hash codes is a necessary, but not sufficient, condition -for the original objects to be equal. -As integer comparisons are very efficient, performing an initial -comparison of hash codes and then performing a detailed comparison -only if the hash codes are equal can improve performance. -The hash codes, in turn, can be mapped to a smaller set of integers, -that can be used as an index, termed a hash index, to a rank one -array, often termed a hash table or hash map. -This document discusses the hash maps in the library. +A hash map (hash table) is a data structure that maps *keys* to +*values*. It uses a hash function to compute a hash code from the *key* +that serves as an index into a linear array of *slots* (buckets) from +which the desired *value* can be extracted. +Each key ideally maps to a unique slot, but most hash functions are +imperfect and can map multiple keys to the same *slot* resulting in +collisions. Hash maps differ in how they deal with such collisions. +This document discusses the hash maps in the Fortran Standard Library. ## Licensing From ce445edf4de70a9f0531c0b7d994aa618504c28f Mon Sep 17 00:00:00 2001 From: William Clodius Date: Tue, 28 Dec 2021 22:02:15 -0700 Subject: [PATCH 07/77] Revised module name The documentation was begun before the final versions of the hash functions codes and the modue stdlib_32_bit_hash_functions was renamed stdlib_hash_32bit. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index d71659e72..d421816f5 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -42,7 +42,7 @@ with a different API. There are three modules: and `stdlib_hashmap_open.f90`. The module `stdlib_hashmap_wrappers` provides an interface to the 32 bit hash functions of the Standard Library module, -`stdlib_32_bit_hash_functions`, and provides wrappers to some of the +`stdlib_hash_32bit`, and provides wrappers to some of the hash functions so that they no longer need to be supplied seeds. The module `stdlib_hashmap_chaining` defines a datatype, `chaining_hash_map_type`, implementing a simple separate chaining hash @@ -84,8 +84,8 @@ entries. The `stdlib_hashmap_wrappers` module provides data types to represent keys and associated data stored in a module, but is also, a -wrapper for the `stdlib_32_bit_hash_functions` module. It allows -direct access to the `stdlib_32_bit_hash_functions` procedures: +wrapper for the `stdlib_hash_32bit` module. It allows +direct access to the `stdlib_hash_32bit` procedures: `fibonacci_hash`, `fnv_1_hasher`, `fnv_1a_hasher`; and provides wrapper functions, `seeded_nmhash32_hasher`, `seeded_nmhash32x_hasher`, and `seeded_water_hasher` to the hashing @@ -759,7 +759,7 @@ The result is a hash code created using the `nmhash32` algorithm. ##### Note `SEEDED_NMHASH32_HASHER` is a wrapper to the `NMHASH32_HASH` of the -module `stdlib_32_bit_hash_functions`, which supplies a fixed seed +module `stdlib_hash_32bit`, which supplies a fixed seed to the wrapped function. `NMHASH32` is an implementation of the `nmhash32` hash code of James Z. M. Gao. This code has good, but not great, performance on long keys, poorer @@ -823,7 +823,7 @@ The result is a hash code created using the `nmhash32x` algorithm. ##### Note `SEEDED_NMHASH32X_HASHER` is a wrapper to the `NMHASH32X_HASH` of the -module `stdlib_32_bit_hash_functions`, which supplies a fixed seed +module `stdlib_hash_32bit`, which supplies a fixed seed to the wrapped function. `NMHASH32X` is an implementation of the `nmhash32x` hash code of James Z. M. Gao. This code has good, but not great, performance on long keys, poorer @@ -886,7 +886,7 @@ The result is a hash code created using the `waterhash` algorithm. ##### Note `SEEDED_WATER_HASHER` is a wrapper to the `WATER_HASH` of the -module `stdlib_32_bit_hash_functions`, which supplies a fixed seed +module `stdlib_hash_32bit`, which supplies a fixed seed to the wrapped function. `WATER_HASH` is an implementation of the `waterhash` hash code of Tommy Ettinger. This code has excellent performance on long keys, and good performance From 24e7154d1b510c44b44dad7c449bd047a1bd24a6 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Tue, 28 Dec 2021 22:27:46 -0700 Subject: [PATCH 08/77] Improved documentation of procedures Improved documentation for copy_key, copy_other, and get. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index d421816f5..742c8fcc3 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -137,9 +137,10 @@ functions for keys. The procedures in each category are listed below. Procedures to manipulate `key_type` data: * `copy_key( key_in, key_out )` - Copies the contents of the key, - key_in, to the key, key_out. + `key_in`, to contents of the key, `key_out`. -* `get( key, value )` - extracts the content of key into value. +* `get( key, value )` - extracts the contents of key into value, an + `int8` array or character string. * `free_key( key )` - frees the memory in key. @@ -150,9 +151,11 @@ Procedures to manipulate `key_type` data: Procedures to manipulate `other_type` data: * `copy_other( other_in, other_out )` - Copies the contents of the - other data in, other_in, to the other data, other_out. + other data, `other_in`, to the contents of the other data, + `other_out`. -* `get( other, value )` - extracts the content of other into value. +* `get( other, value )` - extracts the contents of other into value, an + `int8` array or character string. * `set( other, value )` - sets to content of other to value. From 370019d1a0f97a25e5e6f770bd1949146dcc4c08 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Wed, 29 Dec 2021 18:21:09 -0700 Subject: [PATCH 09/77] Better documented inmap Better documented that inmap is only useful as an index if valid. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 55 ++++++++++++++++++++++++++--------- 1 file changed, 41 insertions(+), 14 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 742c8fcc3..8de117282 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -1332,8 +1332,11 @@ Subroutine the hash map used to store and access the other data. `inmap`: shall be a scalar integer expression of kind `int_index`. It - is an `intent(in)` argument. It should be the `inmap` returned by the - procedure `in_map` or `map_entry`. + is an `intent(in)` argument. It should be a non-zero `inmap` + returned by either procedure `in_map` or `map_entry`. + +* If `inmap` is zero, or the corresponding `key` has been deleted +from the map, `other` is undefined. `other`: shall be a variable of type `other_data`. It is an `intent(out)` argument. It is the other data associated @@ -1342,6 +1345,7 @@ Subroutine * The following is an example of the retrieval of other data associated with an inverse table index: + ##### Example ```Fortran @@ -1740,8 +1744,14 @@ It is an `intent(inout)` argument. It is the hash map with the element to be removed. `inmap`: shall be a scalar integer expression of kind `int_index`. It -is an `intent(in)` argument. It is the index to the inverse table -identifying the entry to be removed. +is an `intent(in)` argument. It is the non-zero index to the inverse +table returned by `in_map` or `map_entry` identifying the entry to be +removed. + +* If `inmap` is zero, or the corresponding `key` has been deleted +from the map, or the `map` has been rehashed subsequent to the +generation of `inmap`, `other` is undefined. + ##### Example @@ -1790,8 +1800,8 @@ is an `intent(inout)` argument. It will be a hash map used to store and access the entry's data. `inmap`: shall be a scalar integer expression of kind `int_index`. It -is an `intent(in)` argument. It is the index in the inverse table to -the entry of interest. +is an `intent(in)` argument. It is the non-zero index in the inverse +table to the entry of interest as returned by `ìn_map` or `map_entry`. `other`: shall be a scalar expression of type `other_type`. It is an `intent(in)` argument. It is the data to be stored as @@ -1950,8 +1960,13 @@ It is an `intent(in)` argument. It is the hash map whose entry is unmapped. `inmap`: shall be a scalar integer expression of kind `int_index`. It -is an `intent(in)` argument. It is the index to the inverse table -identifying the unmapped entry. +is an `intent(in)` argument. It is the non-zero index to the inverse +table identifying the unmapped entry as returned by `ìn_map` or +`map_entry`. + +* If `inmap` is zero or `key` has been eliminated from the `map` +subsequent to the generation of `inmap`, or `mp` has been rehashed +subsequent to the generation of `inmap` then `key` is undefined. `key`: shall be a variable of type `key_type` `INT8`, or an allocatable length default character. It is an @@ -2005,7 +2020,7 @@ It is an `intent(in)` argument. It is the hash map whose inverse table is examined. `inmap`: shall be a scalar integer expression of kind `int_index`. It -is an `intent(in)` argument. It is the index to the inverse table whose +is an `intent(in)` argument. It is an index to the inverse table whose validity is being examined. ##### Result character @@ -2174,7 +2189,7 @@ objects of the type, `open_hash_map_type`. ! Number of probes since last expansion integer(int_calls) :: total_probes = 0 ! Cumulative number of probes -` integer(int_index) :: entries = 0 + integer(int_index) :: entries = 0 ! Number of entries integer(int_index) :: index_mask = 2_int_index**default_bits-1 ! Mask used in linear addressing @@ -2380,6 +2395,10 @@ Subroutine is an `intent(in)` argument. It should be the `inmap` returned by the procedure `in_map` or `map_entry`. +* If `inmap` is zero or `key` has been removed subsequent to the +generation of `inmap`, or `map` hasbeen rehashed ssubsequent to the +generation of `inmap`, then `other` is undefined. + `other`: shall be a variable of type `other_data`. It is an `intent(out)` argument. It is the other data associated with the `inmap` index. @@ -2837,8 +2856,12 @@ is an `intent(inout)` argument. It will be a hash map used to store and access the entry's data. `inmap`: shall be a scalar integer expression of kind `int_index`. It -is an `intent(in)` argument. It is the index in the inverse table to -the entry of interest. +is an `intent(in)` argument. It is the non-zero index in the inverse +table to the entry of interest. + +* `inmap` will be invalid if zero, or `key` has been deleted from the + map subsequent to the generation of `inmap`, or `map` has been + rehashed subsequent to the generation of `inmap`. `other`: shall be a scalar expression of type `other_type`. It is an `intent(in)` argument. It is the data to be stored as @@ -2997,8 +3020,12 @@ It is an `intent(in)` argument. It is the hash map whose entry is unmapped. `inmap`: shall be a scalar integer expression of kind `int_index`. It -is an `intent(in)` argument. It is the index to the inverse table -identifying the unmapped entry. +is an `intent(in)` argument. It is the non-zero index to the inverse +table identifying the unmapped entry. + +* If ``inmap` is zero or `key` hass been eliminated from the table + subsequent to the generation of `inmap`, or `map` has been rehashed + subsequent to the generation of `inmap`, `other` is undefined. `key`: shall be a variable of type `key_type` `INT8`, or an allocatable length default character. It is an From 33647a075dfc3014daeb8e6fba78abc1511bbfc5 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Wed, 29 Dec 2021 19:21:17 -0700 Subject: [PATCH 10/77] Changed example An example declared the type of key_in, but defined key instead of key_in. Replaced key with key_in. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 8de117282..2fce174c3 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -219,7 +219,7 @@ is an `intent(out)` argument. do i=1, 15 value(i) = i end do - call set( key, value ) + call set( key_in, value ) call copy_key( key_in, key_out ) print *, "key_in == key_out = ", key_test( key_in, key_out ) end program demo_copy_key From c386c3692939f7a3f35c75c53e031b38d028a418 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Wed, 29 Dec 2021 19:28:14 -0700 Subject: [PATCH 11/77] Fixed typos for hasher_fun documentation The documentationw as missing an "a", refered to `int322` instead of `int32` and had an incomplete sentence in the note. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 2fce174c3..126ecc182 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -616,7 +616,7 @@ an `intent(out)` argument. ``` -#### `HASHER_FUN`- serves aa function prototype. +#### `HASHER_FUN`- serves aa a function prototype. ##### Status @@ -625,7 +625,7 @@ Experimental ##### Description Serves as a prototype for hashing functions with a single, `key`, -argument returning an `INT322` hash value. +argument returning an `INT32` hash value. ##### Syntax @@ -651,7 +651,7 @@ The result is a hash code. ##### Note `HASHER_FUN` is a prototype for defining dummy arguments and function -pointers intended for use +pointers intended for use as a hash function for the hash maps. ##### Example From 791607e80a7ee8b0c58bab3f3e16421789dac6ca Mon Sep 17 00:00:00 2001 From: William Clodius Date: Wed, 29 Dec 2021 21:03:53 -0700 Subject: [PATCH 12/77] Changed name of equality test function Changed `key_test` to `equal_keys`. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 120 +++++++++++++++++----------------- 1 file changed, 60 insertions(+), 60 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 126ecc182..18ad61b3d 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -123,7 +123,7 @@ opaque. Their current representations are as follows ``` The module also defines seven procedures for those types: `copy_key`, -`copy_other`, `free_key`, `free_other`, `get`, `key_test`, and `set` +`copy_other`, `equal_keys`, `free_key`, `free_other`, `get`, and `set` for use by the hash maps to manipulate or inquire of components of those types. @@ -139,6 +139,8 @@ Procedures to manipulate `key_type` data: * `copy_key( key_in, key_out )` - Copies the contents of the key, `key_in`, to contents of the key, `key_out`. +* `equal_keys( key1, key2 )` - compares two keys for equality. + * `get( key, value )` - extracts the contents of key into value, an `int8` array or character string. @@ -146,8 +148,6 @@ Procedures to manipulate `key_type` data: * `set( key, value )` - sets the content of key to value. -* `key_test( key1, key2 )` - compares two keys for equality. - Procedures to manipulate `other_type` data: * `copy_other( other_in, other_out )` - Copies the contents of the @@ -209,7 +209,7 @@ is an `intent(out)` argument. ```fortran program demo_copy_key use stdlib_hashmap_wrappers, only: & - copy_key, key_test, key_type + copy_key, equal_keys, key_type use iso_fortran_env, only: int8 implicit none integer(int8), allocatable :: value(:) @@ -221,7 +221,7 @@ is an `intent(out)` argument. end do call set( key_in, value ) call copy_key( key_in, key_out ) - print *, "key_in == key_out = ", key_test( key_in, key_out ) + print *, "key_in == key_out = ", equal_keys( key_in, key_out ) end program demo_copy_key ``` @@ -274,6 +274,61 @@ is an `intent(out)` argument. end program demo_copy_other ``` +#### `equal_keys` - Compares two keys for equality + +##### Status + +Experimental + +##### Description + +Returns `.true.` if two keys are equal, and false otherwise. + +##### Syntax + +`test = [[stdlib_hashmap_wrappers:equal_keys]]( key1, key2 )` + +##### Class + +Pure function. + +##### Arguments + +`key1`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. + +`key2`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. + +##### Result character + +The result is a value of type default `LOGICAL`. + +##### Result value + +The result is `.TRUE.` if the keys are equal, otherwise `.FALSS`. + +##### Example + +```fortran + program demo_equal_keys + use stdlib_hashmap_wrappers, only: & + copy_key, equal_keys, key_type, set + use iso_fortran_env, only: int8 + implicit none + integer(int8), allocatable :: value(:) + type(key_type) :: key_in, key_out + integer(int_8) :: i + allocate( value(1:15) ) + do i=1, 15 + value(i) = i + end do + call set( key_in, value ) + call copy_key( key_in, key_out ) + print *, "key_in == key_out = ", equal_keys( key_in, key_out ) + end program demo_equal_keys +``` + #### `FIBONACCI_HASH` - maps an integer to a smaller number of bits @@ -673,61 +728,6 @@ pointers intended for use as a hash function for the hash maps. end program demo_hasher_fun ``` -#### `key_test` - Compares two keys for equality - -##### Status - -Experimental - -##### Description - -Returns `.true.` if two keys are equal, and false otherwise. - -##### Syntax - -`test = [[stdlib_hashmap_wrappers:key_test]]( key1, key2 )` - -##### Class - -Pure function. - -##### Arguments - -`key1`: shall be a scalar expression of type `key_type`. It -is an `intent(in)` argument. - -`key2`: shall be a scalar expression of type `key_type`. It -is an `intent(in)` argument. - -##### Result character - -The result is a value of type default `LOGICAL`. - -##### Result value - -The result is `.TRUE.` if the keys are equal, otherwise `.FALSS`. - -##### Example - -```fortran - program demo_key_test - use stdlib_hashmap_wrappers, only: & - copy_key, key_test, key_type, set - use iso_fortran_env, only: int8 - implicit none - integer(int8), allocatable :: value(:) - type(key_type) :: key_in, key_out - integer(int_8) :: i - allocate( value(1:15) ) - do i=1, 15 - value(i) = i - end do - call set( key_in, value ) - call copy_key( key_in, key_out ) - print *, "key_in == key_out = ", key_test( key_in, key_out ) - end program demo_key_test -``` - #### `SEEDED_NMHASH32_HASHER`- calculates a hash code from a key ##### Status From 58827e62ba15a1198c55b847e95bbb67a8c29e85 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Thu, 30 Dec 2021 13:27:41 -0700 Subject: [PATCH 13/77] Commited suggestions of Jeremie Made the following changes * added ```fortran and ``` to several programs * changed `open_hash_map_type. to `open_hash_map_type`. * changed `chaining_hash_map_type. to `chaining_hash_map_type`. * changed initisl_calls to initial_calls * changed initisl_entries to initial_entries * changed `map`): to `map`: * changed relative loading(map) to relative_loading(map) [ticket: X] --- doc/specs/stdlib_hash_maps.md | 45 ++++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 17 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 18ad61b3d..72d4c6c78 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -1253,7 +1253,7 @@ The result will be the number of procedure calls on the hash map. type(chaining_hash_map_type) :: map type(int_calls) :: initial_calls call init( map, fnv_1_hasher ) - initisl_calls = calls (map) + initial_calls = calls (map) print *, "INITIAL_CALLS = ", initial_calls end program demo_calls ``` @@ -1301,7 +1301,7 @@ The result will be the number of entries in the hash map. type(chaining_hash_map_type) :: map type(int_index) :: initial_entries call init( map, fnv_1_hasher ) - initisl_entries = entries (map) + initial_entries = entries (map) print *, "INITIAL_ENTRIES = ", initial_entries end program demo_entries ``` @@ -1461,7 +1461,7 @@ Subroutine ##### Arguments -`map`): shall be a scalar variable of type +`map`: shall be a scalar variable of type `chaining_hash_map_type`. It is an `intent(out)` argument. It will be a hash map used to store and access the entries. @@ -1498,6 +1498,7 @@ has the value `alloc_fault`. ##### Example +```fortran program demo_init use stdlib_hash_tables, only: & chaining_map_type, fnv_1_hasher & @@ -1508,7 +1509,7 @@ has the value `alloc_fault`. fnv_1a, & slots_bits=10 ) end program demo_init - +``` #### `loading` - Returns the ratio of entries to slots @@ -1602,6 +1603,7 @@ is ignored. ##### Example +```fortran program demo_map_entry use, intrinsic:: iso_fortran_env, only: & int8 @@ -1620,7 +1622,7 @@ is ignored. call map_entry( map, inmap, key, other ) print *, 'INMAP = ', inmap end program demo_map_entry - +``` #### `map_probes` - returns the number of hash map probes @@ -1700,6 +1702,7 @@ It is the hash method to be used by `map`. ##### Example +```fortran program demo_rehash use stdlib_hashmap_chaining, only: & chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& @@ -1717,7 +1720,7 @@ It is the hash method to be used by `map`. call map_entry( map, inmap, key, other ) call rehash( map, fnv_1a_hasher ) end program demo_rehash - +``` #### `remove_entry` - removes an entry from the hash map @@ -1755,6 +1758,7 @@ generation of `inmap`, `other` is undefined. ##### Example +```fortran program demo_remove_entry use stdlib_hashmap_chaining, only: & chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& @@ -1772,7 +1776,7 @@ generation of `inmap`, `other` is undefined. call map_entry( map, inmap, key, other ) call remove_entry( map, inmap ) end program demo_remove_entry - +``` #### `set_other_data` - replaces the other dataa for an entry @@ -1814,6 +1818,7 @@ the other data for the entry at the `inmap` index. ##### Example +```fortran program demo_set_other_data use stdlib_hashmap_chaining, only: & chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& @@ -1832,7 +1837,7 @@ the other data for the entry at the `inmap` index. call set( other, [ 17_int8, 5_int8, 6_int8, 15_int8, 40_int8 ] ) call set_other_data( map, inmap, other ) end program demo_set_other_data - +``` #### `slots` - returns the number of hash map probes @@ -1955,7 +1960,7 @@ Subroutine ##### Arguments -`map`: shall be a scalar expression of type `chaining_hash_map_type. +`map`: shall be a scalar expression of type `chaining_hash_map_type`. It is an `intent(in)` argument. It is the hash map whose entry is unmapped. @@ -1975,6 +1980,7 @@ index `inmap` in the inverse table. ##### Example +```fortran program demo_unmap use stdlib_hashmap_chaining, only: & chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& @@ -1992,7 +1998,7 @@ index `inmap` in the inverse table. call map_entry( map, inmap, key, other ) call unmap( map, inmap, key ) end program demo_unmap - +``` #### `valid_index` - indicates whether `inmap` is a valid index @@ -2521,7 +2527,7 @@ Subroutine ##### Arguments -`map`): shall be a scalar variable of type +`map`: shall be a scalar variable of type `open_hash_map_type`. It is an `intent(out)` argument. It will be a hash map used to store and access the entries. @@ -2558,6 +2564,7 @@ has the value `alloc_fault`. ##### Example +```fortran program demo_init use stdlib_hash_tables, only: & open_map_type, fnv_1_hasher & @@ -2568,7 +2575,7 @@ has the value `alloc_fault`. fnv_1a, & slots_bits=10 ) end program demo_init - +``` @@ -2663,6 +2670,7 @@ is ignored. ##### Example +```fortran program demo_map_entry use, intrinsic:: iso_fortran_env, only: & int8 @@ -2681,7 +2689,7 @@ is ignored. call map_entry( map, inmap, key, other ) print *, 'INMAP = ', inmap end program demo_map_entry - +``` #### `map_probes` - returns the number of hash map probes @@ -2761,6 +2769,7 @@ It is the hash method to be used by `map`. ##### Example +```fortran program demo_rehash use stdlib_hashmap_open, only: & open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& @@ -2778,7 +2787,7 @@ It is the hash method to be used by `map`. call map_entry( map, inmap, key, other ) call rehash( map, fnv_1a_hasher ) end program demo_rehash - +``` #### `relative_loading` - Returns the ratio of `loading` to `load_factor` @@ -2874,6 +2883,7 @@ the other data for the entry at the `inmap` index. ##### Example +```fortran program demo_set_other_data use stdlib_hashmap_open, only: & open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& @@ -2892,7 +2902,7 @@ the other data for the entry at the `inmap` index. call set( other, [ 17_int8, 5_int8, 6_int8, 15_int8, 40_int8 ] call set_other_data( map, inmap, other ) end program demo_set_other_data - +``` #### `slots` - returns the number of hash map probes @@ -3015,7 +3025,7 @@ Subroutine ##### Arguments -`map`: shall be a scalar expression of type `open_hash_map_type. +`map`: shall be a scalar expression of type `open_hash_map_type`. It is an `intent(in)` argument. It is the hash map whose entry is unmapped. @@ -3034,6 +3044,7 @@ index `inmap` in the inverse table. ##### Example +```fortran program demo_unmap use stdlib_hashmap_open, only: & open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& @@ -3051,7 +3062,7 @@ index `inmap` in the inverse table. call map_entry( map, inmap, key, other ) call unmap( map, inmap, key ) end program demo_unmap - +``` #### `valid_index` - indicates whether `inmap` is a valid index From 5e11c7e64ab7b9d94ca00e21eefbaa9bd3bcb793 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Thu, 30 Dec 2021 16:54:50 -0700 Subject: [PATCH 14/77] More changes suggested by Jereemie In stdlib_hassh_maps.md I changed: * All mentions of INT8, INT32, and INT64 to int8, int32, and int64, respectively * All occurences of hash_map changed to hashmap * Revised a paragraph summarizing the three modules * removed a that [ticket: X] --- doc/specs/stdlib_hash_maps.md | 276 +++++++++++++++++----------------- 1 file changed, 138 insertions(+), 138 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 72d4c6c78..85a8d38a0 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -33,9 +33,9 @@ his code. The Fortran Standard Library provides three modules for the implementation of simple hash maps. These maps only accept hash -functions with a single argument, the key, and that yield a 32 bit -hash code, The modules will need to be modified to use hash functions -with a different API. There are three modules: +functions with a single argument, the key, and yield a 32 bit +hash code. The modules will need to be modified if it is desired to +use hash functions with a different API. The three modules are: `stdlib_hashmap_wrappers`, `stdlib_hashmap_chaining` and `stdlib_hashmap_open`, corresponding to the files: `stdlib_hashmap_wrappers.f90`, `stdlib_hashmap_chaining.f90`, @@ -45,19 +45,19 @@ hash functions of the Standard Library module, `stdlib_hash_32bit`, and provides wrappers to some of the hash functions so that they no longer need to be supplied seeds. The module `stdlib_hashmap_chaining` defines a datatype, -`chaining_hash_map_type`, implementing a simple separate chaining hash +`chaining_hashmap_type`, implementing a simple separate chaining hash map noted more for its diagnostics than its performance. Finally the module, `stdlib_hashmap_open` defines a datatype, -`open_hash_map_type`, implementing a simple open addressing hash +`open_hashmap_type`, implementing a simple open addressing hash map noted more for its diagnostics than its performance. These maps use separate chaining with linked lists and linear open addressing, respectively, to deal with hash index collisions, and are largely defined in the separated submodules, `stdlib_hashmap_chainings` and `stdlib_hashmap_opens`, respectively. -In `chaining_hash_map_type` the colliding indices are handled by using +In `chaining_hashmap_type` the colliding indices are handled by using linked lists with their roots at the hash index. -In `open_hash_map_type`, the colliding indices are handled by searching +In `open_hashmap_type`, the colliding indices are handled by searching from the initial hash index in increasing steps of one (modulo the hash map size) for an open map bin. @@ -77,7 +77,7 @@ finalization subroutine avoids memory leaks. The maps can take entry keys of type `key_type`. Both maps allow the addition and lookup of entries, and the inclusion of data in addition to the entry key. -The `chaining_hash_map_type` also allows the selective removal of +The `chaining_hashmap_type` also allows the selective removal of entries. ## The `stdlib_hashmap_wrappers` module @@ -100,7 +100,7 @@ keys and their associated data. The constant `INT_HASH` is used to define the integer kind value for the returned hash codes and variables used to access them. It -currently has the value, `INT32`. +currently has the value, `int32`. ### The `stdlib_hashmap_wrappers` module derived types @@ -350,7 +350,7 @@ Pure function ##### Arguments -`key`: Shall be a scalar integer expression of kind `INT32`. It is an +`key`: Shall be a scalar integer expression of kind `int32`. It is an `intent(in)` argument. `nbits` Shall be a scalar default integer expression with `0 < nbits < @@ -358,7 +358,7 @@ Pure function ##### Result character -The result is an integer of kind `INT32`. +The result is an integer of kind `int32`. ##### Result value @@ -420,7 +420,7 @@ It is an `intent(in)` argument. ##### Result character -The result is a scalar integer of kind `INT32`. +The result is a scalar integer of kind `int32`. ##### Result value @@ -484,7 +484,7 @@ It is an `intent(in)` argument. ##### Result character -The result is a scalar integer of kind `INT32`. +The result is a scalar integer of kind `int32`. ##### Result value @@ -646,7 +646,7 @@ is an `intent(in)` argument. is an `intent(in)` argument. `value`: shall be an allocatable default character string variable, or -an allocatable vector variable of type integer and kind `INT8`. It is +an allocatable vector variable of type integer and kind `int8`. It is an `intent(out)` argument. ##### Example @@ -680,7 +680,7 @@ Experimental ##### Description Serves as a prototype for hashing functions with a single, `key`, -argument returning an `INT32` hash value. +argument returning an `int32` hash value. ##### Syntax @@ -692,12 +692,12 @@ Pure function prototype ##### Argument -`key`: Shall be a rank one array expression of type `INTEGER(INT8)`. +`key`: Shall be a rank one array expression of type `INTEGER(int8)`. It is an `intent(in)` argument. ##### Result character -The result is a scalar integer of kind `INT32`. +The result is a scalar integer of kind `int32`. ##### Result value @@ -753,7 +753,7 @@ It is an `intent(in)` argument. ##### Result character -The result is a scalar integer of kind `INT32`. +The result is a scalar integer of kind `int32`. ##### Result value @@ -817,7 +817,7 @@ It is an `intent(in)` argument. ##### Result character -The result is a scalar integer of kind `INT32`. +The result is a scalar integer of kind `int32`. ##### Result value @@ -880,7 +880,7 @@ It is an `intent(in)` argument. ##### Result character -The result is a scalar integer of kind `INT32`. +The result is a scalar integer of kind `int32`. ##### Result value @@ -952,7 +952,7 @@ is an `intent(out)` argument. is an `intent(out)` argument. `value`: shall be a default character string expression, or a -vector expression of type integer and kind `INT8`. It is an +vector expression of type integer and kind `int8`. It is an `intent(in)` argument. ##### Example @@ -984,7 +984,7 @@ public entities in the `stdlib_hashmap_wrappers` module. It also defines a public data type and associated procedures and constants that implement a simple hash map using separate chaining hashing. The derived type is -`chaining_hash_map_type`. It provides +`chaining_hashmap_type`. It provides procedures to manipulate the structure of the hash map: `init`, `map_entry`, `rehash`, `remove_entry`, and `set_other_data`. It provides procedures to inquire about entries in @@ -1027,15 +1027,15 @@ slots size greater than `2**30`. The constants `int_calls`, `int_depth`, `int_index`, and `int_probes` are used to define integer kind values for various contexts. The number of calls are reported and stored in entities of kind -`int_calls`. Currently `int_calls` has the value of `INT64`. The +`int_calls`. Currently `int_calls` has the value of `int64`. The total depth, the number of inquiries needed to access all elements of the table, is reported and stored in entities of kind -`int_depth`. Currently `int_depth` has the value of `INT64`. The +`int_depth`. Currently `int_depth` has the value of `int64`. The number of entries in the table, is reported and stored in entities of -kind `int_index`. Currently `int_index` has the value of `INT32`. +kind `int_index`. Currently `int_index` has the value of `int32`. The number of probes, hash map enquiries, are reported and stored in entities of kind `int_probes`. Currently `int_probes` has the value of -`INT64`. +`int64`. Finally the error codes `success`, `alloc_fault`, and `array_size_error` are used to report the error status of certain @@ -1048,7 +1048,7 @@ greater than `max_bits`. ### The `stdlib_hashmap_chaining` module's derived types The `stdlib_hashmap_chaining` module defines several derived -types. The only public type is the `chaining_hash_map_type`. There are +types. The only public type is the `chaining_hashmap_type`. There are three other private derived types used in the implementation of the public type: `chaining_map_entry_type`, `chaining_map_entry_ptr`, and `chaining_map_entry_pool`. Each of these is described below. @@ -1071,7 +1071,7 @@ the inverse table. The type's definition is below: next => null() ! Next bucket end type chaining_map_entry_type ``` -Currently the `INT_HASH` and `INT_INDEX` have the value of `INT32`. +Currently the `INT_HASH` and `INT_INDEX` have the value of `int32`. #### The `chaining_map_entry_ptr` derived type @@ -1105,9 +1105,9 @@ costs. The type's definition is below: ``` -#### The `chaining_hash_map_type` derived type +#### The `chaining_hashmap_type` derived type -The `chaining_hash_map_type` derived type implements a separate +The `chaining_hashmap_type` derived type implements a separate chaining hash map. It provides the components `calls`, `probes`, `total_probes`, `entries`, and `slots_bits` to keep track of the hash map's usage. The array element `slots` serves as the @@ -1117,10 +1117,10 @@ elements of type `chaining_map_entry_type`. The list element, `cache`, stores pools of `chaining_map_entry_type` elements for reuse. The component `hasher` is a pointer to the hash function. Finally the type-bound procedure, `free_chaining_map`, serves as a finalizer for -objects of the type, `chaining_hash_map_type`. +objects of the type, `chaining_hashmap_type`. ```fortran - type :: chaining_hash_map_type + type :: chaining_hashmap_type private integer(int_calls) :: calls = 0 ! Number of calls @@ -1144,7 +1144,7 @@ objects of the type, `chaining_hash_map_type`. ! Hash function contains final :: free_chaining_map - end type chaining_hash_map_type + end type chaining_hashmap_type ``` ### Table of `stdlib_hashmap_chaining` procedures @@ -1231,7 +1231,7 @@ Pure function ##### Argument -`map` - shall be an expression of type `chaining_hash_map_type`. +`map` - shall be an expression of type `chaining_hashmap_type`. It is an `intent(in)` argument. ##### Result character @@ -1247,10 +1247,10 @@ The result will be the number of procedure calls on the hash map. ```fortran program demo_calls use stdlib_hashmap_chaining, only: & - chaining_hash_map_type, calls, init, int_calls, & + chaining_hashmap_type, calls, init, int_calls, & fnv_1_hasher implicit none - type(chaining_hash_map_type) :: map + type(chaining_hashmap_type) :: map type(int_calls) :: initial_calls call init( map, fnv_1_hasher ) initial_calls = calls (map) @@ -1279,7 +1279,7 @@ Pure function ##### Argument -`map` - shall be an expression of type `chaining_hash_map_type`. +`map` - shall be an expression of type `chaining_hashmap_type`. It is an `intent(in)` argument. ##### Result character @@ -1295,10 +1295,10 @@ The result will be the number of entries in the hash map. ```fortran program demo_entries use stdlib_hashmap_chaining, only: & - chaining_hash_map_type, entries, init, int_index, & + chaining_hashmap_type, entries, init, int_index, & fnv_1_hasher implicit none - type(chaining_hash_map_type) :: map + type(chaining_hashmap_type) :: map type(int_index) :: initial_entries call init( map, fnv_1_hasher ) initial_entries = entries (map) @@ -1328,7 +1328,7 @@ Subroutine ##### Arguments `map`: shall be a scalar expression of type - `chaining_hash_map_type`. It is an `intent(in)` argument. It will be + `chaining_hashmap_type`. It is an `intent(in)` argument. It will be the hash map used to store and access the other data. `inmap`: shall be a scalar integer expression of kind `int_index`. It @@ -1353,12 +1353,12 @@ from the map, `other` is undefined. use, intrinsic:: iso_fortran_env, only: & int8 use stdlib_hashmap_chaining, only: & - chaining_hash_map_type, fnv_1_hasher, get, get_other_data, & + chaining_hashmap_type, fnv_1_hasher, get, get_other_data, & int_index, key_type, map_entry, other_type, set integer(int_index) :: inmap type(key_type) :: key type(other_type) :: other - type(chaining_hash_map_type) :: map + type(chaining_hashmap_type) :: map integer(int8), allocatable :: data(:) call init( map, fnv_1_hasher ) call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) @@ -1396,7 +1396,7 @@ Subroutine ##### Arguments -`map`: shall be a scalar variable of type `chaining_hash_map_type`. It +`map`: shall be a scalar variable of type `chaining_hashmap_type`. It is an `intent(inout)` argument. It will be the hash map used to store and access the entries. @@ -1419,12 +1419,12 @@ Subroutine use, intrinsic:: iso_fortran_env, only: & int8 use stdlib_hashmap_chaining, only: & - chaining_hash_map_type, fnv_1_hasher, in_map, & + chaining_hashmap_type, fnv_1_hasher, in_map, & int_index, key_type, map_entry, other_type, set integer(int_index) :: inmap type(key_type) :: key type(other_type) :: other - type(chaining_hash_map_type) :: map + type(chaining_hashmap_type) :: map call init( map, fnv_1_hasher ) call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) call set( other, [ 4_int8, 3_int8, 2_int8, 1_int8 ] ) @@ -1449,7 +1449,7 @@ Experimental ##### Description -Initializes a `chaining_hash_map_type` object. +Initializes a `chaining_hashmap_type` object. ##### Syntax @@ -1462,7 +1462,7 @@ Subroutine ##### Arguments `map`: shall be a scalar variable of type - `chaining_hash_map_type`. It is an `intent(out)` argument. It will + `chaining_hashmap_type`. It is an `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`. @@ -1533,7 +1533,7 @@ Pure function ##### Argument -`map` - shall be an expression of type `chaining_hash_map_type`. +`map` - shall be an expression of type `chaining_hashmap_type`. It is an `intent(in)` argument. ##### Result character @@ -1550,10 +1550,10 @@ number of slots in the hash map.? ```fortran program demo_loading use stdlib_hashmap_chaining, only: & - chaining_hash_map_type, init, int_index, & + chaining_hashmap_type, init, int_index, & fnv_1_hasher, loading implicit none - type(chaining_hash_map_type) :: map + type(chaining_hashmap_type) :: map real :: ratio call init( map, fnv_1_hasher ) ratio = loading (map) @@ -1582,7 +1582,7 @@ Subroutine ##### Arguments -`map`: shall be a scalar variable of type `chaining_hash_map_type`. It +`map`: shall be a scalar variable of type `chaining_hashmap_type`. It is an `intent(inout)` argument. It is the hash map to receive the entry. @@ -1608,9 +1608,9 @@ is ignored. use, intrinsic:: iso_fortran_env, only: & int8 use stdlib_hashmap_chaining, only: & - chaining_hash_map_type, fnv_1_hasher, init, & + chaining_hashmap_type, fnv_1_hasher, init, & int_index, key_type, map_entry, other_type, set - type(chaining_hash_map_type) :: map + type(chaining_hashmap_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap @@ -1645,7 +1645,7 @@ Pure function ##### Argument `map`: shall be a scalar integer expression of type -`chaining_hash_map_type`. It is an `intent(in)` argument. It is the +`chaining_hashmap_type`. It is an `intent(in)` argument. It is the hash map of interest. ##### Result character @@ -1661,10 +1661,10 @@ The result is the number of probes of `map`. ```fortran program demo_probes use stdlib_hashmap_chaining, only: & - chaining_hash_map_type, init, int_index, & + chaining_hashmap_type, init, int_index, & fnv_1_hasher, probes implicit none - type(chaining_hash_map_type) :: map + type(chaining_hashmap_type) :: map real :: ratio call init( map, fnv_1_hasher ) ratio = probes (map) @@ -1693,7 +1693,7 @@ Subroutine ##### Arguments -`map` : shall be a scalar variable of type `chaining_hash_map_type`. +`map` : shall be a scalar variable of type `chaining_hashmap_type`. It is an `intent(inout)` argument. It is the hash map whose hashing method is to be changed. @@ -1705,10 +1705,10 @@ It is the hash method to be used by `map`. ```fortran program demo_rehash use stdlib_hashmap_chaining, only: & - chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& + chaining_hashmap_type, fnv_1_hasher, fnv_1a_hasher,& init, int_index, key_type, map_entry, other_type, & rehash, set - type(chaining_hash_map_type) :: map + type(chaining_hashmap_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap @@ -1742,7 +1742,7 @@ Subroutine ##### Arguments -`map`: shall be a scalar variable of type `chaining_hash_map_type`. +`map`: shall be a scalar variable of type `chaining_hashmap_type`. It is an `intent(inout)` argument. It is the hash map with the element to be removed. @@ -1761,10 +1761,10 @@ generation of `inmap`, `other` is undefined. ```fortran program demo_remove_entry use stdlib_hashmap_chaining, only: & - chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& + chaining_hashmap_type, fnv_1_hasher, fnv_1a_hasher,& init, int_index, key_type, map_entry, other_type, & remove_entry, set - type(chaining_hash_map_type) :: map + type(chaining_hashmap_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap @@ -1799,7 +1799,7 @@ Subroutine ##### Arguments -`map`: shall be a scalar variable of type `chaining_hash_map_type`. It +`map`: shall be a scalar variable of type `chaining_hashmap_type`. It is an `intent(inout)` argument. It will be a hash map used to store and access the entry's data. @@ -1821,10 +1821,10 @@ the other data for the entry at the `inmap` index. ```fortran program demo_set_other_data use stdlib_hashmap_chaining, only: & - chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& + chaining_hashmap_type, fnv_1_hasher, fnv_1a_hasher,& init, int_index, key_type, map_entry, other_type, & set, set_other_data - type(chaining_hash_map_type) :: map + type(chaining_hashmap_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap @@ -1860,7 +1860,7 @@ Pure function ##### Argument `map`: shall be a scalar expression of type -`chaining_hash_map_type`. It is an `intent(in)` argument. It is the +`chaining_hashmap_type`. It is an `intent(in)` argument. It is the hash map of interest. ##### Result character @@ -1876,10 +1876,10 @@ The result is the number of slots in `map`. ```fortran program demo_probes use stdlib_hashmap_chaining, only: & - chaining_hash_map_type, init, int_index, & + chaining_hashmap_type, init, int_index, & fnv_1_hasher, slots implicit none - type(chaining_hash_map_type) :: map + type(chaining_hashmap_type) :: map integer(int_index) :: initial_slots call init( map, fnv_1_hasher ) initial_slots = slots (map) @@ -1910,7 +1910,7 @@ Pure function ##### Argument `map`: shall be a scalar expression of type -`chaining_hash_map_type`. It is an `intent(in)` argument. It is the +`chaining_hashmap_type`. It is an `intent(in)` argument. It is the hash map of interest. ##### Result character @@ -1927,10 +1927,10 @@ from their slot index the map. ```fortran program demo_probes use stdlib_hashmap_chaining, only: & - chaining_hash_map_type, init, int_index, & + chaining_hashmap_type, init, int_index, & fnv_1_hasher, total_depth implicit none - type(chaining_hash_map_type) :: map + type(chaining_hashmap_type) :: map integer(int_depth) :: initial_depth call init( map, fnv_1_hasher ) initial_depth = total_depth (map) @@ -1960,7 +1960,7 @@ Subroutine ##### Arguments -`map`: shall be a scalar expression of type `chaining_hash_map_type`. +`map`: shall be a scalar expression of type `chaining_hashmap_type`. It is an `intent(in)` argument. It is the hash map whose entry is unmapped. @@ -1974,7 +1974,7 @@ subsequent to the generation of `inmap`, or `mp` has been rehashed subsequent to the generation of `inmap` then `key` is undefined. `key`: shall be a variable of type `key_type` -`INT8`, or an allocatable length default character. It is an +`int8`, or an allocatable length default character. It is an `intent(out)` argument. It is the `key` associated with the entry at index `inmap` in the inverse table. @@ -1983,10 +1983,10 @@ index `inmap` in the inverse table. ```fortran program demo_unmap use stdlib_hashmap_chaining, only: & - chaining_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& + chaining_hashmap_type, fnv_1_hasher, fnv_1a_hasher,& init, int_index, key_type, map_entry, other_type, & set, unmap - type(chaining_hash_map_type) :: map + type(chaining_hashmap_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap @@ -2021,7 +2021,7 @@ Pure function. ##### Arguments -`map`: shall be a scalar expression of type `chaining_hash_map_type`. +`map`: shall be a scalar expression of type `chaining_hashmap_type`. It is an `intent(in)` argument. It is the hash map whose inverse table is examined. @@ -2043,10 +2043,10 @@ table of `map` and `.false.` otherwise. ```fortran program demo_valid_index use stdlib_hashmap_chaining, only: & - chaining_hash_map_type, init, int_index, & + chaining_hashmap_type, init, int_index, & fnv_1_hasher, valid_index implicit none - type(chaining_hash_map_type) :: map + type(chaining_hashmap_type) :: map integer(int_index) :: inmap logocal :: valid call init( map, fnv_1_hasher ) @@ -2064,7 +2064,7 @@ public entities in the `stdlib_hashmap_wrappers` module. It also defines a public data type and associated procedures and constants that implement a simple hash map using linear open addressing hashing. The derived type is -`open_hash_map_type`. It provides +`open_hashmap_type`. It provides procedures to manipulate the structure of the hash map: `init`, `map_entry`, `rehash`, and `set_other_data`. It provides procedures to inquire about entries in the hash map: @@ -2116,15 +2116,15 @@ value is exceeded. The constants `int_calls`, `int_depth`, `int_index`, and `int_probes` are used to define integer kind values for various contexts. The number of calls are reported and stored in entities of kind -`int_calls`. Currently `int_calls` has the value of `INT64`. The +`int_calls`. Currently `int_calls` has the value of `int64`. The total depth, the number of inquiries needed to access all elements of the table, is reported and stored in entities of kind -`int_depth`. Currently `int_depth` has the value of `INT64`. The +`int_depth`. Currently `int_depth` has the value of `int64`. The number of entries in the table, is reported and stored in entities of -kind `int_index`. Currently `int_index` has the value of `INT32`. +kind `int_index`. Currently `int_index` has the value of `int32`. The number of probes, hash map enquiries, are reported and stored in entities of kind `int_probes`. Currently `int_probes` has the value of -`INT64`. +`int64`. Finally the error codes `success`, `alloc_fault`, and `array_size_error` are used to report the error status of certain @@ -2137,7 +2137,7 @@ greater than `max_bits`. ### The `stdlib_hashmap_open` module's derived types The `stdlib_hashmap_open` module defines several derived -types. The only public type is the `open_hash_map_type`. There are +types. The only public type is the `open_hashmap_type`. There are three other private derived types used in the implementation of the public type: `open_map_entry_type`, and `open_map_entry_ptr`. @@ -2157,7 +2157,7 @@ the inverse table. The type's definition is below: integer(int_index) :: index ! Index into inverse table end type open_map_entry_type ``` -Currently the `INT_HASH` and `INT_INDEX` have the value of `INT32`. +Currently the `INT_HASH` and `INT_INDEX` have the value of `int32`. #### The `open_map_entry_ptr` derived type @@ -2172,9 +2172,9 @@ containing the elements of the table. The type's definition is below: end type open_map_entry_ptr ``` -#### The `open_hash_map_type` derived type +#### The `open_hashmap_type` derived type -The `open_hash_map_type` derived type implements a separate +The `open_hashmap_type` derived type implements a separate open hash map. It provides the elements `calls`, `probes`, `total_probes`, `entries`, and `slots_bits` to keep track of the hash map's usage. The array element `slots` serves as the @@ -2184,10 +2184,10 @@ elements of type `open_map_entry_type`. The list element, `cache`, stores pools of `open_map_entry_type` elements for reuse. The component `hasher` is a pointer to the hash function. Finally the type-bound procedure, `free_open_map`, serves as a finalizer for -objects of the type, `open_hash_map_type`. +objects of the type, `open_hashmap_type`. ```fortran - type :: open_hash_map_type + type :: open_hashmap_type private integer(int_calls) :: calls = 0 ! Number of calls @@ -2209,10 +2209,10 @@ objects of the type, `open_hash_map_type`. ! Hash function contains final :: free_open_map - end type open_hash_map_type + end type open_hashmap_type ``` -### Table of `stdlib_open_ehash_map` procedures +### Table of `stdlib_open_ehashmap` procedures The `stdlib_hashmap_open` module provides procedures in several categories: a procedure to initialize the map; a procedure to @@ -2297,7 +2297,7 @@ Pure function ##### Argument -`map` - shall be an expression of type `open_hash_map_type`. +`map` - shall be an expression of type `open_hashmap_type`. It is an `intent(in)` argument. ##### Result character @@ -2313,10 +2313,10 @@ The result will be the number of procedure calls on the hash map. ```fortran program demo_calls use stdlib_hashmap_open, only: & - open_hash_map_type, calls, init, int_calls, & + open_hashmap_type, calls, init, int_calls, & fnv_1_hasher implicit none - type(open_hash_map_type) :: map + type(open_hashmap_type) :: map type(int_calls) :: initial_calls call init( map, fnv_1_hasher ) initisl_calls = calls (map) @@ -2345,7 +2345,7 @@ Pure function ##### Argument -`map` - shall be an expression of type `open_hash_map_type`. +`map` - shall be an expression of type `open_hashmap_type`. It is an `intent(in)` argument. ##### Result character @@ -2361,10 +2361,10 @@ The result will be the number of entries in the hash map. ```fortran program demo_entries use stdlib_hashmap_open, only: & - open_hash_map_type, entries, init, int_index, & + open_hashmap_type, entries, init, int_index, & fnv_1_hasher implicit none - type(open_hash_map_type) :: map + type(open_hashmap_type) :: map type(int_index) :: initial_entries call init( map, fnv_1_hasher ) initisl_entries = entries (map) @@ -2394,7 +2394,7 @@ Subroutine ##### Arguments `map`: shall be a scalar expression of type - `open_hash_map_type`. It is an `intent(in)` argument. It will be + `open_hashmap_type`. It is an `intent(in)` argument. It will be the hash map used to store and access the other data. `inmap`: shall be a scalar integer expression of kind `int_index`. It @@ -2419,12 +2419,12 @@ generation of `inmap`, then `other` is undefined. use, intrinsic:: iso_fortran_env, only: & int8 use stdlib_hashmap_open, only: & - open_hash_map_type, fnv_1_hasher, get, get_other_data, & + open_hashmap_type, fnv_1_hasher, get, get_other_data, & int_index, key_type, map_entry, other_type, set integer(int_index) :: inmap type(key_type) :: key type(other_type) :: other - type(open_hash_map_type) :: map + type(open_hashmap_type) :: map integer(int8), allocatable :: data(:) call init( map, fnv_1_hasher ) call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) @@ -2462,7 +2462,7 @@ Subroutine ##### Arguments -`map`: shall be a scalar variable of type `open_hash_map_type`. It +`map`: shall be a scalar variable of type `open_hashmap_type`. It is an `intent(inout)` argument. It will be the hash map used to store and access the entries. @@ -2485,12 +2485,12 @@ Subroutine use, intrinsic:: iso_fortran_env, only: & int8 use stdlib_hashmap_open, only: & - open_hash_map_type, fnv_1_hasher, in_map, & + open_hashmap_type, fnv_1_hasher, in_map, & int_index, key_type, map_entry, other_type, set integer(int_index) :: inmap type(key_type) :: key type(other_type) :: other - type(open_hash_map_type) :: map + type(open_hashmap_type) :: map call init( map, fnv_1_hasher ) call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) call set( other, [ 4_int8, 3_int8, 2_int8, 1_int8 ] ) @@ -2515,7 +2515,7 @@ Experimental ##### Description -Initializes a `open_hash_map_type` object. +Initializes a `open_hashmap_type` object. ##### Syntax @@ -2528,7 +2528,7 @@ Subroutine ##### Arguments `map`: shall be a scalar variable of type - `open_hash_map_type`. It is an `intent(out)` argument. It will + `open_hashmap_type`. It is an `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`. @@ -2600,7 +2600,7 @@ Pure function ##### Argument -`map` - shall be an expression of type `open_hash_map_type`. +`map` - shall be an expression of type `open_hashmap_type`. It is an `intent(in)` argument. ##### Result character @@ -2617,10 +2617,10 @@ number of slots in the hash map.? ```fortran program demo_loading use stdlib_hashmap_open, only: & - open_hash_map_type, init, int_index, & + open_hashmap_type, init, int_index, & fnv_1_hasher, loading implicit none - type(open_hash_map_type) :: map + type(open_hashmap_type) :: map real :: ratio call init( map, fnv_1_hasher ) ratio = loading (map) @@ -2649,7 +2649,7 @@ Subroutine ##### Arguments -`map`: shall be a scalar variable of type `open_hash_map_type`. It +`map`: shall be a scalar variable of type `open_hashmap_type`. It is an `intent(inout)` argument. It is the hash map to receive the entry. @@ -2675,9 +2675,9 @@ is ignored. use, intrinsic:: iso_fortran_env, only: & int8 use stdlib_hashmap_open, only: & - open_hash_map_type, fnv_1_hasher, init, & + open_hashmap_type, fnv_1_hasher, init, & int_index, key_type, map_entry, other_type, set - type(open_hash_map_type) :: map + type(open_hashmap_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap @@ -2712,7 +2712,7 @@ Pure function ##### Argument `map`: shall be a scalar integer expression of type -`open_hash_map_type`. It is an `intent(in)` argument. It is the +`open_hashmap_type`. It is an `intent(in)` argument. It is the hash map of interest. ##### Result character @@ -2728,10 +2728,10 @@ The result is the number of probes of `map`. ```fortran program demo_probes use stdlib_hashmap_open, only: & - open_hash_map_type, init, int_index, & + open_hashmap_type, init, int_index, & fnv_1_hasher, probes implicit none - type(open_hash_map_type) :: map + type(open_hashmap_type) :: map real :: ratio call init( map, fnv_1_hasher ) ratio = probes (map) @@ -2760,7 +2760,7 @@ Subroutine ##### Arguments -`map` : shall be a scalar variable of type `open_hash_map_type`. +`map` : shall be a scalar variable of type `open_hashmap_type`. It is an `intent(inout)` argument. It is the hash map whose hashing method is to be changed. @@ -2772,10 +2772,10 @@ It is the hash method to be used by `map`. ```fortran program demo_rehash use stdlib_hashmap_open, only: & - open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& + open_hashmap_type, fnv_1_hasher, fnv_1a_hasher,& init, int_index, key_type, map_entry, other_type, & rehash, set - type(open_hash_map_type) :: map + type(open_hashmap_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap @@ -2810,7 +2810,7 @@ Pure function ##### Argument -`map` - shall be an expression of type `open_hash_map_type`. +`map` - shall be an expression of type `open_hashmap_type`. It is an `intent(in)` argument. ##### Result character @@ -2827,13 +2827,13 @@ number of slots in the hash map relative to the `load_factor`. ```fortran program demo_relative_loading use stdlib_hashmap_open, only: & - open_hash_map_type, init, int_index, & + open_hashmap_type, init, int_index, & fnv_1_hasher, loading implicit none - type(open_hash_map_type) :: map + type(open_hashmap_type) :: map real :: ratio call init( map, fnv_1_hasher ) - ratio = relative loading (map) + ratio = relative_loading (map) print *, "Initial relative loading = ", ratio end program demo_relative_loading ``` @@ -2860,7 +2860,7 @@ Subroutine ##### Arguments -`map`: shall be a scalar variable of type `open_hash_map_type`. It +`map`: shall be a scalar variable of type `open_hashmap_type`. It is an `intent(inout)` argument. It will be a hash map used to store and access the entry's data. @@ -2886,10 +2886,10 @@ the other data for the entry at the `inmap` index. ```fortran program demo_set_other_data use stdlib_hashmap_open, only: & - open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& + open_hashmap_type, fnv_1_hasher, fnv_1a_hasher,& init, int_index, key_type, map_entry, other_type, & set, set_other_data - type(open_hash_map_type) :: map + type(open_hashmap_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap @@ -2925,7 +2925,7 @@ Pure function ##### Argument `map`: shall be a scalar expression of type -`open_hash_map_type`. It is an `intent(in)` argument. It is the +`open_hashmap_type`. It is an `intent(in)` argument. It is the hash map of interest. ##### Result character @@ -2941,10 +2941,10 @@ The result is the number of slots in `map`. ```fortran program demo_probes use stdlib_hashmap_open, only: & - open_hash_map_type, init, int_index, & + open_hashmap_type, init, int_index, & fnv_1_hasher, slots implicit none - type(open_hash_map_type) :: map + type(open_hashmap_type) :: map integer(int_index) :: initial_slots call init( map, fnv_1_hasher ) initial_slots = slots (map) @@ -2975,7 +2975,7 @@ Pure function ##### Argument `map`: shall be a scalar expression of type -`open_hash_map_type`. It is an `intent(in)` argument. It is the +`open_hashmap_type`. It is an `intent(in)` argument. It is the hash map of interest. ##### Result character @@ -2992,10 +2992,10 @@ from their slot index the map. ```fortran program demo_probes use stdlib_hashmap_open, only: & - open_hash_map_type, init, int_index, & + open_hashmap_type, init, int_index, & fnv_1_hasher, total_depth implicit none - type(open_hash_map_type) :: map + type(open_hashmap_type) :: map integer(int_depth) :: initial_depth call init( map, fnv_1_hasher ) initial_depth = total_depth (map) @@ -3025,7 +3025,7 @@ Subroutine ##### Arguments -`map`: shall be a scalar expression of type `open_hash_map_type`. +`map`: shall be a scalar expression of type `open_hashmap_type`. It is an `intent(in)` argument. It is the hash map whose entry is unmapped. @@ -3033,12 +3033,12 @@ is unmapped. is an `intent(in)` argument. It is the non-zero index to the inverse table identifying the unmapped entry. -* If ``inmap` is zero or `key` hass been eliminated from the table +* If `inmap` is zero or `key` hass been eliminated from the table subsequent to the generation of `inmap`, or `map` has been rehashed subsequent to the generation of `inmap`, `other` is undefined. `key`: shall be a variable of type `key_type` -`INT8`, or an allocatable length default character. It is an +`int8`, or an allocatable length default character. It is an `intent(out)` argument. It is the `key` associated with the entry at index `inmap` in the inverse table. @@ -3047,10 +3047,10 @@ index `inmap` in the inverse table. ```fortran program demo_unmap use stdlib_hashmap_open, only: & - open_hash_map_type, fnv_1_hasher, fnv_1a_hasher,& + open_hashmap_type, fnv_1_hasher, fnv_1a_hasher,& init, int_index, key_type, map_entry, other_type, & unmap - type(open_hash_map_type) :: map + type(open_hashmap_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap @@ -3085,7 +3085,7 @@ Pure function. ##### Arguments -`map`: shall be a scalar expression of type `open_hash_map_type`. +`map`: shall be a scalar expression of type `open_hashmap_type`. It is an `intent(in)` argument. It is the hash map whose inverse table is examined. @@ -3108,10 +3108,10 @@ table of `map` and `.false.` otherwise. ```fortran program demo_valid_index use stdlib_hashmap_open, only: & - open_hash_map_type, init, int_index, & + open_hashmap_type, init, int_index, & fnv_1_hasher, valid_index implicit none - type(open_hash_map_type) :: map + type(open_hashmap_type) :: map integer(int_index) :: inmap logocal :: valid call init( map, fnv_1_hasher ) From 7dd1a512160c70bee3229a95ef8929ac7f846c6a Mon Sep 17 00:00:00 2001 From: William Clodius Date: Thu, 30 Dec 2021 18:06:08 -0700 Subject: [PATCH 15/77] More changes suggested by Jeremie Change "module," to "module". Change all upper case names to lower case. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 72 +++++++++++++++++------------------ 1 file changed, 36 insertions(+), 36 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 85a8d38a0..b1973f382 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -47,7 +47,7 @@ hash functions so that they no longer need to be supplied seeds. The module `stdlib_hashmap_chaining` defines a datatype, `chaining_hashmap_type`, implementing a simple separate chaining hash map noted more for its diagnostics than its performance. Finally the -module, `stdlib_hashmap_open` defines a datatype, +module `stdlib_hashmap_open` defines a datatype, `open_hashmap_type`, implementing a simple open addressing hash map noted more for its diagnostics than its performance. @@ -96,9 +96,9 @@ as a kind value,`int_hash`. It also defines two types, `key_type` and `other_type`, and associated procedures, for storing and manipulating keys and their associated data. -### The `stdlib_hashmap_wrappers` constant, `INT_HASH` +### The `stdlib_hashmap_wrappers` constant, `int_hash` -The constant `INT_HASH` is used to define the integer kind value for +The constant `int_hash` is used to define the integer kind value for the returned hash codes and variables used to access them. It currently has the value, `int32`. @@ -302,11 +302,11 @@ is an `intent(in)` argument. ##### Result character -The result is a value of type default `LOGICAL`. +The result is a value of type default `logical`. ##### Result value -The result is `.TRUE.` if the keys are equal, otherwise `.FALSS`. +The result is `.true.` if the keys are equal, otherwise `.falss`. ##### Example @@ -330,7 +330,7 @@ The result is `.TRUE.` if the keys are equal, otherwise `.FALSS`. ``` -#### `FIBONACCI_HASH` - maps an integer to a smaller number of bits +#### `fibonacci_hash` - maps an integer to a smaller number of bits ##### Status @@ -367,7 +367,7 @@ an index into the hash slots. ##### Note -`FIBONACCI_HASH` is an implementation of the Fibonacci Hash of Donald +`fibonacci_hash` is an implementation of the Fibonacci Hash of Donald E. Knuth. It multiplies the `KEY` by the odd valued approximation to `2**32/phi`, where `phi` is the golden ratio 1.618..., and returns the `NBITS` upper bits of the product as the lowest bits of the result. @@ -395,7 +395,7 @@ E. Knuth. It multiplies the `KEY` by the odd valued approximation to ``` -#### `FNV_1_HASHER`- calculates a hash code from a key +#### `fnv_1_hasher`- calculates a hash code from a key ##### Status @@ -428,7 +428,7 @@ The result is a hash code created using the FNV-1 algorithm. ##### Note -`FNV_1_HASHER` is an implementation of the original FNV-1 hash code of +`fnv_1_hasher` is an implementation of the original FNV-1 hash code of Glenn Fowler, Landon Curt Noll, and Phong Vo. This code is relatively fast on short keys, and is small enough that it will often be retained in the instruction cache if hashing is @@ -459,7 +459,7 @@ expected to be minor compared to its faster hashing rate. ``` -#### `FNV_1A_HASHER`- calculates a hash code from a key +#### `fnv_1a_hasher`- calculates a hash code from a key ##### Status @@ -492,7 +492,7 @@ The result is a hash code created using the FNV-1a algorithm. ##### Note -`FNV_1A_HASHER` is an implementation of the original FNV-1A hash code +`fnv_1a_hasher` is an implementation of the original FNV-1A hash code of Glenn Fowler, Landon Curt Noll, and Phong Vo. This code is relatively fast on short keys, and is small enough that it will often be retained in the instruction cache if hashing is @@ -671,7 +671,7 @@ an `intent(out)` argument. ``` -#### `HASHER_FUN`- serves aa a function prototype. +#### `hasher_fun`- serves aa a function prototype. ##### Status @@ -692,7 +692,7 @@ Pure function prototype ##### Argument -`key`: Shall be a rank one array expression of type `INTEGER(int8)`. +`key`: Shall be a rank one array expression of type `integer(int8)`. It is an `intent(in)` argument. ##### Result character @@ -705,7 +705,7 @@ The result is a hash code. ##### Note -`HASHER_FUN` is a prototype for defining dummy arguments and function +`hasher_fun` is a prototype for defining dummy arguments and function pointers intended for use as a hash function for the hash maps. ##### Example @@ -728,7 +728,7 @@ pointers intended for use as a hash function for the hash maps. end program demo_hasher_fun ``` -#### `SEEDED_NMHASH32_HASHER`- calculates a hash code from a key +#### `seeded_nmhash32_hasher`- calculates a hash code from a key ##### Status @@ -761,7 +761,7 @@ The result is a hash code created using the `nmhash32` algorithm. ##### Note -`SEEDED_NMHASH32_HASHER` is a wrapper to the `NMHASH32_HASH` of the +`seeded_nmhash32_hasher` is a wrapper to the `NMHASH32_HASH` of the module `stdlib_hash_32bit`, which supplies a fixed seed to the wrapped function. `NMHASH32` is an implementation of the `nmhash32` hash code of James Z. M. Gao. @@ -792,7 +792,7 @@ applications. end program demo_seeded_nmhash32_hasher ``` -#### `SEEDED_NMHASH32X_HASHER`- calculates a hash code from a key +#### `seeded_nmhash32x_hasher`- calculates a hash code from a key ##### Status @@ -825,9 +825,9 @@ The result is a hash code created using the `nmhash32x` algorithm. ##### Note -`SEEDED_NMHASH32X_HASHER` is a wrapper to the `NMHASH32X_HASH` of the +`seeded_nmhash32x_hasher` is a wrapper to the `nmhash32x_hash` of the module `stdlib_hash_32bit`, which supplies a fixed seed -to the wrapped function. `NMHASH32X` is an implementation of the +to the wrapped function. `nmhash32x` is an implementation of the `nmhash32x` hash code of James Z. M. Gao. This code has good, but not great, performance on long keys, poorer performance on short keys. @@ -855,7 +855,7 @@ applications. end program demo_seeded_nmhash32x_hasher ``` -#### `SEEDED_WATER_HASHER`- calculates a hash code from a key +#### `seeded_water_hasher`- calculates a hash code from a key ##### Status @@ -888,9 +888,9 @@ The result is a hash code created using the `waterhash` algorithm. ##### Note -`SEEDED_WATER_HASHER` is a wrapper to the `WATER_HASH` of the +`seeded_water_hasher` is a wrapper to the `water_hash` of the module `stdlib_hash_32bit`, which supplies a fixed seed -to the wrapped function. `WATER_HASH` is an implementation of the +to the wrapped function. `water_hash` is an implementation of the `waterhash` hash code of Tommy Ettinger. This code has excellent performance on long keys, and good performance on short keys. @@ -1071,7 +1071,7 @@ the inverse table. The type's definition is below: next => null() ! Next bucket end type chaining_map_entry_type ``` -Currently the `INT_HASH` and `INT_INDEX` have the value of `int32`. +Currently the `int_hash` and `int_index` have the value of `int32`. #### The `chaining_map_entry_ptr` derived type @@ -1182,13 +1182,13 @@ Procedures to report the content of a map: * `get_other_data( map, inmap, other )` - Returns the other data associated with the inverse table index -* `in_map( map, inmap, key )` - Returns the index into the INVERSE - array associated with the KEY +* `in_map( map, inmap, key )` - Returns the index into the `inverse` + array associated with the `key` * `unmap( map, inmap, key )` - Returns a copy of the key associated with an index to the inverse table. -* `valid_index(map, inmap)` - Returns a flag indicating whether INMAP +* `valid_index(map, inmap)` - Returns a flag indicating whether `inmap` is a valid index. Procedures to report on the structure of the map: @@ -1236,7 +1236,7 @@ It is an `intent(in)` argument. ##### Result character -The result will be an integer of kind `INT_CALLS`. +The result will be an integer of kind `int_calls`. ##### Result value @@ -1284,7 +1284,7 @@ It is an `intent(in)` argument. ##### Result character -The result will be an integer of kind `INT_INDEX`. +The result will be an integer of kind `int_index`. ##### Result value @@ -1400,7 +1400,7 @@ Subroutine is an `intent(inout)` argument. It will be the hash map used to store and access the entries. -`inmap`: shall be a scalar integer variable of kind `INT_INDEX`. It is +`inmap`: shall be a scalar integer variable of kind `int_index`. It is an `intent(out)` argument. It will be 0 if `key` is not found, otherwise it will be the one's based index to the location of `key` in the hash map's inverse array. @@ -2157,7 +2157,7 @@ the inverse table. The type's definition is below: integer(int_index) :: index ! Index into inverse table end type open_map_entry_type ``` -Currently the `INT_HASH` and `INT_INDEX` have the value of `int32`. +Currently `int_hash` and `int_index` have the value of `int32`. #### The `open_map_entry_ptr` derived type @@ -2244,13 +2244,13 @@ Procedures to report the content of a map: * `get_other_data( map, inmap, other )` - Returns the other data associated with the inverse table index -* `in_map( map, inmap, key )` - Returns the index into the INVERSE - array associated with the KEY +* `in_map( map, inmap, key )` - Returns the index into the `inverse` + array associated with the `key` * `unmap( map, inmap, key )` - Returns a copy of the key associated with an index to the inverse table. -* `valid_index(map, inmap)` - Returns a flag indicating whether INMAP +* `valid_index(map, inmap)` - Returns a flag indicating whether `inmap` is a valid index. Procedures to report on the structure of the map: @@ -2302,7 +2302,7 @@ It is an `intent(in)` argument. ##### Result character -The result will be an integer of kind `INT_CALLS`. +The result will be an integer of kind `int_calls`. ##### Result value @@ -2350,7 +2350,7 @@ It is an `intent(in)` argument. ##### Result character -The result will be an integer of kind `INT_INDEX`. +The result will be an integer of kind `int_index`. ##### Result value @@ -2466,7 +2466,7 @@ Subroutine is an `intent(inout)` argument. It will be the hash map used to store and access the entries. -`inmap`: shall be a scalar integer variable of kind `INT_INDEX`. It is +`inmap`: shall be a scalar integer variable of kind `int_index`. It is an `intent(out)` argument. It will be 0 if `key` is not found, otherwise it will be the one's based index to the location of `key` in the hash map's inverse array. From 60addf43b555cf1b755d518c597038c01f136eff Mon Sep 17 00:00:00 2001 From: William Clodius Date: Thu, 30 Dec 2021 18:42:35 -0700 Subject: [PATCH 16/77] Fixed typos Fixed numerous typos in stdlib_hash_maps.md identified by Jeremie. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 30 ++++++++++++------------------ 1 file changed, 12 insertions(+), 18 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index b1973f382..015ace1f8 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -770,8 +770,6 @@ performance on short keys. As a result it should give fair performance for typical hash map applications. This code passes the SMHasher tests. -As a result it should give good performance for typical hash map -applications. ##### Example @@ -834,8 +832,6 @@ performance on short keys. As a result it should give fair performance for typical hash map applications. This code passes the SMHasher tests. -As a result it should give good performance for typical hash map -applications. ##### Example @@ -897,8 +893,6 @@ on short keys. As a result it should give reasonable performance for typical hash table applications. This code passes the SMHasher tests. -As a result it should give good performance for typical hash map -applications. ##### Example @@ -988,7 +982,7 @@ separate chaining hashing. The derived type is procedures to manipulate the structure of the hash map: `init`, `map_entry`, `rehash`, `remove_entry`, and `set_other_data`. It provides procedures to inquire about entries in -the hash map: `get_other_data`, `in_map`, `unmap`.and `valid_index`. +the hash map: `get_other_data`, `in_map`, `unmap` and `valid_index`. Finally it provides procedures to inquire about the overall structure and performance of the table:`calls`, `entries`, `get_other_data`, `loading`, `slots`, and `total_depth`. The module @@ -1001,7 +995,7 @@ also defines a number of public constants: `inmap_probe_factor`, The module defines several categories of public constants. Some are used to parameterize the empirical slot expansion code. Others -parameterize the slots table size, Some are used to define +parameterize the slots table size. Some are used to define integer kind values for different applications. Finally, some are used to report errors or success. @@ -1039,7 +1033,7 @@ entities of kind `int_probes`. Currently `int_probes` has the value of Finally the error codes `success`, `alloc_fault`, and `array_size_error` are used to report the error status of certain -procedure calla. The `succes` code indicates that no problems were +procedure calls. The `succes` code indicates that no problems were found. The `alloc_fault` code indicates that a memory allocation failed. Finally the `array_size_error` indicates that on table creation `slots_bits` is less than `default_bits` or @@ -1075,7 +1069,7 @@ Currently the `int_hash` and `int_index` have the value of `int32`. #### The `chaining_map_entry_ptr` derived type -The type `chaining_map_entry_ptr` are used to define the elements of +The type `chaining_map_entry_ptr` is used to define the elements of the hash map that are either empty or link to the linked lists containing the elements of the table. The type's definition is below: @@ -1094,7 +1088,7 @@ costs. The type's definition is below: ```fortran type :: chaining_map_entry_pool - ! Type inplementing a pool of allocated + ! Type implementing a pool of allocated ! `chaining_map_entry_type` objects private ! Index of next bucket @@ -1543,7 +1537,7 @@ The result will be a default real. ##### Result value The result will be the ratio of the number of entries relative to the -number of slots in the hash map.? +number of slots in the hash map. ##### Example @@ -2068,7 +2062,7 @@ linear open addressing hashing. The derived type is procedures to manipulate the structure of the hash map: `init`, `map_entry`, `rehash`, and `set_other_data`. It provides procedures to inquire about entries in the hash map: -`get_other_data`, `in_map`, `unmap`.and `valid_index`. Finally it +`get_other_data`, `in_map`, `unmap` and `valid_index`. Finally it provides procedures to inquire about the overall structure and performance of the table:`calls`, `entries`, `get_other_data`, `loading`, `relative_loading`, `slots`, and `total_depth`. The module @@ -2081,7 +2075,7 @@ also defines a number of public constants: `inmap_probe_factor`, The module defines several categories of public constants. Some are used to parameterize the empirical slot expansion code. Others -parameterize the slots table size, Some are used to define +parameterize the slots table size. Some are used to define integer kind values for different applications. Finally, some are used to report errors or success. @@ -2128,7 +2122,7 @@ entities of kind `int_probes`. Currently `int_probes` has the value of Finally the error codes `success`, `alloc_fault`, and `array_size_error` are used to report the error status of certain -procedure calla. The `succes` code indicates that no problems were +procedure calls. The `succes` code indicates that no problems were found. The `alloc_fault` code indicates that a memory allocation failed. The `array_size_error` indicates that on table creation `slots_bits` is less than `default_bits` or @@ -2161,7 +2155,7 @@ Currently `int_hash` and `int_index` have the value of `int32`. #### The `open_map_entry_ptr` derived type -The type `open_map_entry_ptr` are used to define the elements of +The type `open_map_entry_ptr` is used to define the elements of the hash map that are either empty or link to the linked lists containing the elements of the table. The type's definition is below: @@ -2319,7 +2313,7 @@ The result will be the number of procedure calls on the hash map. type(open_hashmap_type) :: map type(int_calls) :: initial_calls call init( map, fnv_1_hasher ) - initisl_calls = calls (map) + initial_calls = calls (map) print *, "INITIAL_CALLS = ", initial_calls end program demo_calls ``` @@ -2610,7 +2604,7 @@ The result will be a default real. ##### Result value The result will be the ratio of the number of entries relative to the -number of slots in the hash map.? +number of slots in the hash map. ##### Example From 0d0669e80326122bc302c49e7484c16227e5e508 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Fri, 31 Dec 2021 14:37:25 -0700 Subject: [PATCH 17/77] Simplified discussion of fibonacci_hash Replaced most of the discussion of the fibonaccI_hash functio, with a reference to the discussion in stdlib_hash_functions.md. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 59 +++-------------------------------- 1 file changed, 4 insertions(+), 55 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 015ace1f8..6ebbd6c1e 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -338,61 +338,10 @@ Experimental ##### Description -Calculates an `nbits` hash code from a 32 bit integer. - -##### Syntax - -`code = [[stdlib_hashmap_wrappers:fibonacci_hash]]( key, nbits )` - -##### Class - -Pure function - -##### Arguments - -`key`: Shall be a scalar integer expression of kind `int32`. It is an -`intent(in)` argument. - -`nbits` Shall be a scalar default integer expression with `0 < nbits < -32`. It is an `intent(in)` argument. - -##### Result character - -The result is an integer of kind `int32`. - -##### Result value - -The result has at most the lowest `nbits` nonzero so it can serve as -an index into the hash slots. - -##### Note - -`fibonacci_hash` is an implementation of the Fibonacci Hash of Donald -E. Knuth. It multiplies the `KEY` by the odd valued approximation to -`2**32/phi`, where `phi` is the golden ratio 1.618..., and returns the -`NBITS` upper bits of the product as the lowest bits of the result. - - -##### Example - -```fortran - program demo_fibonacci_hash - use stdlib_hashmap_wrappers, only: & - fibonacci_hash - use iso_fortran_env, only: int32 - implicit none - integer, allocatable :: array1(:) - integer(int32) :: hash, source - type(key_type) :: key - allocate( array1(0:2**4-1) ) - array1(:) = 0 - source = int(Z'1FFFFFF', int32) - hash = fibonacci_hash(source, 4) - azray1(hash) = source - print *, hash - print *, array - end program demo_fibonacci_hash -``` +`fibonacci_hash` is just a re-export of the function of the same name +implemented in +[`stdlib_hash_32bit`](https://stdlib.fortran-lang.org/page/spec/stdlib_hash_functions.html#fibonacci_hash-maps-an-integer-to-a-smaller-number-of-bits). +It reduces the value of a 32 bit integer to a smaller number of bits. #### `fnv_1_hasher`- calculates a hash code from a key From 4bb3dac50fb12e9aaed3c86589e18f35a6b0a988 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Sun, 2 Jan 2022 08:00:04 -0700 Subject: [PATCH 18/77] Changed documented structure of `other_type` Changed the structure of the `other_type` from a single compone that is a vector of int8s to a single component that is a class(*) allocatable. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 88 +++++++++++++++++++---------------- 1 file changed, 49 insertions(+), 39 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 6ebbd6c1e..51f61e502 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -118,7 +118,7 @@ opaque. Their current representations are as follows type :: other_type private - integer(int8), allocatable :: value(:) + class(*), allocatable :: value end type other_type ``` @@ -141,12 +141,12 @@ Procedures to manipulate `key_type` data: * `equal_keys( key1, key2 )` - compares two keys for equality. -* `get( key, value )` - extracts the contents of key into value, an - `int8` array or character string. +* `get( key, value )` - extracts the contents of `key` into `value`, + an `int8` array or character string. -* `free_key( key )` - frees the memory in key. +* `free_key( key )` - frees the memory in `key`. -* `set( key, value )` - sets the content of key to value. +* `set( key, value )` - sets the content of `key` to `value`. Procedures to manipulate `other_type` data: @@ -154,26 +154,27 @@ Procedures to manipulate `other_type` data: other data, `other_in`, to the contents of the other data, `other_out`. -* `get( other, value )` - extracts the contents of other into value, an - `int8` array or character string. +* `get( other, value )` - extracts the contents of `other` into the + class(*) variable `value`. -* `set( other, value )` - sets to content of other to value. +* `set( other, value )` - sets the content of `other` to the class(*) + variable `value`. -* `free_other( other )` - frees the memory in other. +* `free_other( other )` - frees the memory in `other`. Procedures to hash keys to 32 bit integers: -* `fnv_1_hasher( key )` - hashes a key using the FNV-1 algorithm. +* `fnv_1_hasher( key )` - hashes a `key` using the FNV-1 algorithm. -* `fnv_1a_hasher( key )` - hashes a key using the FNV-1a algorithm. +* `fnv_1a_hasher( key )` - hashes a `key` using the FNV-1a algorithm. -* `seeded_nmhash32_hasher( key )` - hashes a key using the nmhash32 +* `seeded_nmhash32_hasher( key )` - hashes a `key` using the nmhash32 algorithm. -* `seeded_nmhash32x_hasher( key )` - hashes a key using the nmhash32x +* `seeded_nmhash32x_hasher( key )` - hashes a `key` using the nmhash32x algorithm. -* `seeded_water_hasher( key )` - hashes a key using the waterhash +* `seeded_water_hasher( key )` - hashes a `key` using the waterhash algorithm. ### Specifications of the `stdlib_hashmap_wrappers` procedures @@ -186,7 +187,7 @@ Experimental ##### Description -Returns a copy of an input of type `key_type` +Returns a copy of an input of type `key_type`. ##### Syntax @@ -233,7 +234,7 @@ Experimental ##### Description -Returns a copy of an input of type `other_type` +Returns a copy of an input of type `other_type`. ##### Syntax @@ -259,18 +260,23 @@ is an `intent(out)` argument. copy_other, get, other_type, set use iso_fortran_env, only: int8 implicit none - integer(int8), allocatable :: value1(:), value2(:) type(other_type) :: other_in, other_out integer(int_8) :: i - allocate( value1(1:15) ) + class(*), allocatable :: dummy + type dummy_type + integer(int8) :: value(15) + end type + type(dummy_type) :: dummy_val do i=1, 15 - value1(i) = i + dummy_val % value1(i) = i end do - call set( other_in, value1 ) + allocate(other_in % value, source=dummy_val) call copy_other( other_in, other_out ) - call get( other_out, value2 ) - print *, "other_in == other_out = ", & - all( value1 == value2 ) + select type(other_out) + type(dummy_type) + print *, "other_in == other_out = ", & + all( dummy_val % value == other_out % value ) + end select end program demo_copy_other ``` @@ -282,7 +288,7 @@ Experimental ##### Description -Returns `.true.` if two keys are equal, and false otherwise. +Returns `.true.` if two keys are equal, and `.false.` otherwise. ##### Syntax @@ -548,14 +554,16 @@ is an `intent(out)` argument. copy_other, free_other, other_type, set use iso_fortran_env, only: int8 implicit none - integer(int8), allocatable :: value(:) - type(key_type) :: other_in, other_out + type dummy_type + integer(int8) :: value(15) + end type dummy_type + typer(dummy_type) :: dummy_val + type(other_type), allocatable :: other_in, other_out integer(int_8) :: i - allocate( value(1:15) ) do i=1, 15 - value(i) = i + dummy_val % value(i) = i end do - call set( other_in, value ) + allocate(other_in, source=dummy_val) call copy_other( other_in, other_out ) call free_other( other_out ) end program demo_free_other @@ -570,8 +578,8 @@ Experimental ##### Description -Extracts the data from a `key_type` or an `other_type` and stores it -in the variable `value`.. +Extracts the data from a `key_type` or `other_type` and stores it +in the variable `value`. ##### Syntax @@ -581,7 +589,6 @@ or `call [[stdlib_hashmap_wrappers:get]]( other, value )` - ##### Class Subroutine. @@ -594,9 +601,11 @@ is an `intent(in)` argument. `other`: shall be a scalar expression of type `other_type`. It is an `intent(in)` argument. -`value`: shall be an allocatable default character string variable, or -an allocatable vector variable of type integer and kind `int8`. It is -an `intent(out)` argument. +`value`: if the the first argument is of `key_type` `value` shall be +an allocatable default character string variable, or +an allocatable vector variable of type integer and kind `int8`, +otherwise the first argument is of `other_type` and `value` shall be +an allocatable of `class(*)`. It is an `intent(out)` argument. ##### Example @@ -629,7 +638,7 @@ Experimental ##### Description Serves as a prototype for hashing functions with a single, `key`, -argument returning an `int32` hash value. +argument of type `key_type` returning an `int32` hash value. ##### Syntax @@ -894,9 +903,10 @@ is an `intent(out)` argument. `other`: shall be a scalar variable of type `other_type`. It is an `intent(out)` argument. -`value`: shall be a default character string expression, or a -vector expression of type integer and kind `int8`. It is an -`intent(in)` argument. +`value`: if the first argument is `key` `vaalue` shall be a default +character string expression, or a vector expression of type integer +and kind `int8`, while for a first argument of type `other` `value` +shall be of type `class(*)`. It is an `intent(in)` argument. ##### Example From 9f3471d5d342e9a1efcfeccfdbe7463883642f63 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Fri, 7 Jan 2022 13:44:27 -0700 Subject: [PATCH 19/77] Document equality and conversion to inheritence I have made two minor changes and a major change in the proposed code. !. One minor change is that equal keys in stdlib_hashmap_wrappers is now exported as an equality operator and not under its own name. 2. Another minor chane is the procedure relative_loading has been removed. 3. The major change is that I have converted the proper hash map codes into an inheritence tree with the following changes. A. The hash map types are now defined in a new module stdlib_hashmaps with the obvious filename, stdlib_hashmaps.f90. B. There are now three hash map types: hashmap_type, chaining_hashmap_type, and open_hashmap_type with hashmap_type an abstract type that serves as the parent to the other two types. C. The files stdlib_hashmap_chaining.f90 and stdlib_hashmap_open.f90 now define the respective submodules stdlib_hashmap_chaining and stdlib_hashmap_open of the module stdlib_hashmaps and largely implement the codes for their respective types, chaining_hashmap_type and open_hashmap_type. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 1951 ++++++++++----------------------- 1 file changed, 563 insertions(+), 1388 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 51f61e502..3241bf002 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -28,57 +28,70 @@ Chase. While the code has been greatly modified from his implementation, he has give permission for the unrestricted use of his code. - ## The hash map modules -The Fortran Standard Library provides three modules for the +The Fortran Standard Library provides two modules for the implementation of simple hash maps. These maps only accept hash functions with a single argument, the key, and yield a 32 bit hash code. The modules will need to be modified if it is desired to -use hash functions with a different API. The three modules are: -`stdlib_hashmap_wrappers`, `stdlib_hashmap_chaining` and -`stdlib_hashmap_open`, corresponding to the files: -`stdlib_hashmap_wrappers.f90`, `stdlib_hashmap_chaining.f90`, -and `stdlib_hashmap_open.f90`. The module -`stdlib_hashmap_wrappers` provides an interface to the 32 bit -hash functions of the Standard Library module, +use hash functions with a different API. The two modules are: +`stdlib_hashmap_wrappers`, and `stdlib_hashmaps` corresponding to the +files: `stdlib_hashmap_wrappers.f90`, and `stdlib_hashmaps.f90` + +The module `stdlib_hashmap_wrappers` provides types and procedures for +use by `stdlib_hashmaps`. It provides an +interface to the 32 bit hash functions of the Standard Library module, `stdlib_hash_32bit`, and provides wrappers to some of the -hash functions so that they no longer need to be supplied seeds. The -module `stdlib_hashmap_chaining` defines a datatype, -`chaining_hashmap_type`, implementing a simple separate chaining hash -map noted more for its diagnostics than its performance. Finally the -module `stdlib_hashmap_open` defines a datatype, -`open_hashmap_type`, implementing a simple open addressing hash -map noted more for its diagnostics than its performance. - -These maps use separate chaining with linked lists and linear open -addressing, respectively, to deal with hash index collisions, and are -largely defined in the separated submodules, `stdlib_hashmap_chainings` -and `stdlib_hashmap_opens`, respectively. -In `chaining_hashmap_type` the colliding indices are handled by using -linked lists with their roots at the hash index. -In `open_hashmap_type`, the colliding indices are handled by searching -from the initial hash index in increasing -steps of one (modulo the hash map size) for an open map bin. - -The maps share many attributes in common. The two types share a -common Application Programers Interface (API). The maps use powers of -two for their slot sizes, so that the function, `fibonacci_hash`, can +hash functions so that they no longer need to be supplied seeds. It +also defines two data types used to store information in the hash +maps, the `key_type` and the `other_type`. The `key_type` is used to +define keys that, in turn, are used to identify the data entered into +a hash map. The `other_type` is intended to contain the other data +associated with the key. + +The module `stdlib_hashmaps` defines the API for a parent datatype, +`hashmap_type` and two extensions of that hash map type: +`chaining_hashmap_type` and `open_hashmap_type`. + +The `hashmap_type` defines the Application Programers +Interface (API) for the procedures used by its two extensions. It +explicitly defines five non-overridable procedures. It also defines +the interfaces for eleven deferred procedures. It does not define the +finalization routines for the two extension types, or one routine +provided by the `open_hashmap_type`. + +The `chaining_hashmap_type` uses separate chaining with linked +lists to deal with hash index collisions. In separate chaining the +colliding indices are handled by using linked lists with their roots +at the hash index. The `chaining_hashmap_type` procedures are +implemented in the module `stdlib_hashmap_chaining` corresponding +to the file, `stdlib_hashmap_chaining.f90`. + +The `open_hashmap_type` +uses linear open addressing to deal with hash index collisions. In +linear open addressing the colliding indices are +handled by searching from the initial hash index in increasing +steps of one (modulo the hash map size) for an open map slot. +The `open_hashmap_type` procedures are implemented in the submodule +`stdlib_hashmap_open` corresponding to the file +`stdlib_hashmap_open.f90`. + +The maps use powers of two for their slot sizes, so that the function, +`fibonacci_hash`, can be used to map the hash codes to indices in the map. This is expected to be more efficient than prime number mapping using a modulo operation, and reduces the requirement that the hash function need to do a good job randomizing its lower order bits. -This requires a good randomizing hash method for good performance. +They do require a good randomizing hash method for good performance. Both adjust the map size to reduce collisions, based on the ratio of the number of hash map probes to the number of subroutine calls. -The maps make extensive use of pointers internally, but a private +Wile the maps make extensive use of pointers internally, a private finalization subroutine avoids memory leaks. -The maps can take entry keys of type `key_type`. -Both maps allow the addition and lookup of entries, and the inclusion -of data in addition to the entry key. -The `chaining_hashmap_type` also allows the selective removal of -entries. +The maps can take entry keys of type `key_type`, and other data of the +type `other_type`. +The maps allow the addition, removal, and lookup of entries, and the +inclusion of data in addition to the entry key. ## The `stdlib_hashmap_wrappers` module @@ -88,7 +101,7 @@ wrapper for the `stdlib_hash_32bit` module. It allows direct access to the `stdlib_hash_32bit` procedures: `fibonacci_hash`, `fnv_1_hasher`, `fnv_1a_hasher`; and provides wrapper functions, `seeded_nmhash32_hasher`, -`seeded_nmhash32x_hasher`, and `seeded_water_hasher` to the hashing +`seeded_nmhash32x_hasher`, and `seeded_water_hasher` to the hash functions: `nmhash32`, `nmhash32x`, and `water_hash`, respectively. It defines an interface, `hasher_fun`, compatible with the hash functions that take a `non-scalar key`. It defines one integer constant used @@ -96,13 +109,13 @@ as a kind value,`int_hash`. It also defines two types, `key_type` and `other_type`, and associated procedures, for storing and manipulating keys and their associated data. -### The `stdlib_hashmap_wrappers` constant, `int_hash` +### The `stdlib_hashmap_wrappers`'s constant, `int_hash` The constant `int_hash` is used to define the integer kind value for the returned hash codes and variables used to access them. It currently has the value, `int32`. -### The `stdlib_hashmap_wrappers` module derived types +### The `stdlib_hashmap_wrappers`' module's derived types The `stdlib_hashmap_wrappers` module defines two derived types: `key_type`, and `other_type`. The `key_type` is intended to be used @@ -122,8 +135,9 @@ opaque. Their current representations are as follows end type other_type ``` -The module also defines seven procedures for those types: `copy_key`, -`copy_other`, `equal_keys`, `free_key`, `free_other`, `get`, and `set` +The module also defines six procedures for those types: `copy_key`, +`copy_other`, `equal_keys`, `free_key`, `free_other`, `get`, and +`set`, and one operator, `==`, for use by the hash maps to manipulate or inquire of components of those types. @@ -132,15 +146,15 @@ those types. The `stdlib_hashmap_wrappers` module provides procedures in several categories: procedures to manipulate data of the `key_type`; procedures to manipulate data of the `other_type`, and 32 bit hash -functions for keys. The procedures in each category are listed below. +functions for keys. The procedures in each category are listed +below. It also provides an operator to compare two key type values for +equality. Procedures to manipulate `key_type` data: * `copy_key( key_in, key_out )` - Copies the contents of the key, `key_in`, to contents of the key, `key_out`. -* `equal_keys( key1, key2 )` - compares two keys for equality. - * `get( key, value )` - extracts the contents of `key` into `value`, an `int8` array or character string. @@ -177,6 +191,10 @@ Procedures to hash keys to 32 bit integers: * `seeded_water_hasher( key )` - hashes a `key` using the waterhash algorithm. +Operator to compare two `key_type` values for equality + +* `key1 == key2` - compares `key1' with 'key2' for equality + ### Specifications of the `stdlib_hashmap_wrappers` procedures #### `copy_key` - Returns a copy of the key @@ -210,7 +228,7 @@ is an `intent(out)` argument. ```fortran program demo_copy_key use stdlib_hashmap_wrappers, only: & - copy_key, equal_keys, key_type + copy_key, operator(==)equal_keys, key_type use iso_fortran_env, only: int8 implicit none integer(int8), allocatable :: value(:) @@ -222,7 +240,7 @@ is an `intent(out)` argument. end do call set( key_in, value ) call copy_key( key_in, key_out ) - print *, "key_in == key_out = ", equal_keys( key_in, key_out ) + print *, "key_in == key_out = ", key_in == key_out end program demo_copy_key ``` @@ -280,61 +298,6 @@ is an `intent(out)` argument. end program demo_copy_other ``` -#### `equal_keys` - Compares two keys for equality - -##### Status - -Experimental - -##### Description - -Returns `.true.` if two keys are equal, and `.false.` otherwise. - -##### Syntax - -`test = [[stdlib_hashmap_wrappers:equal_keys]]( key1, key2 )` - -##### Class - -Pure function. - -##### Arguments - -`key1`: shall be a scalar expression of type `key_type`. It -is an `intent(in)` argument. - -`key2`: shall be a scalar expression of type `key_type`. It -is an `intent(in)` argument. - -##### Result character - -The result is a value of type default `logical`. - -##### Result value - -The result is `.true.` if the keys are equal, otherwise `.falss`. - -##### Example - -```fortran - program demo_equal_keys - use stdlib_hashmap_wrappers, only: & - copy_key, equal_keys, key_type, set - use iso_fortran_env, only: int8 - implicit none - integer(int8), allocatable :: value(:) - type(key_type) :: key_in, key_out - integer(int_8) :: i - allocate( value(1:15) ) - do i=1, 15 - value(i) = i - end do - call set( key_in, value ) - call copy_key( key_in, key_out ) - print *, "key_in == key_out = ", equal_keys( key_in, key_out ) - end program demo_equal_keys -``` - #### `fibonacci_hash` - maps an integer to a smaller number of bits @@ -686,6 +649,61 @@ pointers intended for use as a hash function for the hash maps. end program demo_hasher_fun ``` +#### `operator(==)` - Compares two keys for equality + +##### Status + +Experimental + +##### Description + +Returns `.true.` if two keys are equal, and `.false.` otherwise. + +##### Syntax + +`test = [stdlib_hashmap_wrappers:key1==key2]` + +##### Class + +Pure operator. + +##### Arguments + +`key1`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. + +`key2`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. + +##### Result character + +The result is a value of type default `logical`. + +##### Result value + +The result is `.true.` if the keys are equal, otherwise `.falss`. + +##### Example + +```fortran + program demo_equal_keys + use stdlib_hashmap_wrappers, only: & + copy_key, operator(==), key_type, set + use iso_fortran_env, only: int8 + implicit none + integer(int8), allocatable :: value(:) + type(key_type) :: key_in, key_out + integer(int_8) :: i + allocate( value(1:15) ) + do i=1, 15 + value(i) = i + end do + call set( key_in, value ) + call copy_key( key_in, key_out ) + print *, "key_in == key_out = ", key_in == key_out + end program demo_equal_keys +``` + #### `seeded_nmhash32_hasher`- calculates a hash code from a key ##### Status @@ -930,27 +948,27 @@ shall be of type `class(*)`. It is an `intent(in)` argument. ``` -## The `stdlib_hashmap_chaining` module +## The `stdlib_hashmaps` module -The `stdlib_hashmap_chaining` module provides access to all the -public entities in the `stdlib_hashmap_wrappers` module. It -also defines a public data type and associated procedures and -constants that implement a simple hash map using -separate chaining hashing. The derived type is -`chaining_hashmap_type`. It provides -procedures to manipulate the structure of the hash map: +The `stdlib_hashmaps` module defines three public data types, +associated procedures and constants that implement two simple hash map +types using separate chaining hashing and open addressing hashing. The +derived type `hashmap_type` is the parent type to its two +extensions: `chaining_hashmap_type` and `open_hashmap_type`. +`chaining_hashmap_type`. The extension types provide +procedures to manipulate the structure of a hash map object: `init`, `map_entry`, `rehash`, `remove_entry`, and -`set_other_data`. It provides procedures to inquire about entries in -the hash map: `get_other_data`, `in_map`, `unmap` and `valid_index`. -Finally it provides procedures to inquire about the overall -structure and performance of the table:`calls`, `entries`, -`get_other_data`, `loading`, `slots`, and `total_depth`. The module -also defines a number of public constants: `inmap_probe_factor`, -`map_probe_factor`, `default_bits`, +`set_other_data`. They also provide procedures to inquire about +entries in the hash map: `get_other_data`, `in_map`, `unmap` and +`valid_index`. Finally they provide procedures to inquire about the +overall structure and performance of the hash map object:`calls`, +`entries`, `get_other_data`, `loading`, `slots`, and +`total_depth`. The module also defines a number of public constants: +`inmap_probe_factor`, `load_factor`, `map_probe_factor`, `default_bits`, `max_bits`, `int_calls`, `int_depth`, `int_index`, `int_probes`, `success`, `alloc_fault`, and `array_size_error`. -### The `stdlib_hashmap_chaining` module's public constants +### The `stdlib_hashmaps` module's public constants The module defines several categories of public constants. Some are used to parameterize the empirical slot expansion code. Others @@ -960,10 +978,10 @@ to report errors or success. The constants `inmap_probe_factor`, and `map_probe_factor` are used to parameterize the slot expansion code used to determine when in a -`inchain_map_call` the number -of slots need to be increased to decrease the lengths of the linked -lists. The constant `inmap_probe_factor` is used to determine when -the ratio of the number of map probes to map calls is too large and +in a procedure call the number +of slots need to be increased to decrease the search path for an +entry. The constant `inmap_probe_factor` is used to determine when +the ratio of the number of map probes to map calls is too large and the slots need expansion. The constant `map_probe_factor` is used to determine when inserting a new entry the ratio of the number of map probes to map calls is too large and the slots need expansion. @@ -990,6 +1008,12 @@ The number of probes, hash map enquiries, are reported and stored in entities of kind `int_probes`. Currently `int_probes` has the value of `int64`. +The constant `load_factor` is only used by the `open_hashmap_type`. It +specifies the maximum fraction of the available slots that may be +filled before expansion occurs. The current `load_factor = ).5625` so +the current implementation of `open_hashmap_type` can only hold a +little more than `2**29` entries. + Finally the error codes `success`, `alloc_fault`, and `array_size_error` are used to report the error status of certain procedure calls. The `succes` code indicates that no problems were @@ -998,13 +1022,97 @@ failed. Finally the `array_size_error` indicates that on table creation `slots_bits` is less than `default_bits` or greater than `max_bits`. -### The `stdlib_hashmap_chaining` module's derived types +### The `stdlib_hashmaps` module's derived types + +The `stdlib_hashmaps` module defines three public derived types and +seven private types used in the implementation of the public +types. The public types are the abstract `hashmap_type` and its +extensions: `chaining_hashmap_type` and `open_hashmap_type`. The three +private derived types, `chaining_map_entry_type`, +`chaining_map_entry_ptr`, and `chaining_map_entry_pool` are used in +the implementation of the `chaining_hashmap_type` public type. The +four private derived types, `open_map_entry_type`, +`open_map_entry_list`, `open_map_entry_ptr`, and `open_map_entry_pool` +are used in the implementation of the `open_hashmap_type` public +type:. Each of these types are described below. + +#### The `hashmap_type` abstract type + +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: +* `call_count` - the number of procedure calls on the map; +* `nbits` - the number of bits used to address the slots; +* `num_entries` - the humber of entries in the map; +* `num_free` - the number of entries in the free list of removed + entries; +* `probe_count` - the number of map probes since the last resizing or + initialization; +* `total_probes` - the number of probes of the map up to the last + resizing or initialization; and +* `hasher` - a pointer to the hash function used by the map. +It also defines five non-overridable procedures: +* `calls` - returns the number of procedure calls on the map; +* `entries` - returns the number of entries in the map; +* `map_probes` - returns the number of map probes since + initialization; +* `num_slots` - returns the number of slots in the map; and +* `slots_bits` - returns the number of bits used to address the slots; +and eleven deferred procedures: +* `get_other_data` - gets the other data associated with the inmap + index; +* `in_map` - gets the inmap index into the inverse map associated with + `key`; +* `init` - initializes the hash map; +* `loading` - returns the ratio of the number of entries to the number + of slots; +* `map_entry` - inserts a key and its other associated data into the + map; +* `rehash` - rehashes the map with the provided hash function; +* `remove` - removes the entry associated wit the inmap index into the + inverse table; +* `set_other_data` - replaces the other data associated with the inmap + index intoo the inverse table; +* `total_depth` - returns the number of probes needed to address all + the entries in the map; +* `unmap` - returns a copy of the key associated with the inmap index + into the inverse table; +* `valid_index` - returns a logical flag indicating whether INMAP is a + valid index into the inverse table. + +The type's definition is below: + +```fortran + type, abstract :: hashmap_type + private + integer(int_calls) :: call_count = 0 + integer(int_calls) :: probe_count = 0 + integer(int_calls) :: total_probes = 0 + integer(int_index) :: num_entries = 0 + integer(int_index) :: num_free = 0 + integer(int_index) :: index_mask = 2_int_index**default_bits-1 + integer(int32) :: nbits = default_bits + procedure(hasher_fun), pointer, nopass :: hasher => fnv_1_hasher + contains + procedure, non_overridable, pass(map) :: calls + procedure, non_overridable, pass(map) :: entries + procedure, non_overridable, pass(map) :: map_probes + procedure, non_overridable, pass(map) :: slots_bits + procedure, non_overridable, pass(map) :: num_slots + procedure(get_other), deferred, pass(map) :: get_other_data + procedure(in_map), deferred, pass(map) :: in_map + procedure(init_map), deferred, pass(map) :: init + procedure(loading), deferred, pass(map) :: loading + procedure(map_entry), deferred, pass(map) :: map_entry + procedure(rehash_map), deferred, pass(map) :: rehash + procedure(remove_entry), deferred, pass(map) :: remove + procedure(set_other), deferred, pass(map) :: set_other_data + procedure(total_depth), deferred, pass(map) :: total_depth + procedure(unmap), deferred, pass(map) :: unmap + procedure(valid_index), deferred, pass(map) :: valid_index + end type hashmap_type +``` -The `stdlib_hashmap_chaining` module defines several derived -types. The only public type is the `chaining_hashmap_type`. There are -three other private derived types used in the implementation of the -public type: `chaining_map_entry_type`, `chaining_map_entry_ptr`, and -`chaining_map_entry_pool`. Each of these is described below. #### The `chaining_map_entry_type` derived type @@ -1060,49 +1168,119 @@ costs. The type's definition is below: #### The `chaining_hashmap_type` derived type -The `chaining_hashmap_type` derived type implements a separate -chaining hash map. It provides the components `calls`, `probes`, -`total_probes`, `entries`, and `slots_bits` to keep track -of the hash map's usage. The array element `slots` serves as the -table proper. The array element `inverse` maps integers to -entries. The linked list entry, `free_list`, keeps track of freed -elements of type `chaining_map_entry_type`. The list element, `cache`, -stores pools of `chaining_map_entry_type` elements for reuse. The -component `hasher` is a pointer to the hash function. Finally the -type-bound procedure, `free_chaining_map`, serves as a finalizer for -objects of the type, `chaining_hashmap_type`. +The `chaining_hashmap_type` derived type extends the `hashmap_type` to +implements a separate chaining hash map. In addition to the components +of the `hashmap_type` it provides the four components: +* `cache` - a pool of `chaining_map_entry_pool` objects used to reduce +allocation costs; +* `free_list` - a free list of map entries; +* `inverse` - an array of `chaining_map_entry_ptr` bucket lists +(inverses) storing entries at fixed locations once +entered; and +* `slots` - an array of bucket lists serving as the hash map. +It also implements all of the deferred procedures of the +`hashmap_type` and a finalizer for its maps. The type's definition is +as follows: ```fortran - type :: chaining_hashmap_type + type, extends(hashmap_type) :: chaining_hashmap_type private - integer(int_calls) :: calls = 0 - ! Number of calls - integer(int_calls) :: probes = 0 - ! Number of probes since last expansion - integer(int_calls) :: total_probes = 0 - ! Cumulative number of probes -` integer(int_index) :: entries = 0 - ! Number of entries - integer(int32) :: slots_bits = default_bits - ! Bits used for slots size + type(chaining_map_entry_pool), pointer :: cache => null() + type(chaining_map_entry_type), pointer :: free_list => null() + type(chaining_map_entry_ptr), allocatable :: inverse(:) type(chaining_map_entry_ptr), allocatable :: slots(:) - ! Array of bucket lists Note # slots=size(slots) - type(chaining_map_entry_ptr), allocatable :: inverse(:) - ! Array of bucket lists (inverses) Note max_elts=size(inverse) - type(chaining_map_entry_type), pointer :: free_list => null() - ! free list of map entries - type(chaining_map_entry_pool), pointer :: cache => null() - ! Pool of allocated chaining_map_entry_type objects - procedure(hasher_fun), pointer, nopass :: hasher => fnv_1_hasher - ! Hash function contains + procedure :: get_other_data => get_other_chaining_data + procedure :: in_map => in_chain_map + procedure :: init => init_chaining_map + procedure :: loading => chaining_loading + procedure :: map_entry => map_chain_entry + procedure :: rehash => rehash_chaining_map + procedure :: remove => remove_chaining_entry + procedure :: set_other_data => set_other_chaining_data + procedure :: total_depth => total_chaining_depth + procedure :: unmap => unmap_chain + procedure :: valid_index => valid_chaining_index final :: free_chaining_map end type chaining_hashmap_type ``` -### Table of `stdlib_hashmap_chaining` procedures +#### The `open_map_entry_type` derived type + +Entities of the type `open_map_entry_type` are used to define +a linked list structure that stores the +key, its other data, the hash of the key, and the resulting index into +the inverse table. The type's definition is below: + +```fortran + type :: open_map_entry_type ! Open hash map entry type + private + integer(int_hash) :: hash_val ! Full hash value + type(key_type) :: key ! The entry's key + type(other_type) :: other ! Other entry data + integer(int_index) :: index ! Index into inverse table + end type open_map_entry_type +``` + +Currently `int_hash` and `int_index` have the value of `int32`. + +#### The `open_map_entry_ptr` derived type + +The type `open_map_entry_ptr` is used to define the elements of +the hash map that are either empty or link to the linked lists +containing the elements of the table. The type's definition is below: + +```fortran + type open_map_entry_ptr ! Wrapper for a pointer to a open + ! map entry type object + type(open_map_entry_type), pointer :: target => null() + end type open_map_entry_ptr +``` + +#### The `open_hashmap_type` derived type + +The `open_hashmap_type` derived type extends the `hashmap_type` to +implement an open addressing hash map. In addition to the components +of the `hashmap_type` it provides the four components: +* `cache` - a pool of `open_map_entry_pool` objects used to reduce +allocation costs; +* `free_list` - a free list of map entries; +* `index_mask` - an `and` mask used in linear addressing; +* `inverse` - an array of `open_map_entry_ptr` bucket lists +(inverses) storing entries at fixed locations once +entered; and +* `slots` - an array of bucket lists serving as the hash map. +It also implements all of the deferred procedures of the +`hashmap_type` and a finalizer for its maps. The type's definition is +as follows: + +```fortran + type, extends(hashmap_type) :: open_hashmap_type + private + integer(int_index) :: index_mask = 2_int_index**default_bits-1 + type(open_map_entry_pool), pointer :: cache => null() + integer(int_index), allocatable :: slots(:) + type(open_map_entry_ptr), allocatable :: inverse(:) + type(open_map_entry_list), pointer :: free_list => null() + contains + procedure :: get_other_data => get_other_open_data + procedure :: in_map => in_open_map + procedure :: init => init_open_map + procedure :: loading => open_loading + procedure :: map_entry => map_open_entry + procedure :: rehash => rehash_open_map + procedure :: remove => remove_open_entry + procedure :: set_other_data => set_other_open_data + procedure :: total_depth => total_open_depth + procedure :: unmap => unmap_open + procedure :: valid_index => valid_open_index + final :: free_open_map + end type open_hashmap_type +``` + +### Table of `stdlib_hashmap` procedures -The `stdlib_hashmap_chaining` module provides procedures in +The `stdlib_hashmap` module provides procedures in several categories: a procedure to initialize the map; a procedure to modify the structure of a map; procedures to modify the content of a map; procedures to report on the content of a map; and procedures @@ -1176,7 +1354,7 @@ Returns the number of procedure calls on a hash map. ##### Syntax -`value = [[stdlib_hashmap_chaining:calls]]( map )` +`value = [[stdlib_hashmaps:map % calls]]()` ##### Class @@ -1184,7 +1362,7 @@ Pure function ##### Argument -`map` - shall be an expression of type `chaining_hashmap_type`. +`map` (pass) - shall be an expression of class `hashmap_type`. It is an `intent(in)` argument. ##### Result character @@ -1199,14 +1377,13 @@ The result will be the number of procedure calls on the hash map. ```fortran program demo_calls - use stdlib_hashmap_chaining, only: & - chaining_hashmap_type, calls, init, int_calls, & - fnv_1_hasher + use stdlib_hashmaps, only: chaining_hashmap_type, int_calls + use stdlib_hashmap_wrappers, only: fnv_1_hasher implicit none type(chaining_hashmap_type) :: map type(int_calls) :: initial_calls - call init( map, fnv_1_hasher ) - initial_calls = calls (map) + call map % init(fnv_1_hasher ) + initial_calls = map % calls() print *, "INITIAL_CALLS = ", initial_calls end program demo_calls ``` @@ -1224,7 +1401,7 @@ Returns the number of entries in a hash map. ##### Syntax -`value = [[stdlib_hashmap_chaining:entries]]( map )` +`value = [[stdlib_hashmaps:map%entries]]()` ##### Class @@ -1232,7 +1409,7 @@ Pure function ##### Argument -`map` - shall be an expression of type `chaining_hashmap_type`. +`map` (pass) - shall be an expression of class `hashmap_type`. It is an `intent(in)` argument. ##### Result character @@ -1247,14 +1424,13 @@ The result will be the number of entries in the hash map. ```fortran program demo_entries - use stdlib_hashmap_chaining, only: & - chaining_hashmap_type, entries, init, int_index, & - fnv_1_hasher + use stdlib_hashmaps, only: open_hashmap_type, int_index + use stdlib_hashmap_wrappers, only: fnv_1_hasher implicit none - type(chaining_hashmap_type) :: map + type(open_hashmap_type) :: map type(int_index) :: initial_entries - call init( map, fnv_1_hasher ) - initial_entries = entries (map) + call map % init( fnv_1_hasher ) + initial_entries = map % entries () print *, "INITIAL_ENTRIES = ", initial_entries end program demo_entries ``` @@ -1272,7 +1448,7 @@ Returns the other data associated with the inverse table index, ##### Syntax -`value = [[stdlib_hashmap_chaining:get_other_data)]]( map, inmap, other )` +`value = [[stdlib_hashmaps:map%get_other_data)]]( inmap, other )` ##### Class @@ -1280,8 +1456,9 @@ Subroutine ##### Arguments -`map`: shall be a scalar expression of type - `chaining_hashmap_type`. It is an `intent(in)` argument. It will be +`map` (pass): shall be a scalar expression of class + `chaining_hashmap_type` or `open_hashmap_type`. It is an + `intent(in)` argument. It will be the hash map used to store and access the other data. `inmap`: shall be a scalar integer expression of kind `int_index`. It @@ -1305,25 +1482,35 @@ from the map, `other` is undefined. program demo_get_other_data use, intrinsic:: iso_fortran_env, only: & int8 - use stdlib_hashmap_chaining, only: & - chaining_hashmap_type, fnv_1_hasher, get, get_other_data, & - int_index, key_type, map_entry, other_type, set - integer(int_index) :: inmap - type(key_type) :: key - type(other_type) :: other + use stdlib_hashmaps, only: chaining_hashmap_type, int_index + use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type + integer(int_index) :: inmap + type(key_type) :: key + type(other_type) :: other type(chaining_hashmap_type) :: map - integer(int8), allocatable :: data(:) - call init( map, fnv_1_hasher ) + type dummy_type + integer(int8) :: value(4) + end type dummy_type + type(dummy_type) :: dummy + class(*), allocatable :: data + dummy % value = [ 4_int8, 3_int8, 2_int8, 1_int8 ] + allocate( data, source=dummy ) + call map % init( fnv_1_hasher ) call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) - call set( other, [ 4_int8, 3_int8, 2_int8, 1_int8 ] ) - call map_entry( map, inmap, key, other ) + call set( other, data ) + call map % map_entry( inmap, key, other ) if ( inmap /= 0 ) then - call get_other_data( map, inmap, other ) + call map % get_other_data( inmap, other ) else stop 'Invalid inmap' end if call get( other, data ) - print *, 'Other data = ', data + select type( data ) + type (dummy_type) + print *, 'Other data % value = ', data % value + type default + print *, 'Invalid data type in other' + end select end program demo_get_other_data ``` @@ -1341,7 +1528,7 @@ associated index into the inverse table. ##### Syntax -`call [[stdlib_hashmap_chaining:in_map]]( map, inmap, key )` +`call [[stdlib_hashmaps:map%in_map]]( inmap, key )` ##### Class @@ -1349,9 +1536,10 @@ Subroutine ##### Arguments -`map`: shall be a scalar variable of type `chaining_hashmap_type`. It - is an `intent(inout)` argument. It will be the hash map used to - store and access the entries. +`map` (pass): shall be a scalar variable of class + `chaining_hashmap_type` or `open_hashmap_type`. It is an + `intent(inout)` argument. It will + be the hash map used to store and access the entries. `inmap`: shall be a scalar integer variable of kind `int_index`. It is an `intent(out)` argument. It will be 0 if `key` is not found, @@ -1371,23 +1559,30 @@ Subroutine program demo_in_map use, intrinsic:: iso_fortran_env, only: & int8 - use stdlib_hashmap_chaining, only: & - chaining_hashmap_type, fnv_1_hasher, in_map, & - int_index, key_type, map_entry, other_type, set - integer(int_index) :: inmap - type(key_type) :: key - type(other_type) :: other + use stdlib_hashmaps, only: & + chaining_hashmap_type, int_index + use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type + integer(int_index) :: inmap + type(key_type) :: key + type(other_type) :: other type(chaining_hashmap_type) :: map - call init( map, fnv_1_hasher ) + type dummy_type + integer(int8) :: value(4) + end type dummy_type + type(dummy_type) :: dummy + class(*), allocatable :: data + dummy % value = [ 4_int8, 3_int8, 2_int8, 1_int8 ] + call map % init( fnv_1_hasher ) call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) - call set( other, [ 4_int8, 3_int8, 2_int8, 1_int8 ] ) - call map_entry( map, inmap, key, other ) + call set( other, data ) + call map % map_entry( inmap, key, other ) if ( inmap /= 0 ) then - call in_map( map, inmap, key + call map % in_map( inmap, key if ( inmap \= 0 ) then print *, 'INMAP = ', inmap else stop 'Invalid inmap from in_map call' + end if else stop 'Invalid inmap from map_entry call' end if @@ -1406,7 +1601,7 @@ Initializes a `chaining_hashmap_type` object. ##### Syntax -`call [[stdlib_hashmap_chaining:init]]( map, hasher [, slots_bits, status ] ] )` +`call [[stdlib_hashmaps:map%init]]( hasher [, slots_bits, status ] ] )` ####@# Class @@ -1414,8 +1609,9 @@ Subroutine ##### Arguments -`map`: shall be a scalar variable of type - `chaining_hashmap_type`. It is an `intent(out)` argument. It will +`map` (pass): shall be a scalar variable of class + `chaining_hashmap_type` or `open_hashmap_type`. It is an + `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`. @@ -1453,14 +1649,11 @@ has the value `alloc_fault`. ```fortran program demo_init - use stdlib_hash_tables, only: & - chaining_map_type, fnv_1_hasher & - init + use stdlib_hashmaps, only: chaining_map_type + use stdlib_hashmap_wrappers, only: fnv_1_hasher type(fnv_1a_type) :: fnv_1 type(chaining_map_type) :: map - call init( map, & - fnv_1a, & - slots_bits=10 ) + call map % init( fnv_1a, slots_bits=10 ) end program demo_init ``` @@ -1478,7 +1671,7 @@ slots in a hash map. ##### Syntax -`value = [[stdlib_hashmap_chaining:loading]]( map )` +`value = [[stdlib_hashmaps:map%loading]]( )` ##### Class @@ -1486,8 +1679,8 @@ Pure function ##### Argument -`map` - shall be an expression of type `chaining_hashmap_type`. -It is an `intent(in)` argument. +`map` (pass) - shall be an expression of class `chaining_hashmap_type` +or ``open_hashmap_type`. It is an `intent(in)` argument. ##### Result character @@ -1502,14 +1695,13 @@ number of slots in the hash map. ```fortran program demo_loading - use stdlib_hashmap_chaining, only: & - chaining_hashmap_type, init, int_index, & - fnv_1_hasher, loading + use stdlib_hashmaps, only: open_hashmap_type + use stdlib_hashmap_wrappers, only: fnv_1_hasher implicit none - type(chaining_hashmap_type) :: map + type(open_hashmap_type) :: map real :: ratio - call init( map, fnv_1_hasher ) - ratio = loading (map) + call map % init( fnv_1_hasher ) + ratio = map % loading () print *, "Initial loading = ", ratio end program demo_loading ``` @@ -1526,7 +1718,7 @@ Inserts an entry into the hash map if it is not already present. ##### Syntax -`call [[stdlib_hashmap_chaining:map_entry]]( map, inmap, key[, other ])` +`call [[stdlib_hashmaps:map%map_entry]]( inmap, key[, other ])` ##### Class @@ -1535,7 +1727,8 @@ Subroutine ##### Arguments -`map`: shall be a scalar variable of type `chaining_hashmap_type`. It +`map` (pass): shall be a scalar variable of class +`chaining_hashmap_type` or `open_hashmap_type`. It is an `intent(inout)` argument. It is the hash map to receive the entry. @@ -1558,21 +1751,19 @@ is ignored. ```fortran program demo_map_entry - use, intrinsic:: iso_fortran_env, only: & - int8 - use stdlib_hashmap_chaining, only: & - chaining_hashmap_type, fnv_1_hasher, init, & - int_index, key_type, map_entry, other_type, set + use, intrinsic:: iso_fortran_env, only: int8 + use stdlib_hashmaps, only: chaining_hashmap_type, int_index + use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type type(chaining_hashmap_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap - call init( map, & - fnv_1_hasher, & - slots_bits=10 ) + class(*), allocatable :: dummy + allocate( dummy, source=4 ) + call map % init( fnv_1_hasher, slots_bits=10 ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) - call map_entry( map, inmap, key, other ) + call set( other, dummy ) + call map % map_entry( inmap, key, other ) print *, 'INMAP = ', inmap end program demo_map_entry ``` @@ -1589,7 +1780,7 @@ Returns the total number of table probes on a hash map ##### Syntax -`Result = [[stdlib_hashmap_chaining:map_probes]]( map )` +`Result = [[stdlib_hashmap:map%map_probes]]( )` ##### Class @@ -1597,9 +1788,9 @@ Pure function ##### Argument -`map`: shall be a scalar integer expression of type -`chaining_hashmap_type`. It is an `intent(in)` argument. It is the -hash map of interest. +`map` (pass): shall be a scalar expression of class +`hashmap_type`. It is an `intent(in)` +argument. It is the hash map of interest. ##### Result character @@ -1607,24 +1798,71 @@ The result is a scalar integer of kind `int_probes`. ##### Result value -The result is the number of probes of `map`. +The result is the number of probes of `map` since initialization or +rehashing. ##### Example ```fortran program demo_probes - use stdlib_hashmap_chaining, only: & - chaining_hashmap_type, init, int_index, & - fnv_1_hasher, probes + use stdlib_hashmaps, only: chaining_hashmap_type, int_index + use stdlib_hashmap_wrappers: fnv_1_hasher implicit none type(chaining_hashmap_type) :: map - real :: ratio - call init( map, fnv_1_hasher ) - ratio = probes (map) - print *, "Initial probes = ", ratio + real :: nprobes + call map % init( fnv_1_hasher ) + nprobes = map % probes() + print *, "Initial probes = ", nprobes end program demo_probes ``` +#### `num_slots` - returns the number of hash map probes + +##### Status + +Experimental + +##### Description + +Returns the total number of slots on a hash map + +##### Syntax + +`Result = [[stdlib_hashmaps:map%num_slots]]( )` + +##### Class + +Pure function + +##### Argument + +`map`: shall be a scalar expression of class +`hashmap_type`. It is an `intent(in)` argument. It is the +hash map of interest. + +##### Result character + +The result is a scalar integer of kind `int_index`. + +##### Result value + +The result is the number of slots in `map`. + +##### Example + +```fortran + program demo_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 ) + initial_slots = map % num_slots () + print *, "Initial slots = ", initial_slots + end program num_slots +``` + #### rehash - changes the hashing function @@ -1638,7 +1876,7 @@ Changes the hashing function for the table entries to that of `hasher`. ##### Syntax -`call [[stdlib_hashmap_chaining:rehash]]( map, hasher )` +`call [[stdlib_hashmaps:map%rehash]]( hasher )` ##### Class @@ -1646,7 +1884,8 @@ Subroutine ##### Arguments -`map` : shall be a scalar variable of type `chaining_hashmap_type`. +`map` (pass): shall be a scalar variable of class +`chaining_hashmap_type` oe `open_hashmap_type`. It is an `intent(inout)` argument. It is the hash map whose hashing method is to be changed. @@ -1657,21 +1896,20 @@ It is the hash method to be used by `map`. ```fortran program demo_rehash - use stdlib_hashmap_chaining, only: & - chaining_hashmap_type, fnv_1_hasher, fnv_1a_hasher,& - init, int_index, key_type, map_entry, other_type, & - rehash, set - type(chaining_hashmap_type) :: map + use stdlib_hashmaps, only: open_hashmap_type, int_index + use stdlib_hasmap_wrappers, only: fnv_1_hasher, fnv_1a_hasher,& + key_type, other_type + type(openn_hashmap_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap - call init( map, & - fnv_1_hasher, & - slots_bits=10 ) + class(*), allocatable :: dummy + allocate( dummy, source='a dummy value' ) + call map % init( fnv_1_hasher, slots_bits=10 ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) - call map_entry( map, inmap, key, other ) - call rehash( map, fnv_1a_hasher ) + call set( other, dummy ) + call map % map_entry( inmap, key, other ) + call map % rehash( fnv_1a_hasher ) end program demo_rehash ``` @@ -1687,7 +1925,7 @@ Removes an entry from a hash map, `map`. ##### Syntax -`call [[stdlib_hashmap_chaining:remove_entry]]( map, inmap )` +`call [[stdlib_hashmaps:map%remove_entry]]( inmap )` ##### Class @@ -1695,7 +1933,8 @@ Subroutine ##### Arguments -`map`: shall be a scalar variable of type `chaining_hashmap_type`. +`map` (pass): shall be a scalar variable of class +`chaining_hashmap_type` or `open_hashmap_type`. It is an `intent(inout)` argument. It is the hash map with the element to be removed. @@ -1713,19 +1952,20 @@ generation of `inmap`, `other` is undefined. ```fortran program demo_remove_entry - use stdlib_hashmap_chaining, only: & - chaining_hashmap_type, fnv_1_hasher, fnv_1a_hasher,& - init, int_index, key_type, map_entry, other_type, & - remove_entry, set - type(chaining_hashmap_type) :: map + use stdlib_hashmaps, only: open_hashmap_type, int_index + use stdlib_hashmap_wrappers, only: fnv_1_hasher, & + fnv_1a_hasher, key_type, other_type + type(open_hashmap_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap + class(*), allocatable :: dummy + allocate( dummy, source=4.0 ) call init( map, & fnv_1_hasher, & slots_bits=10 ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) + call set( other, dummy ) call map_entry( map, inmap, key, other ) call remove_entry( map, inmap ) end program demo_remove_entry @@ -1744,7 +1984,7 @@ inverse table. ##### Syntax -`call [[stdlib_hashmap_chaining:set_other_data]]( map, inmap, other )` +`call [[stdlib_hashmaps:map%set_other_data]]( inmap, other )` ##### Class @@ -1752,7 +1992,8 @@ Subroutine ##### Arguments -`map`: shall be a scalar variable of type `chaining_hashmap_type`. It +`map` (pass): shall be a scalar variable of class +`chaining_hashmap_type` or `open_hashmap_type`. It is an `intent(inout)` argument. It will be a hash map used to store and access the entry's data. @@ -1773,26 +2014,27 @@ the other data for the entry at the `inmap` index. ```fortran program demo_set_other_data - use stdlib_hashmap_chaining, only: & - chaining_hashmap_type, fnv_1_hasher, fnv_1a_hasher,& - init, int_index, key_type, map_entry, other_type, & - set, set_other_data - type(chaining_hashmap_type) :: map + use stdlib_hashmaps, only: open_hashmap_type, int_index + use stdlib_hashmap_wrappers, only: fnv_1_hasher, & + fnv_1a_hasher, key_type, other_type, set + type(open_hashmap_type) :: map type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap - call init( map, & - fnv_1_hasher, & - slots_bits=10 ) + class(*), allocatable :: dummy + call map % init( fnv_1_hasher, slots_bits=10 ) + allocate( dummy, source='A value` ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - Call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) - call map_entry( map, inmap, key, other ) - call set( other, [ 17_int8, 5_int8, 6_int8, 15_int8, 40_int8 ] ) - call set_other_data( map, inmap, other ) + Call set( other, dummy ) + call map % map_entry( inmap, key, other ) + deallocate( dummy ) + allocate( dummy, source='Another value` ) + call set( other, dummy ) + call map % set_other_data( inmap, other ) end program demo_set_other_data ``` -#### `slots` - returns the number of hash map probes +#### `slots_bits` - returns the number of bits used to address the hash map slots ##### Status @@ -1804,7 +2046,7 @@ Returns the total number of slots on a hash map ##### Syntax -`Result = [[stdlib_hashmap_chaining:slots]]( map )` +`Result = [[stdlib_hashmaps:map%slots_bits]]( )` ##### Class @@ -1812,8 +2054,8 @@ Pure function ##### Argument -`map`: shall be a scalar expression of type -`chaining_hashmap_type`. It is an `intent(in)` argument. It is the +`map` (pass): shall be a scalar expression of class +`hashmap_type`. It is an `intent(in)` argument. It is the hash map of interest. ##### Result character @@ -1822,22 +2064,21 @@ The result is a scalar integer of kind `int_index`. ##### Result value -The result is the number of slots in `map`. +The result is the number of bits used in addressing the slots in `map`. ##### Example ```fortran - program demo_probes - use stdlib_hashmap_chaining, only: & - chaining_hashmap_type, init, int_index, & - fnv_1_hasher, slots + program demo_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(int_index) :: initial_slots - call init( map, fnv_1_hasher ) - initial_slots = slots (map) - print *, "Initial slots = ", initial_slots - end program demo_probes + integer :: bits + call map % init( fnv_1_hasher ) + bits = map % slots_bits () + print *, "Initial slot bits = ", bits + end program demo_slots_bits ``` @@ -1854,7 +2095,7 @@ their slot index for a hash map ##### Syntax -`Result = [[stdlib_hashmap_chaining:total_depth]]( map )` +`Result = [[stdlib_hashmaps:map%total_depth]]( )` ##### Class @@ -1862,7 +2103,7 @@ Pure function ##### Argument -`map`: shall be a scalar expression of type +`map` (pass): shall be a scalar expression of class `chaining_hashmap_type`. It is an `intent(in)` argument. It is the hash map of interest. @@ -1878,17 +2119,16 @@ from their slot index the map. ##### Example ```fortran - program demo_probes - use stdlib_hashmap_chaining, only: & - chaining_hashmap_type, init, int_index, & - fnv_1_hasher, total_depth + program demo_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 init( map, fnv_1_hasher ) - initial_depth = total_depth (map) + call map % init( fnv_1_hasher ) + initial_depth = map % total_depth () print *, "Initial total depth = ", initial_depth - end program demo_probes + end program demo_total_depth ``` @@ -1905,7 +2145,7 @@ inverse table. ##### Syntax -`call [[stdlib_hashmap_chaining:unmap]]( map, inmap, key )` +`call [[stdlib_hashmaps:map%unmap]]( inmap, key )` ##### Class @@ -1913,7 +2153,8 @@ Subroutine ##### Arguments -`map`: shall be a scalar expression of type `chaining_hashmap_type`. +`map` (pass): shall be a scalar expression of class +`chaining_hashmap_type` or `open_hashmap_type`. It is an `intent(in)` argument. It is the hash map whose entry is unmapped. @@ -1943,13 +2184,13 @@ index `inmap` in the inverse table. type(key_type) :: key type(other_type) :: other integer(int_index) :: inmap - call init( map, & - fnv_1_hasher, & - slots_bits=10 ) + class(*), allocatable :: dummy + allocate( dummy, source='A value' ) + call map % init( fnv_1_hasher, slots_bits=10 ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) - call map_entry( map, inmap, key, other ) - call unmap( map, inmap, key ) + call set( other, dummy ) + call map % map_entry( inmap, key, other ) + call map % unmap( inmap, key ) end program demo_unmap ``` @@ -1961,12 +2202,12 @@ Experimental ##### Description -Returns a flag indicating whether `inmap` is a valid index in the -inverse table. +Returns a logical flag indicating whether `inmap` is a valid index in +the inverse table. ##### Syntax -`result = [[stdlib_hashmap_chaining:valid_index]]( map, inmap )` +`result = [[stdlib_hashmaps:map % valid_index]]( map )` ##### Class @@ -1974,7 +2215,8 @@ Pure function. ##### Arguments -`map`: shall be a scalar expression of type `chaining_hashmap_type`. +`map` (pass): shall be a scalar expression of class +`chaining_hashmap_type` or `open_hashmap_type`. It is an `intent(in)` argument. It is the hash map whose inverse table is examined. @@ -1995,1082 +2237,15 @@ table of `map` and `.false.` otherwise. ```fortran program demo_valid_index - use stdlib_hashmap_chaining, only: & - chaining_hashmap_type, init, int_index, & - fnv_1_hasher, valid_index + 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) :: inmap logocal :: valid - call init( map, fnv_1_hasher ) + call map % init( fnv_1_hasher ) inmap = 10 - valid = valid_index (map, inmap) + valid = map % valid_index ( inmap) print *, "Initial index of 10 valid for empty map = ", valid end program demo_valid_index ``` - - -## The `stdlib_hashmap_open` module - -The `stdlib_hashmap_open` module provides access to all the -public entities in the `stdlib_hashmap_wrappers` module. It -also defines a public data type and associated procedures and -constants that implement a simple hash map using -linear open addressing hashing. The derived type is -`open_hashmap_type`. It provides -procedures to manipulate the structure of the hash map: -`init`, `map_entry`, `rehash`, and `set_other_data`. It -provides procedures to inquire about entries in the hash map: -`get_other_data`, `in_map`, `unmap` and `valid_index`. Finally it -provides procedures to inquire about the overall structure and -performance of the table:`calls`, `entries`, `get_other_data`, -`loading`, `relative_loading`, `slots`, and `total_depth`. The module -also defines a number of public constants: `inmap_probe_factor`, -`map_probe_factor`, `default_bits`, `max_bits`, `int_calls`, -`int_depth`, `int_index`, `int_probes`, `load_factor`, `success`, -`alloc_fault`, `array_size_error`, and `real_value_error`. - -### The `stdlib_hashmap_open` module's public constants - -The module defines several categories of public constants. Some are -used to parameterize the empirical slot expansion code. Others -parameterize the slots table size. Some are used to define -integer kind values for different applications. Finally, some are used -to report errors or success. - -The constants `inmap_probe_factor`, `map_probe_factor`, and -`load_factor` are used to parameterize the slot expansion code -used to determine when in a call on the map the number -of slots need to be increased to decrease the search lengths. -The constant `inmap_probe_factor` is used to determine when -the ratio of the number of map probes to map calls is too large and -the slots need expansion. The constant `map_probe_factor` is used to -determine when inserting a new entry the ratio of the number of map -probes to map calls is too large and the slots need expansion. -Finally, the -`load_factor` determines the maximum number of entries allowed -relative to the number of slots prior to automatically resizing the -table upon entry insertion. The `load_factor` is a tradeoff between -runtime performance and memory usage, with smaller values of -`load_factor` having the best runtime performance and larger.values -the smaller memory footprint, with common choices being `0.575 <= -load_factor <= 0.75`. The `load_factor` currently has a value -of `0.5625`. - -The constants `default_bits`, and -`max_bits` are used to parameterize the table's slots size. The -`default_bits` constant defines the default initial number of slots -with a current value of 6 resulting in an initial `2**6 == 64` -slots. This may optionally be overridden on hash map creation. The -`max_bits` sets the maximum table size as `2**max_bits`. The current -value of `max_bits` is 3o and the table will not work properly if that -value is exceeded. - -The constants `int_calls`, `int_depth`, `int_index`, and `int_probes` -are used to define integer kind values for various contexts. The -number of calls are reported and stored in entities of kind -`int_calls`. Currently `int_calls` has the value of `int64`. The -total depth, the number of inquiries needed to access all elements -of the table, is reported and stored in entities of kind -`int_depth`. Currently `int_depth` has the value of `int64`. The -number of entries in the table, is reported and stored in entities of -kind `int_index`. Currently `int_index` has the value of `int32`. -The number of probes, hash map enquiries, are reported and stored in -entities of kind `int_probes`. Currently `int_probes` has the value of -`int64`. - -Finally the error codes `success`, `alloc_fault`, and -`array_size_error` are used to report the error status of certain -procedure calls. The `succes` code indicates that no problems were -found. The `alloc_fault` code indicates that a memory allocation -failed. The `array_size_error` indicates that on table -creation `slots_bits` is less than `default_bits` or -greater than `max_bits`. - -### The `stdlib_hashmap_open` module's derived types - -The `stdlib_hashmap_open` module defines several derived -types. The only public type is the `open_hashmap_type`. There are -three other private derived types used in the implementation of the -public type: `open_map_entry_type`, and `open_map_entry_ptr`. - -#### The `open_map_entry_type` derived type - -Entities of the type `open_map_entry_type` are used to define -a linked list structure that stores the -key, its other data, the hash of the key, and the resulting index into -the inverse table. The type's definition is below: - -```fortran - type :: open_map_entry_type ! Open hash map entry type - private - integer(int_hash) :: hash_val ! Full hash value - type(key_type) :: key ! The entry's key - type(other_type) :: other ! Other entry data - integer(int_index) :: index ! Index into inverse table - end type open_map_entry_type -``` -Currently `int_hash` and `int_index` have the value of `int32`. - -#### The `open_map_entry_ptr` derived type - -The type `open_map_entry_ptr` is used to define the elements of -the hash map that are either empty or link to the linked lists -containing the elements of the table. The type's definition is below: - -```fortran - type open_map_entry_ptr ! Wrapper for a pointer to a open - ! map entry type object - type(open_map_entry_type), pointer :: target => null() - end type open_map_entry_ptr -``` - -#### The `open_hashmap_type` derived type - -The `open_hashmap_type` derived type implements a separate -open hash map. It provides the elements `calls`, `probes`, -`total_probes`, `entries`, and `slots_bits` to keep track -of the hash map's usage. The array element `slots` serves as the -table proper. The array element `inverse` maps integers to -entries. The linked list entry, `free_list`, keeps track of freed -elements of type `open_map_entry_type`. The list element, `cache`, -stores pools of `open_map_entry_type` elements for reuse. The -component `hasher` is a pointer to the hash function. Finally the -type-bound procedure, `free_open_map`, serves as a finalizer for -objects of the type, `open_hashmap_type`. - -```fortran - type :: open_hashmap_type - private - integer(int_calls) :: calls = 0 - ! Number of calls - integer(int_calls) :: probes = 0 - ! Number of probes since last expansion - integer(int_calls) :: total_probes = 0 - ! Cumulative number of probes - integer(int_index) :: entries = 0 - ! Number of entries - integer(int_index) :: index_mask = 2_int_index**default_bits-1 - ! Mask used in linear addressing - integer(int32) :: slots_bits = default_bits - ! Bits used for slots size - type(open_map_entry_ptr), allocatable :: slots(:) - ! Array of bucket lists Note # slots=size(slots) - type(open_map_entry_ptr), allocatable :: inverse(:) - ! Array of bucket lists (inverses) Note max_elts=size(inverse) - procedure(hasher_fun), pointer, nopass :: hasher => fnv_1_hasher - ! Hash function - contains - final :: free_open_map - end type open_hashmap_type -``` - -### Table of `stdlib_open_ehashmap` procedures - -The `stdlib_hashmap_open` module provides procedures in -several categories: a procedure to initialize the map; a procedure to -modify the structure of a map; procedures to modify the content of a -map; procedures to report on the content of a map; and procedures -to report on the structure of the map. The procedures in each category -are listed below. - -Procedure to initialize a chaining hash map: - -* `init_map( map, hasher[, slots_bits, status] - )` - Routine to initialize a chaining hash map. - -Procedure to modify the structure of a map: - -* `rehash( map, hasher )` - Routine to change the hash function - for a map. - -Procedures to modify the content of a map: - -* `map_entry( map, inmap, key, other )` - Inserts an entry innto the - hash map. - -* `set_other_data( map, inmap, other )` - Change the other data - associated with the entry. - -Procedures to report the content of a map: - -* `get_other_data( map, inmap, other )` - Returns the other data - associated with the inverse table index - -* `in_map( map, inmap, key )` - Returns the index into the `inverse` - array associated with the `key` - -* `unmap( map, inmap, key )` - Returns a copy of the key associated -with an index to the inverse table. - -* `valid_index(map, inmap)` - Returns a flag indicating whether `inmap` - is a valid index. - -Procedures to report on the structure of the map: - -* `calls( map )` - the number of subroutine calls on the hash map. - -* `entries( map )`- the number of entries in a hash map. - -* `loading( map )` - the number of entries relative to slots in a hash - map. - -* `map_probes( map )` - the total number of table probes on a hash - map. - -* `relative_loading` - the ratio of the map's loading to its - `load_factor`. - -* `slots( map )` - Returns the number of allocated slots in a hash - map. - -* `total_depth( map )` - Returns the total number of one's based -offsets of slot entries from their slot index - - -### Specifications of the `stdlib_hashmap_open` procedures - -#### `calls` - Returns the number of calls on a hash map - -##### Status - -Experimental - -##### Description - -Returns the number of procedure calls on a hash map. - -##### Syntax - -`value = [[stdlib_hashmap_open:calls]]( map )` - -##### Class - -Pure function - -##### Argument - -`map` - shall be an expression of type `open_hashmap_type`. -It is an `intent(in)` argument. - -##### Result character - -The result will be an integer of kind `int_calls`. - -##### Result value - -The result will be the number of procedure calls on the hash map. - -##### Example - -```fortran - program demo_calls - use stdlib_hashmap_open, only: & - open_hashmap_type, calls, init, int_calls, & - fnv_1_hasher - implicit none - type(open_hashmap_type) :: map - type(int_calls) :: initial_calls - call init( map, fnv_1_hasher ) - initial_calls = calls (map) - print *, "INITIAL_CALLS = ", initial_calls - end program demo_calls -``` - - -#### `entries` - Returns the number of entries in a hash map - -##### Status - -Experimental - -##### Description - -Returns the number of entries in a hash map. - -##### Syntax - -`value = [[stdlib_hashmap_open:entries]]( map )` - -##### Class - -Pure function - -##### Argument - -`map` - shall be an expression of type `open_hashmap_type`. -It is an `intent(in)` argument. - -##### Result character - -The result will be an integer of kind `int_index`. - -##### Result value - -The result will be the number of entries in the hash map. - -##### Example - -```fortran - program demo_entries - use stdlib_hashmap_open, only: & - open_hashmap_type, entries, init, int_index, & - fnv_1_hasher - implicit none - type(open_hashmap_type) :: map - type(int_index) :: initial_entries - call init( map, fnv_1_hasher ) - initisl_entries = entries (map) - print *, "INITIAL_ENTRIES = ", initial_entries - end program demo_entries -``` - - -#### `get_other_data` - Returns other data belonging to the inverse table index - -##### Status - -Experimental - -##### Description - -Returns the other data associated with the inverse table index, - -##### Syntax - -`value = [[stdlib_hashmap_open:get_other_data)]]( map, inmap, other )` - -##### Class - -Subroutine - -##### Arguments - -`map`: shall be a scalar expression of type - `open_hashmap_type`. It is an `intent(in)` argument. It will be - the hash map used to store and access the other data. - -`inmap`: shall be a scalar integer expression of kind `int_index`. It - is an `intent(in)` argument. It should be the `inmap` returned by the - procedure `in_map` or `map_entry`. - -* If `inmap` is zero or `key` has been removed subsequent to the -generation of `inmap`, or `map` hasbeen rehashed ssubsequent to the -generation of `inmap`, then `other` is undefined. - -`other`: shall be a variable of type `other_data`. - It is an `intent(out)` argument. It is the other data associated - with the `inmap` index. - -* The following is an example of the retrieval of other data - associated with an inverse table index: - -##### Example - -```Fortran - program demo_get_other_data - use, intrinsic:: iso_fortran_env, only: & - int8 - use stdlib_hashmap_open, only: & - open_hashmap_type, fnv_1_hasher, get, get_other_data, & - int_index, key_type, map_entry, other_type, set - integer(int_index) :: inmap - type(key_type) :: key - type(other_type) :: other - type(open_hashmap_type) :: map - integer(int8), allocatable :: data(:) - call init( map, fnv_1_hasher ) - call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) - call set( other, [ 4_int8, 3_int8, 2_int8, 1_int8 ] ) - call map_entry( map, inmap, key, other ) - if ( inmap /= 0 ) then - call get_other_data( map, inmap, other ) - else - stop 'Invalid inmap' - end if - call get( other, data ) - print *, 'Other data = ', data - end program demo_get_other_data -``` - - -#### `in_map` - searches a map for the presence of a key - -##### Status - -Experimental - -##### Description - -Searches a hash map for the presence of a key and returns the -associated index into the inverse table. - -##### Syntax - -`call [[stdlib_hashmap_open:in_map]]( map, inmap, key )` - -##### Class - -Subroutine - -##### Arguments - -`map`: shall be a scalar variable of type `open_hashmap_type`. It - is an `intent(inout)` argument. It will be the hash map used to - store and access the entries. - -`inmap`: shall be a scalar integer variable of kind `int_index`. It is - an `intent(out)` argument. It will be 0 if `key` is not found, - otherwise it will be the one's based index to the location of `key` - in the hash map's inverse array. - -`key`: shall be a scalar expression of type `key_type`. - It is an `intent(in)` argument. It is the entry's key to be searched - for in the hash map. - -* The following is an example of the retrieval of other data associated with - a key: - -##### Example - -```Fortran - program demo_in_map - use, intrinsic:: iso_fortran_env, only: & - int8 - use stdlib_hashmap_open, only: & - open_hashmap_type, fnv_1_hasher, in_map, & - int_index, key_type, map_entry, other_type, set - integer(int_index) :: inmap - type(key_type) :: key - type(other_type) :: other - type(open_hashmap_type) :: map - call init( map, fnv_1_hasher ) - call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) - call set( other, [ 4_int8, 3_int8, 2_int8, 1_int8 ] ) - call map_entry( map, inmap, key, other ) - if ( inmap /= 0 ) then - call in_map( map, inmap, key - if ( inmap \= 0 ) then - print *, 'INMAP = ', inmap - else - stop 'Invalid inmap from in_map call' - else - stop 'Invalid inmap from map_entry call' - end if - end program demo_in_map -``` - -#### init - initializes a hash map - -##### Status - -Experimental - -##### Description - -Initializes a `open_hashmap_type` object. - -##### Syntax - -`call [[stdlib_hashmap_open:init]]( map, hasher[, slots_bits, status ] ]` - -####@# Class - -Subroutine - -##### Arguments - -`map`: shall be a scalar variable of type - `open_hashmap_type`. It is an `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`. - 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. - -`slots_bits` (optional): shall be a scalar default integer - expression. It is an `intent(in)` argument. The initial number of - slots in the table will be `2**slots_bits`. - -* `slots_bits` shall be a positive default integer less than - `max_slots_bits`, otherwise processing stops with an informative - error code. - -* If `slots_bits` is absent then the effective value for `slots_bits` - is `default_slots_bits`. - -`status` (optional): shall be a scalar integer variable of kind -`int32`. It is an `intent(out)` argument. On return, if present, it -shall have an error code value. - -* If map was successfully initialized then `status` has the value -`success`. - -* If allocation of memory for the `map` arrays fails then `status` -has the value `alloc_fault`. - -* If `slot_bits < 6` or `slots_bits > max_bits` then `status` - has the value of `array_size_error`. - -* If `status` is absent, but `status` would have a value other than -`success`, then processing stops with an informative stop code. - -##### Example - -```fortran - program demo_init - use stdlib_hash_tables, only: & - open_map_type, fnv_1_hasher & - init - type(fnv_1a_type) :: fnv_1 - type(open_map_type) :: map - call init( map, & - fnv_1a, & - slots_bits=10 ) - end program demo_init -``` - - - -#### `loading` - Returns the ratio of entries to slots - -##### Status - -Experimental - -##### Description - -Returns the ratio of the number of entries relative to the number of -slots in a hash map. - -##### Syntax - -`value = [[stdlib_hashmap_open:loading]]( map )` - -##### Class - -Pure function - -##### Argument - -`map` - shall be an expression of type `open_hashmap_type`. -It is an `intent(in)` argument. - -##### Result character - -The result will be a default real. - -##### Result value - -The result will be the ratio of the number of entries relative to the -number of slots in the hash map. - -##### Example - -```fortran - program demo_loading - use stdlib_hashmap_open, only: & - open_hashmap_type, init, int_index, & - fnv_1_hasher, loading - implicit none - type(open_hashmap_type) :: map - real :: ratio - call init( map, fnv_1_hasher ) - ratio = loading (map) - print *, "Initial loading = ", ratio - end program demo_loading -``` - -#### `map_entry` - inserts an entry into the hash map - -##### Status - -Experimental - -##### Description - -Inserts an entry into the hash map if it is not already present. - -##### Syntax - -`call [[stdlib_hashmap_open:map_entry]]( map, inmap, key[, other ])` - - -##### Class - -Subroutine - -##### Arguments - -`map`: shall be a scalar variable of type `open_hashmap_type`. It -is an `intent(inout)` argument. It is the hash map to receive the -entry. - -`inmap`: shall be an integer scalar variable of kind `int_index`. It is - an `intent(out)` argument. It is the index to the table's inverse array - associated with the `key`. - -`key`: shall be either a scalar expression of type `key_type`. - It is an `intent(in)` argument. It is the key for the entry to be - placed in the table. - -`other` (optional): shall be a scalar expression of type `other_type`. - It is an `intent(in)` argument. If present it is the other data to be - associated with the `key`. - -* If `key` is already present in `map` then the presence of `other` -is ignored. - -##### Example - -```fortran - program demo_map_entry - use, intrinsic:: iso_fortran_env, only: & - int8 - use stdlib_hashmap_open, only: & - open_hashmap_type, fnv_1_hasher, init, & - int_index, key_type, map_entry, other_type, set - type(open_hashmap_type) :: map - type(key_type) :: key - type(other_type) :: other - integer(int_index) :: inmap - call init( map, & - fnv_1_hasher, & - slots_bits=10 ) - call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) - call map_entry( map, inmap, key, other ) - print *, 'INMAP = ', inmap - end program demo_map_entry -``` - -#### `map_probes` - returns the number of hash map probes - -##### Status - -Experimental - -##### Description - -Returns the total number of table probes on a hash map - -##### Syntax - -`Result = [[stdlib_hashmap_open:map_probes]]( map )` - -##### Class - -Pure function - -##### Argument - -`map`: shall be a scalar integer expression of type -`open_hashmap_type`. It is an `intent(in)` argument. It is the -hash map of interest. - -##### Result character - -The result is a scalar integer of kind `int_probes`. - -##### Result value - -The result is the number of probes of `map`. - -##### Example - -```fortran - program demo_probes - use stdlib_hashmap_open, only: & - open_hashmap_type, init, int_index, & - fnv_1_hasher, probes - implicit none - type(open_hashmap_type) :: map - real :: ratio - call init( map, fnv_1_hasher ) - ratio = probes (map) - print *, "Initial probes = ", ratio - end program demo_probes -``` - - -#### rehash - changes the hashing function - -##### Status - -Experimental - -##### Description - -Changes the hashing function for the table entries to that of `hasher`. - -##### Syntax - -`call [[stdlib_hashmap_open:rehash]]( map, hasher )` - -##### Class - -Subroutine - -##### Arguments - -`map` : shall be a scalar variable of type `open_hashmap_type`. -It is an `intent(inout)` argument. It is the hash map whose hashing -method is to be changed. - -`hasher`: shall be a function of interface `hasher_fun`. -It is the hash method to be used by `map`. - -##### Example - -```fortran - program demo_rehash - use stdlib_hashmap_open, only: & - open_hashmap_type, fnv_1_hasher, fnv_1a_hasher,& - init, int_index, key_type, map_entry, other_type, & - rehash, set - type(open_hashmap_type) :: map - type(key_type) :: key - type(other_type) :: other - integer(int_index) :: inmap - call init( map, & - fnv_1_hasher, & - slots_bits=10 ) - call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) - call map_entry( map, inmap, key, other ) - call rehash( map, fnv_1a_hasher ) - end program demo_rehash -``` - -#### `relative_loading` - Returns the ratio of `loading` to `load_factor` - -##### Status - -Experimental - -##### Description - -Returns the ratio of the loadings relative to the open hash map's -`load_factor`. - -##### Syntax - -`value = [[stdlib_hashmap_open:relative_loading]]( map )` - -##### Class - -Pure function - -##### Argument - -`map` - shall be an expression of type `open_hashmap_type`. -It is an `intent(in)` argument. - -##### Result character - -The result will be a default real. - -##### Result value - -The result will be the ratio of the number of entries relative to the -number of slots in the hash map relative to the `load_factor`. - -##### Example - -```fortran - program demo_relative_loading - use stdlib_hashmap_open, only: & - open_hashmap_type, init, int_index, & - fnv_1_hasher, loading - implicit none - type(open_hashmap_type) :: map - real :: ratio - call init( map, fnv_1_hasher ) - ratio = relative_loading (map) - print *, "Initial relative loading = ", ratio - end program demo_relative_loading -``` - - -#### `set_other_data` - replaces the other dataa for an entry - -##### Status - -Experimental - -##### Description - -Replaces the other data for the entry at index `inmap` in the -inverse table. - -##### Syntax - -`call [[stdlib_hashmap_open:set_other_data]]( map, inmap, other )` - -##### Class - -Subroutine - -##### Arguments - -`map`: shall be a scalar variable of type `open_hashmap_type`. It -is an `intent(inout)` argument. It will be a hash map used to store -and access the entry's data. - -`inmap`: shall be a scalar integer expression of kind `int_index`. It -is an `intent(in)` argument. It is the non-zero index in the inverse -table to the entry of interest. - -* `inmap` will be invalid if zero, or `key` has been deleted from the - map subsequent to the generation of `inmap`, or `map` has been - rehashed subsequent to the generation of `inmap`. - -`other`: shall be a scalar expression of type `other_type`. -It is an `intent(in)` argument. It is the data to be stored as -the other data for the entry at the `inmap` index. - -* If unable to set the other data associated with `inmap`, either - because `inmap` is not associated with a valid entry or because of - allocation problems, then processing will stop with an informative - stop code. - -##### Example - -```fortran - program demo_set_other_data - use stdlib_hashmap_open, only: & - open_hashmap_type, fnv_1_hasher, fnv_1a_hasher,& - init, int_index, key_type, map_entry, other_type, & - set, set_other_data - type(open_hashmap_type) :: map - type(key_type) :: key - type(other_type) :: other - integer(int_index) :: inmap - call init( map, & - fnv_1_hasher, & - slots_bits=10 ) - call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) - call map_entry( map, inmap, key, other ) - call set( other, [ 17_int8, 5_int8, 6_int8, 15_int8, 40_int8 ] - call set_other_data( map, inmap, other ) - end program demo_set_other_data -``` - -#### `slots` - returns the number of hash map probes - -##### Status - -Experimental - -##### Description - -Returns the total number of slots on a hash map - -##### Syntax - -`Result = [[stdlib_hashmap_open:slots]]( map )` - -##### Class - -Pure function - -##### Argument - -`map`: shall be a scalar expression of type -`open_hashmap_type`. It is an `intent(in)` argument. It is the -hash map of interest. - -##### Result character - -The result is a scalar integer of kind `int_index`. - -##### Result value - -The result is the number of slots in `map`. - -##### Example - -```fortran - program demo_probes - use stdlib_hashmap_open, only: & - open_hashmap_type, init, int_index, & - fnv_1_hasher, slots - implicit none - type(open_hashmap_type) :: map - integer(int_index) :: initial_slots - call init( map, fnv_1_hasher ) - initial_slots = slots (map) - print *, "Initial slots = ", initial_slots - end program demo_probes -``` - - -#### `total_depth` - returns the total depth of the hash map entries - -##### Status - -Experimental - -##### Description - -Returns the total number of one's based offsets of slot entries from -their slot index for a hash map - -##### Syntax - -`Result = [[stdlib_hashmap_open:total_depth]]( map )` - -##### Class - -Pure function - -##### Argument - -`map`: shall be a scalar expression of type -`open_hashmap_type`. It is an `intent(in)` argument. It is the -hash map of interest. - -##### Result character - -The result is a scalar integer of kind `int_depth`. - -##### Result value - -The result is the total number of one's based offsets of slot entries -from their slot index the map. - -##### Example - -```fortran - program demo_probes - use stdlib_hashmap_open, only: & - open_hashmap_type, init, int_index, & - fnv_1_hasher, total_depth - implicit none - type(open_hashmap_type) :: map - integer(int_depth) :: initial_depth - call init( map, fnv_1_hasher ) - initial_depth = total_depth (map) - print *, "Initial total depth = ", initial_depth - end program demo_probes -``` - - -#### `unmap` - returns a copy of the key - -##### Status - -Experimental - -##### Description - -Returns a copy of the key associated with an index to the -inverse table. - -##### Syntax - -`call [[stdlib_hashmap_open:unmap]]( map, inmap, key )` - -##### Class - -Subroutine - -##### Arguments - -`map`: shall be a scalar expression of type `open_hashmap_type`. -It is an `intent(in)` argument. It is the hash map whose entry -is unmapped. - -`inmap`: shall be a scalar integer expression of kind `int_index`. It -is an `intent(in)` argument. It is the non-zero index to the inverse -table identifying the unmapped entry. - -* If `inmap` is zero or `key` hass been eliminated from the table - subsequent to the generation of `inmap`, or `map` has been rehashed - subsequent to the generation of `inmap`, `other` is undefined. - -`key`: shall be a variable of type `key_type` -`int8`, or an allocatable length default character. It is an -`intent(out)` argument. It is the `key` associated with the entry at -index `inmap` in the inverse table. - -##### Example - -```fortran - program demo_unmap - use stdlib_hashmap_open, only: & - open_hashmap_type, fnv_1_hasher, fnv_1a_hasher,& - init, int_index, key_type, map_entry, other_type, & - unmap - type(open_hashmap_type) :: map - type(key_type) :: key - type(other_type) :: other - integer(int_index) :: inmap - call init( map, & - fnv_1_hasher, & - slots_bits=10 ) - call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - call set( other, [ 1_int8, 5_int8, 3_int8, 15_int8 ] ) - call map_entry( map, inmap, key, other ) - call unmap( map, inmap, key ) - end program demo_unmap -``` - -#### `valid_index` - indicates whether `inmap` is a valid index - -##### Status - -Experimental - -##### Description - -Returns a flag indicating whether `inmap` is a valid index in the -inverse table. - -##### Syntax - -`result = [[stdlib_hashmap_open:valid_index]]( map, inmap )` - -##### Class - -Pure function. - -##### Arguments - -`map`: shall be a scalar expression of type `open_hashmap_type`. -It is an `intent(in)` argument. It is the hash map whose inverse -table is examined. - -`inmap`: shall be a scalar integer expression of kind `int_index`. It -is an `intent(in)` argument. It is the index to the inverse table whose -validity is being examined. - -##### Result character - -The result is a default logical scalar. - -##### Result value - -The result is `.true.` if `inmap` is a valid index to the inverse -table of `map` and `.false.` otherwise. - - -##### Example - -```fortran - program demo_valid_index - use stdlib_hashmap_open, only: & - open_hashmap_type, init, int_index, & - fnv_1_hasher, valid_index - implicit none - type(open_hashmap_type) :: map - integer(int_index) :: inmap - logocal :: valid - call init( map, fnv_1_hasher ) - inmap = 10 - valid = valid_index (map, inmap) - print *, "Initial index of 10 valid for empty map = ", valid - end program demo_valid_index -``` - From c9f2d6c47e544e2b466d92a2ca017cabc1badef4 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 10 Jan 2022 12:12:11 -0700 Subject: [PATCH 20/77] Fixed typos Fixed typos mostly in the examples, as found creating documentation fon an implementation of the hash maps that doesn't rely on the inmap index. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 3241bf002..ac1493da4 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -1340,7 +1340,7 @@ Procedures to report on the structure of the map: * `total_depth( map )` - Returns the total number of one's based offsets of slot entries from their slot index -### Specifications of the `stdlib_hashmap_chaining` procedures +### Specifications of the `stdlib_hashmaps` procedures #### `calls` - Returns the number of calls on a hash map @@ -1961,13 +1961,11 @@ generation of `inmap`, `other` is undefined. integer(int_index) :: inmap class(*), allocatable :: dummy allocate( dummy, source=4.0 ) - call init( map, & - fnv_1_hasher, & - slots_bits=10 ) + call map % init( fnv_1_hasher, slots_bits=10 ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) call set( other, dummy ) - call map_entry( map, inmap, key, other ) - call remove_entry( map, inmap ) + call map % map_entry( inmap, key, other ) + call map % remove_entry( inmap ) end program demo_remove_entry ``` @@ -2207,7 +2205,7 @@ the inverse table. ##### Syntax -`result = [[stdlib_hashmaps:map % valid_index]]( map )` +`result = [[stdlib_hashmaps:map % valid_index]]( inmap )` ##### Class @@ -2245,7 +2243,7 @@ table of `map` and `.false.` otherwise. logocal :: valid call map % init( fnv_1_hasher ) inmap = 10 - valid = map % valid_index ( inmap) + valid = map % valid_index ( inmap ) print *, "Initial index of 10 valid for empty map = ", valid end program demo_valid_index ``` From 30b0be3034032199112d00ee2122c4e032089711 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 10 Jan 2022 12:17:07 -0700 Subject: [PATCH 21/77] Added documentation for proposed new API The file stdlib_hashmaps.md contains a description for a proposed API for hash maps where the keys to the entries are used instead of the inmap index. [ticket: X] --- doc/specs/stdlib_hashmaps.md | 2104 ++++++++++++++++++++++++++++++++++ 1 file changed, 2104 insertions(+) create mode 100644 doc/specs/stdlib_hashmaps.md diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md new file mode 100644 index 000000000..c5a8264be --- /dev/null +++ b/doc/specs/stdlib_hashmaps.md @@ -0,0 +1,2104 @@ +--- +title: Hash maps +--- + +# The `stdlib_hashmap_wrappers`, `stdlib_hashmap_chaining` and `stdlib_hashmap_open` modules + +(TOC) + +## Overview of hash maps + +A hash map (hash table) is a data structure that maps *keys* to +*values*. It uses a hash function to compute a hash code from the *key* +that serves as an index into a linear array of *slots* (buckets) from +which the desired *value* can be extracted. +Each key ideally maps to a unique slot, but most hash functions are +imperfect and can map multiple keys to the same *slot* resulting in +collisions. Hash maps differ in how they deal with such collisions. +This document discusses the hash maps in the Fortran Standard Library. + +## Licensing + +The Fortran Standard Library is distributed under the MIT License. +However components of the library should be evaluated as to whether +they are compatible with the MTI License. +The current hash maps were inspired by an +[implementation](http://chasewoerner.org/src/hasht/) of David +Chase. While the code has been greatly modified from his +implementation, he has give permission for the unrestricted use of +his code. + +## The hash map modules + +The Fortran Standard Library provides two modules for the +implementation of simple hash maps. These maps only accept hash +functions with a single argument, the key, and yield a 32 bit +hash code. The modules will need to be modified if it is desired to +use hash functions with a different API. The two modules are: +`stdlib_hashmap_wrappers`, and `stdlib_hashmaps` corresponding to the +files: `stdlib_hashmap_wrappers.f90`, and `stdlib_hashmaps.f90` + +The module `stdlib_hashmap_wrappers` provides types and procedures for +use by `stdlib_hashmaps`. It provides an +interface to the 32 bit hash functions of the Standard Library module, +`stdlib_hash_32bit`, and provides wrappers to some of the +hash functions so that they no longer need to be supplied seeds. It +also defines two data types used to store information in the hash +maps, the `key_type` and the `other_type`. The `key_type` is used to +define keys that, in turn, are used to identify the data entered into +a hash map. The `other_type` is intended to contain the other data +associated with the key. + +The module `stdlib_hashmaps` defines the API for a parent datatype, +`hashmap_type` and two extensions of that hash map type: +`chaining_hashmap_type` and `open_hashmap_type`. + +The `hashmap_type` defines the Application Programers +Interface (API) for the procedures used by its two extensions. It +explicitly defines five non-overridable procedures. It also defines +the interfaces for eleven deferred procedures. It does not define the +finalization routines for the two extension types, or one routine +provided by the `open_hashmap_type`. + +The `chaining_hashmap_type` uses separate chaining with linked +lists to deal with hash index collisions. In separate chaining the +colliding indices are handled by using linked lists with their roots +at the hash index. The `chaining_hashmap_type` procedures are +implemented in the module `stdlib_hashmap_chaining` corresponding +to the file, `stdlib_hashmap_chaining.f90`. + +The `open_hashmap_type` +uses linear open addressing to deal with hash index collisions. In +linear open addressing the colliding indices are +handled by searching from the initial hash index in increasing +steps of one (modulo the hash map size) for an open map slot. +The `open_hashmap_type` procedures are implemented in the submodule +`stdlib_hashmap_open` corresponding to the file +`stdlib_hashmap_open.f90`. + +The maps use powers of two for their slot sizes, so that the function, +`fibonacci_hash`, can +be used to map the hash codes to indices in the map. This is +expected to be more efficient than prime number mapping using a +modulo operation, and reduces the requirement that the hash +function need to do a good job randomizing its lower order bits. +They do require a good randomizing hash method for good performance. +Both adjust the map size to reduce collisions, based on +the ratio of the number of hash map probes to the number of subroutine +calls. +Wile the maps make extensive use of pointers internally, a private +finalization subroutine avoids memory leaks. +The maps can take entry keys of type `key_type`, and other data of the +type `other_type`. +The maps allow the addition, removal, and lookup of entries, and the +inclusion of data in addition to the entry key. + +## The `stdlib_hashmap_wrappers` module + +The `stdlib_hashmap_wrappers` module provides data types to +represent keys and associated data stored in a module, but is also, a +wrapper for the `stdlib_hash_32bit` module. It allows +direct access to the `stdlib_hash_32bit` procedures: +`fibonacci_hash`, `fnv_1_hasher`, `fnv_1a_hasher`; and provides +wrapper functions, `seeded_nmhash32_hasher`, +`seeded_nmhash32x_hasher`, and `seeded_water_hasher` to the hash +functions: `nmhash32`, `nmhash32x`, and `water_hash`, respectively. It +defines an interface, `hasher_fun`, compatible with the hash functions +that take a `non-scalar key`. It defines one integer constant used +as a kind value,`int_hash`. It also defines two types, `key_type` and +`other_type`, and associated procedures, for storing and manipulating +keys and their associated data. + +### The `stdlib_hashmap_wrappers`'s constant, `int_hash` + +The constant `int_hash` is used to define the integer kind value for +the returned hash codes and variables used to access them. It +currently has the value, `int32`. + +### The `stdlib_hashmap_wrappers`' module's derived types + +The `stdlib_hashmap_wrappers` module defines two derived types: +`key_type`, and `other_type`. The `key_type` is intended to be used +for the search keys of hash tables. The `other_type` is intended to +store additional data associated with a key. Both types are +opaque. Their current representations are as follows + +```fortran + type :: key_type + private + integer(int8), allocatable :: value(:) + end type key_type + + type :: other_type + private + class(*), allocatable :: value + end type other_type +``` + +The module also defines six procedures for those types: `copy_key`, +`copy_other`, `equal_keys`, `free_key`, `free_other`, `get`, and +`set`, and one operator, `==`, +for use by the hash maps to manipulate or inquire of components of +those types. + +### Table of `stdlib_hashmap_wrappers` procedures + +The `stdlib_hashmap_wrappers` module provides procedures in +several categories: procedures to manipulate data of the `key_type`; +procedures to manipulate data of the `other_type`, and 32 bit hash +functions for keys. The procedures in each category are listed +below. It also provides an operator to compare two key type values for +equality. + +Procedures to manipulate `key_type` data: + +* `copy_key( key_in, key_out )` - Copies the contents of the key, + `key_in`, to contents of the key, `key_out`. + +* `get( key, value )` - extracts the contents of `key` into `value`, + an `int8` array or character string. + +* `free_key( key )` - frees the memory in `key`. + +* `set( key, value )` - sets the content of `key` to `value`. + +Procedures to manipulate `other_type` data: + +* `copy_other( other_in, other_out )` - Copies the contents of the + other data, `other_in`, to the contents of the other data, + `other_out`. + +* `get( other, value )` - extracts the contents of `other` into the + class(*) variable `value`. + +* `set( other, value )` - sets the content of `other` to the class(*) + variable `value`. + +* `free_other( other )` - frees the memory in `other`. + +Procedures to hash keys to 32 bit integers: + +* `fnv_1_hasher( key )` - hashes a `key` using the FNV-1 algorithm. + +* `fnv_1a_hasher( key )` - hashes a `key` using the FNV-1a algorithm. + +* `seeded_nmhash32_hasher( key )` - hashes a `key` using the nmhash32 + algorithm. + +* `seeded_nmhash32x_hasher( key )` - hashes a `key` using the nmhash32x + algorithm. + +* `seeded_water_hasher( key )` - hashes a `key` using the waterhash + algorithm. + +Operator to compare two `key_type` values for equality + +* `key1 == key2` - compares `key1' with 'key2' for equality + +### Specifications of the `stdlib_hashmap_wrappers` procedures + +#### `copy_key` - Returns a copy of the key + +##### Status + +Experimental + +##### Description + +Returns a copy of an input of type `key_type`. + +##### Syntax + +`call [[stdlib_hashmap_wrappers:copy_key]]( key_in, key_out )` + +##### Class + +Subroutine. + +##### Arguments + +`key_in`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. + +`key_out`: shall be a scalar variable of type `key_type`. It +is an `intent(out)` argument. + +##### Example + +```fortran + program demo_copy_key + use stdlib_hashmap_wrappers, only: & + copy_key, operator(==)equal_keys, key_type + use iso_fortran_env, only: int8 + implicit none + integer(int8), allocatable :: value(:) + type(key_type) :: key_in, key_out + integer(int_8) :: i + allocate( value(1:15) ) + do i=1, 15 + value(i) = i + end do + call set( key_in, value ) + call copy_key( key_in, key_out ) + print *, "key_in == key_out = ", key_in == key_out + end program demo_copy_key +``` + +#### `copy_other` - Returns a copy of the other data + +##### Status + +Experimental + +##### Description + +Returns a copy of an input of type `other_type`. + +##### Syntax + +`call [[stdlib_hashmap_wrappers:copy_other]]( other_in, other_out )` + +##### Class + +Subroutine. + +##### Arguments + +`other_in`: shall be a scalar expression of type `other_type`. It +is an `intent(in)` argument. + +`other_out`: shall be a scalar variable of type `other_type`. It +is an `intent(out)` argument. + +##### Example + +```fortran + program demo_copy_other + use stdlib_hashmap_wrappers, only: & + copy_other, get, other_type, set + use iso_fortran_env, only: int8 + implicit none + type(other_type) :: other_in, other_out + integer(int_8) :: i + class(*), allocatable :: dummy + type dummy_type + integer(int8) :: value(15) + end type + type(dummy_type) :: dummy_val + do i=1, 15 + dummy_val % value1(i) = i + end do + allocate(other_in % value, source=dummy_val) + call copy_other( other_in, other_out ) + select type(other_out) + type(dummy_type) + print *, "other_in == other_out = ", & + all( dummy_val % value == other_out % value ) + end select + end program demo_copy_other +``` + + +#### `fibonacci_hash` - maps an integer to a smaller number of bits + +##### Status + +Experimental + +##### Description + +`fibonacci_hash` is just a re-export of the function of the same name +implemented in +[`stdlib_hash_32bit`](https://stdlib.fortran-lang.org/page/spec/stdlib_hash_functions.html#fibonacci_hash-maps-an-integer-to-a-smaller-number-of-bits). +It reduces the value of a 32 bit integer to a smaller number of bits. + + +#### `fnv_1_hasher`- calculates a hash code from a key + +##### Status + +Experimental + +##### Description + +Calculates a 32 bit hash code from an input of type `key_type`. + +##### Syntax + +`code = [[stdlib_hashmap_wrappers:fnv_1_hasher]]( key )` + +##### Class + +Pure function + +##### Argument + +`key`: Shall be a scalar expression of type `key_type`. +It is an `intent(in)` argument. + +##### Result character + +The result is a scalar integer of kind `int32`. + +##### Result value + +The result is a hash code created using the FNV-1 algorithm. + +##### Note + +`fnv_1_hasher` is an implementation of the original FNV-1 hash code of +Glenn Fowler, Landon Curt Noll, and Phong Vo. +This code is relatively fast on short keys, and is small enough that +it will often be retained in the instruction cache if hashing is +intermitent. +As a result it should give good performance for typical hash map +applications. +This code does not pass any of the SMHasher tests, but the resulting +degradation in performance due to its larger number of collisions is +expected to be minor compared to its faster hashing rate. + + +##### Example + +```fortran + program demo_fnv_1_hasher + use stdlib_hashmap_wrappers, only: & + fnv_1_hasher, key_type, set + use iso_fortran_env, only: int32 + implicit none + integer(int8), allocatable :: array1(:) + integer(int32) :: hash + type(key_type) :: key + array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] + call set( key, array1 ) + hash = fnv_1_hasher(key) + print *, hash + end program demo_fnv_1_hasher +``` + + +#### `fnv_1a_hasher`- calculates a hash code from a key + +##### Status + +Experimental + +##### Description + +Calculates a 32 bit hash code from an input of type `key_type`. + +##### Syntax + +`code = [[stdlib_hashmap_wrappers:fnv_1a_hasher]]( key )` + +##### Class + +Pure function + +##### Argument + +`key`: Shall be a scalar expression of type `key_type`. +It is an `intent(in)` argument. + +##### Result character + +The result is a scalar integer of kind `int32`. + +##### Result value + +The result is a hash code created using the FNV-1a algorithm. + +##### Note + +`fnv_1a_hasher` is an implementation of the original FNV-1A hash code +of Glenn Fowler, Landon Curt Noll, and Phong Vo. +This code is relatively fast on short keys, and is small enough that +it will often be retained in the instruction cache if hashing is +intermitent. +As a result it should give good performance for typical hash map +applications. +This code does not pass any of the SMHasher tests, but the resulting +degradation in performance due to its larger number of collisions is +expected to be minor compared to its faster hashing rate. + + +##### Example + +```fortran + program demo_fnv_1a_hasher + use stdlib_hashmap_wrappers, only: & + fnv_1a_hasher, key_type, set + use iso_fortran_env, only: int32 + implicit none + integer(int8), allocatable :: array1(:) + integer(int32) :: hash + type(key_type) :: key + array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] + call set( key, array1 ) + hash = fnv_1a_hasher(key) + print *, hash + end program demo_fnv_1a_hasher +``` + +#### `free_key` - frees the memory associated with a key + +##### Status + +Experimental + +##### Description + +Deallocates the memory associated with an variable of type +`key_type`. + +##### Syntax + +`call [[stdlib_hashmap_wrappers:free_key]]( key )` + +##### Class + +Subroutine. + +##### Argument + +`key`: shall be a scalar variable of type `key_type`. It +is an `intent(out)` argument. + +##### Example + +```fortran + program demo_free_key + use stdlib_hashmap_wrappers, only: & + copy_key, free_key, key_type, set + use iso_fortran_env, only: int8 + implicit none + integer(int8), allocatable :: value(:) + type(key_type) :: key_in, key_out + integer(int_8) :: i + allocate( value(1:15) ) + do i=1, 15 + value(i) = i + end do + call set( key_in, value ) + call copy_key( key_in, key_out ) + call free_key( key_out ) + end program demo_free_key +``` + +#### `free_other` - frees the memory associated with other data + +##### Status + +Experimental + +##### Description + +Deallocates the memory associated with an variable of type +`other_type`. + +##### Syntax + +`call [[stdlib_hashmap_wrappers:free_other]]( other )` + +##### Class + +Subroutine. + +##### Argument + +`other`: shall be a scalar variable of type `other_type`. It +is an `intent(out)` argument. + +##### Example + +```fortran + program demo_free_other + use stdlib_hashmap_wrappers, only: & + copy_other, free_other, other_type, set + use iso_fortran_env, only: int8 + implicit none + type dummy_type + integer(int8) :: value(15) + end type dummy_type + typer(dummy_type) :: dummy_val + type(other_type), allocatable :: other_in, other_out + integer(int_8) :: i + do i=1, 15 + dummy_val % value(i) = i + end do + allocate(other_in, source=dummy_val) + call copy_other( other_in, other_out ) + call free_other( other_out ) + end program demo_free_other +``` + + +#### `get` - extracts the data from a derived type + +##### Status + +Experimental + +##### Description + +Extracts the data from a `key_type` or `other_type` and stores it +in the variable `value`. + +##### Syntax + +`call [[stdlib_hashmap_wrappers:get]]( key, value )` + +or + +`call [[stdlib_hashmap_wrappers:get]]( other, value )` + +##### Class + +Subroutine. + +##### Argument + +`key`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. + +`other`: shall be a scalar expression of type `other_type`. It +is an `intent(in)` argument. + +`value`: if the the first argument is of `key_type` `value` shall be +an allocatable default character string variable, or +an allocatable vector variable of type integer and kind `int8`, +otherwise the first argument is of `other_type` and `value` shall be +an allocatable of `class(*)`. It is an `intent(out)` argument. + +##### Example + +```fortran + program demo_get + use stdlib_hashmap_wrappers, only: & + get, key_type, set + use iso_fortran_env, only: int8 + implicit none + integer(int8), allocatable :: value(:), result(:) + type(key_type) :: key + integer(int_8) :: i + allocate( value(1:15) ) + do i=1, 15 + value(i) = i + end do + call set( key, value ) + call get( key, result ) + print *, `RESULT == VALUE = ', all( value == result ) + end program demo_get +``` + + +#### `hasher_fun`- serves aa a function prototype. + +##### Status + +Experimental + +##### Description + +Serves as a prototype for hashing functions with a single, `key`, +argument of type `key_type` returning an `int32` hash value. + +##### Syntax + +`type([[stdlib_hashmap_wrappers:hasher_fun]]), pointer :: fun_pointer` + +##### Class + +Pure function prototype + +##### Argument + +`key`: Shall be a rank one array expression of type `integer(int8)`. +It is an `intent(in)` argument. + +##### Result character + +The result is a scalar integer of kind `int32`. + +##### Result value + +The result is a hash code. + +##### Note + +`hasher_fun` is a prototype for defining dummy arguments and function +pointers intended for use as a hash function for the hash maps. + +##### Example + +```fortran + program demo_hasher_fun + use stdlib_hashmap_wrappers, only: & + fnv_1a_hasher, hasher_fun, set + use iso_fortran_env, only: int8, int32 + implicit none + type(hasher_fun), pointer :: hasher_pointer + integer(int8), allocatable :: array1(:) + integer(int32) :: hash + type(key_type) :: key + hasher_pointer => fnv_1a_hasher + array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] + call set( key, array1 ) + hash = hassher_pointer(key) + print *, hash + end program demo_hasher_fun +``` + +#### `operator(==)` - Compares two keys for equality + +##### Status + +Experimental + +##### Description + +Returns `.true.` if two keys are equal, and `.false.` otherwise. + +##### Syntax + +`test = [stdlib_hashmap_wrappers:key1==key2]` + +##### Class + +Pure operator. + +##### Arguments + +`key1`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. + +`key2`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. + +##### Result character + +The result is a value of type default `logical`. + +##### Result value + +The result is `.true.` if the keys are equal, otherwise `.falss`. + +##### Example + +```fortran + program demo_equal_keys + use stdlib_hashmap_wrappers, only: & + copy_key, operator(==), key_type, set + use iso_fortran_env, only: int8 + implicit none + integer(int8), allocatable :: value(:) + type(key_type) :: key_in, key_out + integer(int_8) :: i + allocate( value(1:15) ) + do i=1, 15 + value(i) = i + end do + call set( key_in, value ) + call copy_key( key_in, key_out ) + print *, "key_in == key_out = ", key_in == key_out + end program demo_equal_keys +``` + +#### `seeded_nmhash32_hasher`- calculates a hash code from a key + +##### Status + +Experimental + +##### Description + +Calculates a 32 bit hash code from an input of type `key_type`. + +##### Syntax + +`code = [[stdlib_hashmap_wrappers:seeded_nmhash32_hasher]]( key )` + +##### Class + +Pure function + +##### Argument + +`key`: Shall be a scalar expression of type `key_type`. +It is an `intent(in)` argument. + +##### Result character + +The result is a scalar integer of kind `int32`. + +##### Result value + +The result is a hash code created using the `nmhash32` algorithm. + +##### Note + +`seeded_nmhash32_hasher` is a wrapper to the `NMHASH32_HASH` of the +module `stdlib_hash_32bit`, which supplies a fixed seed +to the wrapped function. `NMHASH32` is an implementation of the +`nmhash32` hash code of James Z. M. Gao. +This code has good, but not great, performance on long keys, poorer +performance on short keys. +As a result it should give fair performance for typical hash map +applications. +This code passes the SMHasher tests. + + +##### Example + +```fortran + program demo_seeded_nmhash32_hasher + use stdlib_hashmap_wrappers, only: & + seeded_nmhash32_hasher, key_type, set + use iso_fortran_env, only: int32 + implicit none + integer(int8), allocatable :: array1(:) + integer(int32) :: hash + type(key_type) :: key + array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] + call set( key, array1 ) + hash = seeded_nmhash32_hasher (key) + print *, hash + end program demo_seeded_nmhash32_hasher +``` + +#### `seeded_nmhash32x_hasher`- calculates a hash code from a key + +##### Status + +Experimental + +##### Description + +Calculates a 32 bit hash code from an input of type `key_type`. + +##### Syntax + +`code = [[stdlib_hashmap_wrappers:seeded_nmhash32x_hasher]]( key )` + +##### Class + +Pure function + +##### Argument + +`key`: Shall be a scalar expression of type `key_type`. +It is an `intent(in)` argument. + +##### Result character + +The result is a scalar integer of kind `int32`. + +##### Result value + +The result is a hash code created using the `nmhash32x` algorithm. + +##### Note + +`seeded_nmhash32x_hasher` is a wrapper to the `nmhash32x_hash` of the +module `stdlib_hash_32bit`, which supplies a fixed seed +to the wrapped function. `nmhash32x` is an implementation of the +`nmhash32x` hash code of James Z. M. Gao. +This code has good, but not great, performance on long keys, poorer +performance on short keys. +As a result it should give fair performance for typical hash map +applications. +This code passes the SMHasher tests. + +##### Example + +```fortran + program demo_seeded_nmhash32x_hasher + use stdlib_hashmap_wrappers, only: & + seeded_nmhash32x_hasher, key_type, set + use iso_fortran_env, only: int32 + implicit none + integer(int8), allocatable :: array1(:) + integer(int32) :: hash + type(key_type) :: key + array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] + call set( key, array1 ) + hash = seeded_nmhash32x_hasher (key) + print *, hash + end program demo_seeded_nmhash32x_hasher +``` + +#### `seeded_water_hasher`- calculates a hash code from a key + +##### Status + +Experimental + +##### Description + +Calculates a 32 bit hash code from an input of type `key_type`. + +##### Syntax + +`code = [[stdlib_hashmap_wrappers:seeded_water_hasher]]( key )` + +##### Class + +Pure function + +##### Argument + +`key`: Shall be a scalar expression of type `key_type`. +It is an `intent(in)` argument. + +##### Result character + +The result is a scalar integer of kind `int32`. + +##### Result value + +The result is a hash code created using the `waterhash` algorithm. + +##### Note + +`seeded_water_hasher` is a wrapper to the `water_hash` of the +module `stdlib_hash_32bit`, which supplies a fixed seed +to the wrapped function. `water_hash` is an implementation of the +`waterhash` hash code of Tommy Ettinger. +This code has excellent performance on long keys, and good performance +on short keys. +As a result it should give reasonable performance for typical hash +table applications. +This code passes the SMHasher tests. + + +##### Example + +```fortran + program demo_seeded_water_hasher + use stdlib_hashmap_wrappers, only: & + seeded_water_hasher, key_type, set + use iso_fortran_env, only: int32 + implicit none + integer(int8), allocatable :: array1(:) + integer(int32) :: hash + type(key_type) :: key + array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] + call set( key, array1 ) + hash = seeded_water_hasher (key) + print *, hash + end program demo_seeded_water_hasher +``` + + +#### `set` - places the data in a derived type + +##### Status + +Experimental + +##### Description + +Places the data from `value` in a `key_type` or an `other_type`. + +##### Syntax + +`call [[stdlib_hashmap_wrappers:set]]( key, value )` + +or + +`call [[stdlib_hashmap_wrappers:set]]( other, value )` + + +##### Class + +Subroutine. + +##### Argument + +`key`: shall be a scalar variable of type `key_type`. It +is an `intent(out)` argument. + +`other`: shall be a scalar variable of type `other_type`. It +is an `intent(out)` argument. + +`value`: if the first argument is `key` `vaalue` shall be a default +character string expression, or a vector expression of type integer +and kind `int8`, while for a first argument of type `other` `value` +shall be of type `class(*)`. It is an `intent(in)` argument. + +##### Example + +```fortran + program demo_set + use stdlib_hashmap_wrappers, only: & + get, key_type, set + use iso_fortran_env, only: int8 + implicit none + integer(int8), allocatable :: value(:), result(:) + type(key_type) :: key + integer(int_8) :: i + allocate( value(1:15) ) + do i=1, 15 + value(i) = i + end do + call set( key, value ) + call get( key, result ) + print *, `RESULT == VALUE = ', all( value == result ) + end program demo_set +``` + + +## The `stdlib_hashmaps` module + +The `stdlib_hashmaps` module defines three public data types, +associated procedures and constants that implement two simple hash map +types using separate chaining hashing and open addressing hashing. The +derived type `hashmap_type` is the parent type to its two +extensions: `chaining_hashmap_type` and `open_hashmap_type`. +`chaining_hashmap_type`. The extension types provide +procedures to manipulate the structure of a hash map object: +`init`, `map_entry`, `rehash`, `remove_entry`, and +`set_other_data`. They also provide procedures to inquire about +entries in the hash map: `get_other_data`, `in_map`, `unmap` and +`valid_index`. Finally they provide procedures to inquire about the +overall structure and performance of the hash map object:`calls`, +`entries`, `get_other_data`, `loading`, `slots`, and +`total_depth`. The module also defines a number of public constants: +`probe_factor`, `load_factor`, `map_probe_factor`, `default_bits`, +`max_bits`, `int_calls`, `int_depth`, `int_index`, +`int_probes`, `success`, `alloc_fault`, and `array_size_error`. + +### The `stdlib_hashmaps` module's public constants + +The module defines several categories of public constants. Some are +used to parameterize the empirical slot expansion code. Others +parameterize the slots table size. Some are used to define +integer kind values for different applications. Finally, some are used +to report errors or success. + +The constants `probe_factor`, and `map_probe_factor` are used to +parameterize the slot expansion code used to determine when in a +in a procedure call the number +of slots need to be increased to decrease the search path for an +entry. The constant `probe_factor` is used to determine when +the ratio of the number of map probes to map calls is too large and +the slots need expansion. The constant `map_probe_factor` is used to +determine when inserting a new entry the ratio of the number of map +probes to map calls is too large and the slots need expansion. + +The constants `default_bits`, and +`max_bits` are used to parameterize the table's slots size. The +`default_bits` constant defines the default initial number of slots +with a current value of 6 resulting in an initial `2**6 == 64` +slots. This may optionally be overridden on hash map creation. The +`max_bits` parameter sets the maximum table size as `2**max_bits` with +a default value for `max_bits` of 30. The table will not work for a +slots size greater than `2**30`. + +The constants `int_calls`, `int_depth`, `int_index`, and `int_probes` +are used to define integer kind values for various contexts. The +number of calls are reported and stored in entities of kind +`int_calls`. Currently `int_calls` has the value of `int64`. The +total depth, the number of inquiries needed to access all elements +of the table, is reported and stored in entities of kind +`int_depth`. Currently `int_depth` has the value of `int64`. The +number of entries in the table, is reported and stored in entities of +kind `int_index`. Currently `int_index` has the value of `int32`. +The number of probes, hash map enquiries, are reported and stored in +entities of kind `int_probes`. Currently `int_probes` has the value of +`int64`. + +The constant `load_factor` is only used by the `open_hashmap_type`. It +specifies the maximum fraction of the available slots that may be +filled before expansion occurs. The current `load_factor = ).5625` so +the current implementation of `open_hashmap_type` can only hold a +little more than `2**29` entries. + +Finally the error codes `success`, `alloc_fault`, and +`array_size_error` are used to report the error status of certain +procedure calls. The `succes` code indicates that no problems were +found. The `alloc_fault` code indicates that a memory allocation +failed. Finally the `array_size_error` indicates that on table +creation `slots_bits` is less than `default_bits` or +greater than `max_bits`. + +### The `stdlib_hashmaps` module's derived types + +The `stdlib_hashmaps` module defines three public derived types and +seven private types used in the implementation of the public +types. The public types are the abstract `hashmap_type` and its +extensions: `chaining_hashmap_type` and `open_hashmap_type`. The three +private derived types, `chaining_map_entry_type`, +`chaining_map_entry_ptr`, and `chaining_map_entry_pool` are used in +the implementation of the `chaining_hashmap_type` public type. The +four private derived types, `open_map_entry_type`, +`open_map_entry_list`, `open_map_entry_ptr`, and `open_map_entry_pool` +are used in the implementation of the `open_hashmap_type` public +type:. Each of these types are described below. + +#### The `hashmap_type` abstract type + +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: +* `call_count` - the number of procedure calls on the map; +* `nbits` - the number of bits used to address the slots; +* `num_entries` - the humber of entries in the map; +* `num_free` - the number of entries in the free list of removed + entries; +* `probe_count` - the number of map probes since the last resizing or + initialization; +* `total_probes` - the number of probes of the map up to the last + resizing or initialization; and +* `hasher` - a pointer to the hash function used by the map. +It also defines five non-overridable procedures: +* `calls` - returns the number of procedure calls on the map; +* `entries` - returns the number of entries in the map; +* `map_probes` - returns the number of map probes since + initialization; +* `num_slots` - returns the number of slots in the map; and +* `slots_bits` - returns the number of bits used to address the slots; +and eleven deferred procedures: +* `get_other_data` - gets the other data associated with the key; +* `init` - initializes the hash map; +* `loading` - returns the ratio of the number of entries to the number + of slots; +* `map_entry` - inserts a key and its other associated data into the + map; +* `rehash` - rehashes the map with the provided hash function; +* `remove` - removes the entry associated wit the key; +* `set_other_data` - replaces the other data associated with the key; +* `total_depth` - returns the number of probes needed to address all + the entries in the map; +* `valid_key` - returns a logical flag indicating whether the key is + defined in the map. + +The type's definition is below: + +```fortran + type, abstract :: hashmap_type + private + integer(int_calls) :: call_count = 0 + integer(int_calls) :: probe_count = 0 + integer(int_calls) :: total_probes = 0 + integer(int_index) :: num_entries = 0 + integer(int_index) :: num_free = 0 + integer(int_index) :: index_mask = 2_int_index**default_bits-1 + integer(int32) :: nbits = default_bits + procedure(hasher_fun), pointer, nopass :: hasher => fnv_1_hasher + contains + procedure, non_overridable, pass(map) :: calls + procedure, non_overridable, pass(map) :: entries + procedure, non_overridable, pass(map) :: map_probes + procedure, non_overridable, pass(map) :: slots_bits + procedure, non_overridable, pass(map) :: num_slots + procedure(get_other), deferred, pass(map) :: get_other_data + procedure(init_map), deferred, pass(map) :: init + procedure(loading), deferred, pass(map) :: loading + procedure(map_entry), deferred, pass(map) :: map_entry + procedure(rehash_map), deferred, pass(map) :: rehash + procedure(remove_entry), deferred, pass(map) :: remove + procedure(set_other), deferred, pass(map) :: set_other_data + procedure(total_depth), deferred, pass(map) :: total_depth + procedure(valid_index), deferred, pass(map) :: valid_key + end type hashmap_type +``` + + +#### The `chaining_map_entry_type` derived type + +Entities of the type `chaining_map_entry_type` are used to define +a linked list structure that stores the +key, its other data, the hash of the key, and the resulting index into +the inverse table. The type's definition is below: + +```fortran + type :: chaining_map_entry_type ! Chaining hash map entry type + private + integer(int_hash) :: hash_val ! Full hash value + type(key_type) :: key ! The entry's key + type(other_type) :: other ! Other entry data + integer(int_index) :: index ! Index into inverse table + type(chaining_map_entry_type), pointer :: & + next => null() ! Next bucket + end type chaining_map_entry_type +``` +Currently the `int_hash` and `int_index` have the value of `int32`. + +#### The `chaining_map_entry_ptr` derived type + +The type `chaining_map_entry_ptr` is used to define the elements of +the hash map that are either empty or link to the linked lists +containing the elements of the table. The type's definition is below: + +```fortran + type chaining_map_entry_ptr ! Wrapper for a pointer to a chaining + ! map entry type object + type(chaining_map_entry_type), pointer :: target => null() + end type chaining_map_entry_ptr +``` + +#### The `chaining_map_entry_pool` derived type + +The type `chaining_map_entry_pool` is used to implement a pool of +allocated `chaining_map_entry_type` elements to save on allocation +costs. The type's definition is below: + +```fortran + type :: chaining_map_entry_pool + ! Type implementing a pool of allocated + ! `chaining_map_entry_type` objects + private + ! Index of next bucket + integer(int_index) :: next = 0 + type(chaining_map_entry_type), allocatable :: more_map_entries(:) + type(chaining_map_entry_pool), pointer :: lastpool => null() + end type chaining_map_entry_pool +``` + + +#### The `chaining_hashmap_type` derived type + +The `chaining_hashmap_type` derived type extends the `hashmap_type` to +implements a separate chaining hash map. In addition to the components +of the `hashmap_type` it provides the four components: +* `cache` - a pool of `chaining_map_entry_pool` objects used to reduce +allocation costs; +* `free_list` - a free list of map entries; +* `inverse` - an array of `chaining_map_entry_ptr` bucket lists +(inverses) storing entries at fixed locations once +entered; and +* `slots` - an array of bucket lists serving as the hash map. +It also implements all of the deferred procedures of the +`hashmap_type` and a finalizer for its maps. The type's definition is +as follows: + +```fortran + type, extends(hashmap_type) :: chaining_hashmap_type + private + type(chaining_map_entry_pool), pointer :: cache => null() + type(chaining_map_entry_type), pointer :: free_list => null() + type(chaining_map_entry_ptr), allocatable :: inverse(:) + type(chaining_map_entry_ptr), allocatable :: slots(:) + contains + procedure :: get_other_data => get_other_chaining_data + procedure :: in_map => in_chain_map + procedure :: init => init_chaining_map + procedure :: loading => chaining_loading + procedure :: map_entry => map_chain_entry + procedure :: rehash => rehash_chaining_map + procedure :: remove => remove_chaining_entry + procedure :: set_other_data => set_other_chaining_data + procedure :: total_depth => total_chaining_depth + procedure :: unmap => unmap_chain + procedure :: valid_index => valid_chaining_index + final :: free_chaining_map + end type chaining_hashmap_type +``` + +#### The `open_map_entry_type` derived type + +Entities of the type `open_map_entry_type` are used to define +a linked list structure that stores the +key, its other data, the hash of the key, and the resulting index into +the inverse table. The type's definition is below: + +```fortran + type :: open_map_entry_type ! Open hash map entry type + private + integer(int_hash) :: hash_val ! Full hash value + type(key_type) :: key ! The entry's key + type(other_type) :: other ! Other entry data + integer(int_index) :: index ! Index into inverse table + end type open_map_entry_type +``` + +Currently `int_hash` and `int_index` have the value of `int32`. + +#### The `open_map_entry_ptr` derived type + +The type `open_map_entry_ptr` is used to define the elements of +the hash map that are either empty or link to the linked lists +containing the elements of the table. The type's definition is below: + +```fortran + type open_map_entry_ptr ! Wrapper for a pointer to a open + ! map entry type object + type(open_map_entry_type), pointer :: target => null() + end type open_map_entry_ptr +``` + +#### The `open_hashmap_type` derived type + +The `open_hashmap_type` derived type extends the `hashmap_type` to +implement an open addressing hash map. In addition to the components +of the `hashmap_type` it provides the four components: +* `cache` - a pool of `open_map_entry_pool` objects used to reduce +allocation costs; +* `free_list` - a free list of map entries; +* `index_mask` - an `and` mask used in linear addressing; +* `inverse` - an array of `open_map_entry_ptr` bucket lists +(inverses) storing entries at fixed locations once +entered; and +* `slots` - an array of bucket lists serving as the hash map. +It also implements all of the deferred procedures of the +`hashmap_type` and a finalizer for its maps. The type's definition is +as follows: + +```fortran + type, extends(hashmap_type) :: open_hashmap_type + private + integer(int_index) :: index_mask = 2_int_index**default_bits-1 + type(open_map_entry_pool), pointer :: cache => null() + integer(int_index), allocatable :: slots(:) + type(open_map_entry_ptr), allocatable :: inverse(:) + type(open_map_entry_list), pointer :: free_list => null() + contains + procedure :: get_other_data => get_other_open_data + procedure :: in_map => in_open_map + procedure :: init => init_open_map + procedure :: loading => open_loading + procedure :: map_entry => map_open_entry + procedure :: rehash => rehash_open_map + procedure :: remove => remove_open_entry + procedure :: set_other_data => set_other_open_data + procedure :: total_depth => total_open_depth + procedure :: unmap => unmap_open + procedure :: valid_index => valid_open_index + final :: free_open_map + end type open_hashmap_type +``` + +### Table of `stdlib_hashmap` procedures + +The `stdlib_hashmap` module provides procedures in +several categories: a procedure to initialize the map; a procedure to +modify the structure of a map; procedures to modify the content of a +map; procedures to report on the content of a map; and procedures +to report on the structure of the map. The procedures in each category +are listed below. + +Procedure to initialize a chaining hash map: + +* `init( map, hasher[, slots_bits, status] )` - Routine + to initialize a chaining hash map. + +Procedure to modify the structure of a map: + +* `rehash( map, hasher )` - Routine to change the hash function + for a map. + +Procedures to modify the content of a map: + +* `map_entry( map, key, other, conflict )` - Inserts an entry into the + hash map. + +* `remove_entry(map, key, existed )` - Remove the entry, if any, + associated with the `key`. + +* `set_other_data( map, key, other, exists )` - Change the other data + associated with the entry. + +Procedures to report the content of a map: + +* `get_other_data( map, key, other, exists )` - Returns the other data + associated with the `key`; + +* `valid_key(map, key)` - Returns a flag indicating whether the `key` + is present in the map. + +Procedures to report on the structure of the map: + +* `calls( map )` - the number of subroutine calls on the hash map. + +* `entries( map )`- the number of entries in a hash map. + +* `loading( map )` - the number of entries relative to the number of + slots in a hash map. + +* `map_probes( map )` - the total number of table probes on a hash + map. + +* `slots( map )` - Returns the number of allocated slots in a hash + map. + +* `total_depth( map )` - Returns the total number of one's based +offsets of slot entries from their slot index + + +### Specifications of the `stdlib_hashmaps` procedures + +#### `calls` - Returns the number of calls on a hash map + +##### Status + +Experimental + +##### Description + +Returns the number of procedure calls on a hash map. + +##### Syntax + +`value = [[stdlib_hashmaps:map % calls]]()` + +##### Class + +Pure function + +##### Argument + +`map` (pass) - shall be an expression of class `hashmap_type`. +It is an `intent(in)` argument. + +##### Result character + +The result will be an integer of kind `int_calls`. + +##### Result value + +The result will be the number of procedure calls on the hash map. + +##### Example + +```fortran + program demo_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 + type(int_calls) :: initial_calls + call map % init(fnv_1_hasher ) + initial_calls = map % calls() + print *, "INITIAL_CALLS = ", initial_calls + end program demo_calls +``` + + +#### `entries` - Returns the number of entries in a hash map + +##### Status + +Experimental + +##### Description + +Returns the number of entries in a hash map. + +##### Syntax + +`value = [[stdlib_hashmaps:map%entries]]()` + +##### Class + +Pure function + +##### Argument + +`map` (pass) - shall be an expression of class `hashmap_type`. +It is an `intent(in)` argument. + +##### Result character + +The result will be an integer of kind `int_index`. + +##### Result value + +The result will be the number of entries in the hash map. + +##### Example + +```fortran + program demo_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 + type(int_index) :: initial_entries + call map % init( fnv_1_hasher ) + initial_entries = map % entries () + print *, "INITIAL_ENTRIES = ", initial_entries + end program demo_entries +``` + + +#### `get_other_data` - Returns other data associated with the `key` + +##### Status + +Experimental + +##### Description + +Returns the other data associated with the `key`, + +##### Syntax + +`value = [[stdlib_hashmaps:map%get_other_data)]]( key, other [, exists] )` + +##### Class + +Subroutine + +##### Arguments + +`map` (pass): shall be a scalar expression of class + `chaining_hashmap_type` or `open_hashmap_type`. It is an + `intent(in)` argument. It will be + the hash map used to store and access the other data. + +`key`: shall be a scalar expression of type `key_type`. It + is an `intent(in)` argument. + +`other`: shall be a variable of type `other_data`. + It is an `intent(out)` argument. It is the other data associated + with the `key`. + +`exists` (optional): shall be a variable of type logical. It is an +`intent(out)` argument. If `true` an entry with the given `key` +exists in the map, if false `other` is undefined. + +* The following is an example of the retrieval of other data + associated with a `key`: + + +##### Example + +```Fortran + program demo_get_other_data + use, intrinsic:: iso_fortran_env, only: & + int8 + use stdlib_hashmaps, only: chaining_hashmap_type, int_index + use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type + logical :: conflict, exists + type(key_type) :: key + type(other_type) :: other + type(chaining_hashmap_type) :: map + type dummy_type + integer(int8) :: value(4) + end type dummy_type + type(dummy_type) :: dummy + class(*), allocatable :: data + dummy % value = [ 4_int8, 3_int8, 2_int8, 1_int8 ] + allocate( data, source=dummy ) + call map % init( fnv_1_hasher ) + call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) + call set( other, data ) + call map % map_entry( key, other. conflict ) + if ( .not. conflict ) then + call map % get_other_data( key, other ) + else + stop 'Key is already present in the map.'' + end if + call get( other, data ) + select type( data ) + type (dummy_type) + print *, 'Other data % value = ', data % value + type default + print *, 'Invalid data type in other' + end select + end program demo_get_other_data +``` + + +#### init - initializes a hash map + +##### Status + +Experimental + +##### Description + +Initializes a `chaining_hashmap_type` object. + +##### Syntax + +`call [[stdlib_hashmaps:map%init]]( hasher [, slots_bits, status ] ] )` + +####@# Class + +Subroutine + +##### Arguments + +`map` (pass): shall be a scalar variable of class + `chaining_hashmap_type` or `open_hashmap_type`. It is an + `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`. + 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. + +`slots_bits` (optional): shall be a scalar default integer + expression. It is an `intent(in)` argument. The initial number of + slots in the table will be `2**slots_bits`. + +* `slots_bits` shall be a positive default integer less than + `max_bits`, otherwise processing stops with an informative + error code. + +* If `slots_bits` is absent then the effective value for `slots_bits` + is `default_slots_bits`. + +`status` (optional): shall be a scalar integer variable of kind +`int32`. It is an `intent(out)` argument. On return if present it +shall have an error code value. + +* If map was successfully initialized then `status` has the value +`success`. + +* If allocation of memory for the `map` arrays fails then `status` +has the value `alloc_fault`. + +* If `slot_bits < 6` or `slots_bits > max_bits` then `status` + has the value of `array_size_error`. + +* If `status` is absent, but `status` would have a value other than +`success`, then processing stops with an informative stop code. + +##### Example + +```fortran + program demo_init + use stdlib_hashmaps, only: chaining_map_type + use stdlib_hashmap_wrappers, only: fnv_1_hasher + type(fnv_1a_type) :: fnv_1 + type(chaining_map_type) :: map + call map % init( fnv_1a, slots_bits=10 ) + end program demo_init +``` + + +#### `loading` - Returns the ratio of entries to slots + +##### Status + +Experimental + +##### Description + +Returns the ratio of the number of entries relative to the number of +slots in a hash map. + +##### Syntax + +`value = [[stdlib_hashmaps:map%loading]]( )` + +##### Class + +Pure function + +##### Argument + +`map` (pass) - shall be an expression of class `chaining_hashmap_type` +or ``open_hashmap_type`. It is an `intent(in)` argument. + +##### Result character + +The result will be a default real. + +##### Result value + +The result will be the ratio of the number of entries relative to the +number of slots in the hash map. + +##### Example + +```fortran + program demo_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 ) + ratio = map % loading () + print *, "Initial loading = ", ratio + end program demo_loading +``` + +#### `map_entry` - inserts an entry into the hash map + +##### Status + +Experimental + +##### Description + +Inserts an entry into the hash map if it is not already present. + +##### Syntax + +`call [[stdlib_hashmaps:map%map_entry]]( key[, other, conflict ] )` + + +##### Class + +Subroutine + +##### Arguments + +`map` (pass): shall be a scalar variable of class +`chaining_hashmap_type` or `open_hashmap_type`. It +is an `intent(inout)` argument. It is the hash map to receive the +entry. + +`key`: shall be a scalar expression of type `key_type`. + It is an `intent(in)` argument. It is the key for the entry to be + placed in the table. + +`other` (optional): shall be a scalar expression of type `other_type`. + It is an `intent(in)` argument. If present it is the other data to be + associated with the `key`. + +`conflict` (optional): shall be a scalar variable of type +`logical`. It is an `intent(in)` argument. If present, a `.true.` +value indicates that an entry with the value of `key` already exists +and the entry was not entered into the map, a `.false` value indicates +that `key` was not present in the map and the entry was added to the +table. + +* If `key` is already present in `map` then the presence of `other` +is ignored. + +##### Example + +```fortran + program demo_map_entry + use, intrinsic:: iso_fortran_env, only: int8 + use stdlib_hashmaps, only: chaining_hashmap_type + use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type + type(chaining_hashmap_type) :: map + type(key_type) :: key + logical :: conflict + type(other_type) :: other + class(*), allocatable :: dummy + allocate( dummy, source=4 ) + call map % init( fnv_1_hasher, slots_bits=10 ) + call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) + call set( other, dummy ) + call map % map_entry( key, other, conflict ) + print *, 'CONFLICT = ', conflict + end program demo_map_entry +``` + +#### `map_probes` - returns the number of hash map probes + +##### Status + +Experimental + +##### Description + +Returns the total number of table probes on a hash map + +##### Syntax + +`Result = [[stdlib_hashmap:map%map_probes]]( )` + +##### Class + +Pure function + +##### Argument + +`map` (pass): shall be a scalar expression of class +`hashmap_type`. It is an `intent(in)` +argument. It is the hash map of interest. + +##### Result character + +The result is a scalar integer of kind `int_probes`. + +##### Result value + +The result is the number of probes of `map` since initialization or +rehashing. + +##### Example + +```fortran + program demo_probes + use stdlib_hashmaps, only: chaining_hashmap_type, int_index + use stdlib_hashmap_wrappers: fnv_1_hasher + implicit none + type(chaining_hashmap_type) :: map + real :: nprobes + call map % init( fnv_1_hasher ) + nprobes = map % probes() + print *, "Initial probes = ", nprobes + end program demo_probes +``` + +#### `num_slots` - returns the number of hash map probes + +##### Status + +Experimental + +##### Description + +Returns the total number of slots on a hash map + +##### Syntax + +`Result = [[stdlib_hashmaps:map%num_slots]]( )` + +##### Class + +Pure function + +##### Argument + +`map`: shall be a scalar expression of class +`hashmap_type`. It is an `intent(in)` argument. It is the +hash map of interest. + +##### Result character + +The result is a scalar integer of kind `int_index`. + +##### Result value + +The result is the number of slots in `map`. + +##### Example + +```fortran + program demo_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 ) + initial_slots = map % num_slots () + print *, "Initial slots = ", initial_slots + end program num_slots +``` + + +#### rehash - changes the hashing function + +##### Status + +Experimental + +##### Description + +Changes the hashing function for the table entries to that of `hasher`. + +##### Syntax + +`call [[stdlib_hashmaps:map%rehash]]( hasher )` + +##### Class + +Subroutine + +##### Arguments + +`map` (pass): shall be a scalar variable of class +`chaining_hashmap_type` oe `open_hashmap_type`. +It is an `intent(inout)` argument. It is the hash map whose hashing +method is to be changed. + +`hasher`: shall be a function of interface `hasher_fun`. +It is the hash method to be used by `map`. + +##### Example + +```fortran + program demo_rehash + use stdlib_hashmaps, only: open_hashmap_type + use stdlib_hasmap_wrappers, only: fnv_1_hasher, fnv_1a_hasher,& + key_type, other_type + type(openn_hashmap_type) :: map + type(key_type) :: key + type(other_type) :: other + class(*), allocatable :: dummy + allocate( dummy, source='a dummy value' ) + call map % init( fnv_1_hasher, slots_bits=10 ) + call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) + call set( other, dummy ) + call map % map_entry( key, other ) + call map % rehash( fnv_1a_hasher ) + end program demo_rehash +``` + +#### `remove_entry` - removes an entry from the hash map + +##### Status + +Experimental + +##### Description + +Removes an entry from a hash map, `map`. + +##### Syntax + +`call [[stdlib_hashmaps:map%remove_entry]]( key[, existed ])` + +##### Class + +Subroutine + +##### Arguments + +`map` (pass): shall be a scalar variable of class +`chaining_hashmap_type` or `open_hashmap_type`. +It is an `intent(inout)` argument. It is the hash map with the element +to be removed. + +`key`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. It is the `key` identifying the entry +to be removed. + +`existed` (optional): shall be a scalar variable of type default +logical. It is an `intent(out)` argument. If present with the value +`true` the entry existed +in the map before removal, if false the entry was not present to be +removed. + +##### Example + +```fortran + program demo_remove_entry + use stdlib_hashmaps, only: open_hashmap_type, int_index + use stdlib_hashmap_wrappers, only: fnv_1_hasher, & + fnv_1a_hasher, key_type, other_type + type(open_hashmap_type) :: map + type(key_type) :: key + type(other_type) :: other + logical :: existed + class(*), allocatable :: dummy + allocate( dummy, source=4.0 ) + call map % init( fnv_1_hasher, slots_bits=10 ) + call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) + call set( other, dummy ) + call map % map_entry( key, other ) + call map % remove_entry( key, existed ) + print *, "Removed key existed = ", existed + end program demo_remove_entry +``` + +#### `set_other_data` - replaces the other dataa for an entry + +##### Status + +Experimental + +##### Description + +Replaces the other data for the entry with the key value, `key`. + +##### Syntax + +`call [[stdlib_hashmaps:map%set_other_data]]( key, other[, exists] )` + +##### Class + +Subroutine + +##### Arguments + +`map` (pass): shall be a scalar variable of class +`chaining_hashmap_type` or `open_hashmap_type`. It +is an `intent(inout)` argument. It will be a hash map used to store +and access the entry's data. + +`key`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. It is the `key` to the entry whose +`other` data is to be replaced. + +`other`: shall be a scalar expression of type `other_type`. +It is an `intent(in)` argument. It is the data to be stored as +the other data for the entry with the key value, `key`. + +`exists` (optional): shall be a scalar variable of type default +logical. It is an `intent(out)` argument. If present with the value +`.true.` an entry with that key existed in the map and its `other` +data was replaced, otherwise if `exists` is `.false.` the entry didnot +exisst and nothing was done. + + +##### Example + +```fortran + program demo_set_other_data + use stdlib_hashmaps, only: open_hashmap_type + use stdlib_hashmap_wrappers, only: fnv_1_hasher, & + fnv_1a_hasher, key_type, other_type, set + type(open_hashmap_type) :: map + type(key_type) :: key + type(other_type) :: other + class(*), allocatable :: dummy + call map % init( fnv_1_hasher, slots_bits=10 ) + allocate( dummy, source='A value` ) + call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) + Call set( other, dummy ) + call map % map_entry( key, other ) + deallocate( dummy ) + allocate( dummy, source='Another value` ) + call set( other, dummy ) + call map % set_other_data( key, other, exists ) + print *, 'The entry to have its other data replaced exists = ', exists + end program demo_set_other_data +``` + +#### `slots_bits` - returns the number of bits used to address the hash map slots + +##### Status + +Experimental + +##### Description + +Returns the total number of slots on a hash map + +##### Syntax + +`Result = [[stdlib_hashmaps:map%slots_bits]]( )` + +##### Class + +Pure function + +##### Argument + +`map` (pass): shall be a scalar expression of class +`hashmap_type`. It is an `intent(in)` argument. It is the +hash map of interest. + +##### Result character + +The result is a scalar integer of kind `int_index`. + +##### Result value + +The result is the number of bits used in addressing the slots in `map`. + +##### Example + +```fortran + program demo_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 ) + bits = map % slots_bits () + print *, "Initial slot bits = ", bits + end program demo_slots_bits +``` + + +#### `total_depth` - returns the total depth of the hash map entries + +##### Status + +Experimental + +##### Description + +Returns the total number of one's based offsets of slot entries from +their slot index for a hash map + +##### Syntax + +`Result = [[stdlib_hashmaps:map%total_depth]]( )` + +##### Class + +Pure function + +##### Argument + +`map` (pass): shall be a scalar expression of class +`chaining_hashmap_type`. It is an `intent(in)` argument. It is the +hash map of interest. + +##### Result character + +The result is a scalar integer of kind `int_depth`. + +##### Result value + +The result is the total number of one's based offsets of slot entries +from their slot index the map. + +##### Example + +```fortran + program demo_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 ) + initial_depth = map % total_depth () + print *, "Initial total depth = ", initial_depth + end program demo_total_depth +``` + + +#### `valid_key` - indicates whether `key` is present + +##### Status + +Experimental + +##### Description + +Returns a logical flag indicating whether `key` exists for an entry in +the map. + +##### Syntax + +`result = [[stdlib_hashmaps:map % valid_index]]( key )` + +##### Class + +Pure function. + +##### Arguments + +`map` (pass): shall be a scalar expression of class +`chaining_hashmap_type` or `open_hashmap_type`. +It is an `intent(in)` argument. It is the hash map whose entries are +examined. + +`key`: shall be a scalar expression a of type `key_type`. It +is an `intent(in)` argument. It is a `key` whose presence in the `map` +is being examined. + +##### Result character + +The result is a default logical scalar. + +##### Result value + +The result is `.true.` if `key` is present in `map` and `.false.` +otherwise. + +##### Example + +```fortran + program demo_valid_key + use stdlib_kinds, only: int8 + use stdlib_hashmaps, only: chaining_hashmap_type + use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type + implicit none + type(chaining_hashmap_type) :: map + type(key_type) :: key + logocal :: valid + call map % init( fnv_1_hasher ) + call set_key(key, [0_int8, 1_int8] ) + valid = map % valid_key ( key ) + print *, "Initial key of 10 valid for empty map = ", valid + end program demo_valid_index +``` From 9c7c0cf1dce63ad4ee77c3d70299a506f22ef121 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 10 Jan 2022 12:33:25 -0700 Subject: [PATCH 22/77] Fixed misspelling Changed intermitent to intermittent [ticket: X] --- doc/specs/stdlib_hash_maps.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index ac1493da4..4ce022609 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -350,7 +350,7 @@ The result is a hash code created using the FNV-1 algorithm. Glenn Fowler, Landon Curt Noll, and Phong Vo. This code is relatively fast on short keys, and is small enough that it will often be retained in the instruction cache if hashing is -intermitent. +intermittent. As a result it should give good performance for typical hash map applications. This code does not pass any of the SMHasher tests, but the resulting @@ -414,7 +414,7 @@ The result is a hash code created using the FNV-1a algorithm. of Glenn Fowler, Landon Curt Noll, and Phong Vo. This code is relatively fast on short keys, and is small enough that it will often be retained in the instruction cache if hashing is -intermitent. +intermittent. As a result it should give good performance for typical hash map applications. This code does not pass any of the SMHasher tests, but the resulting From b30b2575d583d3d246a452091585ca3b7bc19ccc Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 10 Jan 2022 12:34:26 -0700 Subject: [PATCH 23/77] Fixed misspelling Changed intermitent to intermittent. [ticket: X] --- doc/specs/stdlib_hashmaps.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index c5a8264be..f0fe2ff04 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -350,7 +350,7 @@ The result is a hash code created using the FNV-1 algorithm. Glenn Fowler, Landon Curt Noll, and Phong Vo. This code is relatively fast on short keys, and is small enough that it will often be retained in the instruction cache if hashing is -intermitent. +intermittent. As a result it should give good performance for typical hash map applications. This code does not pass any of the SMHasher tests, but the resulting @@ -414,7 +414,7 @@ The result is a hash code created using the FNV-1a algorithm. of Glenn Fowler, Landon Curt Noll, and Phong Vo. This code is relatively fast on short keys, and is small enough that it will often be retained in the instruction cache if hashing is -intermitent. +intermittent. As a result it should give good performance for typical hash map applications. This code does not pass any of the SMHasher tests, but the resulting From 21886cdc94475124429ab2536f5822277fdd0c0c Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Tue, 11 Jan 2022 17:43:39 -0700 Subject: [PATCH 24/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index f0fe2ff04..8e13c2013 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -231,13 +231,9 @@ is an `intent(out)` argument. copy_key, operator(==)equal_keys, key_type use iso_fortran_env, only: int8 implicit none - integer(int8), allocatable :: value(:) + integer(int8) :: i, value(15) type(key_type) :: key_in, key_out - integer(int_8) :: i - allocate( value(1:15) ) - do i=1, 15 - value(i) = i - end do + value = [(i, i = 1, 15)] call set( key_in, value ) call copy_key( key_in, key_out ) print *, "key_in == key_out = ", key_in == key_out From 48ba15891edbcd5ec79325a84e424c625ff9ddc9 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Tue, 11 Jan 2022 17:44:05 -0700 Subject: [PATCH 25/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 8e13c2013..c979b12c3 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -276,11 +276,11 @@ is an `intent(out)` argument. implicit none type(other_type) :: other_in, other_out integer(int_8) :: i - class(*), allocatable :: dummy - type dummy_type + class(*), allocatable :: dummy + type dummy_type integer(int8) :: value(15) end type - type(dummy_type) :: dummy_val + type(dummy_type) :: dummy_val do i=1, 15 dummy_val % value1(i) = i end do From 171029e6eadb118acc916f959b8a9de9400e7b84 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Tue, 11 Jan 2022 17:44:46 -0700 Subject: [PATCH 26/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index c979b12c3..ffdc8aae2 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -468,13 +468,9 @@ is an `intent(out)` argument. copy_key, free_key, key_type, set use iso_fortran_env, only: int8 implicit none - integer(int8), allocatable :: value(:) + integer(int8) :: i, value(15) type(key_type) :: key_in, key_out - integer(int_8) :: i - allocate( value(1:15) ) - do i=1, 15 - value(i) = i - end do + value = [(i, i=1, 15)] call set( key_in, value ) call copy_key( key_in, key_out ) call free_key( key_out ) From 106cefd166bf5c608abfc1076e87d83778c07ee9 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Tue, 11 Jan 2022 17:55:59 -0700 Subject: [PATCH 27/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index ffdc8aae2..c8ac340a8 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -913,7 +913,7 @@ is an `intent(out)` argument. `other`: shall be a scalar variable of type `other_type`. It is an `intent(out)` argument. -`value`: if the first argument is `key` `vaalue` shall be a default +`value`: if the first argument is `key` `value` shall be a default character string expression, or a vector expression of type integer and kind `int8`, while for a first argument of type `other` `value` shall be of type `class(*)`. It is an `intent(in)` argument. From 5f003d75ac306631ca9151c0276879f3e0fbf79b Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Tue, 11 Jan 2022 17:56:55 -0700 Subject: [PATCH 28/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index c8ac340a8..850cde4b0 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -947,7 +947,7 @@ associated procedures and constants that implement two simple hash map types using separate chaining hashing and open addressing hashing. The derived type `hashmap_type` is the parent type to its two extensions: `chaining_hashmap_type` and `open_hashmap_type`. -`chaining_hashmap_type`. The extension types provide +The extension types provide procedures to manipulate the structure of a hash map object: `init`, `map_entry`, `rehash`, `remove_entry`, and `set_other_data`. They also provide procedures to inquire about From a950ef59717629d6fb943083de8059ea864f2ace Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Tue, 11 Jan 2022 17:58:54 -0700 Subject: [PATCH 29/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 850cde4b0..832b35148 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1002,7 +1002,7 @@ entities of kind `int_probes`. Currently `int_probes` has the value of The constant `load_factor` is only used by the `open_hashmap_type`. It specifies the maximum fraction of the available slots that may be -filled before expansion occurs. The current `load_factor = ).5625` so +filled before expansion occurs. The current `load_factor = 0.5625` so the current implementation of `open_hashmap_type` can only hold a little more than `2**29` entries. From e6b8f54556db653d66102ee78bace36f3a206e6f Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Tue, 11 Jan 2022 17:59:42 -0700 Subject: [PATCH 30/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 832b35148..df1699a10 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1026,7 +1026,7 @@ the implementation of the `chaining_hashmap_type` public type. The four private derived types, `open_map_entry_type`, `open_map_entry_list`, `open_map_entry_ptr`, and `open_map_entry_pool` are used in the implementation of the `open_hashmap_type` public -type:. Each of these types are described below. +type. Each of these types are described below. #### The `hashmap_type` abstract type From 8f944825129fdaeffb883e931672a39311898547 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Tue, 11 Jan 2022 18:00:48 -0700 Subject: [PATCH 31/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index df1699a10..d00eddbcb 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1450,11 +1450,12 @@ Subroutine `intent(out)` argument. If `true` an entry with the given `key` exists in the map, if false `other` is undefined. -* The following is an example of the retrieval of other data +##### Example + + The following is an example of the retrieval of other data associated with a `key`: -##### Example ```Fortran program demo_get_other_data From b17830d631f6b85e17dce457fcf941f7dc004c63 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Tue, 11 Jan 2022 18:01:25 -0700 Subject: [PATCH 32/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index d00eddbcb..a6954f9d6 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1477,7 +1477,7 @@ exists in the map, if false `other` is undefined. call map % init( fnv_1_hasher ) call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) call set( other, data ) - call map % map_entry( key, other. conflict ) + call map % map_entry( key, other, conflict ) if ( .not. conflict ) then call map % get_other_data( key, other ) else From e622c4f10f2be7c5b234ccd84088162679cf4999 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Tue, 11 Jan 2022 18:01:52 -0700 Subject: [PATCH 33/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index a6954f9d6..75eca9749 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1585,7 +1585,7 @@ Pure function ##### Argument `map` (pass) - shall be an expression of class `chaining_hashmap_type` -or ``open_hashmap_type`. It is an `intent(in)` argument. +or `open_hashmap_type`. It is an `intent(in)` argument. ##### Result character From d7b90c95077a3896540c877deb4fc08f6100384e Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Tue, 11 Jan 2022 18:02:19 -0700 Subject: [PATCH 34/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 75eca9749..c2b6d66e8 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1481,7 +1481,7 @@ exists in the map, if false `other` is undefined. if ( .not. conflict ) then call map % get_other_data( key, other ) else - stop 'Key is already present in the map.'' + stop 'Key is already present in the map.' end if call get( other, data ) select type( data ) From d4c74878b086b3481a833cd7b704fd60d8e2ef51 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Tue, 11 Jan 2022 18:02:59 -0700 Subject: [PATCH 35/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index c2b6d66e8..5b5e7b602 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1506,7 +1506,7 @@ Initializes a `chaining_hashmap_type` object. ##### Syntax -`call [[stdlib_hashmaps:map%init]]( hasher [, slots_bits, status ] ] )` +`call [[stdlib_hashmaps:map%init]]( hasher [, slots_bits, status ] )` ####@# Class From 983a077662375d9574110d41ba79a6e2fdd840d7 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Tue, 11 Jan 2022 18:03:45 -0700 Subject: [PATCH 36/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 5b5e7b602..49b9bcc95 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1852,7 +1852,7 @@ to be removed. `existed` (optional): shall be a scalar variable of type default logical. It is an `intent(out)` argument. If present with the value `true` the entry existed -in the map before removal, if false the entry was not present to be +in the map before removal, if `false` the entry was not present to be removed. ##### Example From cf89d00ab714147b754fbd01abc56067bf178f24 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Tue, 11 Jan 2022 18:04:25 -0700 Subject: [PATCH 37/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 49b9bcc95..c33f1a378 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -2011,7 +2011,7 @@ Pure function ##### Argument `map` (pass): shall be a scalar expression of class -`chaining_hashmap_type`. It is an `intent(in)` argument. It is the +`hashmap_type`. It is an `intent(in)` argument. It is the hash map of interest. ##### Result character From cb5a6df687af6cde21642cc976017dff87c522b0 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Tue, 11 Jan 2022 18:07:08 -0700 Subject: [PATCH 38/77] Changed (TOC) to [TOC] Changed (TOC) to [TOC] [ticket: X] --- doc/specs/stdlib_hashmaps.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index f0fe2ff04..1adde156f 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -4,7 +4,7 @@ title: Hash maps # The `stdlib_hashmap_wrappers`, `stdlib_hashmap_chaining` and `stdlib_hashmap_open` modules -(TOC) +[TOC] ## Overview of hash maps @@ -113,7 +113,8 @@ keys and their associated data. The constant `int_hash` is used to define the integer kind value for the returned hash codes and variables used to access them. It -currently has the value, `int32`. +currently is importedxd from `stdlib_hash_32bit` where it haas the +value, `int32`. ### The `stdlib_hashmap_wrappers`' module's derived types From 2782d3c2c8597b42b3ef4622a050b1a1c55c0d8d Mon Sep 17 00:00:00 2001 From: William Clodius Date: Tue, 11 Jan 2022 19:13:27 -0700 Subject: [PATCH 39/77] Fixed typos Changed the title to Changed various spellings of the Fortran logical values to `.true.` and `.false.`. [ticket: X] --- doc/specs/stdlib_hashmaps.md | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 9903d6dec..67108fa84 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -2,7 +2,7 @@ title: Hash maps --- -# The `stdlib_hashmap_wrappers`, `stdlib_hashmap_chaining` and `stdlib_hashmap_open` modules +# The `stdlib_hashmap_wrappers`, and `stdlib_hashmaps` modules [TOC] @@ -277,7 +277,7 @@ is an `intent(out)` argument. implicit none type(other_type) :: other_in, other_out integer(int_8) :: i - class(*), allocatable :: dummy + class(*), allocatable :: dummy type dummy_type integer(int8) :: value(15) end type @@ -674,7 +674,7 @@ The result is a value of type default `logical`. ##### Result value -The result is `.true.` if the keys are equal, otherwise `.falss`. +The result is `.true.` if the keys are equal, otherwise `.falss.`. ##### Example @@ -1448,8 +1448,8 @@ Subroutine with the `key`. `exists` (optional): shall be a variable of type logical. It is an -`intent(out)` argument. If `true` an entry with the given `key` -exists in the map, if false `other` is undefined. +`intent(out)` argument. If `.true.` an entry with the given `key` +exists in the map, if `.false.` `other` is undefined. ##### Example @@ -1649,7 +1649,7 @@ entry. `conflict` (optional): shall be a scalar variable of type `logical`. It is an `intent(in)` argument. If present, a `.true.` value indicates that an entry with the value of `key` already exists -and the entry was not entered into the map, a `.false` value indicates +and the entry was not entered into the map, a `.false.` value indicates that `key` was not present in the map and the entry was added to the table. @@ -1852,8 +1852,8 @@ to be removed. `existed` (optional): shall be a scalar variable of type default logical. It is an `intent(out)` argument. If present with the value -`true` the entry existed -in the map before removal, if `false` the entry was not present to be +`.true.` the entry existed +in the map before removal, if `.false.` the entry was not present to be removed. ##### Example From 396b6f6d3b6b6616669617be09979ce3937f5151 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Tue, 11 Jan 2022 20:24:30 -0700 Subject: [PATCH 40/77] Various changes The changes include: Consistently change valid_index to valid_key Removed references to unmap and in_map Changed name( map ...) to map % name(...) Changed deferredxd to deferred [ticket: X] --- doc/specs/stdlib_hashmaps.md | 69 +++++++++++++++++------------------- 1 file changed, 32 insertions(+), 37 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 67108fa84..4160ecb32 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -113,7 +113,7 @@ keys and their associated data. The constant `int_hash` is used to define the integer kind value for the returned hash codes and variables used to access them. It -currently is importedxd from `stdlib_hash_32bit` where it haas the +currently is imported from `stdlib_hash_32bit` where it haas the value, `int32`. ### The `stdlib_hashmap_wrappers`' module's derived types @@ -580,7 +580,7 @@ an allocatable of `class(*)`. It is an `intent(out)` argument. end do call set( key, value ) call get( key, result ) - print *, `RESULT == VALUE = ', all( value == result ) + print *, `RESULT == VALUE = ', all( value == result ) end program demo_get ``` @@ -683,11 +683,9 @@ The result is `.true.` if the keys are equal, otherwise `.falss.`. use stdlib_hashmap_wrappers, only: & copy_key, operator(==), key_type, set use iso_fortran_env, only: int8 - implicit none - integer(int8), allocatable :: value(:) + implicit none + integer(int8) :: i, value(15) type(key_type) :: key_in, key_out - integer(int_8) :: i - allocate( value(1:15) ) do i=1, 15 value(i) = i end do @@ -952,8 +950,8 @@ The extension types provide procedures to manipulate the structure of a hash map object: `init`, `map_entry`, `rehash`, `remove_entry`, and `set_other_data`. They also provide procedures to inquire about -entries in the hash map: `get_other_data`, `in_map`, `unmap` and -`valid_index`. Finally they provide procedures to inquire about the +entries in the hash map: `get_other_data`, `in_map`, and +`valid_key`. Finally they provide procedures to inquire about the overall structure and performance of the hash map object:`calls`, `entries`, `get_other_data`, `loading`, `slots`, and `total_depth`. The module also defines a number of public constants: @@ -1076,7 +1074,6 @@ The type's definition is below: integer(int_calls) :: total_probes = 0 integer(int_index) :: num_entries = 0 integer(int_index) :: num_free = 0 - integer(int_index) :: index_mask = 2_int_index**default_bits-1 integer(int32) :: nbits = default_bits procedure(hasher_fun), pointer, nopass :: hasher => fnv_1_hasher contains @@ -1093,7 +1090,7 @@ The type's definition is below: procedure(remove_entry), deferred, pass(map) :: remove procedure(set_other), deferred, pass(map) :: set_other_data procedure(total_depth), deferred, pass(map) :: total_depth - procedure(valid_index), deferred, pass(map) :: valid_key + procedure(valid_key), deferred, pass(map) :: valid_key end type hashmap_type ``` @@ -1183,9 +1180,8 @@ as follows: procedure :: remove => remove_chaining_entry procedure :: set_other_data => set_other_chaining_data procedure :: total_depth => total_chaining_depth - procedure :: unmap => unmap_chain - procedure :: valid_index => valid_chaining_index - final :: free_chaining_map + procedure :: valid_key => valid_chaining_key + final :: free_chaining_map end type chaining_hashmap_type ``` @@ -1199,10 +1195,10 @@ the inverse table. The type's definition is below: ```fortran type :: open_map_entry_type ! Open hash map entry type private - integer(int_hash) :: hash_val ! Full hash value - type(key_type) :: key ! The entry's key - type(other_type) :: other ! Other entry data - integer(int_index) :: index ! Index into inverse table + integer(int_hash) :: hash_val ! Full hash value + type(key_type) :: key ! The entry's key + type(other_type) :: other ! Other entry data + integer(int_index) :: index ! Index into inverse table end type open_map_entry_type ``` @@ -1216,7 +1212,7 @@ containing the elements of the table. The type's definition is below: ```fortran type open_map_entry_ptr ! Wrapper for a pointer to a open - ! map entry type object + ! map entry type object type(open_map_entry_type), pointer :: target => null() end type open_map_entry_ptr ``` @@ -1243,9 +1239,9 @@ as follows: private integer(int_index) :: index_mask = 2_int_index**default_bits-1 type(open_map_entry_pool), pointer :: cache => null() - integer(int_index), allocatable :: slots(:) - type(open_map_entry_ptr), allocatable :: inverse(:) - type(open_map_entry_list), pointer :: free_list => null() + type(open_map_entry_list), pointer :: free_list => null() + type(open_map_entry_ptr), allocatable :: inverse(:) + integer(int_index), allocatable :: slots(:) contains procedure :: get_other_data => get_other_open_data procedure :: in_map => in_open_map @@ -1256,8 +1252,7 @@ as follows: procedure :: remove => remove_open_entry procedure :: set_other_data => set_other_open_data procedure :: total_depth => total_open_depth - procedure :: unmap => unmap_open - procedure :: valid_index => valid_open_index + procedure :: valid_key => valid_open_key final :: free_open_map end type open_hashmap_type ``` @@ -1273,49 +1268,49 @@ are listed below. Procedure to initialize a chaining hash map: -* `init( map, 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: -* `rehash( map, hasher )` - Routine to change the hash function +* `map % rehash( hasher )` - Routine to change the hash function for a map. Procedures to modify the content of a map: -* `map_entry( map, key, other, conflict )` - Inserts an entry into the +* `map % map_entry( key, other, conflict )` - Inserts an entry into the hash map. -* `remove_entry(map, key, existed )` - Remove the entry, if any, +* `map % remove_entry( key, existed )` - Remove the entry, if any, associated with the `key`. -* `set_other_data( map, key, other, exists )` - Change the other data +* `map % set_other_data( key, other, exists )` - Change the other data associated with the entry. Procedures to report the content of a map: -* `get_other_data( map, key, other, exists )` - Returns the other data +* `map 5 get_other_data( key, other, exists )` - Returns the other data associated with the `key`; -* `valid_key(map, key)` - Returns a flag indicating whether the `key` +* `map % valid_key( key)` - Returns a flag indicating whether the `key` is present in the map. Procedures to report on the structure of the map: -* `calls( map )` - the number of subroutine calls on the hash map. +* `map % calls()` - the number of subroutine calls on the hash map. -* `entries( map )`- the number of entries in a hash map. +* `map % entries()`- the number of entries in a hash map. -* `loading( map )` - the number of entries relative to the number of +* `map % loading()` - the number of entries relative to the number of slots in a hash map. -* `map_probes( map )` - the total number of table probes on a hash +* `map % map_probes()` - the total number of table probes on a hash map. -* `slots( map )` - Returns the number of allocated slots in a hash +* `map % slots()` - Returns the number of allocated slots in a hash map. -* `total_depth( map )` - Returns the total number of one's based +* `map % total_depth()` - Returns the total number of one's based offsets of slot entries from their slot index @@ -2053,7 +2048,7 @@ the map. ##### Syntax -`result = [[stdlib_hashmaps:map % valid_index]]( key )` +`result = [[stdlib_hashmaps:map % valid_key]]( key )` ##### Class From fdd7c92bb75cf3aaabc37679ad8013215cd61a61 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Sun, 16 Jan 2022 08:12:03 -0700 Subject: [PATCH 41/77] Fixed typos Change "cannot" and "exisst" to "can not" and "exist" respectively. [ticket: X] --- doc/specs/stdlib_hashmaps.md | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 4160ecb32..5d8d6f0fc 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -950,7 +950,7 @@ The extension types provide procedures to manipulate the structure of a hash map object: `init`, `map_entry`, `rehash`, `remove_entry`, and `set_other_data`. They also provide procedures to inquire about -entries in the hash map: `get_other_data`, `in_map`, and +entries in the hash map: `get_other_data`, and `valid_key`. Finally they provide procedures to inquire about the overall structure and performance of the hash map object:`calls`, `entries`, `get_other_data`, `loading`, `slots`, and @@ -1172,7 +1172,6 @@ as follows: type(chaining_map_entry_ptr), allocatable :: slots(:) contains procedure :: get_other_data => get_other_chaining_data - procedure :: in_map => in_chain_map procedure :: init => init_chaining_map procedure :: loading => chaining_loading procedure :: map_entry => map_chain_entry @@ -1244,7 +1243,6 @@ as follows: integer(int_index), allocatable :: slots(:) contains procedure :: get_other_data => get_other_open_data - procedure :: in_map => in_open_map procedure :: init => init_open_map procedure :: loading => open_loading procedure :: map_entry => map_open_entry @@ -1375,7 +1373,7 @@ Returns the number of entries in a hash map. ##### Syntax -`value = [[stdlib_hashmaps:map%entries]]()` +`value = [[stdlib_hashmaps:map % entries]]()` ##### Class @@ -1422,7 +1420,7 @@ Returns the other data associated with the `key`, ##### Syntax -`value = [[stdlib_hashmaps:map%get_other_data)]]( key, other [, exists] )` +`value = [[stdlib_hashmaps:map % get_other_data)]]( key, other [, exists] )` ##### Class @@ -1452,7 +1450,6 @@ exists in the map, if `.false.` `other` is undefined. associated with a `key`: - ```Fortran program demo_get_other_data use, intrinsic:: iso_fortran_env, only: & @@ -1909,8 +1906,8 @@ the other data for the entry with the key value, `key`. `exists` (optional): shall be a scalar variable of type default logical. It is an `intent(out)` argument. If present with the value `.true.` an entry with that key existed in the map and its `other` -data was replaced, otherwise if `exists` is `.false.` the entry didnot -exisst and nothing was done. +data was replaced, otherwise if `exists` is `.false.` the entry did +not exist and nothing was done. ##### Example From c0fdd913383292fa25517066fe288ce97fd938d7 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 17 Jan 2022 08:59:36 -0700 Subject: [PATCH 42/77] Improved descriptions KImproved the descriptionsof procedures and their arguments in a number of ways 1. Replaced 'a' with 'the' at a number of locations 2. Replaced 'chaining_hash_map_type with 'hash_map_type' at one location. 3. Replaced 'probes' with 'slots' int the description of 'num_slots. [ticket: X] --- doc/specs/stdlib_hashmaps.md | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 5d8d6f0fc..3899c0126 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1314,7 +1314,7 @@ offsets of slot entries from their slot index ### Specifications of the `stdlib_hashmaps` procedures -#### `calls` - Returns the number of calls on a hash map +#### `calls` - Returns the number of calls on the hash map ##### Status @@ -1361,7 +1361,7 @@ The result will be the number of procedure calls on the hash map. ``` -#### `entries` - Returns the number of entries in a hash map +#### `entries` - Returns the number of entries in the hash map ##### Status @@ -1442,7 +1442,8 @@ Subroutine `exists` (optional): shall be a variable of type logical. It is an `intent(out)` argument. If `.true.` an entry with the given `key` -exists in the map, if `.false.` `other` is undefined. +exists in the map and `other` is defined. If `.false.` `other` is +undefined. ##### Example @@ -1495,7 +1496,7 @@ Experimental ##### Description -Initializes a `chaining_hashmap_type` object. +Initializes a `hashmap_type` object. ##### Syntax @@ -1565,7 +1566,7 @@ Experimental ##### Description Returns the ratio of the number of entries relative to the number of -slots in a hash map. +slots in the hash map. ##### Syntax @@ -1643,7 +1644,7 @@ entry. value indicates that an entry with the value of `key` already exists and the entry was not entered into the map, a `.false.` value indicates that `key` was not present in the map and the entry was added to the -table. +map. * If `key` is already present in `map` then the presence of `other` is ignored. @@ -1677,7 +1678,7 @@ Experimental ##### Description -Returns the total number of table probes on a hash map +Returns the total number of table probes on the hash map. ##### Syntax @@ -1717,7 +1718,7 @@ rehashing. end program demo_probes ``` -#### `num_slots` - returns the number of hash map probes +#### `num_slots` - returns the number of hash map slots. ##### Status @@ -1773,7 +1774,7 @@ Experimental ##### Description -Changes the hashing function for the table entries to that of `hasher`. +Changes the hashing function for the map entries to that of `hasher`. ##### Syntax @@ -1821,7 +1822,7 @@ Experimental ##### Description -Removes an entry from a hash map, `map`. +Removes an entry from the hash map, `map`. ##### Syntax @@ -1846,7 +1847,7 @@ to be removed. logical. It is an `intent(out)` argument. If present with the value `.true.` the entry existed in the map before removal, if `.false.` the entry was not present to be -removed. +removed and the map is unchanged. ##### Example @@ -1878,7 +1879,8 @@ Experimental ##### Description -Replaces the other data for the entry with the key value, `key`. +Replaces the other data in the map for the entry with the key value, +`key`. ##### Syntax @@ -1905,7 +1907,7 @@ the other data for the entry with the key value, `key`. `exists` (optional): shall be a scalar variable of type default logical. It is an `intent(out)` argument. If present with the value -`.true.` an entry with that key existed in the map and its `other` +`.true.` an entry with that `key` existed in the map and its `other` data was replaced, otherwise if `exists` is `.false.` the entry did not exist and nothing was done. @@ -1942,7 +1944,7 @@ Experimental ##### Description -Returns the total number of slots on a hash map +Returns the total number of bits used to address the hash map slots. ##### Syntax From 472eeef34aa5279cf881c824216810b3b66ffce0 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Tue, 18 Jan 2022 14:05:32 -0700 Subject: [PATCH 43/77] Minor error corrections Fixes errors found while working on stdlib_hashmaps.md. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md index 4ce022609..a0ccf9fa5 100755 --- a/doc/specs/stdlib_hash_maps.md +++ b/doc/specs/stdlib_hash_maps.md @@ -2192,6 +2192,8 @@ index `inmap` in the inverse table. end program demo_unmap ``` +{{TOC}} + #### `valid_index` - indicates whether `inmap` is a valid index ##### Status From f4c8c1c88cc352def3140452eb96f1c205f8fb6e Mon Sep 17 00:00:00 2001 From: William Clodius Date: Sun, 23 Jan 2022 06:40:09 -0700 Subject: [PATCH 44/77] Made spelling of procedure consistent A procedure was being called both 'remove' and 'remove_entry'. I changed all spellings to 'remove'. [ticket: X] --- doc/specs/stdlib_hashmaps.md | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 3899c0126..3c656f5fc 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -948,7 +948,7 @@ derived type `hashmap_type` is the parent type to its two extensions: `chaining_hashmap_type` and `open_hashmap_type`. The extension types provide procedures to manipulate the structure of a hash map object: -`init`, `map_entry`, `rehash`, `remove_entry`, and +`init`, `map_entry`, `rehash`, `remove`, and `set_other_data`. They also provide procedures to inquire about entries in the hash map: `get_other_data`, and `valid_key`. Finally they provide procedures to inquire about the @@ -1279,7 +1279,7 @@ Procedures to modify the content of a map: * `map % map_entry( key, other, conflict )` - Inserts an entry into the hash map. -* `map % remove_entry( key, existed )` - Remove the entry, if any, +* `map % remove( key, existed )` - Remove the entry, if any, associated with the `key`. * `map % set_other_data( key, other, exists )` - Change the other data @@ -1814,7 +1814,7 @@ It is the hash method to be used by `map`. end program demo_rehash ``` -#### `remove_entry` - removes an entry from the hash map +#### `remove` - removes an entry from the hash map ##### Status @@ -1826,7 +1826,7 @@ Removes an entry from the hash map, `map`. ##### Syntax -`call [[stdlib_hashmaps:map%remove_entry]]( key[, existed ])` +`call [[stdlib_hashmaps:map%remove]]( key[, existed ])` ##### Class @@ -1852,7 +1852,7 @@ removed and the map is unchanged. ##### Example ```fortran - program demo_remove_entry + program demo_remove use stdlib_hashmaps, only: open_hashmap_type, int_index use stdlib_hashmap_wrappers, only: fnv_1_hasher, & fnv_1a_hasher, key_type, other_type @@ -1866,9 +1866,9 @@ removed and the map is unchanged. call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) call set( other, dummy ) call map % map_entry( key, other ) - call map % remove_entry( key, existed ) + call map % remove( key, existed ) print *, "Removed key existed = ", existed - end program demo_remove_entry + end program demo_remove ``` #### `set_other_data` - replaces the other dataa for an entry From 5053777316854e0fc6d4195616193d9ad9128e65 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Tue, 25 Jan 2022 13:29:25 -0700 Subject: [PATCH 45/77] Changed the function "valid_key" to the subroutine "key_test" In implementing the API described in "stdlib_hashmaps.md" I discovered that the function "key_test" had to be implemented as a subroutine, and that the map argument to "get_other_data" had to have intent inout and not in. [ticket: X] --- doc/specs/stdlib_hashmaps.md | 140 +++++++++++++++++------------------ 1 file changed, 68 insertions(+), 72 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 3c656f5fc..a1b0d34bb 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -951,7 +951,7 @@ procedures to manipulate the structure of a hash map object: `init`, `map_entry`, `rehash`, `remove`, and `set_other_data`. They also provide procedures to inquire about entries in the hash map: `get_other_data`, and -`valid_key`. Finally they provide procedures to inquire about the +`key_test`. Finally they provide procedures to inquire about the overall structure and performance of the hash map object:`calls`, `entries`, `get_other_data`, `loading`, `slots`, and `total_depth`. The module also defines a number of public constants: @@ -1050,8 +1050,10 @@ It also defines five non-overridable procedures: * `num_slots` - returns the number of slots in the map; and * `slots_bits` - returns the number of bits used to address the slots; and eleven deferred procedures: -* `get_other_data` - gets the other data associated with the key; +* `get_other_data` - gets the other map data associated with the key; * `init` - initializes the hash map; +* `key_test` - returns a logical flag indicating whether the key is + defined in the map. * `loading` - returns the ratio of the number of entries to the number of slots; * `map_entry` - inserts a key and its other associated data into the @@ -1061,8 +1063,6 @@ and eleven deferred procedures: * `set_other_data` - replaces the other data associated with the key; * `total_depth` - returns the number of probes needed to address all the entries in the map; -* `valid_key` - returns a logical flag indicating whether the key is - defined in the map. The type's definition is below: @@ -1084,13 +1084,13 @@ The type's definition is below: procedure, non_overridable, pass(map) :: num_slots procedure(get_other), deferred, pass(map) :: get_other_data procedure(init_map), deferred, pass(map) :: init + procedure(key_test), deferred, pass(map) :: key_test procedure(loading), deferred, pass(map) :: loading procedure(map_entry), deferred, pass(map) :: map_entry procedure(rehash_map), deferred, pass(map) :: rehash procedure(remove_entry), deferred, pass(map) :: remove procedure(set_other), deferred, pass(map) :: set_other_data procedure(total_depth), deferred, pass(map) :: total_depth - procedure(valid_key), deferred, pass(map) :: valid_key end type hashmap_type ``` @@ -1173,13 +1173,13 @@ as follows: contains procedure :: get_other_data => get_other_chaining_data procedure :: init => init_chaining_map + procedure :: key => chaining_key_test procedure :: loading => chaining_loading procedure :: map_entry => map_chain_entry procedure :: rehash => rehash_chaining_map procedure :: remove => remove_chaining_entry procedure :: set_other_data => set_other_chaining_data procedure :: total_depth => total_chaining_depth - procedure :: valid_key => valid_chaining_key final :: free_chaining_map end type chaining_hashmap_type ``` @@ -1244,13 +1244,13 @@ as follows: contains procedure :: get_other_data => get_other_open_data procedure :: init => init_open_map + procedure :: key_test => open_key_test procedure :: loading => open_loading procedure :: map_entry => map_open_entry procedure :: rehash => rehash_open_map procedure :: remove => remove_open_entry procedure :: set_other_data => set_other_open_data procedure :: total_depth => total_open_depth - procedure :: valid_key => valid_open_key final :: free_open_map end type open_hashmap_type ``` @@ -1290,8 +1290,8 @@ Procedures to report the content of a map: * `map 5 get_other_data( key, other, exists )` - Returns the other data associated with the `key`; -* `map % valid_key( key)` - Returns a flag indicating whether the `key` - is present in the map. +* `map % key_test( key, present)` - Returns a flag indicating whether + the `key` is present in the map. Procedures to report on the structure of the map: @@ -1428,9 +1428,9 @@ Subroutine ##### Arguments -`map` (pass): shall be a scalar expression of class +`map` (pass): shall be a scalar variable of class `chaining_hashmap_type` or `open_hashmap_type`. It is an - `intent(in)` argument. It will be + `intent(inout)` argument. It will be the hash map used to store and access the other data. `key`: shall be a scalar expression of type `key_type`. It @@ -1557,6 +1557,60 @@ has the value `alloc_fault`. ``` +#### `key_test` - indicates whether `key` is present + +##### Status + +Experimental + +##### Description + +Returns a logical flag indicating whether `key` is present for an +entry in the map. + +##### Syntax + +`result = call [[stdlib_hashmaps:map % valid_key]]( key, present )` + +##### Class + +Subroutine. + +##### Arguments + +`map` (pass): shall be a scalar variable of class +`chaining_hashmap_type` or `open_hashmap_type`. +It is an `intent(inout)` argument. It is the hash map whose entries +are examined. + +`key`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. It is a `key` whose presence in the `map` +is being examined. + +`present` (optional): shall be a scalar variable of type default +`logical`. It is an intent(out) argument. It is a logical flag where +`.true.` indicates that an entry with that `key` is present in the +`map` and `.false.` indicates that no such entry is present. + +##### Example + +```fortran + program demo_key_test + use stdlib_kinds, only: int8 + use stdlib_hashmaps, only: chaining_hashmap_type + use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type + implicit none + type(chaining_hashmap_type) :: map + type(key_type) :: key + logocal :: present + call map % init( fnv_1_hasher ) + call set_key(key, [0_int8, 1_int8] ) + call map % key_test ( key, present ) + print *, "Initial key of 10 present for empty map = ", present + end program demo_key_test +``` + + #### `loading` - Returns the ratio of entries to slots ##### Status @@ -1845,9 +1899,9 @@ to be removed. `existed` (optional): shall be a scalar variable of type default logical. It is an `intent(out)` argument. If present with the value -`.true.` the entry existed -in the map before removal, if `.false.` the entry was not present to be -removed and the map is unchanged. +`.true.` the entry existed in the map before removal, if `.false.` the +entry was not present to be removed and the map is unchanged. If +absent, the procedure returns with no entry with the given key. ##### Example @@ -2032,61 +2086,3 @@ from their slot index the map. print *, "Initial total depth = ", initial_depth end program demo_total_depth ``` - - -#### `valid_key` - indicates whether `key` is present - -##### Status - -Experimental - -##### Description - -Returns a logical flag indicating whether `key` exists for an entry in -the map. - -##### Syntax - -`result = [[stdlib_hashmaps:map % valid_key]]( key )` - -##### Class - -Pure function. - -##### Arguments - -`map` (pass): shall be a scalar expression of class -`chaining_hashmap_type` or `open_hashmap_type`. -It is an `intent(in)` argument. It is the hash map whose entries are -examined. - -`key`: shall be a scalar expression a of type `key_type`. It -is an `intent(in)` argument. It is a `key` whose presence in the `map` -is being examined. - -##### Result character - -The result is a default logical scalar. - -##### Result value - -The result is `.true.` if `key` is present in `map` and `.false.` -otherwise. - -##### Example - -```fortran - program demo_valid_key - use stdlib_kinds, only: int8 - use stdlib_hashmaps, only: chaining_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type - implicit none - type(chaining_hashmap_type) :: map - type(key_type) :: key - logocal :: valid - call map % init( fnv_1_hasher ) - call set_key(key, [0_int8, 1_int8] ) - valid = map % valid_key ( key ) - print *, "Initial key of 10 valid for empty map = ", valid - end program demo_valid_index -``` From 46ba99e35910a18711f1ac7cc225a735b0703b8e Mon Sep 17 00:00:00 2001 From: William Clodius Date: Sun, 6 Mar 2022 12:49:57 +0100 Subject: [PATCH 46/77] Deleted file Deleted stdlib_hash_maps.md as the inmap maping index in it has been replaced by the key of stdlib_hashmaps.md. [ticket: X] --- doc/specs/stdlib_hash_maps.md | 2251 --------------------------------- 1 file changed, 2251 deletions(-) delete mode 100755 doc/specs/stdlib_hash_maps.md diff --git a/doc/specs/stdlib_hash_maps.md b/doc/specs/stdlib_hash_maps.md deleted file mode 100755 index a0ccf9fa5..000000000 --- a/doc/specs/stdlib_hash_maps.md +++ /dev/null @@ -1,2251 +0,0 @@ ---- -title: Hash maps ---- - -# The `stdlib_hashmap_wrappers`, `stdlib_hashmap_chaining` and `stdlib_hashmap_open` modules - -(TOC) - -## Overview of hash maps - -A hash map (hash table) is a data structure that maps *keys* to -*values*. It uses a hash function to compute a hash code from the *key* -that serves as an index into a linear array of *slots* (buckets) from -which the desired *value* can be extracted. -Each key ideally maps to a unique slot, but most hash functions are -imperfect and can map multiple keys to the same *slot* resulting in -collisions. Hash maps differ in how they deal with such collisions. -This document discusses the hash maps in the Fortran Standard Library. - -## Licensing - -The Fortran Standard Library is distributed under the MIT License. -However components of the library should be evaluated as to whether -they are compatible with the MTI License. -The current hash maps were inspired by an -[implementation](http://chasewoerner.org/src/hasht/) of David -Chase. While the code has been greatly modified from his -implementation, he has give permission for the unrestricted use of -his code. - -## The hash map modules - -The Fortran Standard Library provides two modules for the -implementation of simple hash maps. These maps only accept hash -functions with a single argument, the key, and yield a 32 bit -hash code. The modules will need to be modified if it is desired to -use hash functions with a different API. The two modules are: -`stdlib_hashmap_wrappers`, and `stdlib_hashmaps` corresponding to the -files: `stdlib_hashmap_wrappers.f90`, and `stdlib_hashmaps.f90` - -The module `stdlib_hashmap_wrappers` provides types and procedures for -use by `stdlib_hashmaps`. It provides an -interface to the 32 bit hash functions of the Standard Library module, -`stdlib_hash_32bit`, and provides wrappers to some of the -hash functions so that they no longer need to be supplied seeds. It -also defines two data types used to store information in the hash -maps, the `key_type` and the `other_type`. The `key_type` is used to -define keys that, in turn, are used to identify the data entered into -a hash map. The `other_type` is intended to contain the other data -associated with the key. - -The module `stdlib_hashmaps` defines the API for a parent datatype, -`hashmap_type` and two extensions of that hash map type: -`chaining_hashmap_type` and `open_hashmap_type`. - -The `hashmap_type` defines the Application Programers -Interface (API) for the procedures used by its two extensions. It -explicitly defines five non-overridable procedures. It also defines -the interfaces for eleven deferred procedures. It does not define the -finalization routines for the two extension types, or one routine -provided by the `open_hashmap_type`. - -The `chaining_hashmap_type` uses separate chaining with linked -lists to deal with hash index collisions. In separate chaining the -colliding indices are handled by using linked lists with their roots -at the hash index. The `chaining_hashmap_type` procedures are -implemented in the module `stdlib_hashmap_chaining` corresponding -to the file, `stdlib_hashmap_chaining.f90`. - -The `open_hashmap_type` -uses linear open addressing to deal with hash index collisions. In -linear open addressing the colliding indices are -handled by searching from the initial hash index in increasing -steps of one (modulo the hash map size) for an open map slot. -The `open_hashmap_type` procedures are implemented in the submodule -`stdlib_hashmap_open` corresponding to the file -`stdlib_hashmap_open.f90`. - -The maps use powers of two for their slot sizes, so that the function, -`fibonacci_hash`, can -be used to map the hash codes to indices in the map. This is -expected to be more efficient than prime number mapping using a -modulo operation, and reduces the requirement that the hash -function need to do a good job randomizing its lower order bits. -They do require a good randomizing hash method for good performance. -Both adjust the map size to reduce collisions, based on -the ratio of the number of hash map probes to the number of subroutine -calls. -Wile the maps make extensive use of pointers internally, a private -finalization subroutine avoids memory leaks. -The maps can take entry keys of type `key_type`, and other data of the -type `other_type`. -The maps allow the addition, removal, and lookup of entries, and the -inclusion of data in addition to the entry key. - -## The `stdlib_hashmap_wrappers` module - -The `stdlib_hashmap_wrappers` module provides data types to -represent keys and associated data stored in a module, but is also, a -wrapper for the `stdlib_hash_32bit` module. It allows -direct access to the `stdlib_hash_32bit` procedures: -`fibonacci_hash`, `fnv_1_hasher`, `fnv_1a_hasher`; and provides -wrapper functions, `seeded_nmhash32_hasher`, -`seeded_nmhash32x_hasher`, and `seeded_water_hasher` to the hash -functions: `nmhash32`, `nmhash32x`, and `water_hash`, respectively. It -defines an interface, `hasher_fun`, compatible with the hash functions -that take a `non-scalar key`. It defines one integer constant used -as a kind value,`int_hash`. It also defines two types, `key_type` and -`other_type`, and associated procedures, for storing and manipulating -keys and their associated data. - -### The `stdlib_hashmap_wrappers`'s constant, `int_hash` - -The constant `int_hash` is used to define the integer kind value for -the returned hash codes and variables used to access them. It -currently has the value, `int32`. - -### The `stdlib_hashmap_wrappers`' module's derived types - -The `stdlib_hashmap_wrappers` module defines two derived types: -`key_type`, and `other_type`. The `key_type` is intended to be used -for the search keys of hash tables. The `other_type` is intended to -store additional data associated with a key. Both types are -opaque. Their current representations are as follows - -```fortran - type :: key_type - private - integer(int8), allocatable :: value(:) - end type key_type - - type :: other_type - private - class(*), allocatable :: value - end type other_type -``` - -The module also defines six procedures for those types: `copy_key`, -`copy_other`, `equal_keys`, `free_key`, `free_other`, `get`, and -`set`, and one operator, `==`, -for use by the hash maps to manipulate or inquire of components of -those types. - -### Table of `stdlib_hashmap_wrappers` procedures - -The `stdlib_hashmap_wrappers` module provides procedures in -several categories: procedures to manipulate data of the `key_type`; -procedures to manipulate data of the `other_type`, and 32 bit hash -functions for keys. The procedures in each category are listed -below. It also provides an operator to compare two key type values for -equality. - -Procedures to manipulate `key_type` data: - -* `copy_key( key_in, key_out )` - Copies the contents of the key, - `key_in`, to contents of the key, `key_out`. - -* `get( key, value )` - extracts the contents of `key` into `value`, - an `int8` array or character string. - -* `free_key( key )` - frees the memory in `key`. - -* `set( key, value )` - sets the content of `key` to `value`. - -Procedures to manipulate `other_type` data: - -* `copy_other( other_in, other_out )` - Copies the contents of the - other data, `other_in`, to the contents of the other data, - `other_out`. - -* `get( other, value )` - extracts the contents of `other` into the - class(*) variable `value`. - -* `set( other, value )` - sets the content of `other` to the class(*) - variable `value`. - -* `free_other( other )` - frees the memory in `other`. - -Procedures to hash keys to 32 bit integers: - -* `fnv_1_hasher( key )` - hashes a `key` using the FNV-1 algorithm. - -* `fnv_1a_hasher( key )` - hashes a `key` using the FNV-1a algorithm. - -* `seeded_nmhash32_hasher( key )` - hashes a `key` using the nmhash32 - algorithm. - -* `seeded_nmhash32x_hasher( key )` - hashes a `key` using the nmhash32x - algorithm. - -* `seeded_water_hasher( key )` - hashes a `key` using the waterhash - algorithm. - -Operator to compare two `key_type` values for equality - -* `key1 == key2` - compares `key1' with 'key2' for equality - -### Specifications of the `stdlib_hashmap_wrappers` procedures - -#### `copy_key` - Returns a copy of the key - -##### Status - -Experimental - -##### Description - -Returns a copy of an input of type `key_type`. - -##### Syntax - -`call [[stdlib_hashmap_wrappers:copy_key]]( key_in, key_out )` - -##### Class - -Subroutine. - -##### Arguments - -`key_in`: shall be a scalar expression of type `key_type`. It -is an `intent(in)` argument. - -`key_out`: shall be a scalar variable of type `key_type`. It -is an `intent(out)` argument. - -##### Example - -```fortran - program demo_copy_key - use stdlib_hashmap_wrappers, only: & - copy_key, operator(==)equal_keys, key_type - use iso_fortran_env, only: int8 - implicit none - integer(int8), allocatable :: value(:) - type(key_type) :: key_in, key_out - integer(int_8) :: i - allocate( value(1:15) ) - do i=1, 15 - value(i) = i - end do - call set( key_in, value ) - call copy_key( key_in, key_out ) - print *, "key_in == key_out = ", key_in == key_out - end program demo_copy_key -``` - -#### `copy_other` - Returns a copy of the other data - -##### Status - -Experimental - -##### Description - -Returns a copy of an input of type `other_type`. - -##### Syntax - -`call [[stdlib_hashmap_wrappers:copy_other]]( other_in, other_out )` - -##### Class - -Subroutine. - -##### Arguments - -`other_in`: shall be a scalar expression of type `other_type`. It -is an `intent(in)` argument. - -`other_out`: shall be a scalar variable of type `other_type`. It -is an `intent(out)` argument. - -##### Example - -```fortran - program demo_copy_other - use stdlib_hashmap_wrappers, only: & - copy_other, get, other_type, set - use iso_fortran_env, only: int8 - implicit none - type(other_type) :: other_in, other_out - integer(int_8) :: i - class(*), allocatable :: dummy - type dummy_type - integer(int8) :: value(15) - end type - type(dummy_type) :: dummy_val - do i=1, 15 - dummy_val % value1(i) = i - end do - allocate(other_in % value, source=dummy_val) - call copy_other( other_in, other_out ) - select type(other_out) - type(dummy_type) - print *, "other_in == other_out = ", & - all( dummy_val % value == other_out % value ) - end select - end program demo_copy_other -``` - - -#### `fibonacci_hash` - maps an integer to a smaller number of bits - -##### Status - -Experimental - -##### Description - -`fibonacci_hash` is just a re-export of the function of the same name -implemented in -[`stdlib_hash_32bit`](https://stdlib.fortran-lang.org/page/spec/stdlib_hash_functions.html#fibonacci_hash-maps-an-integer-to-a-smaller-number-of-bits). -It reduces the value of a 32 bit integer to a smaller number of bits. - - -#### `fnv_1_hasher`- calculates a hash code from a key - -##### Status - -Experimental - -##### Description - -Calculates a 32 bit hash code from an input of type `key_type`. - -##### Syntax - -`code = [[stdlib_hashmap_wrappers:fnv_1_hasher]]( key )` - -##### Class - -Pure function - -##### Argument - -`key`: Shall be a scalar expression of type `key_type`. -It is an `intent(in)` argument. - -##### Result character - -The result is a scalar integer of kind `int32`. - -##### Result value - -The result is a hash code created using the FNV-1 algorithm. - -##### Note - -`fnv_1_hasher` is an implementation of the original FNV-1 hash code of -Glenn Fowler, Landon Curt Noll, and Phong Vo. -This code is relatively fast on short keys, and is small enough that -it will often be retained in the instruction cache if hashing is -intermittent. -As a result it should give good performance for typical hash map -applications. -This code does not pass any of the SMHasher tests, but the resulting -degradation in performance due to its larger number of collisions is -expected to be minor compared to its faster hashing rate. - - -##### Example - -```fortran - program demo_fnv_1_hasher - use stdlib_hashmap_wrappers, only: & - fnv_1_hasher, key_type, set - use iso_fortran_env, only: int32 - implicit none - integer(int8), allocatable :: array1(:) - integer(int32) :: hash - type(key_type) :: key - array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] - call set( key, array1 ) - hash = fnv_1_hasher(key) - print *, hash - end program demo_fnv_1_hasher -``` - - -#### `fnv_1a_hasher`- calculates a hash code from a key - -##### Status - -Experimental - -##### Description - -Calculates a 32 bit hash code from an input of type `key_type`. - -##### Syntax - -`code = [[stdlib_hashmap_wrappers:fnv_1a_hasher]]( key )` - -##### Class - -Pure function - -##### Argument - -`key`: Shall be a scalar expression of type `key_type`. -It is an `intent(in)` argument. - -##### Result character - -The result is a scalar integer of kind `int32`. - -##### Result value - -The result is a hash code created using the FNV-1a algorithm. - -##### Note - -`fnv_1a_hasher` is an implementation of the original FNV-1A hash code -of Glenn Fowler, Landon Curt Noll, and Phong Vo. -This code is relatively fast on short keys, and is small enough that -it will often be retained in the instruction cache if hashing is -intermittent. -As a result it should give good performance for typical hash map -applications. -This code does not pass any of the SMHasher tests, but the resulting -degradation in performance due to its larger number of collisions is -expected to be minor compared to its faster hashing rate. - - -##### Example - -```fortran - program demo_fnv_1a_hasher - use stdlib_hashmap_wrappers, only: & - fnv_1a_hasher, key_type, set - use iso_fortran_env, only: int32 - implicit none - integer(int8), allocatable :: array1(:) - integer(int32) :: hash - type(key_type) :: key - array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] - call set( key, array1 ) - hash = fnv_1a_hasher(key) - print *, hash - end program demo_fnv_1a_hasher -``` - -#### `free_key` - frees the memory associated with a key - -##### Status - -Experimental - -##### Description - -Deallocates the memory associated with an variable of type -`key_type`. - -##### Syntax - -`call [[stdlib_hashmap_wrappers:free_key]]( key )` - -##### Class - -Subroutine. - -##### Argument - -`key`: shall be a scalar variable of type `key_type`. It -is an `intent(out)` argument. - -##### Example - -```fortran - program demo_free_key - use stdlib_hashmap_wrappers, only: & - copy_key, free_key, key_type, set - use iso_fortran_env, only: int8 - implicit none - integer(int8), allocatable :: value(:) - type(key_type) :: key_in, key_out - integer(int_8) :: i - allocate( value(1:15) ) - do i=1, 15 - value(i) = i - end do - call set( key_in, value ) - call copy_key( key_in, key_out ) - call free_key( key_out ) - end program demo_free_key -``` - -#### `free_other` - frees the memory associated with other data - -##### Status - -Experimental - -##### Description - -Deallocates the memory associated with an variable of type -`other_type`. - -##### Syntax - -`call [[stdlib_hashmap_wrappers:free_other]]( other )` - -##### Class - -Subroutine. - -##### Argument - -`other`: shall be a scalar variable of type `other_type`. It -is an `intent(out)` argument. - -##### Example - -```fortran - program demo_free_other - use stdlib_hashmap_wrappers, only: & - copy_other, free_other, other_type, set - use iso_fortran_env, only: int8 - implicit none - type dummy_type - integer(int8) :: value(15) - end type dummy_type - typer(dummy_type) :: dummy_val - type(other_type), allocatable :: other_in, other_out - integer(int_8) :: i - do i=1, 15 - dummy_val % value(i) = i - end do - allocate(other_in, source=dummy_val) - call copy_other( other_in, other_out ) - call free_other( other_out ) - end program demo_free_other -``` - - -#### `get` - extracts the data from a derived type - -##### Status - -Experimental - -##### Description - -Extracts the data from a `key_type` or `other_type` and stores it -in the variable `value`. - -##### Syntax - -`call [[stdlib_hashmap_wrappers:get]]( key, value )` - -or - -`call [[stdlib_hashmap_wrappers:get]]( other, value )` - -##### Class - -Subroutine. - -##### Argument - -`key`: shall be a scalar expression of type `key_type`. It -is an `intent(in)` argument. - -`other`: shall be a scalar expression of type `other_type`. It -is an `intent(in)` argument. - -`value`: if the the first argument is of `key_type` `value` shall be -an allocatable default character string variable, or -an allocatable vector variable of type integer and kind `int8`, -otherwise the first argument is of `other_type` and `value` shall be -an allocatable of `class(*)`. It is an `intent(out)` argument. - -##### Example - -```fortran - program demo_get - use stdlib_hashmap_wrappers, only: & - get, key_type, set - use iso_fortran_env, only: int8 - implicit none - integer(int8), allocatable :: value(:), result(:) - type(key_type) :: key - integer(int_8) :: i - allocate( value(1:15) ) - do i=1, 15 - value(i) = i - end do - call set( key, value ) - call get( key, result ) - print *, `RESULT == VALUE = ', all( value == result ) - end program demo_get -``` - - -#### `hasher_fun`- serves aa a function prototype. - -##### Status - -Experimental - -##### Description - -Serves as a prototype for hashing functions with a single, `key`, -argument of type `key_type` returning an `int32` hash value. - -##### Syntax - -`type([[stdlib_hashmap_wrappers:hasher_fun]]), pointer :: fun_pointer` - -##### Class - -Pure function prototype - -##### Argument - -`key`: Shall be a rank one array expression of type `integer(int8)`. -It is an `intent(in)` argument. - -##### Result character - -The result is a scalar integer of kind `int32`. - -##### Result value - -The result is a hash code. - -##### Note - -`hasher_fun` is a prototype for defining dummy arguments and function -pointers intended for use as a hash function for the hash maps. - -##### Example - -```fortran - program demo_hasher_fun - use stdlib_hashmap_wrappers, only: & - fnv_1a_hasher, hasher_fun, set - use iso_fortran_env, only: int8, int32 - implicit none - type(hasher_fun), pointer :: hasher_pointer - integer(int8), allocatable :: array1(:) - integer(int32) :: hash - type(key_type) :: key - hasher_pointer => fnv_1a_hasher - array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] - call set( key, array1 ) - hash = hassher_pointer(key) - print *, hash - end program demo_hasher_fun -``` - -#### `operator(==)` - Compares two keys for equality - -##### Status - -Experimental - -##### Description - -Returns `.true.` if two keys are equal, and `.false.` otherwise. - -##### Syntax - -`test = [stdlib_hashmap_wrappers:key1==key2]` - -##### Class - -Pure operator. - -##### Arguments - -`key1`: shall be a scalar expression of type `key_type`. It -is an `intent(in)` argument. - -`key2`: shall be a scalar expression of type `key_type`. It -is an `intent(in)` argument. - -##### Result character - -The result is a value of type default `logical`. - -##### Result value - -The result is `.true.` if the keys are equal, otherwise `.falss`. - -##### Example - -```fortran - program demo_equal_keys - use stdlib_hashmap_wrappers, only: & - copy_key, operator(==), key_type, set - use iso_fortran_env, only: int8 - implicit none - integer(int8), allocatable :: value(:) - type(key_type) :: key_in, key_out - integer(int_8) :: i - allocate( value(1:15) ) - do i=1, 15 - value(i) = i - end do - call set( key_in, value ) - call copy_key( key_in, key_out ) - print *, "key_in == key_out = ", key_in == key_out - end program demo_equal_keys -``` - -#### `seeded_nmhash32_hasher`- calculates a hash code from a key - -##### Status - -Experimental - -##### Description - -Calculates a 32 bit hash code from an input of type `key_type`. - -##### Syntax - -`code = [[stdlib_hashmap_wrappers:seeded_nmhash32_hasher]]( key )` - -##### Class - -Pure function - -##### Argument - -`key`: Shall be a scalar expression of type `key_type`. -It is an `intent(in)` argument. - -##### Result character - -The result is a scalar integer of kind `int32`. - -##### Result value - -The result is a hash code created using the `nmhash32` algorithm. - -##### Note - -`seeded_nmhash32_hasher` is a wrapper to the `NMHASH32_HASH` of the -module `stdlib_hash_32bit`, which supplies a fixed seed -to the wrapped function. `NMHASH32` is an implementation of the -`nmhash32` hash code of James Z. M. Gao. -This code has good, but not great, performance on long keys, poorer -performance on short keys. -As a result it should give fair performance for typical hash map -applications. -This code passes the SMHasher tests. - - -##### Example - -```fortran - program demo_seeded_nmhash32_hasher - use stdlib_hashmap_wrappers, only: & - seeded_nmhash32_hasher, key_type, set - use iso_fortran_env, only: int32 - implicit none - integer(int8), allocatable :: array1(:) - integer(int32) :: hash - type(key_type) :: key - array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] - call set( key, array1 ) - hash = seeded_nmhash32_hasher (key) - print *, hash - end program demo_seeded_nmhash32_hasher -``` - -#### `seeded_nmhash32x_hasher`- calculates a hash code from a key - -##### Status - -Experimental - -##### Description - -Calculates a 32 bit hash code from an input of type `key_type`. - -##### Syntax - -`code = [[stdlib_hashmap_wrappers:seeded_nmhash32x_hasher]]( key )` - -##### Class - -Pure function - -##### Argument - -`key`: Shall be a scalar expression of type `key_type`. -It is an `intent(in)` argument. - -##### Result character - -The result is a scalar integer of kind `int32`. - -##### Result value - -The result is a hash code created using the `nmhash32x` algorithm. - -##### Note - -`seeded_nmhash32x_hasher` is a wrapper to the `nmhash32x_hash` of the -module `stdlib_hash_32bit`, which supplies a fixed seed -to the wrapped function. `nmhash32x` is an implementation of the -`nmhash32x` hash code of James Z. M. Gao. -This code has good, but not great, performance on long keys, poorer -performance on short keys. -As a result it should give fair performance for typical hash map -applications. -This code passes the SMHasher tests. - -##### Example - -```fortran - program demo_seeded_nmhash32x_hasher - use stdlib_hashmap_wrappers, only: & - seeded_nmhash32x_hasher, key_type, set - use iso_fortran_env, only: int32 - implicit none - integer(int8), allocatable :: array1(:) - integer(int32) :: hash - type(key_type) :: key - array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] - call set( key, array1 ) - hash = seeded_nmhash32x_hasher (key) - print *, hash - end program demo_seeded_nmhash32x_hasher -``` - -#### `seeded_water_hasher`- calculates a hash code from a key - -##### Status - -Experimental - -##### Description - -Calculates a 32 bit hash code from an input of type `key_type`. - -##### Syntax - -`code = [[stdlib_hashmap_wrappers:seeded_water_hasher]]( key )` - -##### Class - -Pure function - -##### Argument - -`key`: Shall be a scalar expression of type `key_type`. -It is an `intent(in)` argument. - -##### Result character - -The result is a scalar integer of kind `int32`. - -##### Result value - -The result is a hash code created using the `waterhash` algorithm. - -##### Note - -`seeded_water_hasher` is a wrapper to the `water_hash` of the -module `stdlib_hash_32bit`, which supplies a fixed seed -to the wrapped function. `water_hash` is an implementation of the -`waterhash` hash code of Tommy Ettinger. -This code has excellent performance on long keys, and good performance -on short keys. -As a result it should give reasonable performance for typical hash -table applications. -This code passes the SMHasher tests. - - -##### Example - -```fortran - program demo_seeded_water_hasher - use stdlib_hashmap_wrappers, only: & - seeded_water_hasher, key_type, set - use iso_fortran_env, only: int32 - implicit none - integer(int8), allocatable :: array1(:) - integer(int32) :: hash - type(key_type) :: key - array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] - call set( key, array1 ) - hash = seeded_water_hasher (key) - print *, hash - end program demo_seeded_water_hasher -``` - - -#### `set` - places the data in a derived type - -##### Status - -Experimental - -##### Description - -Places the data from `value` in a `key_type` or an `other_type`. - -##### Syntax - -`call [[stdlib_hashmap_wrappers:set]]( key, value )` - -or - -`call [[stdlib_hashmap_wrappers:set]]( other, value )` - - -##### Class - -Subroutine. - -##### Argument - -`key`: shall be a scalar variable of type `key_type`. It -is an `intent(out)` argument. - -`other`: shall be a scalar variable of type `other_type`. It -is an `intent(out)` argument. - -`value`: if the first argument is `key` `vaalue` shall be a default -character string expression, or a vector expression of type integer -and kind `int8`, while for a first argument of type `other` `value` -shall be of type `class(*)`. It is an `intent(in)` argument. - -##### Example - -```fortran - program demo_set - use stdlib_hashmap_wrappers, only: & - get, key_type, set - use iso_fortran_env, only: int8 - implicit none - integer(int8), allocatable :: value(:), result(:) - type(key_type) :: key - integer(int_8) :: i - allocate( value(1:15) ) - do i=1, 15 - value(i) = i - end do - call set( key, value ) - call get( key, result ) - print *, `RESULT == VALUE = ', all( value == result ) - end program demo_set -``` - - -## The `stdlib_hashmaps` module - -The `stdlib_hashmaps` module defines three public data types, -associated procedures and constants that implement two simple hash map -types using separate chaining hashing and open addressing hashing. The -derived type `hashmap_type` is the parent type to its two -extensions: `chaining_hashmap_type` and `open_hashmap_type`. -`chaining_hashmap_type`. The extension types provide -procedures to manipulate the structure of a hash map object: -`init`, `map_entry`, `rehash`, `remove_entry`, and -`set_other_data`. They also provide procedures to inquire about -entries in the hash map: `get_other_data`, `in_map`, `unmap` and -`valid_index`. Finally they provide procedures to inquire about the -overall structure and performance of the hash map object:`calls`, -`entries`, `get_other_data`, `loading`, `slots`, and -`total_depth`. The module also defines a number of public constants: -`inmap_probe_factor`, `load_factor`, `map_probe_factor`, `default_bits`, -`max_bits`, `int_calls`, `int_depth`, `int_index`, -`int_probes`, `success`, `alloc_fault`, and `array_size_error`. - -### The `stdlib_hashmaps` module's public constants - -The module defines several categories of public constants. Some are -used to parameterize the empirical slot expansion code. Others -parameterize the slots table size. Some are used to define -integer kind values for different applications. Finally, some are used -to report errors or success. - -The constants `inmap_probe_factor`, and `map_probe_factor` are used to -parameterize the slot expansion code used to determine when in a -in a procedure call the number -of slots need to be increased to decrease the search path for an -entry. The constant `inmap_probe_factor` is used to determine when -the ratio of the number of map probes to map calls is too large and -the slots need expansion. The constant `map_probe_factor` is used to -determine when inserting a new entry the ratio of the number of map -probes to map calls is too large and the slots need expansion. - -The constants `default_bits`, and -`max_bits` are used to parameterize the table's slots size. The -`default_bits` constant defines the default initial number of slots -with a current value of 6 resulting in an initial `2**6 == 64` -slots. This may optionally be overridden on hash map creation. The -`max_bits` parameter sets the maximum table size as `2**max_bits` with -a default value for `max_bits` of 30. The table will not work for a -slots size greater than `2**30`. - -The constants `int_calls`, `int_depth`, `int_index`, and `int_probes` -are used to define integer kind values for various contexts. The -number of calls are reported and stored in entities of kind -`int_calls`. Currently `int_calls` has the value of `int64`. The -total depth, the number of inquiries needed to access all elements -of the table, is reported and stored in entities of kind -`int_depth`. Currently `int_depth` has the value of `int64`. The -number of entries in the table, is reported and stored in entities of -kind `int_index`. Currently `int_index` has the value of `int32`. -The number of probes, hash map enquiries, are reported and stored in -entities of kind `int_probes`. Currently `int_probes` has the value of -`int64`. - -The constant `load_factor` is only used by the `open_hashmap_type`. It -specifies the maximum fraction of the available slots that may be -filled before expansion occurs. The current `load_factor = ).5625` so -the current implementation of `open_hashmap_type` can only hold a -little more than `2**29` entries. - -Finally the error codes `success`, `alloc_fault`, and -`array_size_error` are used to report the error status of certain -procedure calls. The `succes` code indicates that no problems were -found. The `alloc_fault` code indicates that a memory allocation -failed. Finally the `array_size_error` indicates that on table -creation `slots_bits` is less than `default_bits` or -greater than `max_bits`. - -### The `stdlib_hashmaps` module's derived types - -The `stdlib_hashmaps` module defines three public derived types and -seven private types used in the implementation of the public -types. The public types are the abstract `hashmap_type` and its -extensions: `chaining_hashmap_type` and `open_hashmap_type`. The three -private derived types, `chaining_map_entry_type`, -`chaining_map_entry_ptr`, and `chaining_map_entry_pool` are used in -the implementation of the `chaining_hashmap_type` public type. The -four private derived types, `open_map_entry_type`, -`open_map_entry_list`, `open_map_entry_ptr`, and `open_map_entry_pool` -are used in the implementation of the `open_hashmap_type` public -type:. Each of these types are described below. - -#### The `hashmap_type` abstract type - -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: -* `call_count` - the number of procedure calls on the map; -* `nbits` - the number of bits used to address the slots; -* `num_entries` - the humber of entries in the map; -* `num_free` - the number of entries in the free list of removed - entries; -* `probe_count` - the number of map probes since the last resizing or - initialization; -* `total_probes` - the number of probes of the map up to the last - resizing or initialization; and -* `hasher` - a pointer to the hash function used by the map. -It also defines five non-overridable procedures: -* `calls` - returns the number of procedure calls on the map; -* `entries` - returns the number of entries in the map; -* `map_probes` - returns the number of map probes since - initialization; -* `num_slots` - returns the number of slots in the map; and -* `slots_bits` - returns the number of bits used to address the slots; -and eleven deferred procedures: -* `get_other_data` - gets the other data associated with the inmap - index; -* `in_map` - gets the inmap index into the inverse map associated with - `key`; -* `init` - initializes the hash map; -* `loading` - returns the ratio of the number of entries to the number - of slots; -* `map_entry` - inserts a key and its other associated data into the - map; -* `rehash` - rehashes the map with the provided hash function; -* `remove` - removes the entry associated wit the inmap index into the - inverse table; -* `set_other_data` - replaces the other data associated with the inmap - index intoo the inverse table; -* `total_depth` - returns the number of probes needed to address all - the entries in the map; -* `unmap` - returns a copy of the key associated with the inmap index - into the inverse table; -* `valid_index` - returns a logical flag indicating whether INMAP is a - valid index into the inverse table. - -The type's definition is below: - -```fortran - type, abstract :: hashmap_type - private - integer(int_calls) :: call_count = 0 - integer(int_calls) :: probe_count = 0 - integer(int_calls) :: total_probes = 0 - integer(int_index) :: num_entries = 0 - integer(int_index) :: num_free = 0 - integer(int_index) :: index_mask = 2_int_index**default_bits-1 - integer(int32) :: nbits = default_bits - procedure(hasher_fun), pointer, nopass :: hasher => fnv_1_hasher - contains - procedure, non_overridable, pass(map) :: calls - procedure, non_overridable, pass(map) :: entries - procedure, non_overridable, pass(map) :: map_probes - procedure, non_overridable, pass(map) :: slots_bits - procedure, non_overridable, pass(map) :: num_slots - procedure(get_other), deferred, pass(map) :: get_other_data - procedure(in_map), deferred, pass(map) :: in_map - procedure(init_map), deferred, pass(map) :: init - procedure(loading), deferred, pass(map) :: loading - procedure(map_entry), deferred, pass(map) :: map_entry - procedure(rehash_map), deferred, pass(map) :: rehash - procedure(remove_entry), deferred, pass(map) :: remove - procedure(set_other), deferred, pass(map) :: set_other_data - procedure(total_depth), deferred, pass(map) :: total_depth - procedure(unmap), deferred, pass(map) :: unmap - procedure(valid_index), deferred, pass(map) :: valid_index - end type hashmap_type -``` - - -#### The `chaining_map_entry_type` derived type - -Entities of the type `chaining_map_entry_type` are used to define -a linked list structure that stores the -key, its other data, the hash of the key, and the resulting index into -the inverse table. The type's definition is below: - -```fortran - type :: chaining_map_entry_type ! Chaining hash map entry type - private - integer(int_hash) :: hash_val ! Full hash value - type(key_type) :: key ! The entry's key - type(other_type) :: other ! Other entry data - integer(int_index) :: index ! Index into inverse table - type(chaining_map_entry_type), pointer :: & - next => null() ! Next bucket - end type chaining_map_entry_type -``` -Currently the `int_hash` and `int_index` have the value of `int32`. - -#### The `chaining_map_entry_ptr` derived type - -The type `chaining_map_entry_ptr` is used to define the elements of -the hash map that are either empty or link to the linked lists -containing the elements of the table. The type's definition is below: - -```fortran - type chaining_map_entry_ptr ! Wrapper for a pointer to a chaining - ! map entry type object - type(chaining_map_entry_type), pointer :: target => null() - end type chaining_map_entry_ptr -``` - -#### The `chaining_map_entry_pool` derived type - -The type `chaining_map_entry_pool` is used to implement a pool of -allocated `chaining_map_entry_type` elements to save on allocation -costs. The type's definition is below: - -```fortran - type :: chaining_map_entry_pool - ! Type implementing a pool of allocated - ! `chaining_map_entry_type` objects - private - ! Index of next bucket - integer(int_index) :: next = 0 - type(chaining_map_entry_type), allocatable :: more_map_entries(:) - type(chaining_map_entry_pool), pointer :: lastpool => null() - end type chaining_map_entry_pool -``` - - -#### The `chaining_hashmap_type` derived type - -The `chaining_hashmap_type` derived type extends the `hashmap_type` to -implements a separate chaining hash map. In addition to the components -of the `hashmap_type` it provides the four components: -* `cache` - a pool of `chaining_map_entry_pool` objects used to reduce -allocation costs; -* `free_list` - a free list of map entries; -* `inverse` - an array of `chaining_map_entry_ptr` bucket lists -(inverses) storing entries at fixed locations once -entered; and -* `slots` - an array of bucket lists serving as the hash map. -It also implements all of the deferred procedures of the -`hashmap_type` and a finalizer for its maps. The type's definition is -as follows: - -```fortran - type, extends(hashmap_type) :: chaining_hashmap_type - private - type(chaining_map_entry_pool), pointer :: cache => null() - type(chaining_map_entry_type), pointer :: free_list => null() - type(chaining_map_entry_ptr), allocatable :: inverse(:) - type(chaining_map_entry_ptr), allocatable :: slots(:) - contains - procedure :: get_other_data => get_other_chaining_data - procedure :: in_map => in_chain_map - procedure :: init => init_chaining_map - procedure :: loading => chaining_loading - procedure :: map_entry => map_chain_entry - procedure :: rehash => rehash_chaining_map - procedure :: remove => remove_chaining_entry - procedure :: set_other_data => set_other_chaining_data - procedure :: total_depth => total_chaining_depth - procedure :: unmap => unmap_chain - procedure :: valid_index => valid_chaining_index - final :: free_chaining_map - end type chaining_hashmap_type -``` - -#### The `open_map_entry_type` derived type - -Entities of the type `open_map_entry_type` are used to define -a linked list structure that stores the -key, its other data, the hash of the key, and the resulting index into -the inverse table. The type's definition is below: - -```fortran - type :: open_map_entry_type ! Open hash map entry type - private - integer(int_hash) :: hash_val ! Full hash value - type(key_type) :: key ! The entry's key - type(other_type) :: other ! Other entry data - integer(int_index) :: index ! Index into inverse table - end type open_map_entry_type -``` - -Currently `int_hash` and `int_index` have the value of `int32`. - -#### The `open_map_entry_ptr` derived type - -The type `open_map_entry_ptr` is used to define the elements of -the hash map that are either empty or link to the linked lists -containing the elements of the table. The type's definition is below: - -```fortran - type open_map_entry_ptr ! Wrapper for a pointer to a open - ! map entry type object - type(open_map_entry_type), pointer :: target => null() - end type open_map_entry_ptr -``` - -#### The `open_hashmap_type` derived type - -The `open_hashmap_type` derived type extends the `hashmap_type` to -implement an open addressing hash map. In addition to the components -of the `hashmap_type` it provides the four components: -* `cache` - a pool of `open_map_entry_pool` objects used to reduce -allocation costs; -* `free_list` - a free list of map entries; -* `index_mask` - an `and` mask used in linear addressing; -* `inverse` - an array of `open_map_entry_ptr` bucket lists -(inverses) storing entries at fixed locations once -entered; and -* `slots` - an array of bucket lists serving as the hash map. -It also implements all of the deferred procedures of the -`hashmap_type` and a finalizer for its maps. The type's definition is -as follows: - -```fortran - type, extends(hashmap_type) :: open_hashmap_type - private - integer(int_index) :: index_mask = 2_int_index**default_bits-1 - type(open_map_entry_pool), pointer :: cache => null() - integer(int_index), allocatable :: slots(:) - type(open_map_entry_ptr), allocatable :: inverse(:) - type(open_map_entry_list), pointer :: free_list => null() - contains - procedure :: get_other_data => get_other_open_data - procedure :: in_map => in_open_map - procedure :: init => init_open_map - procedure :: loading => open_loading - procedure :: map_entry => map_open_entry - procedure :: rehash => rehash_open_map - procedure :: remove => remove_open_entry - procedure :: set_other_data => set_other_open_data - procedure :: total_depth => total_open_depth - procedure :: unmap => unmap_open - procedure :: valid_index => valid_open_index - final :: free_open_map - end type open_hashmap_type -``` - -### Table of `stdlib_hashmap` procedures - -The `stdlib_hashmap` module provides procedures in -several categories: a procedure to initialize the map; a procedure to -modify the structure of a map; procedures to modify the content of a -map; procedures to report on the content of a map; and procedures -to report on the structure of the map. The procedures in each category -are listed below. - -Procedure to initialize a chaining hash map: - -* `init( map, hasher[, slots_bits, status] )` - Routine - to initialize a chaining hash map. - -Procedure to modify the structure of a map: - -* `rehash( map, hasher )` - Routine to change the hash function - for a map. - -Procedures to modify the content of a map: - -* `map_entry( map, inmap, key, other )` - Inserts an entry into the - hash map. - -* `remove_entry(map, inmap)` - Remove the entry, if any, at map % - inverse(inmap). - -* `set_other_data( map, inmap, other )` - Change the other data - associated with the entry. - -Procedures to report the content of a map: - -* `get_other_data( map, inmap, other )` - Returns the other data - associated with the inverse table index - -* `in_map( map, inmap, key )` - Returns the index into the `inverse` - array associated with the `key` - -* `unmap( map, inmap, key )` - Returns a copy of the key associated -with an index to the inverse table. - -* `valid_index(map, inmap)` - Returns a flag indicating whether `inmap` - is a valid index. - -Procedures to report on the structure of the map: - -* `calls( map )` - the number of subroutine calls on the hash map. - -* `entries( map )`- the number of entries in a hash map. - -* `loading( map )` - the number of entries relative to the number of - slots in a hash map. - -* `map_probes( map )` - the total number of table probes on a hash - map. - -* `slots( map )` - Returns the number of allocated slots in a hash - map. - -* `total_depth( map )` - Returns the total number of one's based -offsets of slot entries from their slot index - -### Specifications of the `stdlib_hashmaps` procedures - -#### `calls` - Returns the number of calls on a hash map - -##### Status - -Experimental - -##### Description - -Returns the number of procedure calls on a hash map. - -##### Syntax - -`value = [[stdlib_hashmaps:map % calls]]()` - -##### Class - -Pure function - -##### Argument - -`map` (pass) - shall be an expression of class `hashmap_type`. -It is an `intent(in)` argument. - -##### Result character - -The result will be an integer of kind `int_calls`. - -##### Result value - -The result will be the number of procedure calls on the hash map. - -##### Example - -```fortran - program demo_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 - type(int_calls) :: initial_calls - call map % init(fnv_1_hasher ) - initial_calls = map % calls() - print *, "INITIAL_CALLS = ", initial_calls - end program demo_calls -``` - - -#### `entries` - Returns the number of entries in a hash map - -##### Status - -Experimental - -##### Description - -Returns the number of entries in a hash map. - -##### Syntax - -`value = [[stdlib_hashmaps:map%entries]]()` - -##### Class - -Pure function - -##### Argument - -`map` (pass) - shall be an expression of class `hashmap_type`. -It is an `intent(in)` argument. - -##### Result character - -The result will be an integer of kind `int_index`. - -##### Result value - -The result will be the number of entries in the hash map. - -##### Example - -```fortran - program demo_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 - type(int_index) :: initial_entries - call map % init( fnv_1_hasher ) - initial_entries = map % entries () - print *, "INITIAL_ENTRIES = ", initial_entries - end program demo_entries -``` - - -#### `get_other_data` - Returns other data belonging to the inverse table index - -##### Status - -Experimental - -##### Description - -Returns the other data associated with the inverse table index, - -##### Syntax - -`value = [[stdlib_hashmaps:map%get_other_data)]]( inmap, other )` - -##### Class - -Subroutine - -##### Arguments - -`map` (pass): shall be a scalar expression of class - `chaining_hashmap_type` or `open_hashmap_type`. It is an - `intent(in)` argument. It will be - the hash map used to store and access the other data. - -`inmap`: shall be a scalar integer expression of kind `int_index`. It - is an `intent(in)` argument. It should be a non-zero `inmap` - returned by either procedure `in_map` or `map_entry`. - -* If `inmap` is zero, or the corresponding `key` has been deleted -from the map, `other` is undefined. - -`other`: shall be a variable of type `other_data`. - It is an `intent(out)` argument. It is the other data associated - with the `inmap` index. - -* The following is an example of the retrieval of other data - associated with an inverse table index: - - -##### Example - -```Fortran - program demo_get_other_data - use, intrinsic:: iso_fortran_env, only: & - int8 - use stdlib_hashmaps, only: chaining_hashmap_type, int_index - use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type - integer(int_index) :: inmap - type(key_type) :: key - type(other_type) :: other - type(chaining_hashmap_type) :: map - type dummy_type - integer(int8) :: value(4) - end type dummy_type - type(dummy_type) :: dummy - class(*), allocatable :: data - dummy % value = [ 4_int8, 3_int8, 2_int8, 1_int8 ] - allocate( data, source=dummy ) - call map % init( fnv_1_hasher ) - call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) - call set( other, data ) - call map % map_entry( inmap, key, other ) - if ( inmap /= 0 ) then - call map % get_other_data( inmap, other ) - else - stop 'Invalid inmap' - end if - call get( other, data ) - select type( data ) - type (dummy_type) - print *, 'Other data % value = ', data % value - type default - print *, 'Invalid data type in other' - end select - end program demo_get_other_data -``` - - -#### `in_map` - searches a map for the presence of a key - -##### Status - -Experimental - -##### Description - -Searches a hash map for the presence of a key and returns the -associated index into the inverse table. - -##### Syntax - -`call [[stdlib_hashmaps:map%in_map]]( inmap, key )` - -##### Class - -Subroutine - -##### Arguments - -`map` (pass): shall be a scalar variable of class - `chaining_hashmap_type` or `open_hashmap_type`. It is an - `intent(inout)` argument. It will - be the hash map used to store and access the entries. - -`inmap`: shall be a scalar integer variable of kind `int_index`. It is - an `intent(out)` argument. It will be 0 if `key` is not found, - otherwise it will be the one's based index to the location of `key` - in the hash map's inverse array. - -`key`: shall be a scalar expression of type `key_type`. - It is an `intent(in)` argument. It is the entry's key to be searched - for in the hash map. - -* The following is an example of the retrieval of other data associated with - a key: - -##### Example - -```Fortran - program demo_in_map - use, intrinsic:: iso_fortran_env, only: & - int8 - use stdlib_hashmaps, only: & - chaining_hashmap_type, int_index - use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type - integer(int_index) :: inmap - type(key_type) :: key - type(other_type) :: other - type(chaining_hashmap_type) :: map - type dummy_type - integer(int8) :: value(4) - end type dummy_type - type(dummy_type) :: dummy - class(*), allocatable :: data - dummy % value = [ 4_int8, 3_int8, 2_int8, 1_int8 ] - call map % init( fnv_1_hasher ) - call set( key, [ 0_int8, 1_int8, 2_int8, 3_int8, 4_int8 ] ) - call set( other, data ) - call map % map_entry( inmap, key, other ) - if ( inmap /= 0 ) then - call map % in_map( inmap, key - if ( inmap \= 0 ) then - print *, 'INMAP = ', inmap - else - stop 'Invalid inmap from in_map call' - end if - else - stop 'Invalid inmap from map_entry call' - end if - end program demo_in_map -``` - -#### init - initializes a hash map - -##### Status - -Experimental - -##### Description - -Initializes a `chaining_hashmap_type` object. - -##### Syntax - -`call [[stdlib_hashmaps:map%init]]( hasher [, slots_bits, status ] ] )` - -####@# Class - -Subroutine - -##### Arguments - -`map` (pass): shall be a scalar variable of class - `chaining_hashmap_type` or `open_hashmap_type`. It is an - `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`. - 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. - -`slots_bits` (optional): shall be a scalar default integer - expression. It is an `intent(in)` argument. The initial number of - slots in the table will be `2**slots_bits`. - -* `slots_bits` shall be a positive default integer less than - `max_bits`, otherwise processing stops with an informative - error code. - -* If `slots_bits` is absent then the effective value for `slots_bits` - is `default_slots_bits`. - -`status` (optional): shall be a scalar integer variable of kind -`int32`. It is an `intent(out)` argument. On return if present it -shall have an error code value. - -* If map was successfully initialized then `status` has the value -`success`. - -* If allocation of memory for the `map` arrays fails then `status` -has the value `alloc_fault`. - -* If `slot_bits < 6` or `slots_bits > max_bits` then `status` - has the value of `array_size_error`. - -* If `status` is absent, but `status` would have a value other than -`success`, then processing stops with an informative stop code. - -##### Example - -```fortran - program demo_init - use stdlib_hashmaps, only: chaining_map_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher - type(fnv_1a_type) :: fnv_1 - type(chaining_map_type) :: map - call map % init( fnv_1a, slots_bits=10 ) - end program demo_init -``` - - -#### `loading` - Returns the ratio of entries to slots - -##### Status - -Experimental - -##### Description - -Returns the ratio of the number of entries relative to the number of -slots in a hash map. - -##### Syntax - -`value = [[stdlib_hashmaps:map%loading]]( )` - -##### Class - -Pure function - -##### Argument - -`map` (pass) - shall be an expression of class `chaining_hashmap_type` -or ``open_hashmap_type`. It is an `intent(in)` argument. - -##### Result character - -The result will be a default real. - -##### Result value - -The result will be the ratio of the number of entries relative to the -number of slots in the hash map. - -##### Example - -```fortran - program demo_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 ) - ratio = map % loading () - print *, "Initial loading = ", ratio - end program demo_loading -``` - -#### `map_entry` - inserts an entry into the hash map - -##### Status - -Experimental - -##### Description - -Inserts an entry into the hash map if it is not already present. - -##### Syntax - -`call [[stdlib_hashmaps:map%map_entry]]( inmap, key[, other ])` - - -##### Class - -Subroutine - -##### Arguments - -`map` (pass): shall be a scalar variable of class -`chaining_hashmap_type` or `open_hashmap_type`. It -is an `intent(inout)` argument. It is the hash map to receive the -entry. - -`inmap`: shall be an integer scalar variable of kind `int_index`. It is - an `intent(out)` argument. It is the index to the table's inverse array - associated with the `key`. - -`key`: shall be either a scalar expression of type `key_type`. - It is an `intent(in)` argument. It is the key for the entry to be - placed in the table. - -`other` (optional): shall be a scalar expression of type `other_type`. - It is an `intent(in)` argument. If present it is the other data to be - associated with the `key`. - -* If `key` is already present in `map` then the presence of `other` -is ignored. - -##### Example - -```fortran - program demo_map_entry - use, intrinsic:: iso_fortran_env, only: int8 - use stdlib_hashmaps, only: chaining_hashmap_type, int_index - use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type - type(chaining_hashmap_type) :: map - type(key_type) :: key - type(other_type) :: other - integer(int_index) :: inmap - class(*), allocatable :: dummy - allocate( dummy, source=4 ) - call map % init( fnv_1_hasher, slots_bits=10 ) - call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - call set( other, dummy ) - call map % map_entry( inmap, key, other ) - print *, 'INMAP = ', inmap - end program demo_map_entry -``` - -#### `map_probes` - returns the number of hash map probes - -##### Status - -Experimental - -##### Description - -Returns the total number of table probes on a hash map - -##### Syntax - -`Result = [[stdlib_hashmap:map%map_probes]]( )` - -##### Class - -Pure function - -##### Argument - -`map` (pass): shall be a scalar expression of class -`hashmap_type`. It is an `intent(in)` -argument. It is the hash map of interest. - -##### Result character - -The result is a scalar integer of kind `int_probes`. - -##### Result value - -The result is the number of probes of `map` since initialization or -rehashing. - -##### Example - -```fortran - program demo_probes - use stdlib_hashmaps, only: chaining_hashmap_type, int_index - use stdlib_hashmap_wrappers: fnv_1_hasher - implicit none - type(chaining_hashmap_type) :: map - real :: nprobes - call map % init( fnv_1_hasher ) - nprobes = map % probes() - print *, "Initial probes = ", nprobes - end program demo_probes -``` - -#### `num_slots` - returns the number of hash map probes - -##### Status - -Experimental - -##### Description - -Returns the total number of slots on a hash map - -##### Syntax - -`Result = [[stdlib_hashmaps:map%num_slots]]( )` - -##### Class - -Pure function - -##### Argument - -`map`: shall be a scalar expression of class -`hashmap_type`. It is an `intent(in)` argument. It is the -hash map of interest. - -##### Result character - -The result is a scalar integer of kind `int_index`. - -##### Result value - -The result is the number of slots in `map`. - -##### Example - -```fortran - program demo_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 ) - initial_slots = map % num_slots () - print *, "Initial slots = ", initial_slots - end program num_slots -``` - - -#### rehash - changes the hashing function - -##### Status - -Experimental - -##### Description - -Changes the hashing function for the table entries to that of `hasher`. - -##### Syntax - -`call [[stdlib_hashmaps:map%rehash]]( hasher )` - -##### Class - -Subroutine - -##### Arguments - -`map` (pass): shall be a scalar variable of class -`chaining_hashmap_type` oe `open_hashmap_type`. -It is an `intent(inout)` argument. It is the hash map whose hashing -method is to be changed. - -`hasher`: shall be a function of interface `hasher_fun`. -It is the hash method to be used by `map`. - -##### Example - -```fortran - program demo_rehash - use stdlib_hashmaps, only: open_hashmap_type, int_index - use stdlib_hasmap_wrappers, only: fnv_1_hasher, fnv_1a_hasher,& - key_type, other_type - type(openn_hashmap_type) :: map - type(key_type) :: key - type(other_type) :: other - integer(int_index) :: inmap - class(*), allocatable :: dummy - allocate( dummy, source='a dummy value' ) - call map % init( fnv_1_hasher, slots_bits=10 ) - call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - call set( other, dummy ) - call map % map_entry( inmap, key, other ) - call map % rehash( fnv_1a_hasher ) - end program demo_rehash -``` - -#### `remove_entry` - removes an entry from the hash map - -##### Status - -Experimental - -##### Description - -Removes an entry from a hash map, `map`. - -##### Syntax - -`call [[stdlib_hashmaps:map%remove_entry]]( inmap )` - -##### Class - -Subroutine - -##### Arguments - -`map` (pass): shall be a scalar variable of class -`chaining_hashmap_type` or `open_hashmap_type`. -It is an `intent(inout)` argument. It is the hash map with the element -to be removed. - -`inmap`: shall be a scalar integer expression of kind `int_index`. It -is an `intent(in)` argument. It is the non-zero index to the inverse -table returned by `in_map` or `map_entry` identifying the entry to be -removed. - -* If `inmap` is zero, or the corresponding `key` has been deleted -from the map, or the `map` has been rehashed subsequent to the -generation of `inmap`, `other` is undefined. - - -##### Example - -```fortran - program demo_remove_entry - use stdlib_hashmaps, only: open_hashmap_type, int_index - use stdlib_hashmap_wrappers, only: fnv_1_hasher, & - fnv_1a_hasher, key_type, other_type - type(open_hashmap_type) :: map - type(key_type) :: key - type(other_type) :: other - integer(int_index) :: inmap - class(*), allocatable :: dummy - allocate( dummy, source=4.0 ) - call map % init( fnv_1_hasher, slots_bits=10 ) - call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - call set( other, dummy ) - call map % map_entry( inmap, key, other ) - call map % remove_entry( inmap ) - end program demo_remove_entry -``` - -#### `set_other_data` - replaces the other dataa for an entry - -##### Status - -Experimental - -##### Description - -Replaces the other data for the entry at index `inmap` in the -inverse table. - -##### Syntax - -`call [[stdlib_hashmaps:map%set_other_data]]( inmap, other )` - -##### Class - -Subroutine - -##### Arguments - -`map` (pass): shall be a scalar variable of class -`chaining_hashmap_type` or `open_hashmap_type`. It -is an `intent(inout)` argument. It will be a hash map used to store -and access the entry's data. - -`inmap`: shall be a scalar integer expression of kind `int_index`. It -is an `intent(in)` argument. It is the non-zero index in the inverse -table to the entry of interest as returned by `ìn_map` or `map_entry`. - -`other`: shall be a scalar expression of type `other_type`. -It is an `intent(in)` argument. It is the data to be stored as -the other data for the entry at the `inmap` index. - -* If unable to set the other data associated with `inmap`, either - because `inmap` is not associated with a valid entry or because of - allocation problems, then processing will stop with an informative - stop code. - -##### Example - -```fortran - program demo_set_other_data - use stdlib_hashmaps, only: open_hashmap_type, int_index - use stdlib_hashmap_wrappers, only: fnv_1_hasher, & - fnv_1a_hasher, key_type, other_type, set - type(open_hashmap_type) :: map - type(key_type) :: key - type(other_type) :: other - integer(int_index) :: inmap - class(*), allocatable :: dummy - call map % init( fnv_1_hasher, slots_bits=10 ) - allocate( dummy, source='A value` ) - call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - Call set( other, dummy ) - call map % map_entry( inmap, key, other ) - deallocate( dummy ) - allocate( dummy, source='Another value` ) - call set( other, dummy ) - call map % set_other_data( inmap, other ) - end program demo_set_other_data -``` - -#### `slots_bits` - returns the number of bits used to address the hash map slots - -##### Status - -Experimental - -##### Description - -Returns the total number of slots on a hash map - -##### Syntax - -`Result = [[stdlib_hashmaps:map%slots_bits]]( )` - -##### Class - -Pure function - -##### Argument - -`map` (pass): shall be a scalar expression of class -`hashmap_type`. It is an `intent(in)` argument. It is the -hash map of interest. - -##### Result character - -The result is a scalar integer of kind `int_index`. - -##### Result value - -The result is the number of bits used in addressing the slots in `map`. - -##### Example - -```fortran - program demo_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 ) - bits = map % slots_bits () - print *, "Initial slot bits = ", bits - end program demo_slots_bits -``` - - -#### `total_depth` - returns the total depth of the hash map entries - -##### Status - -Experimental - -##### Description - -Returns the total number of one's based offsets of slot entries from -their slot index for a hash map - -##### Syntax - -`Result = [[stdlib_hashmaps:map%total_depth]]( )` - -##### Class - -Pure function - -##### Argument - -`map` (pass): shall be a scalar expression of class -`chaining_hashmap_type`. It is an `intent(in)` argument. It is the -hash map of interest. - -##### Result character - -The result is a scalar integer of kind `int_depth`. - -##### Result value - -The result is the total number of one's based offsets of slot entries -from their slot index the map. - -##### Example - -```fortran - program demo_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 ) - initial_depth = map % total_depth () - print *, "Initial total depth = ", initial_depth - end program demo_total_depth -``` - - -#### `unmap` - returns a copy of the key - -##### Status - -Experimental - -##### Description - -Returns a copy of the key associated with an index to the -inverse table. - -##### Syntax - -`call [[stdlib_hashmaps:map%unmap]]( inmap, key )` - -##### Class - -Subroutine - -##### Arguments - -`map` (pass): shall be a scalar expression of class -`chaining_hashmap_type` or `open_hashmap_type`. -It is an `intent(in)` argument. It is the hash map whose entry -is unmapped. - -`inmap`: shall be a scalar integer expression of kind `int_index`. It -is an `intent(in)` argument. It is the non-zero index to the inverse -table identifying the unmapped entry as returned by `ìn_map` or -`map_entry`. - -* If `inmap` is zero or `key` has been eliminated from the `map` -subsequent to the generation of `inmap`, or `mp` has been rehashed -subsequent to the generation of `inmap` then `key` is undefined. - -`key`: shall be a variable of type `key_type` -`int8`, or an allocatable length default character. It is an -`intent(out)` argument. It is the `key` associated with the entry at -index `inmap` in the inverse table. - -##### Example - -```fortran - program demo_unmap - use stdlib_hashmap_chaining, only: & - chaining_hashmap_type, fnv_1_hasher, fnv_1a_hasher,& - init, int_index, key_type, map_entry, other_type, & - set, unmap - type(chaining_hashmap_type) :: map - type(key_type) :: key - type(other_type) :: other - integer(int_index) :: inmap - class(*), allocatable :: dummy - allocate( dummy, source='A value' ) - call map % init( fnv_1_hasher, slots_bits=10 ) - call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - call set( other, dummy ) - call map % map_entry( inmap, key, other ) - call map % unmap( inmap, key ) - end program demo_unmap -``` - -{{TOC}} - -#### `valid_index` - indicates whether `inmap` is a valid index - -##### Status - -Experimental - -##### Description - -Returns a logical flag indicating whether `inmap` is a valid index in -the inverse table. - -##### Syntax - -`result = [[stdlib_hashmaps:map % valid_index]]( inmap )` - -##### Class - -Pure function. - -##### Arguments - -`map` (pass): shall be a scalar expression of class -`chaining_hashmap_type` or `open_hashmap_type`. -It is an `intent(in)` argument. It is the hash map whose inverse -table is examined. - -`inmap`: shall be a scalar integer expression of kind `int_index`. It -is an `intent(in)` argument. It is an index to the inverse table whose -validity is being examined. - -##### Result character - -The result is a default logical scalar. - -##### Result value - -The result is `.true.` if `inmap` is a valid index to the inverse -table of `map` and `.false.` otherwise. - -##### Example - -```fortran - program demo_valid_index - 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) :: inmap - logocal :: valid - call map % init( fnv_1_hasher ) - inmap = 10 - valid = map % valid_index ( inmap ) - print *, "Initial index of 10 valid for empty map = ", valid - end program demo_valid_index -``` From c43a5c7c1a60f9087817e80ef38002ce8aa94bb8 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Sun, 6 Mar 2022 12:55:48 +0100 Subject: [PATCH 47/77] Added hashmaps to the index Added hashmaos to the index of documentation. [ticket: X] --- doc/specs/index.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/doc/specs/index.md b/doc/specs/index.md index 95f08a31f..6a8bcd037 100644 --- a/doc/specs/index.md +++ b/doc/specs/index.md @@ -16,7 +16,8 @@ This is and index/directory of the specifications (specs) for each new module/fe - [bitsets](./stdlib_bitsets.html) - Bitset data types and procedures - [error](./stdlib_error.html) - Catching and handling errors - [hash](./stdlib_hash_procedures.html) - Hashing integer - vectors or character strings + vectors or character strings + - [hashmaps](./stdlib_hashmaps.html) - Hash maps/tables - [io](./stdlib_io.html) - Input/output helper & convenience - [kinds](./stdlib_kinds.html) - Kind parameters - [linalg](./stdlib_linalg.html) - Linear Algebra From 42f3f122aa7e994a13d490e0a34ac7f003d0d2c8 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 14 Mar 2022 21:23:50 -0600 Subject: [PATCH 48/77] Added hashmap source files Added the source files for implementing hashmaps: stdlib_hashmap_chaining.f90, stdlib_hashmap_open.f90, stdlib_hashmap_wrappers.f90, and stdlib_hashmaps.f90. Modified CMakeLists.txt and Makefile.manual so that the files would be compiled. [ticket: X] --- src/CMakeLists.txt | 4 + src/Makefile.manual | 12 + src/stdlib_hashmap_chaining.f90 | 848 +++++++++++++++++++++++++++++++ src/stdlib_hashmap_open.f90 | 875 ++++++++++++++++++++++++++++++++ src/stdlib_hashmap_wrappers.f90 | 378 ++++++++++++++ src/stdlib_hashmaps.f90 | 789 ++++++++++++++++++++++++++++ 6 files changed, 2906 insertions(+) create mode 100755 src/stdlib_hashmap_chaining.f90 create mode 100755 src/stdlib_hashmap_open.f90 create mode 100755 src/stdlib_hashmap_wrappers.f90 create mode 100644 src/stdlib_hashmaps.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index d48975a4e..670fde09e 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -83,6 +83,10 @@ fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) set(SRC stdlib_array.f90 stdlib_error.f90 + stdlib_hashmap_wrappers.f90 + stdlib_hashmaps.f90 + stdlib_hashmap_chaining.f90 + stdlib_hashmap_open.f90 stdlib_logger.f90 stdlib_system.F90 stdlib_specialfunctions.f90 diff --git a/src/Makefile.manual b/src/Makefile.manual index 25132a375..dda338f92 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -60,6 +60,8 @@ SRC = f18estop.f90 \ stdlib_error.f90 \ stdlib_specialfunctions.f90 \ stdlib_specialfunctions_legendre.f90 \ + stdlib_hashmap_wrapper.f90 \ + stdlib_hashmaps.f90 \ stdlib_io.f90 \ stdlib_logger.f90 \ stdlib_quadrature_gauss.f90 \ @@ -109,6 +111,16 @@ stdlib_hash_64bit_pengy.o: \ stdlib_hash_64bit.o stdlib_hash_64bit_spookyv2.o: \ stdlib_hash_64bit.o +stdlib_hashmap_wrappers.o: \ + stdlib_kinds.o \ + stdlib_hash_32bit.o +stdlib_hashmaps.o: \ + stdlib_kinds.o \ + stdlib_hashmap_wrappers.o +stdlib_hashmap_chaining.o: \ + stdlib_hashmaps.o +stdlib_hashmap_open.o: \ + stdlib_hashmaps.o stdlib_ascii.o: stdlib_kinds.o stdlib_bitsets.o: stdlib_kinds.o \ stdlib_optval.o diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 new file mode 100755 index 000000000..ecb687e98 --- /dev/null +++ b/src/stdlib_hashmap_chaining.f90 @@ -0,0 +1,848 @@ +!! The module STDLIB_HASHMAP_CHAINING implements a simple separate +!! chaining hash map. The implementation is loosely based on a C +!! implementation by David Chase, http://chasewoerner.org/src/hasht/, for +!! which he has given permission to use in the Fortran Standard Library. + +! Note an error in the code caused attempts to deallocate already deallocated +! entries. This did not cause stat to be non-zero, but did cause system errors, +! on my Mac. I therefore decided to remove all deallocation error reporting. + +submodule(stdlib_hashmaps) stdlib_hashmap_chaining +!! Version: Experimental +!! +!! Implements a simple separate chaining hash map. + + implicit none + +! Error messages + character(len=*), parameter :: & + alloc_inv_fault = "CHAINING_HASHMAP_TYPE % INVERSE allocation " // & + "fault.", & + alloc_slots_fault = "CHAINING_HASHMAP_TYPE % SLOTS allocation " // & + "fault.", & + conflicting_key = "KEY already exists in MAP.", & + expand_slots_fail = "CHAINING_HASHMAP_TYPE % SLOTS allocation > " // & + "max bits.", & + init_slots_pow_fail = "SLOT_BITS is not between DEFAULT_BITS " // & + "and MAX_BITS.", & + invalid_inmap = "INMAP was not a valid INVERSE index.", & + map_consist_fault = "The hash map found a inconsistency." + + character(len=*), parameter :: submodule_name = "STDLIB_HASHMAP_CHAINING" + + interface expand_slots +!! Version: Experimental +!! +!! Interface to internal procedure that expands the number of map slots. + module procedure expand_chaining_slots + end interface expand_slots + + interface extend_map_entry_pool +!! Version: Experimental +!! +!! Interface to internal procedure that expands a chaining map entry pool. + module procedure extend_chaining_map_entry_pool + end interface extend_map_entry_pool + + interface free_map +!! Version: Experimental +!! +!! Interface to procedure that finalizes a chaining hash map. + module procedure free_chaining_map + end interface free_map + + interface free_map_entry_pool +!! Version: Experimental +!! +!! Interface to internal procedure that finalizes a chaining hash map +!! entry pool. + module procedure free_map_entry_pool + end interface free_map_entry_pool + + interface get_other_data +!! Version: Experimental +!! +!! Interface to procedure that gets an entry's other data. + module procedure get_other_chaining_data + end interface get_other_data + + interface init +!! Version: Experimental +!! +!! Interface to initialization procedure for a chaining hash map. + module procedure init_chaining_map + end interface init + + interface rehash +!! Version: Experimental +!! +!! Interface to a procedure that changes the hash function that +!! is used to map the keys into a chaining hash map. + module procedure rehash_chaining_map + end interface rehash + + interface remove +!! Version: Experimental +!! +!! Interface to a procedure that removes the entry associated with a key + module procedure remove_chaining_entry ! Chase's delent + end interface remove + + interface set_other_data +!! Version: Experimental +!! +!! Interface to a procedure that changes the other data associated with a key + module procedure set_other_chaining_data + end interface set_other_data + +contains + +! Internal routine to make a duplicate map with more hash slots. +! Note David Chase had pointer returning functions, but the logic did not +! depend on the result value + subroutine expand_chaining_slots( map ) +!! Version: Experimental +!! +!! Internal routine to make a duplicate map with more hash slots. +!! Doubles the size of the map % slots array +!! Arguments: +!! map - the hash map whose hash slots are to be expanded +! + type(chaining_hashmap_type), intent(inout) :: map + + type(chaining_map_entry_type), pointer :: current_entry + type(chaining_map_entry_ptr), allocatable :: dummy_slots(:) + integer(int_index) :: min_size, new_size + integer(int_index) :: old_size, & + slot_index + integer(int32) :: bits, & + stat + character(256) :: errmsg + character(*), parameter :: procedure = 'EXPAND_SLOTS' + + if ( map % nbits == max_bits ) then + error stop submodule_name // ' % ' // procedure // ': ' // & + expand_slots_fail + end if + + old_size = size(map % slots, kind=int_index) + + determine_new_size: if ( map % num_entries <= old_size ) then +! Expand by factor of two to improve efficiency + new_size = 2*old_size + bits = map % nbits + 1 + else +! Expand so the number of slots is no more than 2**max_bits but otherwise +! at least the number of entries + min_size = map % num_entries + new_size = old_size + bits = map % nbits + do + bits = bits + 1 + new_size = new_size * 2 + if ( bits >= max_bits .OR. new_size >= min_size ) exit + end do + end if determine_new_size + + allocate( dummy_slots(0:new_size-1), stat=stat, errmsg=errmsg ) + if (stat /= 0) then + write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg) + error stop submodule_name // ' % ' // procedure // ': ' // & + alloc_slots_fault + end if + + map % nbits = bits + do slot_index=0, new_size-1 + dummy_slots(slot_index) % target => null() ! May be redundant + end do + + map % total_probes = map % total_probes + map % probe_count + map % probe_count = 0 + +! This maps old slots entries to new slots, but we could also map inverse +! entries to new_slots + do slot_index=0, old_size-1 + do while( associated(map % slots(slot_index) % target) ) + current_entry => map % slots(slot_index) % target + map % slots(slot_index) % target => current_entry % next + call remap( dummy_slots, current_entry, map % nbits ) + end do + end do + + call move_alloc( dummy_slots, map % slots ) + + contains + + subroutine remap(slots, gentry, bits) + type(chaining_map_entry_ptr), intent(inout) :: slots(0:) + type(chaining_map_entry_type), intent(inout), target :: gentry + integer(int_hash), intent(in) :: bits + + integer(int_index) :: hash_index + type(chaining_map_entry_type), pointer :: where_loc + + hash_index = fibonacci_hash( gentry % hash_val, bits ) + where_loc => slots(hash_index) % target + gentry % next => null() ! May be redundant + + if ( associated( where_loc ) ) then + do while ( associated(where_loc % next) ) + where_loc => where_loc % next + end do + where_loc % next => gentry + else + slots(hash_index) % target => gentry + end if + + end subroutine remap + + end subroutine expand_chaining_slots + + + subroutine extend_chaining_map_entry_pool(map) ! gent_pool_new +!! Version: Experimental +!! +!! Add more map_entrys to the pool head +!! Arguments: +!! pool - a chaining map entry pool + type(chaining_hashmap_type), intent(inout) :: map + + type(chaining_map_entry_pool), pointer :: pool + + allocate(pool) + allocate(pool % more_map_entries(0:pool_size-1)) + pool % next = 0 ! may be redundant + pool % lastpool => map % cache + map % cache => pool + + end subroutine extend_chaining_map_entry_pool + + +! Internal final routine to free a map and its memory + module subroutine free_chaining_map( map ) +!! Version: Experimental +!! +!! Frees internal memory of an chaining map +!! Arguments: +!! map - the chaining hash map whose memory is to be freed +! + type(chaining_hashmap_type), intent(inout) :: map + + integer(int_index) :: i + type(chaining_map_entry_type), pointer :: next + + if ( allocated( map % slots ) ) then + remove_slot_links: do i=0, size( map % slots ) - 1 + if ( associated( map % slots(i) % target ) ) then + map % slots(i) % target => null() + end if + end do remove_slot_links + deallocate( map % slots ) + end if + + if ( allocated( map % inverse) ) then + remove_links: do i=1, size( map % inverse, kind=int_index ) + if ( associated( map % inverse(i) % target ) ) then + map % inverse(i) % target % next => null() + end if + map % inverse(i) % target => null() + end do remove_links + deallocate( map % inverse ) + end if + + free_free_list: do + if ( associated( map % free_list) ) then + next => map % free_list % next + map % free_list => next + cycle free_free_list + else + map % num_free = 0 + exit free_free_list + end if + end do free_free_list + + if ( associated( map % cache ) ) call free_map_entry_pool(map % cache) + + map % num_entries = 0 + + end subroutine free_chaining_map + + + recursive subroutine free_map_entry_pool(pool) ! gent_pool_free +!! Version: Experimental +!! +!! Recursively descends map entry pool list freeing each element +!! Arguments: +!! pool The map entry pool whose elements are to be freed +! + type(chaining_map_entry_pool), intent(inout), pointer :: pool + + if ( .not. associated(pool) ) return + call free_map_entry_pool(pool % lastpool) + deallocate( pool ) + + end subroutine free_map_entry_pool + + + module subroutine get_other_chaining_data( map, key, other, exists ) +!! Version: Experimental +!! +!! Returns the other data associated with the inverse table index +!! Arguments: +!! map - a chaining hash map +!! key - the key associated with a map entry +!! other - the other data associated with the key +!! exists - a logical flag indicating whether an entry with that key exists +! + class(chaining_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(out) :: other + logical, intent(out), optional :: exists + + integer(int_index) :: inmap + character(*), parameter :: procedure = 'GET_OTHER_DATA' + + call in_chain_map(map, inmap, key) + if ( inmap <= 0 .or. & + inmap > size(map % inverse, kind=int_index ) ) then + if ( present(exists) ) then + exists = .false. + return + else + error stop submodule_name // ' % ' // procedure // ': ' // & + invalid_inmap + end if + else if ( associated( map % inverse(inmap) % target ) ) then + if (present(exists) ) exists = .true. + call copy_other( map % inverse(inmap) % target % other, other ) + else + if ( present(exists) ) then + exists = .false. + return + else + error stop submodule_name // ' % ' // procedure // ': ' // & + map_consist_fault + end if + end if + + end subroutine get_other_chaining_data + + + subroutine in_chain_map(map, inmap, key) +!! Version: Experimental +!! +!! Returns the index into the INVERSE array associated with the KEY +!! Arguments: +!! map - the hash map of interest +!! inmap - the returned index into the INVERSE array of entry pointers +!! key - the key identifying the entry of interest +! + class(chaining_hashmap_type), intent(inout) :: map + integer(int_index), intent(out) :: inmap + type(key_type), intent(in) :: key + + integer(int_hash) :: hash_val, hash_index + type(chaining_map_entry_type), pointer :: gentry, pentry, sentry + + if ( map % probe_count > inmap_probe_factor * map % call_count ) then + if ( map % nbits < max_bits .AND. & + map % num_entries > size( map % slots, kind=int_index ) ) then + call expand_slots(map) + end if + end if + map % call_count = map % call_count + 1 + hash_val = map % hasher( key ) + hash_index = fibonacci_hash( hash_val, map % nbits ) + pentry => map % slots(hash_index) % target + sentry => pentry + + climb_chain: do + gentry => pentry + map % probe_count = map % probe_count + 1 + if (.not. associated( gentry ) ) then + write(error_unit,*) "gentry not associated" + inmap = 0 + return + else if ( hash_val == gentry % hash_val ) then + if ( key == gentry % key ) then +! The swap to front seems to confuse gfortran's pointers +! if ( .not. associated( pentry, sentry ) ) then +! ! swap to front +! pentry => gentry % next +! gentry % next => sentry +! sentry => gentry +! end if + inmap = gentry % inmap + return + end if + end if + pentry => gentry % next + end do climb_chain + + end subroutine in_chain_map + + + module subroutine init_chaining_map( map, & + hasher, & + slots_bits, & + status ) +!! Version: Experimental +!! +!! Routine to allocate an empty map with HASHER as the hash function, +!! 2**SLOTS_BITS initial SIZE(map % slots), and SIZE(map % slots) limited +!! to a maximum of 2**MAX_BITS. All fields are initialized. +!! Arguments: +!! map - the chaining hash map to be initialized +!! hasher - the hash function to be used to map keys to slots +!! slots_bits - the bits of two used to initialize the number of slots +!! status - an integer error status flag with the allowed values: +!! success - no problems were found +!! alloc_fault - map % slots or map % inverse could not be allocated +!! array_size_error - slots_bits is less than default_bits or +!! greater than max_bits +! + class(chaining_hashmap_type), intent(out) :: map + procedure(hasher_fun) :: hasher + integer, intent(in), optional :: slots_bits + integer(int32), intent(out), optional :: status + + character(256) :: errmsg = '' + integer(int_index) :: index + character(*), parameter :: procedure = 'INIT' + integer(int_index) :: slots + integer(int32) :: stat + + map % call_count = 0 + map % probe_count = 0 + map % total_probes = 0 + + map % hasher => hasher + + call free_chaining_map( map ) + + if ( present(slots_bits) ) then + if ( slots_bits < 6 .OR. slots_bits > max_bits ) then + if ( present(status) ) then + status = array_size_error + return + else + error stop submodule_name // ' % ' // procedure // ': ' // & + init_slots_pow_fail + end if + end if + map % nbits = slots_bits + else + map % nbits = min( default_bits, max_bits ) + end if + + slots = 2_int_index**map % nbits + + allocate( map % slots(0:slots-1), stat=stat, errmsg=errmsg ) + if ( stat /= 0 ) then + if ( present(status) ) then + status = alloc_fault + return + else + write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg) + error stop submodule_name // ' % ' // procedure // ': ' // & + alloc_slots_fault + end if + end if + do index = 0, size( map % slots, kind=int_index )-1 + map % slots(index) % target => null() ! May be redundant + end do + +! 5*s from Chase's g_new_map + allocate( map % inverse(1:slots), stat=stat, errmsg=errmsg ) + if ( stat /= 0 ) then + if ( present( status ) ) then + status = alloc_fault + return + else + write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg) + error stop submodule_name // ' % ' // procedure // ': ' // & + alloc_inv_fault + end if + end if + do index=1, size(map % inverse, kind=int_index) + map % inverse(index) % target => null() + end do + + call extend_map_entry_pool(map) + + if (present(status) ) status = success + + end subroutine init_chaining_map + + + pure module function chaining_loading( map ) +!! Version: Experimental +!! +!! Returns the number of entries relative to slots in a hash map +!! Arguments: +!! map - a chaining hash map + class(chaining_hashmap_type), intent(in) :: map + real :: chaining_loading + + chaining_loading = real( map % num_entries ) / & + real( size( map % slots, kind=int_index ) ) + + end function chaining_loading + + + module subroutine map_chain_entry(map, key, other, conflict) +!! Version: Experimental +!! +!! Inserts an entry into the hash table +!! Arguments: +!! map - the hash table of interest +!! key - the key identifying the entry +!! other - other data associated with the key +!! conflict - logical flag indicating whether the entry key conflicts +!! with an existing key +! + class(chaining_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(in), optional :: other + logical, intent(out), optional :: conflict + + integer(int_hash) :: hash_index + integer(int_hash) :: hash_val + integer(int_index) :: inmap + type(chaining_map_entry_type), pointer :: new_ent + type(chaining_map_entry_type), pointer :: gentry, pentry, sentry + character(*), parameter :: procedure = 'MAP_ENTRY' + + hash_val = map % hasher( key ) + + if ( map % probe_count > map_probe_factor * map % call_count ) then + call expand_slots(map) + end if + map % call_count = map % call_count + 1 + hash_index = fibonacci_hash( hash_val, map % nbits ) + pentry => map % slots(hash_index) % target + sentry => pentry + + do + gentry => pentry + map % probe_count = map % probe_count + 1 + if ( .not. associated( gentry ) ) then + call allocate_chaining_map_entry( map, new_ent ) + new_ent % hash_val = hash_val +! Adding to tail of chain doesn't work on gfortran +! new_ent % next => sentry +! sentry => new_ent +! Adding to head of chain works on gfortran + new_ent % next => map % slots(hash_index) % target + map % slots(hash_index) % target => new_ent + call copy_key( key, new_ent % key ) + if ( present(other) ) call copy_other( other, new_ent % other ) + + if ( new_ent % inmap == 0 ) then + map % num_entries = map % num_entries + 1 + inmap = map % num_entries + else + inmap = new_ent % inmap + end if + + if ( inmap == size( map % inverse, kind=int_index ) ) then + call expand_inverse( map ) + end if + new_ent % inmap = inmap + map % inverse(inmap) % target => new_ent + if ( present(conflict) ) conflict = .false. + + return + + else if ( hash_val == gentry % hash_val ) then + if ( key == gentry % key ) then + inmap = gentry % inmap + if ( .not. associated( pentry, sentry ) ) then + ! Swap to front + pentry => gentry % next + gentry % next => sentry + sentry => gentry + end if + if ( present(conflict) ) then + conflict = .true. + else + error stop submodule_name // ' % ' // procedure & + // ': ' // conflicting_key + end if + return + end if + end if + pentry => gentry % next + + end do + + contains + + subroutine allocate_chaining_map_entry(map, bucket) ! Chases gent_malloc +! allocates a hash bucket + type(chaining_hashmap_type), intent(inout) :: map + type(chaining_map_entry_type), pointer, intent(out) :: bucket + + type(chaining_map_entry_pool), pointer :: pool + + pool => map % cache + map % num_entries = map % num_entries + 1 + if ( associated(map % free_list) ) then +! Get hash bucket from free_list + bucket => map % free_list + map % free_list => bucket % next + map % num_free = map % num_free - 1 + else +! Get hash bucket from pool + if ( pool % next == pool_size ) then +! Expand pool + call extend_map_entry_pool(map) + pool => map % cache + end if + bucket => pool % more_map_entries(pool % next) + pool % next = pool % next + 1 ! 0s based + if ( map % num_entries > & + size( map % inverse, kind=int_index ) ) & + then + call expand_inverse( map ) + end if + bucket % inmap = map % num_entries + end if + + end subroutine allocate_chaining_map_entry + + + subroutine expand_inverse(map) +! Increase size of map % inverse + type(chaining_hashmap_type), intent(inout) :: map + type(chaining_map_entry_ptr), allocatable :: dummy_inverse(:) + integer(int32) :: stat + character(256) :: errmsg + character(*), parameter :: procedure = 'MAP_ENTRY' + + allocate( dummy_inverse( 1:2*size(map % inverse, & + kind=int_index) ), & + stat=stat, & + errmsg=errmsg ) + if ( stat /= 0 ) then + write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg) + error stop submodule_name // ' % ' // procedure // ': ' // & + alloc_inv_fault + end if + + dummy_inverse(1:size(map % inverse, kind=int_index)) = & + map % inverse(:) + + call move_alloc( dummy_inverse, map % inverse ) + + end subroutine expand_inverse + + end subroutine map_chain_entry + + + module subroutine rehash_chaining_map( map, hasher ) +!! Version: Experimental +!! +!! Changes the hashing method of the table entries to that of HASHER. +!! Arguments: +!! map the table to be rehashed +!! hasher the hasher function to be used for the table +! + class(chaining_hashmap_type), intent(inout) :: map + procedure(hasher_fun) :: hasher + + integer(int_hash) :: hash_val + integer(int_index) :: i + integer(int_index) :: index + + map % hasher => hasher + + do i=0, size( map % slots, kind=int_index ) - 1 + map % slots(i) % target => null() + end do + + do i=1, map % num_entries + map % num_free + if ( .not. associated( map % inverse(i) % target ) ) cycle + hash_val = map % hasher ( map % inverse(i) % target % key ) + map % inverse(i) % target % hash_val = hash_val + index = fibonacci_hash( hash_val, map % nbits ) + map % inverse(i) % target % inmap = i + if ( associated( map % slots(index) % target ) ) then + map % inverse(i) % target % next => map % slots(index) % target + map % slots(index) % target => map % inverse(i) % target + else + map % slots(index) % target => map % inverse(i) % target + map % slots(index) % target % next => null() + end if + end do + + end subroutine rehash_chaining_map + + + module subroutine remove_chaining_entry(map, key, existed) +!! Remove the entry, if any, that has the key +!! Arguments: +!! map - the table from which the entry is to be removed +!! key - the key to an entry +!! existed - a logical flag indicating whether an entry with the key +!! was present in the original map +! + class(chaining_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + logical, intent(out), optional :: existed + + type(chaining_map_entry_type), pointer :: bucket, aentry, bentry, centry + integer(int_hash) :: hash_val + integer(int_index) :: inmap, k, level + + call in_chain_map( map, inmap, key ) + if ( inmap < 1 .or. inmap > size( map % inverse ) ) then + if ( present( existed ) ) existed = .false. + return + end if + + bucket => map % inverse(inmap) % target + if ( .not. associated(bucket) ) then + if ( present( existed ) ) existed = .false. + return + end if + if ( present(existed) ) existed = .true. + hash_val = bucket % hash_val + k = fibonacci_hash( hash_val, map % nbits ) + allocate(aentry) + aentry => map % slots(k) % target + if ( associated(aentry) ) then + if ( aentry % inmap == inmap ) then + bentry => aentry % next + map % slots(k) % target => bentry + aentry % next => map % free_list + map % free_list => aentry + map % inverse(inmap) % target => null() + map % num_free = map % num_free + 1 + map % num_entries = map % num_entries - 1 + return + end if + else + return + end if + level = 1 + centry => map % slots(k) % target + aentry => aentry % next + + FIND_SLOTS_ENTRY:do + if ( .not. associated(aentry) ) return + if ( aentry % inmap == inmap ) exit + centry => aentry + aentry => aentry % next + level = level + 1 + end do FIND_SLOTS_ENTRY + + bentry => aentry % next + aentry % next => map % free_list + map % free_list => aentry + centry % next => bentry + map % inverse(inmap) % target => null() + map % num_free = map % num_free + 1 + + end subroutine remove_chaining_entry + + + module subroutine set_other_chaining_data( map, key, other, exists ) +!! Version: Experimental +!! +!! Change the other data associated with the key +!! Arguments: +!! map - the map with the entry of interest +!! key - the key to the entry inthe map +!! other - the new data to be associated with the key +!! exists - a logical flag indicating whether the key is already entered +!! in the map +! + class(chaining_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(in) :: other + logical, intent(out), optional :: exists + + integer(int_index) :: inmap + character(*), parameter :: procedure = 'SET_OTHER_DATA' + + call in_chain_map( map, inmap, key ) + if ( inmap <= 0 .or. inmap > size( map % inverse, kind=int_index ) ) & + then + if ( present(exists) ) then + exists = .false. + return + else + error stop submodule_name // ' % ' // procedure // ': ' // & + invalid_inmap + end if + else if ( associated( map % inverse(inmap) % target ) ) then + associate( target => map % inverse(inmap) % target ) + call copy_other( other, target % other ) + if ( present(exists) ) exists = .true. + return + end associate + else + error stop submodule_name // ' % ' // procedure // ': ' // & + invalid_inmap + end if + + end subroutine set_other_chaining_data + + + module function total_chaining_depth( map ) result(total_depth) +!! Version: Experimental +!! +!! Returns the total number of ones based offsets of slot entries from +!! their slot index for a hash map +!! Arguments: +!! map - an chaining hash map + class(chaining_hashmap_type), intent(in) :: map + integer(int_depth) :: total_depth + + type(chaining_map_entry_type), pointer :: current_key + integer(int_index) :: slot, slots + integer(int_depth) :: index + + total_depth = 0_int_depth + slots = size( map % slots, kind=int_index ) + do slot=0, slots-1 + current_key => map % slots(slot) % target + index = 0_int_depth + do while( associated(current_key) ) + index = index + 1_int_depth + total_depth = total_depth + index + current_key => current_key % next + end do + end do + + end function total_chaining_depth + + + module subroutine chaining_key_test(map, key, present) +!! Version: Experimental +!! +!! Returns a logical flag indicating whether KEY is present in the hash map +!! Arguments: +!! map - the hash map of interest +!! key - the key of interest +!! present - a logical flag indicating whether key is present in map +! + class(chaining_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + logical, intent(out) :: present + + integer(int_index) :: inmap + + call in_chain_map( map, inmap, key ) + if ( inmap <= 0 .or. inmap > size( map % inverse, kind=int_index ) ) & + then + present = .false. + else + present = associated( map % inverse(inmap) % target ) + end if + + end subroutine chaining_key_test + + +end submodule stdlib_hashmap_chaining diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 new file mode 100755 index 000000000..8f70d7ea3 --- /dev/null +++ b/src/stdlib_hashmap_open.f90 @@ -0,0 +1,875 @@ +!! The module, STDLIB_HASHMAP_OPEN implements a simple open addresing hash +!! map using linear addressing. The implementation is loosely based on a +!! C implementation by David Chase, http://chasewoerner.org/src/hasht/, for +!! which he has given permission to use in the Fortran Standard Library. + +! Note an error in the code caused attempts to deallocate already deallocated +! entries. This did not cause stat to be non-zero, but did cause system errors, +! on my Mac. I therefore decided to remove all deallocation error reporting. + +submodule(stdlib_hashmaps) stdlib_hashmap_open + + use, intrinsic :: iso_fortran_env, only: & + character_storage_size, & + error_unit + + use stdlib_hashmap_wrappers + + implicit none + +! Error messages + character(len=*), parameter :: & + alloc_inv_fault = "OPEN_HASHMAP_TYPE % INVERSE allocation fault.", & + alloc_key_fault = "KEY allocation fault.", & + alloc_slots_fault = "OPEN_HASHMAP_TYPE % SLOTS allocation fault.", & + conflicting_key = "KEY already exists in MAP.", & + expand_slots_fail = "OPEN_HASHMAP_TYPE % SLOTS allocation > " // & + "MAX_BITS.", & + init_slots_pow_fail = "SLOTS_BITS is not between DEFAULT_BITS " // & + "and MAX_BITS.", & + invalid_inmap = "INMAP was not a valid INVERSE index.", & + map_consist_fault = "The hash map found an inconsistency." + + character(*), parameter :: submodule_name = 'STDLIB_HASHMAP_OPEN' + + + interface expand_slots +!! Version: Experimental +!! +!! Interface to internal procedure that expands an open map's slots. + module procedure expand_open_slots + end interface expand_slots + + interface extend_map_entry_pool +!! Version: Experimental +!! +!! Interface to internal procedure that expands an open map entry pool. + module procedure extend_open_map_entry_pool + end interface extend_map_entry_pool + + interface free_map +!! Version: Experimental +!! +!! Interface to procedure that finalizes an open hash map. + module procedure free_open_map + end interface free_map + + interface free_map_entry_pool +!! Version: Experimental +!! +!! Interface to internal procedure that finalizes an open hash map +!! entry pool. + module procedure free_map_entry_pool + end interface free_map_entry_pool + + interface get_other_data +!! Version: Experimental +!! +!! Interface to procedure that gets an entry's other data. + module procedure get_other_open_data + end interface get_other_data + + interface init +!! Version: Experimental +!! +!! Interface to initialization procedure for an open hash map. + module procedure init_open_map + end interface init + + interface rehash +!! Version: Experimental +!! +!! Interface to a procedure that changes the hash function that +!! is used to map the keys into an open hash map. + module procedure rehash_open_map + end interface rehash + + interface remove +!! Version: Experimental +!! +!! Interface to a procedure that removees an entry from an open hash map. + module procedure remove_open_entry + end interface remove + + interface set_other_data +!! Version: Experimental +!! +!! Interface to a procedure that changes the other data associated with a key + module procedure set_other_open_data + end interface set_other_data + +contains + + + subroutine expand_open_slots( map ) +!! Version: Experimental +!! +!! Internal routine to make a duplicate map with more hash slots. +!! Doubles the size of the map % slots array +!! Arguments: +!! map - the hash table whose hash slots are to be expanded +! + type(open_hashmap_type), intent(inout) :: map + + integer(int_hash) :: base_slot + integer(int_index), allocatable :: dummy_slots(:) + integer(int_index) :: inv_index, & + new_size, & + offset, & + old_size, & + test_slot + integer(int32) :: bits, & + stat + + character(256) :: errmsg + character(*), parameter :: procedure = 'EXPAND_SLOTS' + + if ( map % nbits == max_bits ) then + error stop submodule_name // ' % ' // procedure // ': ' // & + expand_slots_fail + end if + + old_size = size(map % slots, kind=int_index) + + new_size = 2*old_size + bits = map % nbits + 1 + + allocate( dummy_slots(0:new_size-1), stat=stat, errmsg=errmsg ) + if (stat /= 0) then + error stop submodule_name // ' % ' // procedure // ': ' // & + alloc_slots_fault + end if + + map % nbits = bits + + dummy_slots(:) = 0 + map % index_mask = new_size-1 + + map % total_probes = map % total_probes + map % probe_count + map % probe_count = 0 + + REMAP_SLOTS: do inv_index=1_int_index, & + map % num_entries + map % num_free + associate( inverse => map % inverse(inv_index) ) + if ( associated(inverse % target) ) then + base_slot = fibonacci_hash( inverse % target % hash_val, & + map % nbits ) + offset = 0 + FIND_EMPTY_SLOT: do + test_slot = iand( int( base_slot + offset, int_hash), & + map % index_mask ) + if ( dummy_slots(test_slot) == 0 ) then + dummy_slots(test_slot) = inv_index + exit FIND_EMPTY_SLOT + end if + offset = offset + 1 + end do FIND_EMPTY_SLOT + end if + end associate + end do REMAP_SLOTS + + call move_alloc( dummy_slots, map % slots ) + + end subroutine expand_open_slots + + + subroutine extend_open_map_entry_pool(pool) ! gent_pool_new +!! Version: Experimental +!! +!! Add more map_entrys to the pool head +!! Arguments: +!! pool - an open map entry pool + type(open_map_entry_pool), intent(inout), pointer :: pool + + type(open_map_entry_pool), pointer :: map_entry_pool_head + + allocate(map_entry_pool_head) + allocate(map_entry_pool_head % more_map_entries(0:pool_size-1)) + map_entry_pool_head % lastpool => pool + pool => map_entry_pool_head + pool % next = 0 + + end subroutine extend_open_map_entry_pool + + + recursive subroutine free_map_entry_pool(pool) ! gent_pool_free +!! Version: Experimental +!! Note the freeing of allocated memory may be unnecessary +!! +!! Recursively descends map entry pool list freeing each element +!! Arguments: +!! pool The map entry pool whose elements are to be freed +! + type(open_map_entry_pool), intent(inout), pointer :: pool + + type(open_map_entry_pool), pointer :: lastpool + + if ( associated(pool) ) then + lastpool => pool % lastpool + pool % lastpool => null() + deallocate( pool ) +! Trace component pointers/lists + call free_map_entry_pool( lastpool ) + end if + + end subroutine free_map_entry_pool + + + module subroutine free_open_map( map ) +!! Version: Experimental +!! +!! Frees internal memory of an open map +!! Arguments: +!! map - the open hash map whose memory is to be freed +! + type(open_hashmap_type), intent(inout) :: map + + type(open_map_entry_list), pointer :: free_list + integer(int_index) :: i + + if ( allocated( map % slots ) ) then + deallocate( map % slots ) + end if + + if ( allocated( map % inverse ) ) then + remove_links: do i=1, size( map % inverse, kind=int_index ) + map % inverse(i) % target => null() + end do remove_links + deallocate( map % inverse ) + end if + + free_free_list: do while( map % num_free > 0 ) + free_list => map % free_list + map % free_list => map % free_list % next + free_list % next => null() + free_list % target => null() + map % num_free = map % num_free - 1 + end do free_free_list + map % num_free = 0 + + if ( associated( map % cache ) ) call free_map_entry_pool(map % cache) + + map % num_entries = 0 + + end subroutine free_open_map + + + module subroutine get_other_open_data( map, key, other, exists ) +!! Version: Experimental +!! +!! Returns the other data associated with the inverse table index +!! Arguments: +!! map - an open hash table +!! key - the key associated with a map entry +!! other - the other data associated with the key +!! exists - a logical flag indicating whether an entry with that key exists +! + class(open_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(out) :: other + logical, intent(out), optional :: exists + + integer(int_index) :: inmap + character(*), parameter :: procedure = 'GET_OTHER_DATA' + + call in_open_map(map, inmap, key) + if ( inmap <= 0 .or. & + inmap > map % num_entries + map % num_free ) then + if ( present(exists) ) then + exists = .false. + return + else + error stop submodule_name // ' % ' // procedure // ': ' // & + invalid_inmap + end if + else if ( associated( map % inverse(inmap) % target ) ) then + exists = .true. + call copy_other( map % inverse(inmap) % target % other, other ) + else + if ( present(exists) ) then + exists = .false. + return + else + error stop submodule_name // ' % ' // procedure // ': ' // & + map_consist_fault + end if + end if + + end subroutine get_other_open_data + + + subroutine in_open_map(map, inmap, key) ! Chase's inmap +!! Version: Experimental +!! +!! Retuns the index into the INVERSE array associated with the KEY +!! Arguments: +!! map - the hash map of interest +!! inmap - the returned index into the INVERSE array of entry pointers +!! key - the key identifying the entry of interest +! + class(open_hashmap_type), intent(inout) :: map + integer(int_index), intent(out) :: inmap + type(key_type), intent(in) :: key + + character(*), parameter :: procedure = 'IN_MAP' + integer(int_hash) :: & + base_slot, & + hash_val, & + test_slot + integer(int_index) :: & + offset + + hash_val = map % hasher( key ) + + if ( map % probe_count > inmap_probe_factor * map % call_count .or. & + map % num_entries >= load_factor * & + size( map % slots, kind=int_index ) ) then + if ( map % nbits < max_bits ) & + call expand_slots(map) + end if + + map % call_count = map % call_count + 1 + base_slot = fibonacci_hash( hash_val, map % nbits ) + offset = 0_int_index + PROBE_SLOTS: do + test_slot = iand( base_slot + offset, map % index_mask ) + map % probe_count = map % probe_count + 1 + inmap = map % slots( test_slot ) + if ( inmap == 0 ) then + return + else if ( inmap < 0 .or. & + inmap > map % num_entries + map % num_free ) then + error stop submodule_name // ' % ' // procedure // ': ' // & + map_consist_fault + else if ( .not. associated( map % inverse(inmap) % target ) ) then + error stop submodule_name // ' % ' // procedure // ': ' // & + map_consist_fault + else + associate( inverse => map % inverse(inmap) ) + if ( hash_val == inverse % target % hash_val ) then + if ( key == inverse % target % key ) then + return + end if + end if + end associate + end if + offset = offset + 1_int_index + end do PROBE_SLOTS + + end subroutine in_open_map + + + module subroutine init_open_map( map, & + hasher, & + slots_bits, & + status ) +!! Version: Experimental +!! +!! Routine to allocate an empty map with HASHER as the hash function, +!! 2**SLOTS_BITS initial SIZE(map % slots), and SIZE(map % slots) limited to a +!! maximum of 2**MAX_BITS. All fields are initialized. +!! Arguments: +!! map - the open hash maap to be initialized +!! hasher - the hash function to be used to map keys to slots +!! slots_bits - the number of bits used to map to the slots +!! status - an integer error status flag with the allowed values: +!! success - no problems were found +!! alloc_fault - map % slots or map % inverse could not be allocated +!! array_size_error - slots_bits is less than default_bitd or +!! greater than max_bits + + class(open_hashmap_type), intent(out) :: map + procedure(hasher_fun) :: hasher + integer, intent(in), optional :: slots_bits + integer(int32), intent(out), optional :: status + + character(256) :: errmsg + integer(int_index) :: i + character(*), parameter :: procedure = 'INIT' + integer(int_index) :: slots + integer(int32) :: stat + type(open_map_entry_pool), pointer :: map_entry_pool_head + + map % call_count = 0 + map % probe_count = 0 + map % total_probes = 0 + + map % hasher => hasher + + if ( present(slots_bits) ) then + if ( slots_bits < default_bits .OR. & + slots_bits > max_bits ) then + if ( present(status) ) then + status = array_size_error + return + else + error stop submodule_name // ' % ' // procedure // ': ' // & + init_slots_pow_fail + end if + end if + map % nbits = slots_bits + else + map % nbits = min( default_bits, max_bits ) + end if + + slots = 2_int32**map % nbits + map % index_mask = slots - 1 + + allocate( map % slots(0:slots-1), stat=stat, errmsg=errmsg ) + if ( stat /= 0 ) then + if ( present(status) ) then + status = alloc_fault + return + else + write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg) + error stop submodule_name // ' % ' // procedure // ': ' // & + alloc_slots_fault + end if + end if + + do i=0, size( map % slots, kind=int_index ) - 1 + map % slots(i) = 0 ! May be redundant + end do + +!! 5*s from Chase's g_new_map + allocate( map % inverse(1:ceiling(load_factor*slots, & + kind=int_index)), & + stat=stat, & + errmsg=errmsg ) + if ( stat /= 0 ) then + if ( present( status ) ) then + status = alloc_fault + return + else + write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg) + error stop submodule_name // ' % ' // procedure // ': ' // & + alloc_inv_fault + end if + end if + + do i=1, size(map % inverse, kind=int_index) + map % inverse(i) % target => null() + end do + + do while(associated(map % cache)) + map_entry_pool_head => map % cache + map % cache => map_entry_pool_head % lastpool + map_entry_pool_head % lastpool => null() + deallocate( map_entry_pool_head % more_map_entries ) + deallocate( map_entry_pool_head ) + end do + + call extend_map_entry_pool(map % cache) + + if (present(status) ) status = success + + end subroutine init_open_map + + + pure module function open_loading( map ) +!! Version: Experimental +!! +!! Returns the number of entries relative to slots in a hash map +!! Arguments: +!! map - an open hash map + class(open_hashmap_type), intent(in) :: map + real :: open_loading + + open_loading = real( map % num_entries ) / & + size( map % slots, kind=int_index ) + + end function open_loading + + + module subroutine map_open_entry(map, key, other, conflict) +!! Version: Experimental +!! +!! Inserts an entry into the hash table +!! Arguments: +!! map the hash table of interest +!! key - the key identifying the entry +!! other - other data associated with the key +!! conflict - logical flag indicating whether the entry key conflicts +!! with an existing key +! + class(open_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(in), optional :: other + logical, intent(out), optional :: conflict + + type(open_map_entry_type), pointer :: new_ent + integer(int_hash) :: base_slot + integer(int_hash) :: hash_val + integer(int_index) :: inmap, offset, test_slot + character(*), parameter :: procedure = 'MAP_ENTRY' + + hash_val = map % hasher( key ) + + if ( map % probe_count > map_probe_factor * map % call_count .or. & + map % num_entries >= load_factor * size( map % slots, & + kind=int_index) ) then + call expand_slots(map) + end if + map % call_count = map % call_count + 1 + base_slot = fibonacci_hash( hash_val, map % nbits ) + + offset = 0 + PROBE_SUCCESSIVE_SLOTS: do + map % probe_count = map % probe_count + 1 + test_slot = iand( base_slot + offset, map % index_mask ) + inmap = map % slots(test_slot) + if ( inmap == 0 ) then + call allocate_open_map_entry(map, new_ent) + new_ent % hash_val = hash_val + call copy_key( key, new_ent % key ) + if ( present( other ) ) & + call copy_other( other, new_ent % other ) + inmap = new_ent % inmap + map % inverse( inmap ) % target => new_ent + map % slots( test_slot ) = inmap + if ( present(conflict) ) conflict = .false. + return + else if ( inmap < 0 .or. & + inmap > map % num_entries + map % num_free ) then + error stop submodule_name // ' % ' // procedure // ': ' // & + invalid_inmap + else if (.not. associated( map % inverse(inmap) % target ) ) then + error stop submodule_name // ' % ' // procedure // ': ' // & + invalid_inmap + else + associate( target => map % inverse(inmap) % target ) + if ( hash_val == target % hash_val ) then + if ( key == target % key ) then + ! entry already exists + if ( present(conflict) ) then + conflict = .true. + else + error stop submodule_name // ' % ' // procedure & + // ': ' // conflicting_key + end if + return + end if + end if + end associate + end if + offset = offset + 1 + end do PROBE_SUCCESSIVE_SLOTS + + contains + + subroutine allocate_open_map_entry(map, bucket) +! allocates a hash bucket + type(open_hashmap_type), intent(inout) :: map + + type(open_map_entry_type), pointer, intent(out) :: bucket + type(open_map_entry_list), pointer :: free_list + type(open_map_entry_pool), pointer :: pool + + pool => map % cache + map % num_entries = map % num_entries + 1 + if ( associated(map % free_list) ) then +! Get hash bucket from free_list + free_list => map % free_list + bucket => free_list % target + map % free_list => free_list % next + free_list % target => null() + free_list % next => null() + if (bucket % inmap == 0) stop "bucket % inmap == 0" + map % num_free = map % num_free - 1 + else +! Get hash bucket from pool + if ( pool % next == pool_size ) then +! Expand pool + call extend_map_entry_pool(map % cache) + pool => map % cache + end if + bucket => pool % more_map_entries(pool % next) + pool % next = pool % next + 1 ! 0s based -> post-increment + if ( map % num_entries > & + size( map % inverse, kind=int_index ) ) then + call expand_inverse( map ) + end if + if ( map % num_entries == 0 ) stop "MAP % NUM_ENTRIES == 0." + bucket % inmap = map % num_entries + end if + + end subroutine allocate_open_map_entry + + subroutine expand_inverse(map) +!! Increase size of map % inverse + type(open_hashmap_type), intent(inout) :: map + type(open_map_entry_ptr), allocatable :: dummy_inverse(:) + + integer(int32) :: stat + character(256) :: errmsg + + allocate( dummy_inverse(1:2*size(map % inverse, kind=int_index)), & + stat=stat, errmsg=errmsg ) + if ( stat /= 0 ) then + write(error_unit, '(a)') 'Allocation ERRMSG: ' // trim(errmsg) + error stop submodule_name // ' % ' // procedure // ': ' // & + alloc_inv_fault + end if + dummy_inverse(1:size(map % inverse, kind=int_index)) = & + map % inverse(:) + + call move_alloc( dummy_inverse, map % inverse ) + + end subroutine expand_inverse + + end subroutine map_open_entry + + + module subroutine rehash_open_map( map, hasher ) +!! Version: Experimental +!! +!! Changes the hashing method of the table entries to that of HASHER. +!! Arguments: +!! map the table to be rehashed +!! hasher the hasher function to be used for the table +! + class(open_hashmap_type), intent(inout) :: map + procedure(hasher_fun) :: hasher + + integer(int_hash) :: base_slot + integer(int_hash) :: hash_val + integer(int_index) :: i, test_slot, offset + + map % hasher => hasher + + map % slots = 0 + + do i=1, map % num_entries + map % num_free + if ( .not. associated( map % inverse(i) % target ) ) cycle + hash_val = map % hasher( map % inverse(i) % target % key ) + map % inverse(i) % target % hash_val = hash_val + base_slot = fibonaccI_hash( hash_val, map % nbits ) + offset = 0 + FIND_EMPTY_SLOT: do + test_slot = iand( int( base_slot + offset, int_hash ), & + map % index_mask ) + if ( map % slots(test_slot) == 0 ) then + map % slots(test_slot) = i + exit FIND_EMPTY_SLOT + end if + offset = offset + 1 + end do FIND_EMPTY_SLOT + end do + + end subroutine rehash_open_map + + + module subroutine remove_open_entry(map, key, existed) +!! Remove the entry, if any, that has the key +!! Arguments: +!! map - the table from which the entry is to be removed +!! key - the key to an entry +!! existed - a logical flag indicating whether an entry with the key +!! was present in the original map +! + class(open_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + logical, intent(out), optional :: existed + + type(open_map_entry_list), pointer :: aentry + type(open_map_entry_type), pointer :: bucket + integer(int_index) :: base_slot + integer(int_index) :: current_index + integer(int_index) :: current_slot + integer(int_index) :: empty_slot + integer(int_index) :: inmap + logical :: overlap + integer(int_index) :: slot_index + + overlap = .false. + call in_open_map( map, inmap, key ) + if ( inmap < 1 .or. inmap > size( map % inverse ) ) then + if ( present( existed ) ) existed = .false. + return + end if + + bucket => map % inverse(inmap) % target + if ( associated(bucket) ) then + base_slot = fibonacci_hash( bucket % hash_val, map % nbits ) + if ( present(existed) ) existed = .true. + else + if ( present( existed ) ) existed = .false. + return + end if + +! Find slot associated with inmap and nullify the pointer + current_slot = base_slot + search_for_inmap: do + slot_index = map % slots(current_slot) + if ( slot_index == inmap ) then + allocate(aentry) + aentry % target => map % inverse(inmap) % target + aentry % next => map % free_list + map % free_list => aentry + map % num_free = map % num_free + 1 + map % slots( current_slot ) = 0 + map % inverse(inmap) % target => null() + map % num_entries = map % num_entries - 1 + empty_slot = current_slot + current_slot = iand( map % index_mask, current_slot + 1 ) + if ( map % slots(current_slot) == 0 ) return + if ( current_slot == 0 ) overlap = .true. + exit search_for_inmap + else + if ( map % slots(current_slot) == 0 ) return + current_slot = iand( map % index_mask, current_slot + 1 ) + if ( current_slot == 0 ) overlap = .true. + cycle search_for_inmap + end if + end do search_for_inmap + +! Have found slot and stored it in free_list, now may need to iteratively +! swap to fill holes. First search backwards to find start of run. + find_run_start: do + base_slot = iand( map % index_mask, base_slot - 1 ) + if ( base_slot == map % index_mask ) then + if ( map % slots(base_slot) == 0 ) then + base_slot = 0 + exit find_run_start + else + overlap = .true. + cycle find_run_start + end if + else if ( map % slots(base_slot) == 0 ) then + base_slot = iand( map % index_mask, base_slot + 1 ) + exit find_run_start + else + cycle find_run_start + end if + end do find_run_start + +! Search forward for entry to fill empty slot + fill_empty_slots: do + bucket => map % inverse(map % slots(current_slot) ) % target + current_index = fibonacci_hash( bucket % hash_val, & + map % nbits ) + if ( overlap .and. empty_slot < base_slot ) then + if ( ( current_index >= base_slot .and. & + current_index <= map % index_mask ) .or. & + ( current_index >= 0 .and. & + current_index <= empty_slot ) ) then + map % slots( empty_slot ) = map % slots( current_slot ) + map % slots( current_slot ) = 0 + empty_slot = current_slot + end if + current_slot = iand( map % index_mask, current_slot + 1 ) + else + if ( current_index >= base_slot .and. & + current_index <= empty_slot ) then + map % slots( empty_slot ) = map % slots( current_slot ) + map % slots( current_slot ) = 0 + empty_slot = current_slot + end if + current_slot = iand( map % index_mask, current_slot + 1 ) + if ( current_slot == 0 ) overlap = .true. + end if + if ( map % slots( current_slot ) == 0 ) exit fill_empty_slots + end do fill_empty_slots + + end subroutine remove_open_entry + + + module subroutine set_other_open_data( map, key, other, exists ) +!! Version: Experimental +!! +!! Change the other data associated with the key +!! Arguments: +!! map - the map with the entry of interest +!! key - the key to the entry inthe map +!! other - the new data to be associated with the key +!! exists - a logical flag indicating whether the key is already entered +!! in the map +! + class(open_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(in) :: other + logical, intent(out),optional :: exists + + integer(int_index) :: inmap + + character(*), parameter :: procedure = 'SET_OTHER_DATA' + + call in_open_map( map, inmap, key ) + if ( inmap <= 0 .or. inmap > size( map % inverse, kind=int_index ) ) & + then + if ( present(exists) ) then + exists = .false. + return + else + error stop submodule_name // ' % ' // procedure // ': ' // & + invalid_inmap + end if + else if ( associated( map % inverse(inmap) % target ) ) then + associate( target => map % inverse(inmap) % target ) + call copy_other( other, target % other ) + if ( present(exists) ) exists = .true. + return + end associate + else + error stop submodule_name // ' % ' // procedure // ': ' // & + invalid_inmap + end if + + end subroutine set_other_open_data + + + module function total_open_depth( map ) result(total_depth) +!! Version: Experimental +!! +!! Returns the total number of ones based offsets of slot entries from +!! their slot index for a hash map +!! Arguments: +!! map - an open hash map + class(open_hashmap_type), intent(in) :: map + integer(int64) :: total_depth + + integer(int_index) :: inv_index, slot, slots + integer(int_hash) :: index + + total_depth = 0_int64 + slots = size( map % slots, kind=int_index ) + do slot=0, slots-1 + if ( map % slots( slot ) == 0 ) cycle + inv_index = map % slots( slot ) + if ( inv_index <= 0 ) cycle + associate( inverse => map % inverse( inv_index )) + index = fibonacci_hash( inverse % target % hash_val, & + map % nbits ) + end associate + total_depth = total_depth + & + iand( slot - index, map % index_mask ) + 1_int64 + end do + + end function total_open_depth + + + module subroutine open_key_test(map, key, present) +!! Version: Experimental +!! +!! Returns a logical flag indicating whether KEY exists in the hash map +!! Arguments: +!! map - the hash map of interest +!! key - the key of interest +! + class(open_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + logical, intent(out) :: present + + integer(int_index) :: inmap + + call in_open_map( map, inmap, key ) + if ( inmap <= 0 .or. inmap > size( map % inverse, kind=int_index ) ) & + then + present = .false. + else + present = associated( map % inverse(inmap) % target ) + end if + + end subroutine open_key_test + +end submodule stdlib_hashmap_open diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 new file mode 100755 index 000000000..7b4fbdb6c --- /dev/null +++ b/src/stdlib_hashmap_wrappers.f90 @@ -0,0 +1,378 @@ +!! The module STDLIB_HASHMAP_WRAPPERS provides wrappers for vqrious +!! entities used by the hash map procedures. These include wrappers for the +!! `key` and òther`data, and hashing procedures to operate on entities of +!! the `key_type`. + +module stdlib_hashmap_wrappers + + use, intrinsic :: iso_fortran_env, only : & + character_storage_size + + use stdlib_hash_32bit + + use stdlib_kinds, only : & + int8, & + int16, & + int32, & + int64, & + dp + + implicit none + + private + +!! Public procedures + public :: & + copy_key, & + copy_other, & + fibonacci_hash, & + fnv_1_hasher, & + fnv_1a_hasher, & + free_key, & + free_other, & + get, & + hasher_fun, & + operator(==), & + seeded_nmhash32_hasher, & + seeded_nmhash32x_hasher, & + seeded_water_hasher, & + set + +!! Public types + public :: & + key_type, & + other_type + +!! Public integers + public :: & + int_hash + + integer, parameter :: & +! Should be 8 + bits_int8 = bit_size(0_int8) + + integer, parameter :: & + bits_char = character_storage_size, & + bytes_char = bits_char/bits_int8 + + type :: key_type +!! Version: Experimental +!! +!! A wrapper type for the key's true type +! private + integer(int8), allocatable :: value(:) + end type key_type + + abstract interface +!! Version: Experimental +!! +!! Abstract interface to a 64 bit hash function operating on a KEY_TYPE + pure function hasher_fun( key ) result(hash_value) + import key_type, int_hash + type(key_type), intent(in) :: key + integer(int_hash) :: hash_value + end function hasher_fun + end interface + + type :: other_type +!! Version: Experimental +!! +!! A wrapper type for the other data's true type +! private + class(*), allocatable :: value + end type other_type + + interface get + + module procedure get_char_key, & + get_int8_key + + end interface get + + + interface operator(==) + module procedure equal_keys + end interface operator(==) + + interface set + + module procedure set_char_key, & + set_int8_key, & + set_other + + end interface set + +contains + + + pure subroutine copy_key( key_in, key_out ) +!! Version: Experimental +!! +!! Copies the contents of the key, key_in, to the key, key_out +!! Arguments: +!! key_in - the input key +!! key_out - the output key + type(key_type), intent(in) :: key_in + type(key_type), intent(out) :: key_out + + key_out % value = key_in % value + + end subroutine copy_key + + + subroutine copy_other( other_in, other_out ) +!! Version: Experimental +!! +!! Copies the other data, other_in, to the variable, other_out +!! Arguments: +!! other_in - the input data +!! other_out - the output data + type(other_type), intent(in) :: other_in + type(other_type), intent(out) :: other_out + + allocate(other_out % value, source = other_in % value ) + + end subroutine copy_other + + + function equal_keys( key1, key2 ) result(test) ! Chase's tester +!! Version: Experimental +!! +!! Compares two keys for equality +!! Arguments: +!! key1 - the first key +!! key2 - the second key + logical :: test + type(key_type), intent(in) :: key1 + type(key_type), intent(in) :: key2 + + if ( size(key1 % value, kind=int64) /= & + size(key2 % value, kind=int64) ) then + test = .false. + return + end if + + if ( all( key1 % value == key2 % value ) ) then + test = .true. + else + test = .false. + end if + + end function equal_keys + + + subroutine free_key( key ) +!! Version: Experimental +!! +!! Frees the memory in a key +!! Arguments: +!! key - the key + type(key_type), intent(inout) :: key + + if ( allocated( key % value ) ) deallocate( key % value ) + + end subroutine free_key + + + subroutine free_other( other ) +!! Version: Experimental +!! +!! Frees the memory in the other data +!! Arguments: +!! other - the other data + type(other_type), intent(inout) :: other + + if ( allocated( other % value) ) deallocate( other % value ) + + end subroutine free_other + + + subroutine get_char_key( key, value ) +!! Version: Experimental +!! +!! Gets the contents of the key as a CHARACTER string +!! Arguments: +!! key - the input key +!! value - the contents of key mapped to a CHARACTER string + type(key_type), intent(in) :: key + character(:), allocatable, intent(out) :: value + + integer(int64) :: key_as_char + integer(int64) :: key_size + + key_size = size( key % value, kind=int64 ) + select case( bytes_char ) + case(1) + key_as_char = key_size + case(2) + if ( iand( key_size, 1_int64 ) > 0 ) then + stop 'KEY does not map to a character string.' + end if + key_as_char = ishft( key_size, -1 ) + case(4) + if ( iand( key_size, 3_int64) > 0 ) then + stop 'KEY does not map to a character string.' + end if + key_as_char = ishft( key_size, -2 ) + case default + stop 'CHARACTER has an unrecognized size.' + end select + + allocate( character( len=key_as_char ) :: value ) + + value(1:key_as_char) = transfer( key % value, value ) + + end subroutine get_char_key + + subroutine get_other( other, value ) +!! Version: Experimental +!! +!! Gets the contents of the other as a CLASS(*) string +!! Arguments: +!! other - the input other data +!! value - the contents of other mapped to a CLASS(*) variable + type(other_type), intent(in) :: other + class(*), allocatable, intent(out) :: value + + allocate(value, source=other % value) + + end subroutine get_other + + + subroutine get_int8_key( key, value ) +!! Version: Experimental +!! +!! Gets the contents of the key as an INTEGER(INT8) vector +!! Arguments: +!! key - the input key +!! value - the contents of key mapped to an INTEGER(INT8) vector + type(key_type), intent(in) :: key + integer(int8), allocatable, intent(out) :: value(:) + + value = key % value + + end subroutine get_int8_key + + + subroutine set_char_key( key, value ) +!! Version: Experimental +!! +!! Sets the contents of the key from a CHARACTER string +!! Arguments: +!! key - the output key +!! value - the input CHARACTER string + type(key_type), intent(out) :: key + character(*), intent(in) :: value(:) + + key % value = transfer( value, key % value, & + bytes_char * len( value ) ) + + end subroutine set_char_key + + + subroutine set_other( other, value ) +!! Version: Experimental +!! +!! Sets the contents of the other data from a CLASS(*) variable +!! Arguments: +!! other - the output other data +!! value - the input CLASS(*) variable + type(other_type), intent(out) :: other + class(*), intent(in) :: value + + allocate(other % value, source=value) + + end subroutine set_other + + + subroutine set_int8_key( key, value ) +!! Version: Experimental +!! +!! Sets the contents of the key from an INTEGER(INT8) vector +!! Arguments: +!! key - the output key +!! value - the input INTEGER(INT8) vector + type(key_type), intent(out) :: key + integer(int8), intent(in) :: value(:) + + key % value = value + + end subroutine set_int8_key + + + pure function fnv_1_hasher( key ) +!! Version: Experimental +!! +!! Hashes a key with the FNV_1 algorithm +!! Arguments: +!! key - the key to be hashed + type(key_type), intent(in) :: key + integer(int_hash) :: fnv_1_hasher + + fnv_1_hasher = fnv_1_hash( key % value ) + + end function fnv_1_hasher + + + pure function fnv_1a_hasher( key ) +!! Version: Experimental +!! +!! Hashes a key with the FNV_1a algorithm +!! Arguments: +!! key - the key to be hashed + type(key_type), intent(in) :: key + integer(int_hash) :: fnv_1a_hasher + + fnv_1a_hasher = fnv_1a_hash( key % value ) + + end function fnv_1a_hasher + + + pure function seeded_nmhash32_hasher( key ) +!! Version: Experimental +!! +!! Hashes a key with the NMHASH32 hash algorithm +!! Arguments: +!! key - the key to be hashed +!! seed - the seed (unused) for the hashing algorithm + type(key_type), intent(in) :: key + integer(int_hash) :: seeded_nmhash32_hasher + + seeded_nmhash32_hasher = nmhash32( key % value, & + int( z'DEADBEEF', int32 ) ) + + end function seeded_nmhash32_hasher + + + pure function seeded_nmhash32x_hasher( key ) +!! Version: Experimental +!! +!! Hashes a key with the NMHASH32X hash algorithm +!! Arguments: +!! key - the key to be hashed +!! seed - the seed (unused) for the hashing algorithm + type(key_type), intent(in) :: key + integer(int_hash) :: seeded_nmhash32x_hasher + + seeded_nmhash32x_hasher = nmhash32x( key % value, & + int( z'DEADBEEF', int32 ) ) + + end function seeded_nmhash32x_hasher + + + pure function seeded_water_hasher( key ) +!! Version: Experimental +!! +!! Hashes a key with the waterhash algorithm +!! Arguments: +!! key - the key to be hashed + type(key_type), intent(in) :: key + integer(int_hash) :: seeded_water_hasher + + seeded_water_hasher = water_hash( key % value, & + int( z'DEADBEEF1EADBEEF', int64 ) ) + + end function seeded_water_hasher + + +end module stdlib_hashmap_wrappers diff --git a/src/stdlib_hashmaps.f90 b/src/stdlib_hashmaps.f90 new file mode 100644 index 000000000..54527d58f --- /dev/null +++ b/src/stdlib_hashmaps.f90 @@ -0,0 +1,789 @@ +!! The module, STDLIB_HASH_MAPS, implements two hash maps: +!! CHAINING_HASH_MAP_TYPE, a separate chaining hash map; and OPEN_HASH_MAP_TYPE, +!! an open addresing hash map using linear addressing. The two hash maps are +!! implementations of the abstract type, HASH_MAP_TYPE. + +module stdlib_hashmaps + + use, intrinsic :: iso_fortran_env, only: & + character_storage_size, & + error_unit + + use stdlib_kinds, only: & + dp, & + int8, & + int16, & + int32, & + int64 + + use stdlib_hashmap_wrappers + + implicit none + + private + +!! Public data_types + public :: & + chaining_hashmap_type, & + hashmap_type, & + open_hashmap_type + +!! Values that parameterize David Chase's empirical SLOT expansion code + integer, parameter :: & + inmap_probe_factor = 10, & + map_probe_factor = 5 + +!! Values that parameterize the SLOTS table size + integer, parameter, public :: & + default_bits = 6, & + max_bits = 30 + +!! KIND values used to parameterixe the hash map and its procedures + integer, parameter, public :: & + int_calls = int64, & + int_depth = int64, & + int_index = int32, & + int_probes = int64 + +!! Error codes returned by the hash map procedures + integer, parameter, public :: & + success = 0, & + alloc_fault = 1, & + array_size_error = 2 + +! The number of bits used by various types + integer, parameter :: & +! Should be 8 + int8_bits = bit_size(0_int8), & + char_bits = character_storage_size + +!! The hash map load factor + real, parameter, public :: & + load_factor = 0.5625 + +!! The size of the pools of allocated map entries + integer(int32), parameter :: pool_size = 64 + + character(*), parameter, private :: module_name = 'STDLIB_HASHMAPS' + + type, abstract :: hashmap_type +!! Version: Experimental +!! +!! Type implementing an abstract hash map + private + integer(int_calls) :: call_count = 0 +!! Number of calls + integer(int_calls) :: probe_count = 0 +!! Number of probes since last expansion + integer(int_calls) :: total_probes = 0 +!! Cumulative number of probes + integer(int_index) :: num_entries = 0 +!! Number of entries + integer(int_index) :: num_free = 0 +!! 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 +!! Hash function + + contains + + procedure, non_overridable, pass(map) :: calls + procedure, non_overridable, pass(map) :: entries + procedure, non_overridable, pass(map) :: map_probes + procedure, non_overridable, pass(map) :: num_slots + procedure, non_overridable, pass(map) :: slots_bits + procedure(get_other), deferred, pass(map) :: get_other_data + procedure(init_map), deferred, pass(map) :: init + procedure(key_test), deferred, pass(map) :: key_test + procedure(loading), deferred, pass(map) :: loading + procedure(map_entry), deferred, pass(map) :: map_entry + procedure(rehash_map), deferred, pass(map) :: rehash + procedure(remove_entry), deferred, pass(map) :: remove + procedure(set_other), deferred, pass(map) :: set_other_data + procedure(total_depth), deferred, pass(map) :: total_depth + + end type hashmap_type + + + abstract interface + + subroutine get_other( map, key, other, exists ) +!! Version: Experimental +!! +!! Returns the other data associated with the inverse table index +!! Arguments: +!! map - a hash map +!! key - the key associated with a map entry +!! other - the other data associated with the key +!! exists - a logical flag indicating whether an entry with that key exists +! + import hashmap_type, key_type, other_type + class(hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(out) :: other + logical, intent(out), optional :: exists + end subroutine get_other + + subroutine init_map( map, & + hasher, & + slots_bits, & + status ) +!! Version: Experimental +!! +!! Routine to allocate an empty map with HASHER as the hash function, +!! 2**SLOTS_BITS initial SIZE(map % slots), SIZE(map % slots) limited to a +!! maximum of 2**MAX_BITS, and with up to LOAD_FACTOR * SIZE(map % slots), +!! map % inverse elements. All fields are initialized. +!! Arguments: +!! map - the hash maap to be initialized +!! hasher - the hash function to be used to map keys to slots +!! slots_bits - the number of bits initially used to map to the slots +!! status - an integer error status flag with the allowed values: +!! success - no problems were found +!! alloc_fault - map % slots or map % inverse could not be allocated +!! array_size_error - slots_bits or max_bits is less than +!! default_bits or greater than strict_max_bits +!! real_value_error - load_factor is less than 0.375 or greater than +!! 0.875 +! + import hashmap_type, hasher_fun, int32 + class(hashmap_type), intent(out) :: map + procedure(hasher_fun) :: hasher + integer, intent(in), optional :: slots_bits + integer(int32), intent(out), optional :: status + end subroutine init_map + + subroutine key_test(map, key, present) +!! Version: Experimental +!! +!! Returns a logical flag indicating whether KEY exists in the hash map +!! Arguments: +!! map - the hash map of interest +!! key - the key of interest +!! present - a flag indicating whether key is present in the map +! + import hashmap_type, key_type + class(hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + logical, intent(out) :: present + end subroutine key_test + + pure function loading( map ) +!! Version: Experimental +!! +!! Returns the number of entries relative to slots in a hash map +!! Arguments: +!! map - a hash map + import hashmap_type + class(hashmap_type), intent(in) :: map + real :: loading + end function loading + + subroutine map_entry(map, key, other, conflict) +!! Version: Experimental +!! +!! Inserts an entry into the hash table +!! Arguments: +! + import hashmap_type, key_type, other_type + class(hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(in), optional :: other + logical, intent(out), optional :: conflict + end subroutine map_entry + + subroutine rehash_map( map, hasher ) +!! Version: Experimental +!! +!! Changes the hashing method of the table entries to that of HASHER. +!! Arguments: +!! map the table to be rehashed +!! hasher the hasher function to be used for the table +! + import hashmap_type, hasher_fun + class(hashmap_type), intent(inout) :: map + procedure(hasher_fun) :: hasher + end subroutine rehash_map + + subroutine remove_entry(map, key, existed) ! Chase's delent +!! Version: Experimental +!! +!! Remove the entry, if any, that has the key +!! Arguments: +!! map - the table from which the entry is to be removed +!! key - the key to an entry +!! existed - a logical flag indicating whether an entry with the key +!! was present in the original map +! + import hashmap_type, key_type + class(hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + logical, intent(out), optional :: existed + end subroutine remove_entry + + subroutine set_other( map, key, other, exists ) +!! Version: Experimental +!! +!! Change the other data associated with the key +!! Arguments: +!! map - the map with the entry of interest +!! key - the key to the entry inthe map +!! other - the new data to be associated with the key +!! exists - a logical flag indicating whether the key is already entered +!! in the map +!! +! + import hashmap_type, key_type, other_type + class(hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(in) :: other + logical, intent(out), optional :: exists + end subroutine set_other + + function total_depth( map ) +!! Version: Experimental +!! +!! Returns the total number of ones based offsets of slot entriesyy from +!! their slot index for a hash map +!! Arguments: +!! map - a hash map + import hashmap_type, int64 + class(hashmap_type), intent(in) :: map + integer(int64) :: total_depth + end function total_depth + + end interface + +!! API for the chaining_hashmap_type + + type :: chaining_map_entry_type ! Hash entry +!! Version: Experimental +!! +!! Chaining hash map entry type + private + integer(int_hash) :: hash_val +!! Full hash value + type(key_type) :: key +!! The entry's key + type(other_type) :: other +!! Other entry data + integer(int_index) :: inmap +!! Index into inverse table + type(chaining_map_entry_type), pointer :: next => null() +!! Next bucket + end type chaining_map_entry_type + + + type chaining_map_entry_ptr +!! Version: Experimental +!! +!! Wrapper for a pointer to a chaining map entry type object + type(chaining_map_entry_type), pointer :: target => null() + end type chaining_map_entry_ptr + + + type :: chaining_map_entry_pool +!! Version: Experimental +!! +!! Type implementing a pool of allocated `chaining_map_entry_type` + private +! Index of next bucket + integer(int_index) :: next = 0 + type(chaining_map_entry_type), allocatable :: more_map_entries(:) + type(chaining_map_entry_pool), pointer :: lastpool => null() + end type chaining_map_entry_pool + + + type, extends(hashmap_type) :: chaining_hashmap_type +!! Version: Experimental +!! +!! Type inplementing the `chaining_hashmap_type` types + private + type(chaining_map_entry_pool), pointer :: cache => null() +!! Pool of allocated chaining_map_entry_type objects + type(chaining_map_entry_type), pointer :: free_list => null() +!! free list of map entries + type(chaining_map_entry_ptr), allocatable :: inverse(:) +!! Array of bucket lists (inverses) Note max_elts=size(inverse) + type(chaining_map_entry_ptr), allocatable :: slots(:) +!! Array of bucket lists Note # slots=size(slots) + contains + procedure :: get_other_data => get_other_chaining_data + procedure :: init => init_chaining_map + procedure :: loading => chaining_loading + procedure :: map_entry => map_chain_entry + procedure :: rehash => rehash_chaining_map + procedure :: remove => remove_chaining_entry + procedure :: set_other_data => set_other_chaining_data + procedure :: total_depth => total_chaining_depth + procedure :: key_test => chaining_key_test + final :: free_chaining_map + end type chaining_hashmap_type + + + interface + + module subroutine free_chaining_map( map ) +!! Version: Experimental +!! +!! Frees internal memory of an chaining map +!! Arguments: +!! map - the chaining hash map whose memory is to be freed +! + type(chaining_hashmap_type), intent(inout) :: map + end subroutine free_chaining_map + + + module subroutine get_other_chaining_data( map, key, other, exists ) +!! Version: Experimental +!! +!! Returns the other data associated with the inverse table index +!! Arguments: +!! map - a chaining hash table +!! key - the key associated with a map entry +!! other - the other data associated with the key +!! exists - a logical flag indicating whether an entry with that key exists +! + class(chaining_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(out) :: other + logical, intent(out), optional :: exists + end subroutine get_other_chaining_data + + + module subroutine init_chaining_map( map, & + hasher, & + slots_bits, & + status ) +!! Version: Experimental +!! +!! Routine to allocate an empty map with HASHER as the hash function, +!! 2**SLOTS_BITS initial SIZE(map % slots), and SIZE(map % slots) limited +!! to a maximum of 2**MAX_BITS. All fields are initialized. +!! Arguments: +!! map - the chaining hash map to be initialized +!! hasher - the hash function to be used to map keys to slots +!! slots_bits - the bits of two used to initialize the number of slots +!! status - an integer error status flag with the allowed values: +!! success - no problems were found +!! alloc_fault - map % slots or map % inverse could not be allocated +!! array_size_error - slots_bits is less than default_bits or +!! greater than max_bits +! + class(chaining_hashmap_type), intent(out) :: map + procedure(hasher_fun) :: hasher + integer, intent(in), optional :: slots_bits + integer(int32), intent(out), optional :: status + end subroutine init_chaining_map + + + module subroutine chaining_key_test(map, key, present) +!! Version: Experimental +!! +!! Returns a logical flag indicating whether KEY is present in the hash map +!! Arguments: +!! map - the hash map of interest +!! key - the key of interest +!! present - a logical flag indicating whether key is present in map +! + class(chaining_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + logical, intent(out) :: present + end subroutine chaining_key_test + + + pure module function chaining_loading( map ) +!! Version: Experimental +!! +!! Returns the number of entries relative to slots in a hash map +!! Arguments: +!! map - a chaining hash map + class(chaining_hashmap_type), intent(in) :: map + real :: chaining_loading + end function chaining_loading + + + module subroutine map_chain_entry(map, key, other, conflict) +! +! Inserts an entry innto the hash map +! Arguments: +!! map - the hash table of interest +!! key - the key identifying the entry +!! other - other data associated with the key +!! conflict - logical flag indicating whether the entry key conflicts +!! with an existing key +! + class(chaining_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(in), optional :: other + logical, intent(out), optional :: conflict + end subroutine map_chain_entry + + + module subroutine rehash_chaining_map( map, hasher ) +!! Version: Experimental +!! +!! Changes the hashing method of the table entries to that of HASHER. +!! Arguments: +!! map the table to be rehashed +!! hasher the hasher function to be used for the table +! + class(chaining_hashmap_type), intent(inout) :: map + procedure(hasher_fun) :: hasher + end subroutine rehash_chaining_map + + + module subroutine remove_chaining_entry(map, key, existed) +!! Version: Experimental +!! +!! Remove the entry, if any, that has the key +!! Arguments: +!! map - the table from which the entry is to be removed +!! key - the key to an entry +!! existed - a logical flag indicating whether an entry with the key +!! was present in the original map +! + class(chaining_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + logical, intent(out), optional :: existed + end subroutine remove_chaining_entry + + + module subroutine set_other_chaining_data( map, key, other, exists ) +!! Version: Experimental +!! +!! Change the other data associated with the key +!! Arguments: +!! map - the map with the entry of interest +!! key - the key to the entry inthe map +!! other - the new data to be associated with the key +!! exists - a logical flag indicating whether the key is already entered +!! in the map +! + class(chaining_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(in) :: other + logical, intent(out), optional :: exists + end subroutine set_other_chaining_data + + + module function total_chaining_depth( map ) result(total_depth) +!! Version: Experimental +!! +!! Returns the total number of ones based offsets of slot entries from +!! their slot index for a hash map +!! Arguments: +!! map - an chaining hash map + class(chaining_hashmap_type), intent(in) :: map + integer(int_depth) :: total_depth + end function total_chaining_depth + + end interface + +!! API for the open_hashmap_type + + type :: open_map_entry_type +!! Version: Experimental +!! +!! Open hash map entry type + private + integer(int_hash) :: hash_val +!! Full hash value + type(key_type) :: key +!! Hash entry key + type(other_type) :: other +!! Other entry data + integer(int_index) :: inmap +!! Index into inverse table + end type open_map_entry_type + + type :: open_map_entry_list +!! Version: Experimental +!! +!! Open hash map entry type + private + type(open_map_entry_type), pointer :: target => null() + type(open_map_entry_list), pointer :: next => null() + end type open_map_entry_list + + + type open_map_entry_ptr +!! Version: Experimental +!! +!! Wrapper for a pointer to an open hash map entry type object + type(open_map_entry_type), pointer :: target => null() + end type open_map_entry_ptr + + + type :: open_map_entry_pool +!! Version: Experimental +!! +!! Type implementing a pool of allocated `open_map_entry_type` + private + integer(int_index) :: next = 0 +!! Index of next bucket + type(open_map_entry_type), allocatable :: more_map_entries(:) + type(open_map_entry_pool), pointer :: lastpool => null() + end type open_map_entry_pool + + + type, extends(hashmap_type) :: open_hashmap_type +!! Version: Experimental +!! +!! Type implementing an "open" hash map + private + integer(int_index) :: index_mask = 2_int_index**default_bits-1 +!! Mask used in linear addressing + type(open_map_entry_pool), pointer :: cache => null() +!! Pool of allocated open_map_entry_type objects + type(open_map_entry_list), pointer :: free_list => null() +!! free list of map entries + type(open_map_entry_ptr), allocatable :: inverse(:) +!! Array of bucket lists (inverses) Note max_elts=size(inverse) + integer(int_index), allocatable :: slots(:) +!! Array of indices to the inverse Note # slots=size(slots) + contains + procedure :: get_other_data => get_other_open_data + procedure :: init => init_open_map + procedure :: loading => open_loading + procedure :: map_entry => map_open_entry + procedure :: rehash => rehash_open_map + procedure :: remove => remove_open_entry + procedure :: set_other_data => set_other_open_data + procedure :: total_depth => total_open_depth + procedure :: key_test => open_key_test + final :: free_open_map + end type open_hashmap_type + + interface + + module subroutine free_open_map( map ) +!! Version: Experimental +!! +!! Frees internal memory of an open map +!! Arguments: +!! map - the open hash map whose memory is to be freed +! + type(open_hashmap_type), intent(inout) :: map + end subroutine free_open_map + + + module subroutine get_other_open_data( map, key, other, exists ) +!! Version: Experimental +!! +!! Returns the other data associated with the inverse table index +!! Arguments: +!! map - an open hash table +!! key - the key associated with a map entry +!! other - the other data associated with the key +!! exists - a logical flag indicating whether an entry with that key exists +! + class(open_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(out) :: other + logical, intent(out), optional :: exists + end subroutine get_other_open_data + + + module subroutine init_open_map( map, & + hasher, & + slots_bits, & + status ) +!! Version: Experimental +!! +!! Routine to allocate an empty map with HASHER as the hash function, +!! 2**SLOTS_BITS initial SIZE(map % slots), and SIZE(map % slots) limited to a +!! maximum of 2**MAX_BITS. All fields are initialized. +!! Arguments: +!! map - the open hash maap to be initialized +!! hasher - the hash function to be used to map keys to slots +!! slots_bits - the number of bits used to map to the slots +!! status - an integer error status flag with the allowed values: +!! success - no problems were found +!! alloc_fault - map % slots or map % inverse could not be allocated +!! array_size_error - slots_bits is less than default_bitd or +!! greater than max_bits + + class(open_hashmap_type), intent(out) :: map + procedure(hasher_fun) :: hasher + integer, intent(in), optional :: slots_bits + integer(int32), intent(out), optional :: status + end subroutine init_open_map + + + module subroutine open_key_test(map, key, present) +!! Version: Experimental +!! +!! Returns a logical flag indicating whether KEY exists in the hash map +!! Arguments: +!! map - the hash map of interest +!! key - the key of interest +!! present - a logical flag indicating whether KEY exists in the hash map +! + class(open_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + logical, intent(out) :: present + end subroutine open_key_test + + + pure module function open_loading( map ) +!! Version: Experimental +!! +!! Returns the number of entries relative to slots in a hash map +!! Arguments: +!! map - an open hash map + class(open_hashmap_type), intent(in) :: map + real :: open_loading + end function open_loading + + + module subroutine map_open_entry(map, key, other, conflict) +!! Version: Experimental +!! +!! Inserts an entry into the hash table +!! Arguments: +!! map - the hash table of interest +!! key - the key identifying the entry +!! other - other data associated with the key +!! conflict - logical flag indicating whether the entry key conflicts +!! with an existing key +! + class(open_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(in), optional :: other + logical, intent(out), optional :: conflict + end subroutine map_open_entry + + + module subroutine rehash_open_map( map, hasher ) +!! Version: Experimental +!! +!! Changes the hashing method of the table entries to that of HASHER. +!! Arguments: +!! map the table to be rehashed +!! hasher the hasher function to be used for the table +! + class(open_hashmap_type), intent(inout) :: map + procedure(hasher_fun) :: hasher + end subroutine rehash_open_map + + + module subroutine remove_open_entry(map, key, existed) +!! Remove the entry, if any, that has the key +!! Arguments: +!! map - the table from which the entry is to be removed +!! key - the key to an entry +!! existed - a logical flag indicating whether an entry with the key +!! was present in the original map +! + class(open_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + logical, intent(out), optional :: existed + end subroutine remove_open_entry + + + module subroutine set_other_open_data( map, key, other, exists ) +!! Version: Experimental +!! +!! Change the other data associated with the key +!! Arguments: +!! map - the map with the entry of interest +!! key - the key to the entry inthe map +!! other - the new data to be associated with the key +!! exists - a logical flag indicating whether the key is already entered +!! in the map +! + class(open_hashmap_type), intent(inout) :: map + type(key_type), intent(in) :: key + type(other_type), intent(in) :: other + logical, intent(out), optional :: exists + end subroutine set_other_open_data + + + module function total_open_depth( map ) result(total_depth) +!! Version: Experimental +!! +!! Returns the total number of ones based offsets of slot entries from +!! their slot index for a hash map +!! Arguments: +!! map - an open hash map + class(open_hashmap_type), intent(in) :: map + integer(int64) :: total_depth + end function total_open_depth + + end interface + +contains + + pure function calls( map ) +!! Version: Experimental +!! +!! Returns the number of subroutine calls on an open hash map +!! Arguments: +!! map - an open hash map + class(hashmap_type), intent(in) :: map + integer(int_calls) :: calls + + calls = map % call_count + + end function calls + + pure function entries( map ) +!! Version: Experimental +!! +!! Returns the number of entries in a hash map +!! Arguments: +!! map - an open hash map + class(hashmap_type), intent(in) :: map + integer(int_index) :: entries + + entries = map % num_entries + + end function entries + + + pure function map_probes( map ) +!! Version: Experimental +!! +!! Returns the total number of table probes on a hash map +!! Arguments: +!! map - an open hash map + class(hashmap_type), intent(in) :: map + integer(int_calls) :: map_probes + + map_probes = map % total_probes + map % probe_count + + end function map_probes + + + pure function num_slots( map ) +!! Version: Experimental +!! +!! Returns the number of allocated slots in a hash map +!! Arguments: +!! map - an open hash map + class(hashmap_type), intent(in) :: map + integer(int_index) :: num_slots + + num_slots = 2**map % nbits + + end function num_slots + + + pure function slots_bits( map ) +!! Version: Experimental +!! +!! Returns the number of bits used to specify the number of allocated +!! slots in a hash map +!! Arguments: +!! map - an open hash map + class(hashmap_type), intent(in) :: map + integer :: slots_bits + + slots_bits = map % nbits + + end function slots_bits + + +end module stdlib_hashmaps From 2741106a28e1eb3ffd7079c9139ec0dcc787e08f Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 14 Mar 2022 21:33:48 -0600 Subject: [PATCH 49/77] Added hashmaps test files Added the test codes hashmaps/test_chaining_maps.f90, hashmaps/test_open_maps.f90; and the hashmaps/CMakeLists.txt, and hashmaps/Makefile.manual to compile them. Modified CMakeLists.txt and Maakeefile.manual so that the hashmaps subdirectory would be added to the test directories to be compiled. [ticket: X] --- src/tests/CMakeLists.txt | 1 + src/tests/Makefile.manual | 1 + src/tests/hashmaps/CMakeLists.txt | 3 + src/tests/hashmaps/Makefile.manual | 4 + src/tests/hashmaps/test_chaining_maps.f90 | 294 +++++++++++++++++++++ src/tests/hashmaps/test_open_maps.f90 | 295 ++++++++++++++++++++++ 6 files changed, 598 insertions(+) create mode 100755 src/tests/hashmaps/CMakeLists.txt create mode 100755 src/tests/hashmaps/Makefile.manual create mode 100755 src/tests/hashmaps/test_chaining_maps.f90 create mode 100755 src/tests/hashmaps/test_open_maps.f90 diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt index de110ca62..e2dbeee88 100644 --- a/src/tests/CMakeLists.txt +++ b/src/tests/CMakeLists.txt @@ -20,6 +20,7 @@ add_subdirectory(ascii) add_subdirectory(bitsets) add_subdirectory(hash_functions) add_subdirectory(hash_functions_perf) +add_subdirectory(hashmaps) add_subdirectory(io) add_subdirectory(linalg) add_subdirectory(logger) diff --git a/src/tests/Makefile.manual b/src/tests/Makefile.manual index 370f2e3c8..65c72766b 100644 --- a/src/tests/Makefile.manual +++ b/src/tests/Makefile.manual @@ -17,6 +17,7 @@ all test clean:: $(MAKE) -f Makefile.manual --directory=bitsets $@ $(MAKE) -f Makefile.manual --directory=hash_functions_perf $@ $(MAKE) -f Makefile.manual --directory=hash_functions $@ + $(MAKE) -f Makefile.manual --directory=hashmaps $@ $(MAKE) -f Makefile.manual --directory=io $@ $(MAKE) -f Makefile.manual --directory=logger $@ $(MAKE) -f Makefile.manual --directory=optval $@ diff --git a/src/tests/hashmaps/CMakeLists.txt b/src/tests/hashmaps/CMakeLists.txt new file mode 100755 index 000000000..2d88e06af --- /dev/null +++ b/src/tests/hashmaps/CMakeLists.txt @@ -0,0 +1,3 @@ +ADDTEST(chaining_maps) +ADDTEST(open_maps) + diff --git a/src/tests/hashmaps/Makefile.manual b/src/tests/hashmaps/Makefile.manual new file mode 100755 index 000000000..78ea929bd --- /dev/null +++ b/src/tests/hashmaps/Makefile.manual @@ -0,0 +1,4 @@ +PROGS_SRC = test_chaining_maps.f90 test_open_maps.f90 + + +include ../Makefile.manual.test.mk diff --git a/src/tests/hashmaps/test_chaining_maps.f90 b/src/tests/hashmaps/test_chaining_maps.f90 new file mode 100755 index 000000000..d63346e3d --- /dev/null +++ b/src/tests/hashmaps/test_chaining_maps.f90 @@ -0,0 +1,294 @@ +program test_chaining_maps +!! Test various aspects of the runtime system. +!! Running this program may require increasing the stack size to above 48 MBytes +!! or decreasing rand_power to 20 or less + + use stdlib_kinds, only: & + dp, & + int8, & + int32 + + use stdlib_hashmaps, only : chaining_hashmap_type, int_depth, int_index + use stdlib_hashmap_wrappers + + implicit none + + type dummy_type + integer(int8), allocatable :: value(:) + end type dummy_type + + integer(int32), parameter :: huge32 = huge(0_int32) + real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp + integer, parameter :: rand_power = 18 + integer, parameter :: rand_size = 2**rand_power + integer, parameter :: test_size = rand_size*4 + integer, parameter :: test_16 = 2**4 + integer, parameter :: test_256 = 2**8 + + integer :: index + integer :: lun + type(chaining_hashmap_type) :: map + real(dp) :: rand2(2) + integer(int32) :: rand_object(rand_size) + integer(int8) :: test_8_bits(test_size) + + open( newunit=lun, file="test_chaining_maps.txt", access="sequential", & + action="write", form="formatted", position="rewind" ) + write(lun, '("| ", a17, " | ", a12, " | ", a15, " | ", a10, " |")') & + 'Algorithm', 'Process', 'Data Set', 'Time (s)' + + do index=1, rand_size + call random_number(rand2) + if (rand2(1) < 0.5_dp) then + rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1 + else + rand_object(index) = floor(rand2(2)*hugep1, int32) + end if + end do + + test_8_bits(:) = transfer( rand_object, 0_int8, test_size ) + + call map % init( fnv_1_hasher, slots_bits=10 ) + 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' ) + call report_rehash_times( map, fnv_1_hasher, 'FNV-1', '16 byte words' ) + 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 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' ) + call report_rehash_times( map, fnv_1_hasher, 'FNV-1', '256 byte words' ) + call report_hash_statistics( map, 'FNV-1', '256 byte words' ) + call report_removal_times( map, test_256, 'FNV-1', '256 byte words' ) + + call map % init( fnv_1a_hasher, slots_bits=10 ) + call input_random_data( map, test_16, 'FNV-1A', "16 byte words" ) + call test_inquire_data( map, test_16, 'FNV-1A', "16 byte words" ) + call test_get_data( map, test_16, 'FNV-1A', '16 byte words' ) + call report_rehash_times( map, fnv_1a_hasher, 'FNV-1', '16 byte words' ) + call report_hash_statistics( map, 'FNV-1A', '16 byte words' ) + call report_removal_times( map, test_16, 'FNV-1a', '16 byte words' ) + + call map % init( fnv_1a_hasher, slots_bits=10 ) + call input_random_data( map, test_256, 'FNV-1A', "256 byte words" ) + call test_inquire_data( map, test_256, 'FNV-1A', "256 byte words" ) + call test_get_data( map, test_256, 'FNV-1A', '256 byte words' ) + call report_rehash_times( map, fnv_1_hasher, 'FNV-1A', '256 byte words' ) + call report_hash_statistics( map, 'FNV-1A', '256 byte words' ) + call report_removal_times( map, test_256, 'FNV-1A', '256 byte words' ) + + call map % init( seeded_nmhash32_hasher, slots_bits=10 ) + call input_random_data( map, test_16, 'Seeded_Nmhash32', "16 byte words" ) + call test_inquire_data( map, test_16, 'Seeded_Nmhash32', "16 byte words" ) + call test_get_data( map, test_16, 'Seeded_Nmhash32', '16 byte words' ) + call report_rehash_times( map, seeded_nmhash32_hasher, 'Seeded_Nmhash32', & + '16 byte words' ) + call report_hash_statistics( map, 'Seeded_Nmhash32', '16 byte words' ) + call report_removal_times( map, test_16, 'Seeded_Nmhash32', & + '16 byte words' ) + + call map % init( seeded_nmhash32_hasher, slots_bits=10 ) + call input_random_data( map, test_256, 'Seeded_Nmhash32', "256 byte words" ) + call test_inquire_data( map, test_256, 'Seeded_Nmhash32', "256 byte words" ) + call test_get_data( map, test_256, 'Seeded_Nmhash32', '256 byte words' ) + call report_rehash_times( map, seeded_nmhash32_hasher, 'Seeded_Nmhash32', & + '256 byte words' ) + call report_hash_statistics( map, 'Seeded_Nmhash32', '256 byte words' ) + call report_removal_times( map, test_256, 'Seeded_Nmhash32', & + '256 byte words' ) + + call map % init( seeded_nmhash32x_hasher, slots_bits=10 ) + call input_random_data( map, test_16, 'Seeded_Nmhash32x', "16 byte words" ) + call test_inquire_data( map, test_16, 'Seeded_Nmhash32x', "16 byte words" ) + call test_get_data( map, test_16, 'Seeded_Nmhash32x', '16 byte words' ) + call report_rehash_times( map, seeded_nmhash32x_hasher, & + 'Seeded_Nmhash32x', '16 byte words' ) + call report_hash_statistics( map, 'Seeded_Nmhash32x', '16 byte words' ) + call report_removal_times( map, test_16, 'Seeded_Nmhash32x', & + '16 byte words' ) + + call map % init( seeded_nmhash32x_hasher, slots_bits=10 ) + call input_random_data( map, test_256, 'Seeded_Nmhash32x', & + "256 byte words" ) + call test_inquire_data( map, test_256, 'Seeded_Nmhash32x', & + "256 byte words" ) + call test_get_data( map, test_256, 'Seeded_Nmhash32x', '256 byte words' ) + call report_rehash_times( map, seeded_nmhash32x_hasher, & + 'Seeded_Nmhash32x', '256 byte words' ) + call report_hash_statistics( map, 'Seeded_Nmhash32x', '256 byte words' ) + call report_removal_times( map, test_256, 'Seeded_Nmhash32x', & + '256 byte words' ) + + call map % init( seeded_water_hasher, slots_bits=10 ) + call input_random_data( map, test_16, 'Seeded_Water', "16 byte words" ) + call test_inquire_data( map, test_16, 'Seeded_Water', "16 byte words" ) + call test_get_data( map, test_16, 'Seeded_Water', '16 byte words' ) + call report_rehash_times( map, seeded_water_hasher, & + 'Seeded_Water', '16 byte words' ) + call report_hash_statistics( map, 'Seeded_Water', '16 byte words' ) + call report_removal_times( map, test_16, 'Seeded_Water', & + '16 byte words' ) + + call map % init( seeded_water_hasher, slots_bits=10 ) + call input_random_data( map, test_256, 'Seeded_Water', & + "256 byte words" ) + call test_inquire_data( map, test_256, 'Seeded_Water', & + "256 byte words" ) + call test_get_data( map, test_256, 'Seeded_Water', '256 byte words' ) + call report_rehash_times( map, seeded_water_hasher, & + 'Seeded_Water', '256 byte words' ) + call report_hash_statistics( map, 'Seeded_Water', '256 byte words' ) + call report_removal_times( map, test_256, 'Seeded_Water', & + '256 byte words' ) + +contains + + subroutine input_random_data( map, test_block, hash_name, size_name ) + type(chaining_hashmap_type), intent(inout) :: map + integer(int_index), intent(in) :: test_block + character(*), intent(in) :: hash_name + character(*), intent(in) :: size_name + class(*), allocatable :: dummy + type(dummy_type) :: dummy_val + integer :: index2 + type(key_type) :: key + type(other_type) :: other + real :: t1, t2, tdiff + logical :: conflict + + call cpu_time(t1) + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + if (allocated(dummy)) deallocate(dummy) + dummy_val % value = test_8_bits( index2:index2+test_block-1 ) + allocate( dummy, source=dummy_val ) + call set ( other, dummy ) + call map % map_entry( key, other, conflict ) + if (conflict) & + error stop "Unable to map entry because of a key conflict." + end do + call cpu_time(t2) + tdiff = t2-t1 + write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') & + trim(hash_name), 'Enter data', size_name, tdiff + + end subroutine input_random_data + + + subroutine test_inquire_data( map, test_block, hash_name, size_name ) + type(chaining_hashmap_type), intent(inout) :: map + integer(int_index), intent(in) :: test_block + character(*), intent(in) :: hash_name, size_name + integer :: index2 + logical :: present + type(key_type) :: key + real :: t1, t2, tdiff + + call cpu_time(t1) + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % key_test( key, present ) + if (.not. present) & + error stop "KEY not found in map KEY_TEST." + end do + call cpu_time(t2) + tdiff = t2-t1 + write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') & + trim(hash_name), 'Inquire data', size_name, tdiff + + end subroutine test_inquire_data + + + subroutine test_get_data( map, test_block, hash_name, size_name ) + type(chaining_hashmap_type), intent(inout) :: map + integer(int_index), intent(in) :: test_block + character(*), intent(in) :: hash_name, size_name + integer :: index2 + type(key_type) :: key + type(other_type) :: other + logical :: exists + real :: t1, t2, tdiff + + call cpu_time(t1) + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % get_other_data( key, other, exists ) + if (.not. exists) & + error stop "Unable to get data because key not found in map." + end do + call cpu_time(t2) + tdiff = t2-t1 + write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') & + trim(hash_name), 'Get data', size_name, tdiff + + end subroutine test_get_data + + + subroutine report_rehash_times( map, hasher, hash_name, size_name ) + type(chaining_hashmap_type), intent(inout) :: map + procedure(hasher_fun) :: hasher + character(*), intent(in) :: hash_name, size_name + real :: t1, t2, tdiff + + call cpu_time(t1) + call map % rehash( hasher ) + call cpu_time(t2) + tdiff = t2-t1 + + write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') & + trim(hash_name), 'Rehash data', size_name, tdiff + + end subroutine report_rehash_times + + + subroutine report_removal_times( map, test_block, hash_name, size_name ) + type(chaining_hashmap_type), intent(inout) :: map + integer(int_index), intent(in) :: test_block + character(*), intent(in) :: hash_name, size_name + real :: t1, t2, tdiff + type(key_type) :: key + integer(int_index) :: index2 + logical :: existed + + call cpu_time(t1) + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % remove(key, existed) + if ( .not. existed ) & + error stop "Key not found in entry removal." + end do + call cpu_time(t2) + tdiff = t2-t1 + + write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') & + trim(hash_name), 'Remove data', size_name, tdiff + flush(lun) + + end subroutine report_removal_times + + + subroutine report_hash_statistics( map, hash_name, size_name ) + type(chaining_hashmap_type), intent(inout) :: map + character(*), intent(in) :: hash_name, size_name + integer(int_depth) :: depth + + write(lun, *) + write(lun, '("Statistics for chaining hash table with ",' // & + 'A, " hasher on ", A, ".")' ) hash_name, size_name + write(lun, '("Slots = ", I0)' ) map % num_slots() + write(lun, '("Calls = ", I0)' ) map % calls() + write(lun, '("Entries = ", I0)' ) map % entries() + write(lun, '("Total probes = ", I0)' ) map % map_probes() + write(lun, '("Loading = ", ES10.3)' ) map % loading() + depth = map % total_depth() + write(lun, '("Total depth = ", I0)' ) depth + write(lun, '("Relative depth = ", ES10.3)') & + real( depth ) / real( map % entries() ) + + end subroutine report_hash_statistics + + +end program test_chaining_maps diff --git a/src/tests/hashmaps/test_open_maps.f90 b/src/tests/hashmaps/test_open_maps.f90 new file mode 100755 index 000000000..d569d238c --- /dev/null +++ b/src/tests/hashmaps/test_open_maps.f90 @@ -0,0 +1,295 @@ +program test_open_maps +!! Test various aspects of the runtime system. +!! Running this program may require increasing the stack size to above 48 MBytes +!! or decreasing rand_power to 20 or less + + use stdlib_kinds, only: & + dp, & + int8, & + int32 + + use stdlib_hashmaps, only : open_hashmap_type, int_depth, int_index + use stdlib_hashmap_wrappers + + implicit none + + type dummy_type + integer(int8), allocatable :: value(:) + end type dummy_type + + integer(int32), parameter :: huge32 = huge(0_int32) + real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp + integer, parameter :: rand_power = 18 + integer, parameter :: rand_size = 2**rand_power + integer, parameter :: test_size = rand_size*4 + integer, parameter :: test_16 = 2**4 + integer, parameter :: test_256 = 2**8 + + integer :: index + integer :: lun + type(open_hashmap_type) :: map + real(dp) :: rand2(2) + integer(int32) :: rand_object(rand_size) + integer(int8) :: test_8_bits(test_size) + + + open( newunit=lun, file="test_open_maps.txt", access="sequential", & + action="write", form="formatted", position="rewind" ) + write(lun, '("| ", a17, " | ", a12, " | ", a15, " | ", a10, " |")') & + 'Algorithm', 'Process', 'Data Set', 'Time (s)' + + do index=1, rand_size + call random_number(rand2) + if (rand2(1) < 0.5_dp) then + rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1 + else + rand_object(index) = floor(rand2(2)*hugep1, int32) + end if + end do + + test_8_bits(:) = transfer( rand_object, 0_int8, test_size ) + + call map % init( fnv_1_hasher, slots_bits=10 ) + 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' ) + call report_rehash_times( map, fnv_1_hasher, 'FNV-1', '16 byte words' ) + 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 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' ) + call report_rehash_times( map, fnv_1_hasher, 'FNV-1', '256 byte words' ) + call report_hash_statistics( map, 'FNV-1', '256 byte words' ) + call report_removal_times( map, test_256, 'FNV-1', '256 byte words' ) + + call map % init( fnv_1a_hasher, slots_bits=10 ) + call input_random_data( map, test_16, 'FNV-1A', "16 byte words" ) + call test_inquire_data( map, test_16, 'FNV-1A', "16 byte words" ) + call test_get_data( map, test_16, 'FNV-1A', '16 byte words' ) + call report_rehash_times( map, fnv_1a_hasher, 'FNV-1', '16 byte words' ) + call report_hash_statistics( map, 'FNV-1A', '16 byte words' ) + call report_removal_times( map, test_16, 'FNV-1a', '16 byte words' ) + + call map % init( fnv_1a_hasher, slots_bits=10 ) + call input_random_data( map, test_256, 'FNV-1A', "256 byte words" ) + call test_inquire_data( map, test_256, 'FNV-1A', "256 byte words" ) + call test_get_data( map, test_256, 'FNV-1A', '256 byte words' ) + call report_rehash_times( map, fnv_1_hasher, 'FNV-1A', '256 byte words' ) + call report_hash_statistics( map, 'FNV-1A', '256 byte words' ) + call report_removal_times( map, test_256, 'FNV-1A', '256 byte words' ) + + call map % init( seeded_nmhash32_hasher, slots_bits=10 ) + call input_random_data( map, test_16, 'Seeded_Nmhash32', "16 byte words" ) + call test_inquire_data( map, test_16, 'Seeded_Nmhash32', "16 byte words" ) + call test_get_data( map, test_16, 'Seeded_Nmhash32', '16 byte words' ) + call report_rehash_times( map, seeded_nmhash32_hasher, 'Seeded_Nmhash32', & + '16 byte words' ) + call report_hash_statistics( map, 'Seeded_Nmhash32', '16 byte words' ) + call report_removal_times( map, test_16, 'Seeded_Nmhash32', & + '16 byte words' ) + + call map % init( seeded_nmhash32_hasher, slots_bits=10 ) + call input_random_data( map, test_256, 'Seeded_Nmhash32', "256 byte words" ) + call test_inquire_data( map, test_256, 'Seeded_Nmhash32', "256 byte words" ) + call test_get_data( map, test_256, 'Seeded_Nmhash32', '256 byte words' ) + call report_rehash_times( map, seeded_nmhash32_hasher, 'Seeded_Nmhash32', & + '256 byte words' ) + call report_hash_statistics( map, 'Seeded_Nmhash32', '256 byte words' ) + call report_removal_times( map, test_256, 'Seeded_Nmhash32', & + '256 byte words' ) + + call map % init( seeded_nmhash32x_hasher, slots_bits=10 ) + call input_random_data( map, test_16, 'Seeded_Nmhash32x', "16 byte words" ) + call test_inquire_data( map, test_16, 'Seeded_Nmhash32x', "16 byte words" ) + call test_get_data( map, test_16, 'Seeded_Nmhash32x', '16 byte words' ) + call report_rehash_times( map, seeded_nmhash32x_hasher, & + 'Seeded_Nmhash32x', '16 byte words' ) + call report_hash_statistics( map, 'Seeded_Nmhash32x', '16 byte words' ) + call report_removal_times( map, test_16, 'Seeded_Nmhash32x', & + '16 byte words' ) + + call map % init( seeded_nmhash32x_hasher, slots_bits=10 ) + call input_random_data( map, test_256, 'Seeded_Nmhash32x', & + "256 byte words" ) + call test_inquire_data( map, test_256, 'Seeded_Nmhash32x', & + "256 byte words" ) + call test_get_data( map, test_256, 'Seeded_Nmhash32x', '256 byte words' ) + call report_rehash_times( map, seeded_nmhash32x_hasher, & + 'Seeded_Nmhash32x', '256 byte words' ) + call report_hash_statistics( map, 'Seeded_Nmhash32x', '256 byte words' ) + call report_removal_times( map, test_256, 'Seeded_Nmhash32x', & + '256 byte words' ) + + call map % init( seeded_water_hasher, slots_bits=10 ) + call input_random_data( map, test_16, 'Seeded_Water', "16 byte words" ) + call test_inquire_data( map, test_16, 'Seeded_Water', "16 byte words" ) + call test_get_data( map, test_16, 'Seeded_Water', '16 byte words' ) + call report_rehash_times( map, seeded_water_hasher, & + 'Seeded_Water', '16 byte words' ) + call report_hash_statistics( map, 'Seeded_Water', '16 byte words' ) + call report_removal_times( map, test_16, 'Seeded_Water', & + '16 byte words' ) + + call map % init( seeded_water_hasher, slots_bits=10 ) + call input_random_data( map, test_256, 'Seeded_Water', & + "256 byte words" ) + call test_inquire_data( map, test_256, 'Seeded_Water', & + "256 byte words" ) + call test_get_data( map, test_256, 'Seeded_Water', '256 byte words' ) + call report_rehash_times( map, seeded_water_hasher, & + 'Seeded_Water', '256 byte words' ) + call report_hash_statistics( map, 'Seeded_Water', '256 byte words' ) + call report_removal_times( map, test_256, 'Seeded_Water', & + '256 byte words' ) + +contains + + subroutine input_random_data( map, test_block, hash_name, size_name ) + type(open_hashmap_type), intent(inout) :: map + integer(int_index), intent(in) :: test_block + character(*), intent(in) :: hash_name + character(*), intent(in) :: size_name + class(*), allocatable :: dummy + type(dummy_type) :: dummy_val + integer :: index2 + type(key_type) :: key + type(other_type) :: other + real :: t1, t2, tdiff + logical :: conflict + + call cpu_time(t1) + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + if (allocated(dummy)) deallocate(dummy) + dummy_val % value = test_8_bits( index2:index2+test_block-1 ) + allocate( dummy, source=dummy_val ) + call set ( other, dummy ) + call map % map_entry( key, other, conflict ) + if (conflict) & + error stop "Unable to map entry because of a key conflict." + end do + call cpu_time(t2) + tdiff = t2-t1 + write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') & + trim(hash_name), 'Enter data', size_name, tdiff + + end subroutine input_random_data + + + subroutine test_inquire_data( map, test_block, hash_name, size_name ) + type(open_hashmap_type), intent(inout) :: map + integer(int_index), intent(in) :: test_block + character(*), intent(in) :: hash_name, size_name + integer :: index2 + logical :: present + type(key_type) :: key + real :: t1, t2, tdiff + + call cpu_time(t1) + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % key_test( key, present ) + if (.not. present) & + error stop "KEY not found in map KEY_TEST." + end do + call cpu_time(t2) + tdiff = t2-t1 + write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') & + trim(hash_name), 'Inquire data', size_name, tdiff + + end subroutine test_inquire_data + + + subroutine test_get_data( map, test_block, hash_name, size_name ) + type(open_hashmap_type), intent(inout) :: map + integer(int_index), intent(in) :: test_block + character(*), intent(in) :: hash_name, size_name + integer :: index2 + type(key_type) :: key + type(other_type) :: other + logical :: exists + real :: t1, t2, tdiff + + call cpu_time(t1) + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % get_other_data( key, other, exists ) + if (.not. exists) & + error stop "Unable to get data because key not found in map." + end do + call cpu_time(t2) + tdiff = t2-t1 + write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') & + trim(hash_name), 'Get data', size_name, tdiff + + end subroutine test_get_data + + + subroutine report_rehash_times( map, hasher, hash_name, size_name ) + type(open_hashmap_type), intent(inout) :: map + procedure(hasher_fun) :: hasher + character(*), intent(in) :: hash_name, size_name + real :: t1, t2, tdiff + + call cpu_time(t1) + call map % rehash( hasher ) + call cpu_time(t2) + tdiff = t2-t1 + + write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') & + trim(hash_name), 'Rehash data', size_name, tdiff + + end subroutine report_rehash_times + + + subroutine report_removal_times( map, test_block, hash_name, size_name ) + type(open_hashmap_type), intent(inout) :: map + integer(int_index), intent(in) :: test_block + character(*), intent(in) :: hash_name, size_name + real :: t1, t2, tdiff + type(key_type) :: key + integer(int_index) :: index2 + logical :: existed + + call cpu_time(t1) + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % remove(key, existed) + if ( .not. existed ) & + error stop "Key not found in entry removal." + end do + call cpu_time(t2) + tdiff = t2-t1 + + write(lun, '("|", a18, " | ", a12, " | ", a15, " | ", f10.5, " |")') & + trim(hash_name), 'Remove data', size_name, tdiff + flush(lun) + + end subroutine report_removal_times + + + subroutine report_hash_statistics( map, hash_name, size_name ) + type(open_hashmap_type), intent(inout) :: map + character(*), intent(in) :: hash_name, size_name + integer(int_depth) :: depth + + write(lun, *) + write(lun, '("Statistics for open hash table with ",' // & + 'A, " hasher on ", A, ".")' ) hash_name, size_name + write(lun, '("Slots = ", I0)' ) map % num_slots() + write(lun, '("Calls = ", I0)' ) map % calls() + write(lun, '("Entries = ", I0)' ) map % entries() + write(lun, '("Total probes = ", I0)' ) map % map_probes() + write(lun, '("Loading = ", ES10.3)' ) map % loading() + depth = map % total_depth() + write(lun, '("Total depth = ", I0)' ) depth + write(lun, '("Relative depth = ", ES10.3)') & + real( depth ) / real( map % entries() ) + + end subroutine report_hash_statistics + + +end program test_open_maps From a98a1d7673bb9b242caf778fb24cc87b94fa3c80 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 14 Mar 2022 22:00:03 -0600 Subject: [PATCH 50/77] Corrected typos and ensured no trailing whitespace. Corrected misspellings detected by the build system's spellchecker. Also used emacs M-X deletete-trailing-whitespace. [ticket: X] --- src/stdlib_hashmap_chaining.f90 | 2 +- src/stdlib_hashmap_wrappers.f90 | 6 +++--- src/stdlib_hashmaps.f90 | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index ecb687e98..987867768 100755 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -679,7 +679,7 @@ module subroutine rehash_chaining_map( map, hasher ) end subroutine rehash_chaining_map - module subroutine remove_chaining_entry(map, key, existed) + module subroutine remove_chaining_entry(map, key, existed) !! Remove the entry, if any, that has the key !! Arguments: !! map - the table from which the entry is to be removed diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index 7b4fbdb6c..c126d89dc 100755 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -1,13 +1,13 @@ !! The module STDLIB_HASHMAP_WRAPPERS provides wrappers for vqrious !! entities used by the hash map procedures. These include wrappers for the -!! `key` and òther`data, and hashing procedures to operate on entities of +!! `key` and `other` data, and hashing procedures to operate on entities of !! the `key_type`. module stdlib_hashmap_wrappers use, intrinsic :: iso_fortran_env, only : & character_storage_size - + use stdlib_hash_32bit use stdlib_kinds, only : & @@ -235,7 +235,7 @@ subroutine get_other( other, value ) class(*), allocatable, intent(out) :: value allocate(value, source=other % value) - + end subroutine get_other diff --git a/src/stdlib_hashmaps.f90 b/src/stdlib_hashmaps.f90 index 54527d58f..cc3450456 100644 --- a/src/stdlib_hashmaps.f90 +++ b/src/stdlib_hashmaps.f90 @@ -1,6 +1,6 @@ !! The module, STDLIB_HASH_MAPS, implements two hash maps: !! CHAINING_HASH_MAP_TYPE, a separate chaining hash map; and OPEN_HASH_MAP_TYPE, -!! an open addresing hash map using linear addressing. The two hash maps are +!! an open addressing hash map using linear addressing. The two hash maps are !! implementations of the abstract type, HASH_MAP_TYPE. module stdlib_hashmaps @@ -298,7 +298,7 @@ end function total_depth type, extends(hashmap_type) :: chaining_hashmap_type !! Version: Experimental !! -!! Type inplementing the `chaining_hashmap_type` types +!! Type implementing the `chaining_hashmap_type` types private type(chaining_map_entry_pool), pointer :: cache => null() !! Pool of allocated chaining_map_entry_type objects From 4ced8006e8e7b3911ced55141adfc2c69d2f7f7a Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 14 Mar 2022 22:06:42 -0600 Subject: [PATCH 51/77] Corrected misspellings Fixed misspellings detected by the build system's spell checker. [ticket: X] --- src/stdlib_hashmap_open.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index 8f70d7ea3..3ff3500d2 100755 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -1,4 +1,4 @@ -!! The module, STDLIB_HASHMAP_OPEN implements a simple open addresing hash +!! The module, STDLIB_HASHMAP_OPEN implements a simple open addressing hash !! map using linear addressing. The implementation is loosely based on a !! C implementation by David Chase, http://chasewoerner.org/src/hasht/, for !! which he has given permission to use in the Fortran Standard Library. @@ -301,7 +301,7 @@ end subroutine get_other_open_data subroutine in_open_map(map, inmap, key) ! Chase's inmap !! Version: Experimental !! -!! Retuns the index into the INVERSE array associated with the KEY +!! Returns the index into the INVERSE array associated with the KEY !! Arguments: !! map - the hash map of interest !! inmap - the returned index into the INVERSE array of entry pointers From 4eb70ff8f33a263e488f4fcc7b78bbca932e0413 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 14 Mar 2022 22:13:19 -0600 Subject: [PATCH 52/77] Fixed misspelling of a file The make -f Makefile.manual was lookin for stdlib_hashmap_wrapper.f90 instead of stdlib_hashmap_wrappers.f90. [ticket: X] --- src/Makefile.manual | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index dda338f92..af3c9917f 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -60,7 +60,7 @@ SRC = f18estop.f90 \ stdlib_error.f90 \ stdlib_specialfunctions.f90 \ stdlib_specialfunctions_legendre.f90 \ - stdlib_hashmap_wrapper.f90 \ + stdlib_hashmap_wrappers.f90 \ stdlib_hashmaps.f90 \ stdlib_io.f90 \ stdlib_logger.f90 \ From 3a935cfdca9eb7b6fe6e18c3ab15696e08bac06e Mon Sep 17 00:00:00 2001 From: William Clodius Date: Tue, 15 Mar 2022 06:38:46 -0600 Subject: [PATCH 53/77] Fixed Makefile.manual Changed src/Makefile.manual so that stdlib_hashmap_chaining.f90 and stdlib_hashmap_open.f90 are included in the library. Changed the formatting of src/tets/hashmaps/Makefile.manual so that it is more consistent with other tests Makefile.manual(s). [ticket: X] --- src/Makefile.manual | 2 ++ src/tests/hashmaps/Makefile.manual | 3 ++- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index af3c9917f..f5b08af9e 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -62,6 +62,8 @@ SRC = f18estop.f90 \ stdlib_specialfunctions_legendre.f90 \ stdlib_hashmap_wrappers.f90 \ stdlib_hashmaps.f90 \ + stdlib_hashmap_chaining.f90 \ + stdlib_hashmap_open.f90 \ stdlib_io.f90 \ stdlib_logger.f90 \ stdlib_quadrature_gauss.f90 \ diff --git a/src/tests/hashmaps/Makefile.manual b/src/tests/hashmaps/Makefile.manual index 78ea929bd..254423a77 100755 --- a/src/tests/hashmaps/Makefile.manual +++ b/src/tests/hashmaps/Makefile.manual @@ -1,4 +1,5 @@ -PROGS_SRC = test_chaining_maps.f90 test_open_maps.f90 +PROGS_SRC = test_chaining_maps.f90 \ + test_open_maps.f90 include ../Makefile.manual.test.mk From a56732995189bc5d72ca422a812101b8b9fce81e Mon Sep 17 00:00:00 2001 From: William Clodius Date: Tue, 15 Mar 2022 10:22:17 -0600 Subject: [PATCH 54/77] Changed "and" to "an" Changed "This is and index/directory of ..." to "This is and index/directory of...". [ticket: X] --- doc/specs/index.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/index.md b/doc/specs/index.md index 6a8bcd037..efc601d0d 100644 --- a/doc/specs/index.md +++ b/doc/specs/index.md @@ -4,7 +4,7 @@ title: Specifications (specs) # Fortran stdlib Specifications (specs) -This is and index/directory of the specifications (specs) for each new module/feature as described in the +This is an index/directory of the specifications (specs) for each new module/feature as described in the [workflow document](../Workflow.html). [TOC] From 67e63d3396de698a9fb7fe31508c950e67d26b08 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Sun, 24 Apr 2022 15:26:13 -0600 Subject: [PATCH 55/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index a1b0d34bb..9e2ed6240 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1287,7 +1287,7 @@ Procedures to modify the content of a map: Procedures to report the content of a map: -* `map 5 get_other_data( key, other, exists )` - Returns the other data +* `map % get_other_data( key, other, exists )` - Returns the other data associated with the `key`; * `map % key_test( key, present)` - Returns a flag indicating whether From a169c656d0efe4ff4d5c284bc257df8f108bf71e Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Sun, 24 Apr 2022 15:26:33 -0600 Subject: [PATCH 56/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 9e2ed6240..1049945dc 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1980,7 +1980,7 @@ not exist and nothing was done. call map % init( fnv_1_hasher, slots_bits=10 ) allocate( dummy, source='A value` ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) - Call set( other, dummy ) + call set( other, dummy ) call map % map_entry( key, other ) deallocate( dummy ) allocate( dummy, source='Another value` ) From 16b22273f2649c6efcff915d629b6e6d43174e73 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Sun, 24 Apr 2022 15:26:56 -0600 Subject: [PATCH 57/77] Update src/stdlib_hashmap_wrappers.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_hashmap_wrappers.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index c126d89dc..f81fff66b 100755 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -1,4 +1,4 @@ -!! The module STDLIB_HASHMAP_WRAPPERS provides wrappers for vqrious +!! The module STDLIB_HASHMAP_WRAPPERS provides wrappers for various !! entities used by the hash map procedures. These include wrappers for the !! `key` and `other` data, and hashing procedures to operate on entities of !! the `key_type`. From 6da72d4aba0f63a4a5e01bbfe73dab23fee29dee Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Thu, 5 May 2022 14:07:20 -0600 Subject: [PATCH 58/77] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Ian Giestas Pauli --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 1049945dc..2926dbd53 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1354,7 +1354,7 @@ The result will be the number of procedure calls on the hash map. implicit none type(chaining_hashmap_type) :: map type(int_calls) :: initial_calls - call map % init(fnv_1_hasher ) + call map % init( fnv_1_hasher ) initial_calls = map % calls() print *, "INITIAL_CALLS = ", initial_calls end program demo_calls From d16145348333c5f402fc6f0743dcfbf91290c0a9 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Mon, 9 May 2022 15:38:09 -0600 Subject: [PATCH 59/77] Update src/stdlib_hashmap_wrappers.f90 Co-authored-by: Ian Giestas Pauli --- src/stdlib_hashmap_wrappers.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index f81fff66b..281651c15 100755 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -206,7 +206,7 @@ subroutine get_char_key( key, value ) key_as_char = key_size case(2) if ( iand( key_size, 1_int64 ) > 0 ) then - stop 'KEY does not map to a character string.' + error stop 'Internal Error at stdlib_hashmaps: System uses 2 bytes per character, so key_size can't be an odd number' end if key_as_char = ishft( key_size, -1 ) case(4) From 85dad9dff70dc6175581823845cc3a9a2c5dc11d Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Mon, 9 May 2022 15:39:51 -0600 Subject: [PATCH 60/77] Update src/stdlib_hashmap_wrappers.f90 Co-authored-by: Ian Giestas Pauli --- src/stdlib_hashmap_wrappers.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index 281651c15..e6be2dd62 100755 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -262,7 +262,7 @@ subroutine set_char_key( key, value ) !! key - the output key !! value - the input CHARACTER string type(key_type), intent(out) :: key - character(*), intent(in) :: value(:) + character(*), intent(in) :: value key % value = transfer( value, key % value, & bytes_char * len( value ) ) From 8ae3263e3c0aa24efff35c3189b7fbebe4bbdff2 Mon Sep 17 00:00:00 2001 From: "William B. Clodius" Date: Mon, 9 May 2022 15:41:17 -0600 Subject: [PATCH 61/77] Update src/stdlib_hashmap_chaining.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_hashmap_chaining.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 987867768..20ed49d0d 100755 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -406,7 +406,7 @@ module subroutine init_chaining_map( map, & integer, intent(in), optional :: slots_bits integer(int32), intent(out), optional :: status - character(256) :: errmsg = '' + character(256) :: errmsg integer(int_index) :: index character(*), parameter :: procedure = 'INIT' integer(int_index) :: slots From fd15686659fecd4724deb11042cde286b8ef7cf3 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Mon, 9 May 2022 18:48:23 -0300 Subject: [PATCH 62/77] fixed issue with string escaping in "can't" --- src/stdlib_hashmap_wrappers.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index e6be2dd62..675be0d38 100755 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -206,7 +206,7 @@ subroutine get_char_key( key, value ) key_as_char = key_size case(2) if ( iand( key_size, 1_int64 ) > 0 ) then - error stop 'Internal Error at stdlib_hashmaps: System uses 2 bytes per character, so key_size can't be an odd number' + error stop "Internal Error at stdlib_hashmaps: System uses 2 bytes per character, so key_size can't be an odd number" end if key_as_char = ishft( key_size, -1 ) case(4) From 0f64bc01f49df6a92a0ebfbec5fd7fd6cf450fe4 Mon Sep 17 00:00:00 2001 From: Ian Giestas Pauli Date: Mon, 9 May 2022 18:58:46 -0300 Subject: [PATCH 63/77] fixed issue with line being too long in error stop --- src/stdlib_hashmap_wrappers.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index 675be0d38..a922a5dd4 100755 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -206,7 +206,9 @@ subroutine get_char_key( key, value ) key_as_char = key_size case(2) if ( iand( key_size, 1_int64 ) > 0 ) then - error stop "Internal Error at stdlib_hashmaps: System uses 2 bytes per character, so key_size can't be an odd number" + error stop "Internal Error at stdlib_hashmaps:& + & System uses 2 bytes per character, so& + & key_size can't be an odd number" end if key_as_char = ishft( key_size, -1 ) case(4) From dcfb087a229933cf16894f0050cb914afd6bd460 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 9 May 2022 16:51:22 -0600 Subject: [PATCH 64/77] Made changes in stdlib_hashmaps.md suggested by Ian Gaestrus Pauli and Ivan Pi Changed names of arguments to copy_key from key_in and key_out to old_key and new_key. Added note to set_key definition to show how values ofther than scalar default characters and int8 vectors can be used as keys. Chaanged hassher_pointer to hasher_pointer. [ticket: X] --- doc/specs/stdlib_hashmaps.md | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 2926dbd53..91e3f8255 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -136,7 +136,7 @@ opaque. Their current representations are as follows end type other_type ``` -The module also defines six procedures for those types: `copy_key`, +The module also defines six procedures for those types: `copy_key`, `copy_other`, `equal_keys`, `free_key`, `free_other`, `get`, and `set`, and one operator, `==`, for use by the hash maps to manipulate or inquire of components of @@ -210,7 +210,7 @@ Returns a copy of an input of type `key_type`. ##### Syntax -`call [[stdlib_hashmap_wrappers:copy_key]]( key_in, key_out )` +`call [[stdlib_hashmap_wrappers:copy_key]]( old_key, new_key )` ##### Class @@ -218,10 +218,10 @@ Subroutine. ##### Arguments -`key_in`: shall be a scalar expression of type `key_type`. It +`old_key`: shall be a scalar expression of type `key_type`. It is an `intent(in)` argument. -`key_out`: shall be a scalar variable of type `key_type`. It +`new_key`: shall be a scalar variable of type `key_type`. It is an `intent(out)` argument. ##### Example @@ -233,11 +233,11 @@ is an `intent(out)` argument. use iso_fortran_env, only: int8 implicit none integer(int8) :: i, value(15) - type(key_type) :: key_in, key_out + type(key_type) :: old_key, new_key value = [(i, i = 1, 15)] call set( key_in, value ) - call copy_key( key_in, key_out ) - print *, "key_in == key_out = ", key_in == key_out + call copy_key( old_key, new_key ) + print *, "old_key == new_key = ", old_key == new_key end program demo_copy_key ``` @@ -637,7 +637,7 @@ pointers intended for use as a hash function for the hash maps. hasher_pointer => fnv_1a_hasher array1 = [ 5_int8, 4_int8, 3_int8, 1_int8, 10_int8, 4_int8 ] call set( key, array1 ) - hash = hassher_pointer(key) + hash = hasher_pointer(key) print *, hash end program demo_hasher_fun ``` @@ -913,10 +913,16 @@ is an `intent(out)` argument. is an `intent(out)` argument. `value`: if the first argument is `key` `value` shall be a default -character string expression, or a vector expression of type integer +character string scalar expression, or a vector expression of type integer and kind `int8`, while for a first argument of type `other` `value` shall be of type `class(*)`. It is an `intent(in)` argument. +##### Note + +Values of types other than a scalar default character or an +`INT8` vector can be used as the basis of a `key` by transferring the +value to an `INT8` vector. + ##### Example ```fortran From 5d6741d0d421cab084822522235b8cd074eace0d Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 9 May 2022 16:59:09 -0600 Subject: [PATCH 65/77] Changed api of set for keys Changed the arguments from key_in and key_out to old_key andnew_key. [ticket: X] --- src/stdlib_hashmap_wrappers.f90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index a922a5dd4..4a57345dc 100755 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -105,17 +105,17 @@ end function hasher_fun contains - pure subroutine copy_key( key_in, key_out ) + pure subroutine copy_key( old_key, new_key ) !! Version: Experimental !! -!! Copies the contents of the key, key_in, to the key, key_out +!! Copies the contents of the key, old_key, to the key, out_key !! Arguments: -!! key_in - the input key -!! key_out - the output key - type(key_type), intent(in) :: key_in - type(key_type), intent(out) :: key_out +!! old_key - the input key +!! new_key - the output copy of old_key + type(key_type), intent(in) :: old_key + type(key_type), intent(out) :: new_key - key_out % value = key_in % value + new_key % value = old_key % value end subroutine copy_key From 21c9fc4d0ac6f3c57e2164fa8097d085a078ba89 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 9 May 2022 17:10:36 -0600 Subject: [PATCH 66/77] Corrected the use of set for keys in examples Change the use of set for keys in several examples, e.g., the output key was sometimes called key_in and the set procedure was sometimes called set_key. [ticket: X] --- doc/specs/stdlib_hashmaps.md | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 91e3f8255..6f44288c0 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -229,14 +229,14 @@ is an `intent(out)` argument. ```fortran program demo_copy_key use stdlib_hashmap_wrappers, only: & - copy_key, operator(==)equal_keys, key_type + copy_key, operator(==), equal_keys, key_type use iso_fortran_env, only: int8 implicit none integer(int8) :: i, value(15) type(key_type) :: old_key, new_key value = [(i, i = 1, 15)] - call set( key_in, value ) - call copy_key( old_key, new_key ) + call set( key_out, value ) + call copy_key( key_out, new_key ) print *, "old_key == new_key = ", old_key == new_key end program demo_copy_key ``` @@ -470,11 +470,11 @@ is an `intent(out)` argument. use iso_fortran_env, only: int8 implicit none integer(int8) :: i, value(15) - type(key_type) :: key_in, key_out + type(key_type) :: old_key, new_key value = [(i, i=1, 15)] - call set( key_in, value ) - call copy_key( key_in, key_out ) - call free_key( key_out ) + call set( old_key, value ) + call copy_key( old_key, new_key ) + call free_key( old_key ) end program demo_free_key ``` @@ -685,13 +685,13 @@ The result is `.true.` if the keys are equal, otherwise `.falss.`. use iso_fortran_env, only: int8 implicit none integer(int8) :: i, value(15) - type(key_type) :: key_in, key_out + type(key_type) :: old_key, new_key do i=1, 15 value(i) = i end do - call set( key_in, value ) - call copy_key( key_in, key_out ) - print *, "key_in == key_out = ", key_in == key_out + call set( old_key, value ) + call copy_key( old_key, new_key ) + print *, "old_key == new_key = ", old_key == new_key end program demo_equal_keys ``` @@ -1610,7 +1610,7 @@ is being examined. type(key_type) :: key logocal :: present call map % init( fnv_1_hasher ) - call set_key(key, [0_int8, 1_int8] ) + 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 demo_key_test From 817633f1c981c6e7d29b07feb4cfdbf80cf970d2 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 9 May 2022 20:58:54 -0600 Subject: [PATCH 67/77] Improved error messages Changed error messages to use error stop, module name and procedure name. [ticket: X] --- src/stdlib_hashmap_open.f90 | 13 ++++++++----- src/stdlib_hashmap_wrappers.f90 | 10 +++++++--- 2 files changed, 15 insertions(+), 8 deletions(-) diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index 3ff3500d2..b31b1efd7 100755 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -559,11 +559,10 @@ module subroutine map_open_entry(map, key, other, conflict) subroutine allocate_open_map_entry(map, bucket) ! allocates a hash bucket - type(open_hashmap_type), intent(inout) :: map - - type(open_map_entry_type), pointer, intent(out) :: bucket + type(open_hashmap_type), intent(inout) :: map type(open_map_entry_type), pointer, intent(out) :: bucket type(open_map_entry_list), pointer :: free_list type(open_map_entry_pool), pointer :: pool + character(*), parameter :: procedure_name = "ALLOCATE_MAP_ENTRY" pool => map % cache map % num_entries = map % num_entries + 1 @@ -574,7 +573,9 @@ subroutine allocate_open_map_entry(map, bucket) map % free_list => free_list % next free_list % target => null() free_list % next => null() - if (bucket % inmap == 0) stop "bucket % inmap == 0" + if (bucket % inmap <= 0) & + error stop submodule_name // " % " // procedure_name // & + ": Failed consistency check: BUCKET % INMAP <= 0" map % num_free = map % num_free - 1 else ! Get hash bucket from pool @@ -589,7 +590,9 @@ subroutine allocate_open_map_entry(map, bucket) size( map % inverse, kind=int_index ) ) then call expand_inverse( map ) end if - if ( map % num_entries == 0 ) stop "MAP % NUM_ENTRIES == 0." + if ( map % num_entries <= 0 ) & + error stop submodule_name // " % " // procedure_name // & + ": Failed consistency check: MAP % NUM_ENTRIES <= 0." bucket % inmap = map % num_entries end if diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index 4a57345dc..564c26c96 100755 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -55,6 +55,8 @@ module stdlib_hashmap_wrappers bits_char = character_storage_size, & bytes_char = bits_char/bits_int8 + character(*), parameter :: module_name = "STDLIB_HASHMAP_WRAPPERS" + type :: key_type !! Version: Experimental !! @@ -196,6 +198,7 @@ subroutine get_char_key( key, value ) !! value - the contents of key mapped to a CHARACTER string type(key_type), intent(in) :: key character(:), allocatable, intent(out) :: value + character(*), parameter :: procedure_name = "GET" integer(int64) :: key_as_char integer(int64) :: key_size @@ -206,9 +209,10 @@ subroutine get_char_key( key, value ) key_as_char = key_size case(2) if ( iand( key_size, 1_int64 ) > 0 ) then - error stop "Internal Error at stdlib_hashmaps:& - & System uses 2 bytes per character, so& - & key_size can't be an odd number" + error stop module_name // " % " procedure_name // & + ": Internal Error at stdlib_hashmaps: " // & + "System uses 2 bytes per character, so " // & + "key_size can't be an odd number" end if key_as_char = ishft( key_size, -1 ) case(4) From 080d71933760d0cb68d2b218f231709984a9abae Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 9 May 2022 21:16:40 -0600 Subject: [PATCH 68/77] Fixed carriage return Accidentally deleted carriage return which caused compillation problems. Fixed. [ticket: X] --- src/stdlib_hashmap_open.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index b31b1efd7..d27441548 100755 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -559,7 +559,8 @@ module subroutine map_open_entry(map, key, other, conflict) subroutine allocate_open_map_entry(map, bucket) ! allocates a hash bucket - type(open_hashmap_type), intent(inout) :: map type(open_map_entry_type), pointer, intent(out) :: bucket + type(open_hashmap_type), intent(inout) :: map + type(open_map_entry_type), pointer, intent(out) :: bucket type(open_map_entry_list), pointer :: free_list type(open_map_entry_pool), pointer :: pool character(*), parameter :: procedure_name = "ALLOCATE_MAP_ENTRY" From ea7d80f7b63bf0ad17a6e45d71ca245498fb1ee2 Mon Sep 17 00:00:00 2001 From: William Clodius Date: Mon, 9 May 2022 21:22:26 -0600 Subject: [PATCH 69/77] Fixed string in error message Added missing concatenation operator. [ticket: X] --- src/stdlib_hashmap_wrappers.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index 564c26c96..487fe20a9 100755 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -198,7 +198,7 @@ subroutine get_char_key( key, value ) !! value - the contents of key mapped to a CHARACTER string type(key_type), intent(in) :: key character(:), allocatable, intent(out) :: value - character(*), parameter :: procedure_name = "GET" + character(*), parameter :: procedure = "GET" integer(int64) :: key_as_char integer(int64) :: key_size @@ -209,7 +209,7 @@ subroutine get_char_key( key, value ) key_as_char = key_size case(2) if ( iand( key_size, 1_int64 ) > 0 ) then - error stop module_name // " % " procedure_name // & + error stop module_name // " % " // procedure // & ": Internal Error at stdlib_hashmaps: " // & "System uses 2 bytes per character, so " // & "key_size can't be an odd number" From ede1534b33880c18581712cb8c5cc4b435b0538d Mon Sep 17 00:00:00 2001 From: William Clodius Date: Tue, 10 May 2022 14:25:39 -0600 Subject: [PATCH 70/77] Improved error reporting Changed two error messages in get_char_keys so that they used error stop instead of stop and provided more detailed information. [ticket: X] --- src/stdlib_hashmap_wrappers.f90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index 487fe20a9..b9f704d3a 100755 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -212,16 +212,22 @@ subroutine get_char_key( key, value ) error stop module_name // " % " // procedure // & ": Internal Error at stdlib_hashmaps: " // & "System uses 2 bytes per character, so " // & - "key_size can't be an odd number" + "key_size can't be an odd number." end if key_as_char = ishft( key_size, -1 ) case(4) if ( iand( key_size, 3_int64) > 0 ) then - stop 'KEY does not map to a character string.' + error stop module_name // " % " // procedure // & + ": Internal Error at stdlib_hashmaps: " // & + "System uses 4 bytes per character, and " // & + "key_size is not a multiple of four." end if key_as_char = ishft( key_size, -2 ) case default - stop 'CHARACTER has an unrecognized size.' + error stop module_name // " % " // procedure // & + ": Internal Error: " // & + "System doesn't use a power of two for its " // & + "character size as expected by stdlib_hashmaps." end select allocate( character( len=key_as_char ) :: value ) From b2276b7f55dd9080b8a7224231f4781f8195fdbb Mon Sep 17 00:00:00 2001 From: William Clodius Date: Tue, 10 May 2022 21:20:55 -0600 Subject: [PATCH 71/77] Changed error reporting for in_chain_map. Removed write to error_unit aand documented error reporting via inmap. [ticket: X] --- src/stdlib_hashmap_chaining.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 20ed49d0d..7db08861a 100755 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -334,7 +334,9 @@ subroutine in_chain_map(map, inmap, key) !! Returns the index into the INVERSE array associated with the KEY !! Arguments: !! map - the hash map of interest -!! inmap - the returned index into the INVERSE array of entry pointers +!! inmap - the returned index into the INVERSE array of entry pointers. +!! A value of zero indicates that an entry with that key was not +!! found. !! key - the key identifying the entry of interest ! class(chaining_hashmap_type), intent(inout) :: map @@ -360,7 +362,6 @@ subroutine in_chain_map(map, inmap, key) gentry => pentry map % probe_count = map % probe_count + 1 if (.not. associated( gentry ) ) then - write(error_unit,*) "gentry not associated" inmap = 0 return else if ( hash_val == gentry % hash_val ) then From c4d4ec77c1ece910ca43878b803ad65e6e953b72 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Fri, 17 Jun 2022 23:28:38 +0200 Subject: [PATCH 72/77] change proposed to specs --- doc/specs/stdlib_hashmaps.md | 95 ++++++++++++++++++++++++------------ 1 file changed, 64 insertions(+), 31 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 6f44288c0..df37b308b 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -170,9 +170,9 @@ Procedures to manipulate `other_type` data: `other_out`. * `get( other, value )` - extracts the contents of `other` into the - class(*) variable `value`. + `class(*)` variable `value`. -* `set( other, value )` - sets the content of `other` to the class(*) +* `set( other, value )` - sets the content of `other` to the `class(*)` variable `value`. * `free_other( other )` - frees the memory in `other`. @@ -194,7 +194,7 @@ Procedures to hash keys to 32 bit integers: Operator to compare two `key_type` values for equality -* `key1 == key2` - compares `key1' with 'key2' for equality +* `key1 == key2` - compares `key1` with `key2` for equality ### Specifications of the `stdlib_hashmap_wrappers` procedures @@ -445,7 +445,7 @@ Experimental ##### Description -Deallocates the memory associated with an variable of type +Deallocates the memory associated with a variable of type `key_type`. ##### Syntax @@ -486,7 +486,7 @@ Experimental ##### Description -Deallocates the memory associated with an variable of type +Deallocates the memory associated with a variable of type `other_type`. ##### Syntax @@ -580,7 +580,7 @@ an allocatable of `class(*)`. It is an `intent(out)` argument. end do call set( key, value ) call get( key, result ) - print *, `RESULT == VALUE = ', all( value == result ) + print *, 'RESULT == VALUE = ', all( value == result ) end program demo_get ``` @@ -654,7 +654,7 @@ Returns `.true.` if two keys are equal, and `.false.` otherwise. ##### Syntax -`test = [stdlib_hashmap_wrappers:key1==key2]` +`test = key1 == key2` ##### Class @@ -920,8 +920,8 @@ shall be of type `class(*)`. It is an `intent(in)` argument. ##### Note Values of types other than a scalar default character or an -`INT8` vector can be used as the basis of a `key` by transferring the -value to an `INT8` vector. +`int8` vector can be used as the basis of a `key` by transferring the +value to an `int8` vector. ##### Example @@ -940,7 +940,7 @@ value to an `INT8` vector. end do call set( key, value ) call get( key, result ) - print *, `RESULT == VALUE = ', all( value == result ) + print *, 'RESULT == VALUE = ', all( value == result ) end program demo_set ``` @@ -1038,35 +1038,57 @@ 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: + * `call_count` - the number of procedure calls on the map; + * `nbits` - the number of bits used to address the slots; + * `num_entries` - the humber of entries in the map; + * `num_free` - the number of entries in the free list of removed entries; + * `probe_count` - the number of map probes since the last resizing or initialization; + * `total_probes` - the number of probes of the map up to the last resizing or initialization; and + * `hasher` - a pointer to the hash function used by the map. + It also defines five non-overridable procedures: + * `calls` - returns the number of procedure calls on the map; + * `entries` - returns the number of entries in the map; + * `map_probes` - returns the number of map probes since initialization; + * `num_slots` - returns the number of slots in the map; and + * `slots_bits` - returns the number of bits used to address the slots; and eleven deferred procedures: + * `get_other_data` - gets the other map data associated with the key; + * `init` - initializes the hash map; + * `key_test` - returns a logical flag indicating whether the key is defined in the map. + * `loading` - returns the ratio of the number of entries to the number of slots; + * `map_entry` - inserts a key and its other associated data into the map; + * `rehash` - rehashes the map with the provided hash function; + * `remove` - removes the entry associated wit the key; + * `set_other_data` - replaces the other data associated with the key; + * `total_depth` - returns the number of probes needed to address all the entries in the map; @@ -1158,13 +1180,18 @@ costs. The type's definition is below: The `chaining_hashmap_type` derived type extends the `hashmap_type` to implements a separate chaining hash map. In addition to the components of the `hashmap_type` it provides the four components: + * `cache` - a pool of `chaining_map_entry_pool` objects used to reduce allocation costs; + * `free_list` - a free list of map entries; + * `inverse` - an array of `chaining_map_entry_ptr` bucket lists (inverses) storing entries at fixed locations once entered; and + * `slots` - an array of bucket lists serving as the hash map. + It also implements all of the deferred procedures of the `hashmap_type` and a finalizer for its maps. The type's definition is as follows: @@ -1227,14 +1254,20 @@ containing the elements of the table. The type's definition is below: The `open_hashmap_type` derived type extends the `hashmap_type` to implement an open addressing hash map. In addition to the components of the `hashmap_type` it provides the four components: + * `cache` - a pool of `open_map_entry_pool` objects used to reduce allocation costs; + * `free_list` - a free list of map entries; + * `index_mask` - an `and` mask used in linear addressing; + * `inverse` - an array of `open_map_entry_ptr` bucket lists (inverses) storing entries at fixed locations once entered; and + * `slots` - an array of bucket lists serving as the hash map. + It also implements all of the deferred procedures of the `hashmap_type` and a finalizer for its maps. The type's definition is as follows: @@ -1332,7 +1365,7 @@ Returns the number of procedure calls on a hash map. ##### Syntax -`value = [[stdlib_hashmaps:map % calls]]()` +`value = map % [[hashmap_type(type):calls(bound)]]()` ##### Class @@ -1379,7 +1412,7 @@ Returns the number of entries in a hash map. ##### Syntax -`value = [[stdlib_hashmaps:map % entries]]()` +`value = map % [[hashmap_type(type):entries(bound)]]()` ##### Class @@ -1426,7 +1459,7 @@ Returns the other data associated with the `key`, ##### Syntax -`value = [[stdlib_hashmaps:map % get_other_data)]]( key, other [, exists] )` +`value = map % [[hashmap_type(type):get_other_data(bound)]]( key, other [, exists] )` ##### Class @@ -1447,7 +1480,7 @@ Subroutine with the `key`. `exists` (optional): shall be a variable of type logical. It is an -`intent(out)` argument. If `.true.` an entry with the given `key` +`intent(out)` argument. If `.true.` an entry with the given `key` exists in the map and `other` is defined. If `.false.` `other` is undefined. @@ -1457,7 +1490,7 @@ undefined. associated with a `key`: -```Fortran +```fortran program demo_get_other_data use, intrinsic:: iso_fortran_env, only: & int8 @@ -1494,7 +1527,7 @@ undefined. ``` -#### init - initializes a hash map +#### `init` - Initializes a hash map ##### Status @@ -1506,9 +1539,9 @@ Initializes a `hashmap_type` object. ##### Syntax -`call [[stdlib_hashmaps:map%init]]( hasher [, slots_bits, status ] )` +`call map % [[hashmap_type(type):init(bound)]]( hasher [, slots_bits, status ] )` -####@# Class +##### Class Subroutine @@ -1576,7 +1609,7 @@ entry in the map. ##### Syntax -`result = call [[stdlib_hashmaps:map % valid_key]]( key, present )` +`result = call map % [[hashmap_type(type):key_test(bound)]]( key, present )` ##### Class @@ -1630,7 +1663,7 @@ slots in the hash map. ##### Syntax -`value = [[stdlib_hashmaps:map%loading]]( )` +`value = map % [[hashmap_type(type):loading(bound)]]( )` ##### Class @@ -1677,7 +1710,7 @@ Inserts an entry into the hash map if it is not already present. ##### Syntax -`call [[stdlib_hashmaps:map%map_entry]]( key[, other, conflict ] )` +`call map % [[hashmap_type(type):map_entry(bound)]]( key[, other, conflict ] )` ##### Class @@ -1742,7 +1775,7 @@ Returns the total number of table probes on the hash map. ##### Syntax -`Result = [[stdlib_hashmap:map%map_probes]]( )` +`result = map % [[hashmap_type(type):map_probes(bound)]]( )` ##### Class @@ -1790,7 +1823,7 @@ Returns the total number of slots on a hash map ##### Syntax -`Result = [[stdlib_hashmaps:map%num_slots]]( )` +`result = map % [[hashmap_type(type):num_slots(bound)]]( )` ##### Class @@ -1826,7 +1859,7 @@ The result is the number of slots in `map`. ``` -#### rehash - changes the hashing function +#### `rehash` - changes the hashing function ##### Status @@ -1838,7 +1871,7 @@ Changes the hashing function for the map entries to that of `hasher`. ##### Syntax -`call [[stdlib_hashmaps:map%rehash]]( hasher )` +`call map % [[hashmap_type(type):rehash(bound)]]( hasher )` ##### Class @@ -1847,7 +1880,7 @@ Subroutine ##### Arguments `map` (pass): shall be a scalar variable of class -`chaining_hashmap_type` oe `open_hashmap_type`. +`chaining_hashmap_type` or `open_hashmap_type`. It is an `intent(inout)` argument. It is the hash map whose hashing method is to be changed. @@ -1886,7 +1919,7 @@ Removes an entry from the hash map, `map`. ##### Syntax -`call [[stdlib_hashmaps:map%remove]]( key[, existed ])` +`call map % [[hashmap_type(type):remove(bound)]]( key[, existed ])` ##### Class @@ -1931,7 +1964,7 @@ absent, the procedure returns with no entry with the given key. end program demo_remove ``` -#### `set_other_data` - replaces the other dataa for an entry +#### `set_other_data` - replaces the other data for an entry ##### Status @@ -1944,7 +1977,7 @@ Replaces the other data in the map for the entry with the key value, ##### Syntax -`call [[stdlib_hashmaps:map%set_other_data]]( key, other[, exists] )` +`call map % [[hashmap_type(type):set_other_data(bound)]]( key, other[, exists] )` ##### Class @@ -2008,7 +2041,7 @@ Returns the total number of bits used to address the hash map slots. ##### Syntax -`Result = [[stdlib_hashmaps:map%slots_bits]]( )` +`result = map % [[hashmap_type(type):slots_bits(bound)]]( )` ##### Class @@ -2057,7 +2090,7 @@ their slot index for a hash map ##### Syntax -`Result = [[stdlib_hashmaps:map%total_depth]]( )` +`result = map % [[hashmap_type:total_depth]]( )` ##### Class From b4c0b75c5d3e4d8a3571a08f775a70e80113a000 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Fri, 17 Jun 2022 17:32:47 -0400 Subject: [PATCH 73/77] Update doc/specs/stdlib_hashmaps.md --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index df37b308b..4f386c9ac 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1527,7 +1527,7 @@ undefined. ``` -#### `init` - Initializes a hash map +#### `init` - initializes a hash map ##### Status From fa71f368d9e99bfa8f0849bed57da7e9bb25803e Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 18 Jun 2022 19:56:27 +0200 Subject: [PATCH 74/77] add links in stdlib_hashmap_wrappers.f90 --- src/stdlib_hashmap_wrappers.f90 | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index b9f704d3a..67b13b96e 100755 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -110,7 +110,9 @@ end function hasher_fun pure subroutine copy_key( old_key, new_key ) !! Version: Experimental !! -!! Copies the contents of the key, old_key, to the key, out_key +!! Copies the contents of the key, old_key, to the key, new_key +!! ([Specifications](../page/specs/stdlib_hashmaps.html#copy_key-returns-a-copy-of-the-key)) +!! !! Arguments: !! old_key - the input key !! new_key - the output copy of old_key @@ -126,6 +128,8 @@ subroutine copy_other( other_in, other_out ) !! Version: Experimental !! !! Copies the other data, other_in, to the variable, other_out +!! ([Specifications](../page/specs/stdlib_hashmaps.html#copy_other-returns-a-copy-of-the-other-data)) +!! !! Arguments: !! other_in - the input data !! other_out - the output data @@ -141,6 +145,8 @@ function equal_keys( key1, key2 ) result(test) ! Chase's tester !! Version: Experimental !! !! Compares two keys for equality +!! ([Specifications](../page/specs/stdlib_hashmaps.html#operator(==)-compares-two-keys-for-equality)) +!! !! Arguments: !! key1 - the first key !! key2 - the second key @@ -167,6 +173,8 @@ subroutine free_key( key ) !! Version: Experimental !! !! Frees the memory in a key +!! ([Specifications](../page/specs/stdlib_hashmaps.html#free_key-frees-the-memory-associated-with-a-key)) +!! !! Arguments: !! key - the key type(key_type), intent(inout) :: key @@ -180,6 +188,8 @@ subroutine free_other( other ) !! Version: Experimental !! !! Frees the memory in the other data +!! ([Specifications](../page/specs/stdlib_hashmaps.html#free_other-frees-the-memory-associated-with-other-data)) +!! !! Arguments: !! other - the other data type(other_type), intent(inout) :: other @@ -330,6 +340,8 @@ pure function fnv_1a_hasher( key ) !! Version: Experimental !! !! Hashes a key with the FNV_1a algorithm +!! ([Specifications](../page/specs/stdlib_hashmaps.html#fnv_1a_hasher-calculates-a-hash-code-from-a-key)) +!! !! Arguments: !! key - the key to be hashed type(key_type), intent(in) :: key @@ -344,6 +356,8 @@ pure function seeded_nmhash32_hasher( key ) !! Version: Experimental !! !! Hashes a key with the NMHASH32 hash algorithm +!! ([Specifications](../page/specs/stdlib_hashmaps.html#seeded_nmhash32_hasher-calculates-a-hash-code-from-a-key)) +!! !! Arguments: !! key - the key to be hashed !! seed - the seed (unused) for the hashing algorithm @@ -360,6 +374,7 @@ pure function seeded_nmhash32x_hasher( key ) !! Version: Experimental !! !! Hashes a key with the NMHASH32X hash algorithm +!! ([Specifications](../page/specs/stdlib_hashmaps.html#seeded_nmhash32x_hasher-calculates-a-hash-code-from-a-key)) !! Arguments: !! key - the key to be hashed !! seed - the seed (unused) for the hashing algorithm @@ -376,6 +391,8 @@ pure function seeded_water_hasher( key ) !! Version: Experimental !! !! Hashes a key with the waterhash algorithm +!! ([Specifications](../page/specs/stdlib_hashmaps.html#seeded_water_hasher-calculates-a-hash-code-from-a-key)) +!! !! Arguments: !! key - the key to be hashed type(key_type), intent(in) :: key From 95bed1dec45b6829584450efc6c0f281ac474809 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 18 Jun 2022 21:04:21 +0200 Subject: [PATCH 75/77] add links in stdlib_hashmaps --- src/stdlib_hashmaps.f90 | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/src/stdlib_hashmaps.f90 b/src/stdlib_hashmaps.f90 index cc3450456..f7f29c683 100644 --- a/src/stdlib_hashmaps.f90 +++ b/src/stdlib_hashmaps.f90 @@ -70,6 +70,7 @@ module stdlib_hashmaps !! Version: Experimental !! !! Type implementing an abstract hash map +!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-hashmap_type-abstract-type)) private integer(int_calls) :: call_count = 0 !! Number of calls @@ -158,6 +159,8 @@ subroutine key_test(map, key, present) !! Version: Experimental !! !! Returns a logical flag indicating whether KEY exists in the hash map +!! ([Specifications](../page/specs/stdlib_hashmaps.html#key_test-indicates-whether-key-is-present)) +!! !! Arguments: !! map - the hash map of interest !! key - the key of interest @@ -173,6 +176,8 @@ pure function loading( map ) !! Version: Experimental !! !! Returns the number of entries relative to slots in a hash map +!! ([Specifications](../page/specs/stdlib_hashmaps.html#loading-returns-the-ratio-of-entries-to-slots)) +!! !! Arguments: !! map - a hash map import hashmap_type @@ -184,8 +189,8 @@ subroutine map_entry(map, key, other, conflict) !! Version: Experimental !! !! Inserts an entry into the hash table -!! Arguments: -! +!! ([Specifications](../page/specs/stdlib_hashmaps.html#map_entry-inserts-an-entry-into-the-hash-map)) +!! import hashmap_type, key_type, other_type class(hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key @@ -246,6 +251,7 @@ function total_depth( map ) !! !! Returns the total number of ones based offsets of slot entriesyy from !! their slot index for a hash map +!! ([Specifications](../page/specs/stdlib_hashmaps.html#total_depth-returns-the-total-depth-of-the-hash-map-entries)) !! Arguments: !! map - a hash map import hashmap_type, int64 @@ -261,6 +267,7 @@ end function total_depth !! Version: Experimental !! !! Chaining hash map entry type +!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-chaining_map_entry_type-derived-type)) private integer(int_hash) :: hash_val !! Full hash value @@ -279,6 +286,7 @@ end function total_depth !! Version: Experimental !! !! Wrapper for a pointer to a chaining map entry type object +!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-chaining_map_entry_type_ptr-derived-type)) type(chaining_map_entry_type), pointer :: target => null() end type chaining_map_entry_ptr @@ -287,6 +295,7 @@ end function total_depth !! Version: Experimental !! !! Type implementing a pool of allocated `chaining_map_entry_type` +!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-chaining_map_entry_pool-derived-type)) private ! Index of next bucket integer(int_index) :: next = 0 @@ -299,6 +308,7 @@ end function total_depth !! Version: Experimental !! !! Type implementing the `chaining_hashmap_type` types +!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-chaining_hashmap_type-derived-type)) private type(chaining_map_entry_pool), pointer :: cache => null() !! Pool of allocated chaining_map_entry_type objects @@ -487,6 +497,7 @@ end function total_chaining_depth !! Version: Experimental !! !! Open hash map entry type +!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-open_map_entry_type-derived-type)) private integer(int_hash) :: hash_val !! Full hash value @@ -512,6 +523,7 @@ end function total_chaining_depth !! Version: Experimental !! !! Wrapper for a pointer to an open hash map entry type object +!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-open_map_entry_ptr-derived-type)) type(open_map_entry_type), pointer :: target => null() end type open_map_entry_ptr @@ -720,6 +732,8 @@ pure function calls( map ) !! Version: Experimental !! !! Returns the number of subroutine calls on an open hash map +!! ([Specifications](../page/specs/stdlib_hashmaps.html#calls-returns-the-number-of-calls-on-the-hash-map)) +!! !! Arguments: !! map - an open hash map class(hashmap_type), intent(in) :: map @@ -733,6 +747,8 @@ pure function entries( map ) !! Version: Experimental !! !! Returns the number of entries in a hash map +!! ([Specifications](../page/specs/stdlib_hashmaps.html#entries-returns-the-number-of-entries-in-the-hash-map)) +!! !! Arguments: !! map - an open hash map class(hashmap_type), intent(in) :: map @@ -747,6 +763,8 @@ pure function map_probes( map ) !! Version: Experimental !! !! Returns the total number of table probes on a hash map +!! ([Specifications](../page/specs/stdlib_hashmaps.html#map_probes-returns-the-number-of-hash-map-probes)) +!! !! Arguments: !! map - an open hash map class(hashmap_type), intent(in) :: map @@ -761,6 +779,8 @@ pure function num_slots( map ) !! Version: Experimental !! !! Returns the number of allocated slots in a hash map +!! ([Specifications](../page/specs/stdlib_hashmaps.html#num_slots-returns-the-number-of-hash-map-slots)) +!! !! Arguments: !! map - an open hash map class(hashmap_type), intent(in) :: map @@ -776,6 +796,8 @@ pure function slots_bits( map ) !! !! Returns the number of bits used to specify the number of allocated !! slots in a hash map +!! ([Specifications](../page/specs/stdlib_hashmaps.html#slots_bits-returns-the-number-of-bits-used-to-address-the-hash-map-slots)) +!! !! Arguments: !! map - an open hash map class(hashmap_type), intent(in) :: map From 45b92c78b6cd9e0fcb538a4dba2af2d5a3e0985b Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 18 Jun 2022 21:05:09 +0200 Subject: [PATCH 76/77] fix some typos in stdlib_hashmaps.md --- doc/specs/stdlib_hashmaps.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 4f386c9ac..abe6b92c8 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -53,7 +53,7 @@ The module `stdlib_hashmaps` defines the API for a parent datatype, `hashmap_type` and two extensions of that hash map type: `chaining_hashmap_type` and `open_hashmap_type`. -The `hashmap_type` defines the Application Programers +The `hashmap_type` defines the Application Programmers Interface (API) for the procedures used by its two extensions. It explicitly defines five non-overridable procedures. It also defines the interfaces for eleven deferred procedures. It does not define the @@ -113,7 +113,7 @@ keys and their associated data. The constant `int_hash` is used to define the integer kind value for the returned hash codes and variables used to access them. It -currently is imported from `stdlib_hash_32bit` where it haas the +currently is imported from `stdlib_hash_32bit` where it has the value, `int32`. ### The `stdlib_hashmap_wrappers`' module's derived types @@ -229,7 +229,7 @@ is an `intent(out)` argument. ```fortran program demo_copy_key use stdlib_hashmap_wrappers, only: & - copy_key, operator(==), equal_keys, key_type + copy_key, operator(==), key_type use iso_fortran_env, only: int8 implicit none integer(int8) :: i, value(15) @@ -1043,7 +1043,7 @@ seven private components: * `nbits` - the number of bits used to address the slots; -* `num_entries` - the humber of entries in the map; +* `num_entries` - the number of entries in the map; * `num_free` - the number of entries in the free list of removed entries; @@ -1609,7 +1609,7 @@ entry in the map. ##### Syntax -`result = call map % [[hashmap_type(type):key_test(bound)]]( key, present )` +`call map % [[hashmap_type(type):key_test(bound)]]( key, present )` ##### Class From 45fd15ccacb000a7d7c64dab9b767462b073bcb2 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 18 Jun 2022 23:15:21 +0200 Subject: [PATCH 77/77] Addition of test_maps using test-drive --- src/tests/hashmaps/CMakeLists.txt | 10 + src/tests/hashmaps/test_maps.fypp | 378 ++++++++++++++++++++++++++++++ 2 files changed, 388 insertions(+) create mode 100644 src/tests/hashmaps/test_maps.fypp diff --git a/src/tests/hashmaps/CMakeLists.txt b/src/tests/hashmaps/CMakeLists.txt index 2d88e06af..7831dde7d 100755 --- a/src/tests/hashmaps/CMakeLists.txt +++ b/src/tests/hashmaps/CMakeLists.txt @@ -1,3 +1,13 @@ +### Pre-process: .fpp -> .f90 via Fypp + +# Create a list of the files to be preprocessed +set(fppFiles + test_maps.fypp +) + +fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) + ADDTEST(chaining_maps) ADDTEST(open_maps) +ADDTEST(maps) diff --git a/src/tests/hashmaps/test_maps.fypp b/src/tests/hashmaps/test_maps.fypp new file mode 100644 index 000000000..cd1e3a4ee --- /dev/null +++ b/src/tests/hashmaps/test_maps.fypp @@ -0,0 +1,378 @@ +#:set HASH_NAME = ["fnv_1_hasher", "fnv_1a_hasher", "seeded_nmhash32_hasher", "seeded_nmhash32x_hasher", "seeded_water_hasher"] +#:set SIZE_NAME = ["16", "256"] +module test_stdlib_chaining_maps +!! Test various aspects of the runtime system. +!! Running this program may require increasing the stack size to above 48 MBytes +!! or decreasing rand_power to 20 or less + use testdrive, only : new_unittest, unittest_type, error_type, check + use :: stdlib_kinds, only : dp, int8, int32 + use stdlib_hashmaps, only : chaining_hashmap_type, int_depth, int_index + use stdlib_hashmap_wrappers + + implicit none + private + + type dummy_type + integer(int8), allocatable :: value(:) + end type dummy_type + + integer(int32), parameter :: huge32 = huge(0_int32) + real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp + integer, parameter :: rand_power = 18 + integer, parameter :: rand_size = 2**rand_power + integer, parameter :: test_size = rand_size*4 + integer, parameter :: test_16 = 2**4 + integer, parameter :: test_256 = 2**8 + + public :: collect_stdlib_chaining_maps + +contains + + !> Collect all exported unit tests + subroutine collect_stdlib_chaining_maps(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("chaining-maps-fnv_1_hasher-16-byte-words", test_fnv_1_hasher_16_byte_words) & + #:for hash_ in HASH_NAME + #:for size_ in SIZE_NAME + , new_unittest("chaining-maps-${hash_}$-${size_}$-byte-words", test_${hash_}$_${size_}$_byte_words) & + #:endfor + #:endfor + ] + + end subroutine collect_stdlib_chaining_maps + + #:for hash_ in HASH_NAME + #:for size_ in SIZE_NAME + subroutine test_${hash_}$_${size_}$_byte_words(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + type(chaining_hashmap_type) :: map + integer(int8) :: test_8_bits(test_size) + + call generate_vector(test_8_bits) + + call map % init( ${hash_}$, slots_bits=10 ) + + call test_input_random_data(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + call test_inquire_data(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + call test_get_data(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + call test_removal(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + end subroutine + #:endfor + #:endfor + + + subroutine generate_vector(test_8_bits) + integer(int8), intent(out) :: test_8_bits(test_size) + + integer :: index + real(dp) :: rand2(2) + integer(int32) :: rand_object(rand_size) + + do index=1, rand_size + call random_number(rand2) + if (rand2(1) < 0.5_dp) then + rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1 + else + rand_object(index) = floor(rand2(2)*hugep1, int32) + end if + end do + + test_8_bits(:) = transfer( rand_object, 0_int8, test_size ) + + end subroutine + + subroutine test_input_random_data(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(chaining_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(int_index), intent(in) :: test_block + class(*), allocatable :: dummy + type(dummy_type) :: dummy_val + integer :: index2 + type(key_type) :: key + type(other_type) :: other + logical :: conflict + + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + if (allocated(dummy)) deallocate(dummy) + dummy_val % value = test_8_bits( index2:index2+test_block-1 ) + allocate( dummy, source=dummy_val ) + call set ( other, dummy ) + call map % map_entry( key, other, conflict ) + call check(error, .not.conflict, "Unable to map entry because of a key conflict.") + if (allocated(error)) return + end do + + end subroutine + + subroutine test_inquire_data(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(chaining_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(int_index), intent(in) :: test_block + integer :: index2 + logical :: present + type(key_type) :: key + + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % key_test( key, present ) + call check(error, present, "KEY not found in map KEY_TEST.") + if (allocated(error)) return + end do + + end subroutine + + subroutine test_get_data(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(chaining_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(int_index), intent(in) :: test_block + integer :: index2 + type(key_type) :: key + type(other_type) :: other + logical :: exists + + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % get_other_data( key, other, exists ) + call check(error, exists, "Unable to get data because key not found in map.") + end do + + end subroutine + + subroutine test_removal(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(chaining_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(int_index), intent(in) :: test_block + type(key_type) :: key + integer(int_index) :: index2 + logical :: existed + + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % remove(key, existed) + call check(error, existed, "Key not found in entry removal.") + end do + + end subroutine + +end module + +module test_stdlib_open_maps +!! Test various aspects of the runtime system. +!! Running this program may require increasing the stack size to above 48 MBytes +!! or decreasing rand_power to 20 or less + use testdrive, only : new_unittest, unittest_type, error_type, check + use :: stdlib_kinds, only : dp, int8, int32 + use stdlib_hashmaps, only : open_hashmap_type, int_depth, int_index + use stdlib_hashmap_wrappers + + implicit none + private + + type dummy_type + integer(int8), allocatable :: value(:) + end type dummy_type + + integer(int32), parameter :: huge32 = huge(0_int32) + real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp + integer, parameter :: rand_power = 18 + integer, parameter :: rand_size = 2**rand_power + integer, parameter :: test_size = rand_size*4 + integer, parameter :: test_16 = 2**4 + integer, parameter :: test_256 = 2**8 + + public :: collect_stdlib_open_maps + +contains + + !> Collect all exported unit tests + subroutine collect_stdlib_open_maps(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("open-maps-fnv_1_hasher-16-byte-words", test_fnv_1_hasher_16_byte_words) & + #:for hash_ in HASH_NAME + #:for size_ in SIZE_NAME + , new_unittest("open-maps-${hash_}$-${size_}$-byte-words", test_${hash_}$_${size_}$_byte_words) & + #:endfor + #:endfor + ] + + end subroutine collect_stdlib_open_maps + + #:for hash_ in HASH_NAME + #:for size_ in SIZE_NAME + subroutine test_${hash_}$_${size_}$_byte_words(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + type(open_hashmap_type) :: map + integer(int8) :: test_8_bits(test_size) + + call generate_vector(test_8_bits) + + call map % init( ${hash_}$, slots_bits=10 ) + + call test_input_random_data(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + call test_inquire_data(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + call test_get_data(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + call test_removal(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + end subroutine + #:endfor + #:endfor + + + subroutine generate_vector(test_8_bits) + integer(int8), intent(out) :: test_8_bits(test_size) + + integer :: index + real(dp) :: rand2(2) + integer(int32) :: rand_object(rand_size) + + do index=1, rand_size + call random_number(rand2) + if (rand2(1) < 0.5_dp) then + rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1 + else + rand_object(index) = floor(rand2(2)*hugep1, int32) + end if + end do + + test_8_bits(:) = transfer( rand_object, 0_int8, test_size ) + + end subroutine + + subroutine test_input_random_data(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(open_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(int_index), intent(in) :: test_block + class(*), allocatable :: dummy + type(dummy_type) :: dummy_val + integer :: index2 + type(key_type) :: key + type(other_type) :: other + logical :: conflict + + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + if (allocated(dummy)) deallocate(dummy) + dummy_val % value = test_8_bits( index2:index2+test_block-1 ) + allocate( dummy, source=dummy_val ) + call set ( other, dummy ) + call map % map_entry( key, other, conflict ) + call check(error, .not.conflict, "Unable to map entry because of a key conflict.") + if (allocated(error)) return + end do + + end subroutine + + subroutine test_inquire_data(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(open_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(int_index), intent(in) :: test_block + integer :: index2 + logical :: present + type(key_type) :: key + + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % key_test( key, present ) + call check(error, present, "KEY not found in map KEY_TEST.") + if (allocated(error)) return + end do + + end subroutine + + subroutine test_get_data(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(open_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(int_index), intent(in) :: test_block + integer :: index2 + type(key_type) :: key + type(other_type) :: other + logical :: exists + + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % get_other_data( key, other, exists ) + call check(error, exists, "Unable to get data because key not found in map.") + end do + + end subroutine + + subroutine test_removal(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(open_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(int_index), intent(in) :: test_block + type(key_type) :: key + integer(int_index) :: index2 + logical :: existed + + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % remove(key, existed) + call check(error, existed, "Key not found in entry removal.") + end do + + end subroutine + +end module + + +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type + use test_stdlib_open_maps, only : collect_stdlib_open_maps + use test_stdlib_chaining_maps, only : collect_stdlib_chaining_maps + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("stdlib-open-maps", collect_stdlib_open_maps) & + , new_testsuite("stdlib-chaining-maps", collect_stdlib_chaining_maps) & + ] + + do is = 1, size(testsuites) + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if +end program