Program g01affe
! G01AFF Example Program Text
! Mark 30.2 Release. NAG Copyright 2024.
! .. Use Statements ..
Use nag_library, Only: g01aff, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: nin = 5, nout = 6
! .. Local Scalars ..
Real (Kind=nag_wp) :: chis
Integer :: ifail, im, in, j, k, ldnob, ldpred, &
m, m1, m2, n, n1, n2, ndf, npos, num
! .. Local Arrays ..
Real (Kind=nag_wp) :: p(21)
Real (Kind=nag_wp), Allocatable :: pred(:,:)
Integer, Allocatable :: nobs(:,:)
! .. Executable Statements ..
Write (nout,*) 'G01AFF Example Program Results'
Write (nout,*)
! Skip heading in data file
Read (nin,*)
! Read in the problem size (where N and M are the number of
! rows and columns in the two way table NOBS)
Read (nin,*) im, in, num
! M and N as supplied to G01AFF must be 1 more than the number
! of rows and columns of data in NOBS
m = im + 1
n = in + 1
ldnob = m
ldpred = m
Allocate (nobs(ldnob,n),pred(ldpred,n))
! Read in data
Read (nin,*)(nobs(j,1:in),j=1,im)
Write (nout,*) 'Data as input -'
Write (nout,99992) 'Number of rows', im
Write (nout,99992) 'Number of columns', in
Write (nout,99992) 'NUM =', num, &
' (NUM = 1 means table reduced in size if necessary)'
! Perform the analysis
ifail = 0
Call g01aff(ldnob,ldpred,m,n,nobs,num,pred,chis,p,npos,ndf,m1,n1,ifail)
! Display results
If (num==0) Then
m2 = m - 1
n2 = n - 1
If (m1/=m2) Then
Write (nout,99992) 'No. of rows reduced from ', m2, ' to ', m1
End If
If (n1/=n2) Then
Write (nout,99992) 'No. of cols reduced from ', n2, ' to ', n1
End If
Write (nout,*)
Write (nout,*) 'Table of observed and expected frequencies'
Write (nout,*)
Write (nout,*) ' Column'
Write (nout,99991)(k,k=1,n1)
Write (nout,*) 'Row'
Do j = 1, m1
Write (nout,99999) j, nobs(j,1:n1)
Write (nout,99998) pred(j,1:n1)
Write (nout,99994) 'Row total = ', nobs(j,n)
End Do
Write (nout,*)
Write (nout,*) 'Column'
Write (nout,99993) 'totals', nobs(m,1:n1)
Write (nout,99994) 'Grand total = ', nobs(m,n)
Write (nout,*)
Write (nout,99997) 'Chi-squared = ', chis, ' D.F. = ', ndf
Else
Write (nout,*) 'Fisher''s exact test for 2*2 table'
Write (nout,*)
Write (nout,*) 'Table of observed frequencies'
Write (nout,*)
Write (nout,*) ' Column'
Write (nout,*) ' 1 2'
Write (nout,*) 'Row'
Do j = 1, 2
Write (nout,99999) j, nobs(j,1:2)
Write (nout,99994) 'Row total = ', nobs(j,n)
End Do
Write (nout,*)
Write (nout,*) 'Column'
Write (nout,99993) 'totals', nobs(m,1:2)
Write (nout,99994) 'Grand total = ', nobs(m,n)
Write (nout,*)
Write (nout,99996) 'This table corresponds to element ', npos, &
' in vector P below'
Write (nout,*)
Write (nout,*) 'Vector P'
Write (nout,*)
Write (nout,*) ' I P(I)'
Write (nout,99995)(j,p(j),j=1,num)
End If
99999 Format (1X,I2,4X,10I6)
99998 Format (8X,12F6.0)
99997 Format (1X,A,F10.3,A,I3)
99996 Format (1X,A,I4,A)
99995 Format (1X,I2,F9.4)
99994 Format (49X,A,I7)
99993 Format (1X,A,10I6)
99992 Format (1X,A,I3,A,I3)
99991 Format (7X,10I6)
End Program g01affe