! NOTE: NAG syntax for Binomial density:
!
! SUBROUTINE G01BJF(N, P, K, PLEK, PGTK, PEQK, IFAIL)
! INTEGER N, K, IFAIL
! REAL P, PLEK, PGTK, PEQK
!
! When the binomial distribution of X is
! Bin(N, P) 
! The results are (INOUT parameters)
! PLEK = probability that X < K
! PGTK = probability that X > K
! PEQK = probability that X = K
!
! IFAIL is the error code, 0 being successful execution.
!

MODULE proposal
IMPLICIT NONE
PRIVATE
  INTERFACE generate
     MODULE procedure generate_int, generate_real
  END INTERFACE

PUBLIC :: generate 

CONTAINS
  ! These subroutines generate samples from the proposal strategy
  ! into a buffer so that we don't need a function call every time
  ! we need a new value to propose.
  SUBROUTINE generate_int(name, buffer)
    IMPLICIT NONE
    
    CHARACTER(LEN=*), INTENT(IN) :: name
    INTEGER, DIMENSION(:), INTENT(INOUT) :: buffer
    
    SELECT CASE (name)
    CASE ('beta')
       ! here we have hardcoded:
       CALL uniform_discrete_random(1, 2, buffer)

    CASE ('x') 
       CALL binomial_random(3, 0.5, buffer)

    CASE ('obs') 
       CALL binomial_random(3, 0.5, buffer)
       
    CASE DEFAULT
    END SELECT
    
  END SUBROUTINE generate_int
  
  SUBROUTINE generate_real(name, buffer)
    IMPLICIT NONE

    CHARACTER(LEN=*), INTENT(IN) :: name
    REAL, DIMENSION(:), INTENT(INOUT) :: buffer
    
    SELECT CASE (name)
       !  CASE ('beta') this is a discrete parameter, not found here
       ! here we have hardcoded:
    CASE ('alpha') ! etc...
       CALL uniform_continuous_random(0.0, 1.0, buffer)
       
    END SELECT
    
  END SUBROUTINE generate_real
  
  SUBROUTINE uniform_discrete_random(left, right, buffer)
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: left
    INTEGER, INTENT(IN) :: right
    INTEGER, DIMENSION(:), INTENT(OUT) :: buffer
    
    REAL, DIMENSION(SIZE(buffer)) :: temp
    
    
    CALL RANDOM_NUMBER(temp)
    
    buffer = NINT(left + temp*(right-left))
    
  END SUBROUTINE  uniform_discrete_random
    
  SUBROUTINE uniform_continuous_random(left, right, buffer)
    IMPLICIT NONE
    REAL, INTENT(IN) :: left
    REAL, INTENT(IN) :: right
    REAL, DIMENSION(:), INTENT(OUT) :: buffer
    
    CALL RANDOM_NUMBER(buffer)
    
    buffer = left + buffer*(right-left)
    
  END SUBROUTINE  uniform_continuous_random
  
  SUBROUTINE binomial_random(n, p, buffer)

    INTEGER, INTENT(IN) :: n
    REAL, INTENT(IN) :: p
    INTEGER, DIMENSION(:), INTENT(OUT) :: buffer

    REAL, DIMENSION(n) :: temp
    INTEGER :: i

    DO i= 1, SIZE(buffer)
       CALL RANDOM_NUMBER(temp)
       buffer(i) = COUNT(temp > p)       
    END DO

  END SUBROUTINE binomial_random

END MODULE proposal
