diff --git a/doc/specs/index.md b/doc/specs/index.md index 95f08a31f..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] @@ -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 diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md new file mode 100644 index 000000000..abe6b92c8 --- /dev/null +++ b/doc/specs/stdlib_hashmaps.md @@ -0,0 +1,2127 @@ +--- +title: Hash maps +--- + +# The `stdlib_hashmap_wrappers`, and `stdlib_hashmaps` 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 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 +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 is imported from `stdlib_hash_32bit` where it 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]]( old_key, new_key )` + +##### Class + +Subroutine. + +##### Arguments + +`old_key`: shall be a scalar expression of type `key_type`. It +is an `intent(in)` argument. + +`new_key`: 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(==), 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_out, value ) + call copy_key( key_out, new_key ) + print *, "old_key == new_key = ", old_key == new_key + 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 a 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) :: i, value(15) + type(key_type) :: old_key, new_key + value = [(i, i=1, 15)] + call set( old_key, value ) + call copy_key( old_key, new_key ) + call free_key( old_key ) + end program demo_free_key +``` + +#### `free_other` - frees the memory associated with other data + +##### Status + +Experimental + +##### Description + +Deallocates the memory associated with a 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 = hasher_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 = 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) :: i, value(15) + type(key_type) :: old_key, new_key + do i=1, 15 + value(i) = i + end do + 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 +``` + +#### `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` `value` shall be a default +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 + 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`. +The extension types provide +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 +`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: +`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 = 0.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 number 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; + +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(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(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 +``` + + +#### 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 :: 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 + 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() + 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 :: 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 + 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: + +* `map % init( hasher[, slots_bits, status] )` - Routine + to initialize a chaining hash map. + +Procedure to modify the structure of a map: + +* `map % rehash( hasher )` - Routine to change the hash function + for a map. + +Procedures to modify the content of a map: + +* `map % map_entry( key, other, conflict )` - Inserts an entry into the + hash map. + +* `map % remove( key, existed )` - Remove the entry, if any, + associated with the `key`. + +* `map % set_other_data( key, other, exists )` - Change the other data + associated with the entry. + +Procedures to report the content of a map: + +* `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 + the `key` is present in the map. + +Procedures to report on the structure of the map: + +* `map % calls()` - the number of subroutine calls on the hash map. + +* `map % entries()`- the number of entries in a hash map. + +* `map % loading()` - the number of entries relative to the number of + slots in a hash map. + +* `map % map_probes()` - the total number of table probes on a hash + map. + +* `map % slots()` - Returns the number of allocated slots in a hash + map. + +* `map % total_depth()` - 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 the hash map + +##### Status + +Experimental + +##### Description + +Returns the number of procedure calls on a hash map. + +##### Syntax + +`value = map % [[hashmap_type(type):calls(bound)]]()` + +##### 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 the hash map + +##### Status + +Experimental + +##### Description + +Returns the number of entries in a hash map. + +##### Syntax + +`value = map % [[hashmap_type(type):entries(bound)]]()` + +##### 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 = map % [[hashmap_type(type):get_other_data(bound)]]( 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 + 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 and `other` is defined. If `.false.` `other` is +undefined. + +##### Example + + The following is an example of the retrieval of other data + associated with a `key`: + + +```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 `hashmap_type` object. + +##### Syntax + +`call map % [[hashmap_type(type):init(bound)]]( 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 +``` + + +#### `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 + +`call map % [[hashmap_type(type):key_test(bound)]]( 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, [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 + +Experimental + +##### Description + +Returns the ratio of the number of entries relative to the number of +slots in the hash map. + +##### Syntax + +`value = map % [[hashmap_type(type):loading(bound)]]( )` + +##### 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 map % [[hashmap_type(type):map_entry(bound)]]( 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 +map. + +* 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 the hash map. + +##### Syntax + +`result = map % [[hashmap_type(type):map_probes(bound)]]( )` + +##### 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 slots. + +##### Status + +Experimental + +##### Description + +Returns the total number of slots on a hash map + +##### Syntax + +`result = map % [[hashmap_type(type):num_slots(bound)]]( )` + +##### 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 map entries to that of `hasher`. + +##### Syntax + +`call map % [[hashmap_type(type):rehash(bound)]]( hasher )` + +##### 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 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` - removes an entry from the hash map + +##### Status + +Experimental + +##### Description + +Removes an entry from the hash map, `map`. + +##### Syntax + +`call map % [[hashmap_type(type):remove(bound)]]( 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 and the map is unchanged. If +absent, the procedure returns with no entry with the given key. + +##### Example + +```fortran + 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 + 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( key, existed ) + print *, "Removed key existed = ", existed + end program demo_remove +``` + +#### `set_other_data` - replaces the other data for an entry + +##### Status + +Experimental + +##### Description + +Replaces the other data in the map for the entry with the key value, +`key`. + +##### Syntax + +`call map % [[hashmap_type(type):set_other_data(bound)]]( 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 did +not exist 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 bits used to address the hash map slots. + +##### Syntax + +`result = map % [[hashmap_type(type):slots_bits(bound)]]( )` + +##### 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 = map % [[hashmap_type:total_depth]]( )` + +##### 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_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 +``` diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 40a5940a6..b79d920e9 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -84,6 +84,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/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 new file mode 100755 index 000000000..7db08861a --- /dev/null +++ b/src/stdlib_hashmap_chaining.f90 @@ -0,0 +1,849 @@ +!! 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. +!! 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 + 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 + 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..d27441548 --- /dev/null +++ b/src/stdlib_hashmap_open.f90 @@ -0,0 +1,879 @@ +!! 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. + +! 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 +!! +!! 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(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 + character(*), parameter :: procedure_name = "ALLOCATE_MAP_ENTRY" + + 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) & + 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 + 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 ) & + error stop submodule_name // " % " // procedure_name // & + ": Failed consistency check: 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..67b13b96e --- /dev/null +++ b/src/stdlib_hashmap_wrappers.f90 @@ -0,0 +1,407 @@ +!! 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`. + +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 + + character(*), parameter :: module_name = "STDLIB_HASHMAP_WRAPPERS" + + 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( old_key, new_key ) +!! Version: Experimental +!! +!! 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 + type(key_type), intent(in) :: old_key + type(key_type), intent(out) :: new_key + + new_key % value = old_key % 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 +!! ([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 + 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 +!! ([Specifications](../page/specs/stdlib_hashmaps.html#operator(==)-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 +!! ([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 + + if ( allocated( key % value ) ) deallocate( key % value ) + + end subroutine free_key + + + 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 + + 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 + character(*), parameter :: procedure = "GET" + + 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 + 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." + end if + key_as_char = ishft( key_size, -1 ) + case(4) + if ( iand( key_size, 3_int64) > 0 ) then + 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 + 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 ) + + 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 +!! ([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 + 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 +!! ([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 + 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 +!! ([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 + 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 +!! ([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 + 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..f7f29c683 --- /dev/null +++ b/src/stdlib_hashmaps.f90 @@ -0,0 +1,811 @@ +!! 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 addressing 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 +!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-hashmap_type-abstract-type)) + 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 +!! ([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 +!! 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 +!! ([Specifications](../page/specs/stdlib_hashmaps.html#loading-returns-the-ratio-of-entries-to-slots)) +!! +!! 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 +!! ([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 + 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 +!! ([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 + 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 +!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-chaining_map_entry_type-derived-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 +!! ([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 + + + type :: chaining_map_entry_pool +!! 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 + 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 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 + 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 +!! ([Specifications](../page/specs/stdlib_hashmaps.html#the-open_map_entry_type-derived-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 +!! ([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 + + + 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 +!! ([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 + 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 +!! ([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 + 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 +!! ([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 + 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 +!! ([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 + 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 +!! ([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 + integer :: slots_bits + + slots_bits = map % nbits + + end function slots_bits + + +end module stdlib_hashmaps diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt index a4250d7ba..de332abb3 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/hashmaps/CMakeLists.txt b/src/tests/hashmaps/CMakeLists.txt new file mode 100755 index 000000000..7831dde7d --- /dev/null +++ b/src/tests/hashmaps/CMakeLists.txt @@ -0,0 +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/Makefile.manual b/src/tests/hashmaps/Makefile.manual new file mode 100755 index 000000000..254423a77 --- /dev/null +++ b/src/tests/hashmaps/Makefile.manual @@ -0,0 +1,5 @@ +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_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 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