mod_hash_table.f

Go to the documentation of this file.

!                       *********************
                        MODULE mod_hash_table
!                       *********************
!
!***********************************************************************
! PARTEL
!***********************************************************************
!
!BRIEF    Functions to handle hash_table for partel
!
      USE declarations_special
      IMPLICIT NONE
!
      !THIS HASH TABLE IS SPECIFICALY MADE FOR PARTEL AND IS ABSOLUTELY
      !NOT GENERIC.
      !THIS HASH TABLE PROVIDE INSERTION AND SEARCH BUT NO DELETION
      !
      !THE IMPLEMENTATION USE OPEN ADDRESSING WITH LINEAR PROBING FOR
      !COLLISION RESOLUTION
!
      INTEGER, PARAMETER :: unused = -1
!
      !THIS TYPE IS THE ELEMENT CONTAINED BY THE HASH TABLE.
      !THE X AND Y REPRESENTS THE INDICES OF THE ARRAYS PARTEL USED
      !PREVIOUSLY. SO FROM THE USER POINT OF VIEW, X AND Y ARE ALWAYS
      !POSITIVE BUT INTERNALY THE HASH TABLE USE NEGATIVE VALUE TO
      !REPRESENTS AN UNUSED ELEMENT, WHICH MEANS THAHT THE HASH TABLE
      !IS FREE TO INSERT AT THIS ELEMENT
      !
      !V CAN BE POSITIVE OR NEGATIVE
      TYPE hash_table_el
        INTEGER :: x=unused
        INTEGER :: y, v
      END TYPE
!
      TYPE hash_table
        TYPE(hash_table_el), ALLOCATABLE :: table(:)
!
        !THE NUMBER OF INSERTED ELEMENTS IN THE HASH TABLE
        INTEGER :: nelts = 0
!
        !THE DEFAULT VALUE RETURNED WHEN THE USER SEARCH FOR A
        !VALUE WHICH IS NOT CONTAINED BY THE HASH TABLE
        INTEGER :: default_value = 0
!
        !THE MAXIMUM NUMBER OF CONSECUTIVE ELEMENTS WE HAVE TO
        !BROWSE WHEN SEARCHING FOR A VALUE
        INTEGER :: longuest_probe = 0
!
        !WHEN THE RATIO 'NO. OF ELTS / SIZE OF THE HASH TABLE' IS
        !SUPERIOR TO MAX_LOAD_FACTOR, THE TABLE WILL GROW
        REAL :: max_load_factor = 0.75
      END TYPE hash_table
!
      CONTAINS
!***********************************************************************
      SUBROUTINE hash_table_create
!***********************************************************************
!
     &(ht, table_size)
!
!***********************************************************************
! PARTEL                                                      27/02/2018
!***********************************************************************
!
!brief    The newly created hash table will have at least 1M elements.
!         If the user ask for a size which is not a power of two, the
!         size will be rounded to the nearest superior power of two
!
!history  Judicaël Grasset (Daresbury Lab & EDF)
!+        27/02/2018
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| HT         |<->| Hash table
!| TABLE_SIZE |-->| The required size
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        TYPE(hash_table), INTENT(INOUT) :: HT
        INTEGER, INTENT(IN) :: TABLE_SIZE
        INTEGER :: IERR, P2
!
        p2 = nearest_superior_power_2(table_size)
        ALLOCATE(ht%TABLE(p2), stat=ierr)
        CALL check_allocate(ierr, 'HASH TABLE CREATION')
      END SUBROUTINE
!
!***********************************************************************
      SUBROUTINE hash_table_destroy
!***********************************************************************
!
     &(ht)
!
!***********************************************************************
! PARTEL                                                      27/02/2018
!***********************************************************************
!
!brief    Destroy a hash table and free his memory.
!
!history  Judicaël Grasset (Daresbury Lab & EDF)
!+        27/02/2018
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| HT         |<->| Hash table to destroy
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        TYPE(hash_table), INTENT(INOUT) :: HT
!
        ht%NELTS=-1
        ht%DEFAULT_VALUE=-1
        ht%LONGUEST_PROBE=-1
        IF(ALLOCATED(ht%TABLE)) DEALLOCATE(ht%TABLE)
      END SUBROUTINE
!***********************************************************************
      PURE FUNCTION nearest_superior_power_2
!***********************************************************************
!
     &(x) result(p2)
!
!***********************************************************************
! PARTEL                                                      27/02/2018
!***********************************************************************
!
!brief    Compute the nearest power of two of X which is at least 2**20
!
!history  Judicaël Grasset (Daresbury Lab & EDF)
!+        27/02/2018
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| X     |-->| Minimum required by user
!| P2    |<--| Nearest power of two found (at least 2**20)
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        INTEGER, INTENT(IN) :: X
        INTEGER :: P2
        !WILL SET THE DEFAULT SIZE OF THE HASHTABLE TO
        !1MIB OF ELEMENTS
        p2 = 2**20
!
        DO WHILE(p2 < x)
          p2 = p2*2
        END DO
      END FUNCTION
!***********************************************************************
      PURE FUNCTION elegant_pairing
!***********************************************************************
!
     &(x,y) result(pairing)
!
!***********************************************************************
! PARTEL                                                      27/02/2018
!***********************************************************************
!
!brief    Elegant pairing,algorithm by matthew szudzik(wolfram research)
!
!history  Judicaël Grasset (Daresbury Lab & EDF)
!+        27/02/2018
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| X       |-->| First number to paired
!| Y       |-->| Second Number to paired
!| PAIRING |<--| Pairing of X and Y
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        INTEGER, INTENT(IN) :: X,Y
        INTEGER(KIND=K8) :: PAIRING

        IF (x >= y) THEN
          pairing = int(x, kind=k8) * x + x + y
        ELSE
          pairing = y * y + x
        END IF
      END FUNCTION elegant_pairing
!
!***********************************************************************
      PURE FUNCTION hash
!***********************************************************************
!
     &(k, table_size) result(h)
!
!***********************************************************************
! PARTEL                                                      27/02/2018
!***********************************************************************
!
!brief    Hide the real hash function from the user
!
!history  Judicaël Grasset (Daresbury Lab & EDF)
!+        27/02/2018
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| K          |-->| Key to hash
!| TABLE_SIZE |-->| Size of the hash table
!| H          |<--| Computed hash
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        INTEGER(KIND=K8), INTENT(IN) :: K
        INTEGER, INTENT(IN) :: TABLE_SIZE
        INTEGER :: H
!
        !ADD ONE TO BE IN THE RANGE OF FORTRAN ARRAY (1:N)
        h=fingerprint(k,int(table_size, k8))+1
      END FUNCTION hash
!
!***********************************************************************
      PURE FUNCTION fingerprint
!***********************************************************************
!
     &(k, s) result(h)
!
!***********************************************************************
! PARTEL                                                      27/02/2018
!***********************************************************************
!
!brief    Fingerprint is a sightly modified version of the fingerprint
!         from the farmhash(v1.1) framework of google (mit licence)
!         https://github.com/google/farmhash/blob/master/src/farmhash.h
!
!history  Judicaël Grasset (Daresbury Lab & EDF)
!+        27/02/2018
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| K   |-->| Key to hash
!| S   |-->| Size of the hash table
!| H   |<--| Computed hash
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        INTEGER(KIND=K8), INTENT(IN) :: K
        INTEGER(KIND=K8), INTENT(IN) :: S
        !MAGIC NUMBER FROM MURMURHASH 3
        INTEGER(KIND=K8)::KMUL
        INTEGER(KIND=K8) :: B
        INTEGER :: H
#ifdef NAGFOR
        !THIS CONSTANT COMES FROM KNUTH,
        !THE ART OF COMPUTER PROGRAMMING,
        !VOL.3, SORTING AND SEARCHING, 1973
        DOUBLE PRECISION, PARAMETER :: A=(2.2360679774d0-1d0)/2d0
!
        kmul=z'CC9E2D51'
        h=floor(dble(s) * dmod(dble(k)*a,1d0))
        h=abs(h)
#else
!
        kmul=z'CC9E2D51'
        b = k*kmul
        b = ieor(b, ishft(b,44))
        b = b*kmul
        b = ieor(b, ishft(b,41))
        b = b*kmul
!
        !IN THE ORIGINAL FINGERPRINT FROM HASHFARM, ONLY UNSIGNED
        !INTEGER WERE USED, SO WHEN THE INT OVERFLOW IT WAS
        !POSITIVE, BUT WE DO NOT HAVE UNSIGNED IN FORTRAN
        b = abs(b)
!
        !WE CAN DO THE MODULO BY BITSHIFT BECAUSE WE KNOW THE SIZE
        !IS A POWER OF TWO. DOING THIS WAY SHOULD BE REALLY FASTER
        !THAN USING THE MODULO
        !B = MOD(B,SK16)
        b = iand(b, s-1)
!
        !B CAN BE CASTED TO A SMALLER INTEGER SINCE IT HAVE
        !BEEN REDUCED BY A MODULO OF THE HASHTABLE SIZE, WHICH IS
        !ALWAYS CONTAINED INTO AN INT
        h = int(b)
#endif
      END FUNCTION
!***********************************************************************
      RECURSIVE SUBROUTINE hash_table_insert
!***********************************************************************
!
     &(ht, x, y, v)
!
!***********************************************************************
! PARTEL                                                      27/02/2018
!***********************************************************************
!
!brief    Insert an element into the hash table. Will make the hash to
!         table grow if necessary (See max_load_factor).
!
!history  Judicaël Grasset (Daresbury Lab & EDF)
!+        27/02/2018
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| HT  |<->| Hash table to insert into
!| X   |-->| X coordinate of the element
!| Y   |-->| Y coordinate of the element
!| V   |-->| Value to insert
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        TYPE(hash_table), INTENT(INOUT) :: HT
        INTEGER, INTENT(IN) :: X,Y,V
        INTEGER :: I, PROBE_SIZE
        INTEGER(KIND=K8) :: K

        IF(x < 0 .OR. y < 0) THEN
          WRITE(lu,*)'X AND Y MUST BE POSITIVE'
          CALL plante(1,'MOD_HASH_TABLE')
        END IF
!
        !CHECK IF IT'S TIME TO GROW
        IF(REAL(ht%nelts)/SIZE(ht%table)>HT%MAX_LOAD_FACTOR) then
          CALL hash_table_grow(ht)
        END IF
!
        !TRANSFORM THE COORDINATES INTO A SINGLE INTEGER
        k = elegant_pairing(x,y)
!
        i = hash(k, SIZE(ht%TABLE))
!
        probe_size = 0
!
        DO WHILE (ht%TABLE(i)%X /= unused)
!
          !TEST IF IT'S A MODIFICATION OF AN ALREADY EXISTING ELT
          IF(ht%TABLE(i)%X == x .AND. ht%TABLE(i)%Y == y)EXIT
!
          i = i+1
          probe_size = probe_size+1
!
          !IF WE ARE AT THE END OF THE TABLE, CONTINUE TO SEARCH
          !FROM THE BEGINING
          IF(i>SIZE(ht%TABLE)) i=1
        END DO
!
        ht%TABLE(i)%X = x
        ht%TABLE(i)%Y = y
        ht%TABLE(i)%V = v
!
        IF(ht%LONGUEST_PROBE < probe_size) THEN
          ht%LONGUEST_PROBE=probe_size
        END IF
!
        ht%NELTS = ht%NELTS+1
      END SUBROUTINE
!***********************************************************************
      FUNCTION hash_table_get
!***********************************************************************
!
     &(ht, x, y) result(v)
!
!***********************************************************************
! PARTEL                                                      27/02/2018
!***********************************************************************
!
!brief    Return the value contained in the couple (x,y), will return
!         default_value if the couple is not found
!
!history  Judicaël Grasset (Daresbury Lab & EDF)
!+        27/02/2018
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| HT  |-->| Hash table to insert into
!| X   |-->| X coordinate of the element
!| Y   |-->| Y coordinate of the element
!| V   |<--| Retrieved value
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        TYPE(hash_table), INTENT(IN) :: HT
        INTEGER, INTENT(IN) :: X, Y
        INTEGER :: I, V
        INTEGER(KIND=K8) :: K

        IF(x < 0 .OR. y < 0) THEN
          WRITE(lu,*)'X AND Y MUST BE POSITIVE'
          CALL plante(1,'MOD_HASH_TABLE')
        END IF
!
        v = ht%DEFAULT_VALUE
!
        k = elegant_pairing(x,y)
        i = hash(k, SIZE(ht%TABLE))
!
        DO WHILE(ht%TABLE(i)%X /= unused)
          IF(ht%TABLE(i)%X == x .AND. ht%TABLE(i)%Y == y) THEN
            v = ht%TABLE(i)%V
            EXIT
          END IF
          i = i+1
          IF(i>SIZE(ht%TABLE)) i = 1
        END DO
      END FUNCTION hash_table_get
!***********************************************************************
      SUBROUTINE hash_table_grow
!***********************************************************************
!
     &(ht)
!
!***********************************************************************
! PARTEL                                                      27/02/2018
!***********************************************************************
!
!brief    Increase the size of the hash table, currently by doubling it
!
!history  Judicaël Grasset (Daresbury Lab & EDF)
!+        27/02/2018
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| HT  |-->| Hash table to grow
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        TYPE(hash_table), INTENT(INOUT) :: HT
        TYPE(hash_table) :: NEW_HT
        INTEGER :: I
!
        CALL hash_table_create(new_ht, SIZE(ht%TABLE)*2)
!
        DO i=1,SIZE(ht%TABLE)
          IF(ht%TABLE(i)%X /= unused) THEN
            CALL hash_table_insert(new_ht,
     &        ht%TABLE(i)%X, ht%TABLE(i)%Y, ht%TABLE(i)%V)
          END IF
        END DO
!
#ifdef NAGFOR
        ALLOCATE(ht%TABLE(SIZE(new_ht%TABLE)))
        ht%TABLE = new_ht%TABLE
        DEALLOCATE(new_ht%TABLE)
#else
        CALL move_alloc(new_ht%TABLE, ht%TABLE)
#endif
        ht%LONGUEST_PROBE = new_ht%LONGUEST_PROBE
        CALL hash_table_destroy(new_ht)
      END SUBROUTINE hash_table_grow
!
!***********************************************************************
      SUBROUTINE hash_table_stat
!***********************************************************************
!
     &(ht)
!
!***********************************************************************
! PARTEL                                                      27/02/2018
!***********************************************************************
!
!brief    Print some statistics about an hash table
!
!history  Judicaël Grasset (Daresbury Lab & EDF)
!+        27/02/2018
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| HT  |-->| Hash table
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        TYPE(hash_table), INTENT(IN) :: HT
        WRITE(lu,*)'LARGEST NO. OF COLLISIONS',ht%LONGUEST_PROBE
        WRITE(lu,*)'NUMBER OF BUCKETS:',SIZE(ht%TABLE)
        WRITE(lu,*)'NUMBER OF ELEMENTS:',ht%NELTS
      END SUBROUTINE
!
!***********************************************************************
      SUBROUTINE hash_table_test
!***********************************************************************
!
     &()
!
!***********************************************************************
! PARTEL                                                      27/02/2018
!***********************************************************************
!
!brief    Some tests to check that the hash table implementations is
!         working. Only usefull for debugging.
!
!history  Judicaël Grasset (Daresbury Lab & EDF)
!+        27/02/2018
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| HT  |-->| Hash table
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        TYPE(hash_table) :: HT
        INTEGER :: V,I
!
        CALL hash_table_create(ht, 1024)
!
        !SIMPLE INSERT
        CALL hash_table_insert(ht, 10,10,10)
        v=hash_table_get(ht,10,10)
        IF (v/=10) THEN
          WRITE(lu,*)'FOUND',v,'SHOULD HAVE BEEN 10'
          CALL plante(1,'MOD_HASH_TABLE')
        END IF
!
        !SIMPLE INSERT WITH NEGATIVE VALUE
        CALL hash_table_insert(ht, 10,20,-10)
        v=hash_table_get(ht,10,20)
        IF (v/=-10) THEN
          WRITE(lu,*)'FOUND',v,'SHOULD HAVE BEEN -10'
          CALL plante(1,'MOD_HASH_TABLE')
        END IF
!
        !INSERT WITH GIANTIC X Y
        CALL hash_table_insert(ht, 1234567890,1234567890,42)
        v=hash_table_get(ht,1234567890,1234567890)
        IF (v/=42) THEN
          WRITE(lu,*)'FOUND',v,'SHOULD HAVE BEEN 42'
          CALL plante(1,'MOD_HASH_TABLE')
        END IF
!
        !INSERT LOT OF DATA
        DO i=100,4298500
          CALL hash_table_insert(ht,i,i,i)
        END DO
        DO i=100,4298500
          v=hash_table_get(ht,i,i)
          IF (v /= i) THEN
            WRITE(lu,*)'FOUND',v,'SHOULD HAVE BEEN',i
            CALL plante(1,'MOD_HASH_TABLE')
          END IF
        END DO
!
        !CHANGE THE VALUE OF AN ALREADY EXISTING ELEMENT
        CALL hash_table_insert(ht,10,10,2017)
        v=hash_table_get(ht,10,10)
        IF (v /= 2017) THEN
          WRITE(lu,*)'FOUND',v,'SHOULD HAVE BEEN 2017'
          CALL plante(1,'MOD_HASH_TABLE')
        END IF
!
        CALL hash_table_stat(ht)
        CALL hash_table_destroy(ht)
        WRITE(lu,*)'HASH_TABLE: ALL TEST PASSED'
      END SUBROUTINE hash_table_test
!
      END MODULE mod_hash_table