! this file contains two modules; the first with strict deletion and the second with lazy deletion

! open addressing with linear probing. KD 2/2015. 
! The hashing fucntion makes sure that adjacent keys are spaced d places apart in the table
MODULE hash_mod
IMPLICIT NONE
PRIVATE
PUBLIC hash_init,hash_exists,hash_insert,hash_remove,hash_stat
INTEGER, ALLOCATABLE :: table(:)
INTEGER, PARAMETER :: empty=-huge(empty)-1,d=1009  ! lowest integer as marker
INTEGER :: ntable=0

CONTAINS

SUBROUTINE hash_init(n)
! create an empty hash table of size m>n, with m prime
IMPLICIT NONE
INTEGER, INTENT(IN) :: n
INTEGER i

IF (n>HUGE(n)/d) STOP 'hash_init: n is too high'  ! danger of integer overflow
IF (ALLOCATED(table)) DEALLOCATE(table)
DO i=n+mod(n,2)+1,min(max(3,2*n-1),huge(i)),2 ! try odd numbers only
! going to 2n-1 is enough due to Bertrand's postulate (actually a theorem)
  IF (i==d) CYCLE
  IF (is_prime(i)) THEN
    ALLOCATE(table(0:i-1))
    table=empty
    ntable=i
    EXIT
  ENDIF
END DO
CONTAINS
LOGICAL FUNCTION is_prime(i)
  IMPLICIT NONE
  INTEGER, INTENT(IN) ::i
  INTEGER j
 
  is_prime=.TRUE. 
  IF (i<4) RETURN    
  IF (MOD(i,2)==0) THEN
    is_prime=.FALSE.
    RETURN
  END IF
  DO j=3,INT(SQRT(i+0.5)),2
    IF (MOD(i,j)==0) THEN
      is_prime=.FALSE.
      RETURN
    END IF    
  END DO
END FUNCTION is_prime 
END SUBROUTINE hash_init

SUBROUTINE hash_insert(key)
IMPLICIT NONE
INTEGER, INTENT(IN) :: key
INTEGER i,j,k

IF (ntable==0) STOP 'hash_insert: hash_init was never called'
IF (key==empty) STOP 'hash_insert called with invalid key'

k=d*MODULO(key,ntable)   ! to avoid integer overflow in MOD(), multiply by d here
DO j=0,ntable-1
  i=MOD(k+j,ntable)
  IF (table(i)==empty) THEN
    table(i)=key
    RETURN
  END IF
END DO
STOP 'hash_insert: table full'
END SUBROUTINE hash_insert

LOGICAL FUNCTION hash_exists(key)
IMPLICIT NONE
INTEGER, INTENT(IN) :: key
INTEGER i,j,k

IF (ntable==0) STOP 'hash_exists: hash_init was never called'
IF (key==empty) STOP 'hash_exists called with invalid key'

k=d*MODULO(key,ntable)   ! to avoid integer overflow in MOD(), multiply by d here
hash_exists=.FALSE.
DO j=0,ntable-1
  i=MOD(k+j,ntable)
  IF (table(i)==key) THEN
    hash_exists=.TRUE.
    RETURN
  ELSE IF (table(i)==empty) THEN
    RETURN
  END IF
END DO
END FUNCTION hash_exists

SUBROUTINE hash_remove(key)
IMPLICIT NONE
INTEGER, INTENT(IN) :: key
INTEGER i,j,k,r

IF (ntable==0) STOP 'hash_remove: hash_init was never called'
IF (key==empty) STOP 'hash_remove called with invalid key'

k=d*MODULO(key,ntable)   ! to avoid integer overflow in MOD(), multiply by d here
DO j=0,ntable-1
  i=MOD(k+j,ntable)
  IF (table(i)==empty) THEN
    STOP 'hash_remove: did not find key'
  ELSE IF (table(i)==key) THEN 
    EXIT
  END IF
END DO
IF (j==ntable) STOP 'hash_remove: did not find key'
! I copied D.Knuth's Algorithm R, p527 chapter 6.4 of "Sorting and Searching"
! but I have to change his < sign to > because I'm increasing indices
! I think this is exactly equivalent to http://stackoverflow.com/questions/279539/best-way-to-remove-an-entry-from-a-hash-table
! similar? implementations can also be found at
! https://en.wikipedia.org/w/index.php?title=Hash_table&oldid=95275577#Example_pseudocode
! http://en.wikipedia.org/wiki/Open_addressing
R1: DO
      table(i)=empty
      j=i
R2:   DO
        i=MOD(i+1,ntable)
        IF (table(i)==empty) EXIT R1
        r=d*MOD(table(i),ntable)
        r=MOD(r,ntable)          ! natural position of key at table(i)
        IF ((i>=r.AND.r>j).OR.(r>j.AND.j>i).OR.(j>i.AND.i>=r)) CYCLE
	EXIT
      END DO R2
      table(j)=table(i)
    END DO R1
END SUBROUTINE hash_remove

SUBROUTINE hash_stat
IMPLICIT NONE

PRINT*,'size, number filled,first 11 entries:',ntable,COUNT(table/=empty)
PRINT*,table(0:10)

END SUBROUTINE hash_stat

END MODULE hash_mod

!
!
! open addressing with linear probing and lazy deletion. KD 2/2015.
! The hashing fucntion makes sure that adjacent keys are spaced d places apart in the table!
!
!

MODULE hash_lazy_mod
IMPLICIT NONE
PRIVATE
PUBLIC hash_init,hash_exists,hash_insert,hash_remove,hash_stat
INTEGER, ALLOCATABLE :: table(:)
INTEGER, PARAMETER :: empty=-huge(empty)-1,removed=empty+1,d=1009  ! lowest integer as "empty" marker
INTEGER :: ntable=0

CONTAINS

SUBROUTINE hash_init(n)
! create an empty hash table of size m>n, with m prime
IMPLICIT NONE
INTEGER, INTENT(IN) :: n
INTEGER i

IF (ALLOCATED(table)) DEALLOCATE(table)
DO i=n+mod(n,2)+1,min(max(3,2*n-1),huge(i)),2 ! try odd numbers only
! going to 2n-1 is enough due to Bertrand's postulate (actually a theorem)
  IF (i==d) CYCLE
  IF (is_prime(i)) THEN
    ALLOCATE(table(0:i-1))
    table=empty
    ntable=i
    EXIT
  ENDIF
END DO
CONTAINS
LOGICAL FUNCTION is_prime(i)
  IMPLICIT NONE
  INTEGER, INTENT(IN) ::i
  INTEGER j
 
  is_prime=.TRUE. 
  IF (i<4) RETURN    
  IF (MOD(i,2)==0) THEN
    is_prime=.FALSE.
    RETURN
  END IF
  DO j=3,INT(SQRT(i+0.5)),2
    IF (MOD(i,j)==0) THEN
      is_prime=.FALSE.
      RETURN
    END IF    
  END DO
END FUNCTION is_prime 
END SUBROUTINE hash_init

SUBROUTINE hash_insert(key)
IMPLICIT NONE
INTEGER, INTENT(IN) :: key
INTEGER i,j,k

IF (ntable==0) STOP 'hash_insert: hash_init was never called'
IF (key<=removed) STOP 'hash_insert called with invalid key'

k=d*MODULO(key,ntable)   ! to avoid integer overflow in MOD(), multiply by d here
DO j=0,ntable-1
  i=MOD(k+j,ntable)
  IF (table(i)<=removed) THEN
    table(i)=key
    RETURN
  END IF
END DO
STOP 'hash_insert: table is full'
END SUBROUTINE hash_insert

LOGICAL FUNCTION hash_exists(key)
! this function does part of the "lazy deletion" work
IMPLICIT NONE
INTEGER, INTENT(IN) :: key
INTEGER i,j,k,found_removed

IF (ntable==0) STOP 'hash_exists: hash_init was never called'
IF (key<=removed) STOP 'hash_exists called with invalid key'

k=d*MODULO(key,ntable)   ! to avoid integer overflow in MOD(), multiply by d here
hash_exists=.FALSE.
found_removed=-1
DO j=0,ntable-1     
  i=MOD(k+j,ntable)
  IF (table(i)==key) THEN
    hash_exists=.TRUE.
! relocate this key from its old position to a previously deleted one
    IF (found_removed>=0) THEN
      table(found_removed)=table(i)
      k=MOD(i+1,ntable)  ! check the next position
      IF (table(k)==empty) THEN
        table(i)=empty
      ELSE
        table(i)=removed
      END IF
    END IF
    RETURN
  ELSE IF (table(i)==empty) THEN ! not found
    RETURN
  ELSE IF (table(i)==removed) THEN
    IF (found_removed<0) found_removed=i
  END IF
END DO
END FUNCTION hash_exists

SUBROUTINE hash_remove(key)
IMPLICIT NONE
INTEGER, INTENT(IN) :: key
INTEGER i,j,k

IF (ntable==0) STOP 'hash_remove: hash_init was never called'
IF (key<=removed) STOP 'hash_remove called with invalid key'

k=d*MODULO(key,ntable)   ! to avoid integer overflow in MOD(), multiply by d here
DO j=0,ntable-1
  i=MOD(k+j,ntable)
  IF (table(i)==empty) THEN
    STOP 'hash_remove: did not find key'
  ELSE IF (table(i)==key) THEN 
    k=MOD(i+1,ntable)  ! check the next position
    IF (table(k)==empty) THEN
      table(i)=empty
    ELSE
      table(i)=removed
    END IF
    RETURN
  END IF
END DO
IF (j==ntable) STOP 'hash_remove: did not find key'

END SUBROUTINE hash_remove

SUBROUTINE hash_stat
IMPLICIT NONE

PRINT*,'size, number filled, number deleted, first 11 entries:',ntable,COUNT(table==empty),COUNT(table==removed)
PRINT*,table(0:10)

END SUBROUTINE hash_stat

END MODULE hash_lazy_mod


!PROGRAM test_hash
!USE hash_mod
!IMPLICIT NONE
!INTEGER, ALLOCATABLE :: test(:)
!REAL, ALLOCATABLE :: r(:)
!INTEGER i,n
!
!PRINT*,'n?'
!READ*,n
!CALL hash_init(n)
!ALLOCATE(r(2*n),test(2*n))
!CALL RANDOM_NUMBER(r)
!test=n*r
!DO i=1,2*n
!  IF (.NOT.hash_exists(test(i))) CALL hash_insert(test(i))
!  IF (test(i)==94.OR.test(i)==95) PRINT*,test(i),hash_exists(test(i))
!END DO
!CALL hash_stat
!DO i=1,n
!  IF (ANY(test==i).AND..NOT.hash_exists(i)) PRINT*,i,hash_exists(i)
!  IF (ALL(test/=i).AND.hash_exists(i)) PRINT*,i,hash_exists(i)
!END DO
!! test removal
!DO i=1,2*n
!  IF (test(i)>n*0.9) THEN
!    PRINT*,'remove',test(i),hash_exists(test(i))
!    IF (hash_exists(test(i))) CALL hash_remove(test(i))
!  END IF
!END DO
!CALL hash_stat
!DO i=1,n
!  IF (ANY(test==i).AND..NOT.hash_exists(i)) PRINT*,i,hash_exists(i)
!  IF (ALL(test/=i).AND.hash_exists(i)) PRINT*,i,hash_exists(i)
!END DO
!END
