! Loads a previously created memory matrix and computes pairwise cosines
! between words listed in an input file. 
!
! Syntax: Cosine_Between <FILE> 
!
! The first line of FILE must contain the number of comparisons (integer), 
! and each of the subsequent 1..N lines contains the pairs of words in 
! lowercase, with a space between each word
!
! If either word does not appear in the lexicon, N/A is output with a zero 
! cosine--note that this zero should be coded as a missing value in 
! subsequent analyses
!
! The cosine of the vectors can be replaced by the Euclidean distance 
! by replacing the call to "Vector_Cosine" with a call to the inline 
! function "Distance" 

!======================================================================
MODULE Declare_Constants

implicit none

private

intrinsic KIND 
 integer,   public, parameter           :: wp = KIND(1.0D0)

 integer,   public, parameter :: D              = 2048,    &
				 MAX_WORDS      = 90000,   &
				 SENT_CHARS     = 400,    &
				 WORD_CHARS     = 20,	  &
				

END MODULE Declare_Constants
!======================================================================

program Cosine_Between

USE Declare_Constants

implicit none
  
  character(len=WORD_CHARS) :: Word(MAX_WORDS), W1, W2
  character(len=30)         :: cos_file
  real(wp)                  :: Memory(D,MAX_WORDS), Mean_Cos
  integer                   :: Words_Learned, i, j, P1(D), P2(D), n_Comparisons, Pos1, Pos2, n_args, iargc
 			     
  logical                   :: FLAG1, FLAG2



!=======================================

 n_args = iargc()

 call getarg(1, cos_file)
 cos_file = trim(cos_file)
 open(unit=1, file=cos_file, status='old')
 read(1,*) n_Comparisons
 Mean_Cos = 0.0
 
do i = 1, n_Comparisons
 FLAG1=.false.
 FLAG2=.false.
 Pos1 = 0
 Pos2 = 0
 read(1,*) W1, W2
 
 do j = 1, MAX_WORDS
  if (Word(j) == W1) then 
    FLAG1=.true.
    Pos1 = j
  endif
  if (Word(j) == W2) then
    FLAG2=.true.
    Pos2 = j
  endif
  if (FLAG1 .and. FLAG2) exit  
 enddo
 
 
 if ((Pos1==0) .or. (Pos2==0)) then 
   write(*,*) trim(W1), ' ', trim(W2), ' ', 'NA'
 else
  write(*,*) trim(W1), ' ', trim(W2), ' ', Vector_Cosine(Memory(:,Pos1), Memory(:,Pos2), D)
 endif
 
enddo !i

 !write(*,*) 'Mean Cosine: ', Mean_Cos/n_Comparisons
 close(1)
 
!======================================= 
 CONTAINS
!=======================================  


!*************************************************************************************
subroutine Read_Matrix(Memory, Words_Learned, Word)
  character(len=WORD_CHARS) :: Word(MAX_WORDS)
  real                  :: Memory(D,MAX_WORDS)
  integer                   :: Words_Learned, i

 
 open(unit=10, file='word_labels.txt', status='old') 
 open(unit=11, file='matrix.mat', status='old', form='unformatted')

 read(10,*) Words_Learned 
 
 do i = 1, Words_Learned
   read(10,'(a20)') Word(i)
   read(11) Memory(:,i)
 enddo

 close(10)
 close(11)

 end subroutine Read_Matrix 
!*************************************************************************************


!================================================================
!          PROXIMITY ROUTINES:
!================================================================
!****************************************************************
function Vector_Length (Vector, n)
   integer :: i, n 
   real(wp)    :: Vector_Length, Vector(n), SS

 SS = 0.0
  SS = dot_product(Vector, Vector)
 Vector_Length = sqrt(SS)
end function Vector_Length 
!****************************************************************



!****************************************************************
subroutine Normalize (Vector_In, n)
   integer             :: i, n
   real(wp)              :: Vector_In(n), Vect_Length, Test_Val
  
  Test_Val = dot_product(Vector_In, Vector_In)
  if (Test_Val == 0.0) then 
    return
  endif
  
  
  Vect_Length = 0.0 
  Vect_Length = Vector_Length(Vector_In, n)
  Vector_In = Vector_In / Vect_Length
end subroutine Normalize
!****************************************************************


!****************************************************************
function Vector_Cosine (Vector1, Vector2, n)
   
   real*8    :: Vector1(n), Vector2(n)
   real*8    :: Vector_Cosine
   integer :: n, i
 
 call Normalize(Vector1, n) 
 call Normalize(Vector2, n) 
 Vector_Cosine = dot_product(Vector1, Vector2)
 
end function Vector_Cosine
!****************************************************************

!***************************************************************
function Distance (Vector1, Vector2, n)
   real*8    :: Vector1(n), Vector2(n)
   real*8    :: Distance, Sum
   integer :: n, i

 sum = 0.0
 do i = 1, n
  sum = sum  + ((Vector1(i) - Vector2(i)) **2)
 enddo
 Distance = sum

end function Distance
!***************************************************************
end program Cosine_Between