Program g02kafe ! G02KAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g02kaf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: h, nep, rss, tau, tol Integer :: df, i, ifail, ip, ldx, m, n, niter, & opt, optloo, orig ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: b(:), res(:), vif(:), x(:,:), y(:) Real (Kind=nag_wp) :: perr(5) Integer, Allocatable :: isx(:) ! .. Intrinsic Procedures .. Intrinsic :: count ! .. Executable Statements .. Write (nout,*) 'G02KAF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in the problem size Read (nin,*) n, m, h, opt, tol, niter, orig, optloo, tau ldx = n Allocate (x(ldx,m),y(n),isx(m)) ! Read in data Read (nin,*)(x(i,1:m),y(i),i=1,n) ! Read in variable inclusion flags Read (nin,*) isx(1:m) ! Calculate IP ip = count(isx(1:m)==1) Allocate (b(ip+1),vif(ip),res(n)) ! Fit ridge regression model ifail = -1 Call g02kaf(n,m,x,ldx,isx,ip,tau,y,h,opt,niter,tol,nep,orig,b,vif,res, & rss,df,optloo,perr,ifail) If (ifail/=0) Then If (ifail/=-1) Then Go To 100 End If End If ! Display results Write (nout,99999) 'Value of ridge parameter:', h Write (nout,*) Write (nout,99998) 'Sum of squares of residuals:', rss Write (nout,99997) 'Degrees of freedom: ', df Write (nout,99999) 'Number of effective parameters:', nep Write (nout,*) Write (nout,*) 'Parameter estimates' Write (nout,99995)(i,b(i),i=1,ip+1) Write (nout,*) Write (nout,99996) 'Number of iterations:', niter Write (nout,*) If (opt==1) Then Write (nout,*) 'Ridge parameter minimises GCV' Else If (opt==2) Then Write (nout,*) 'Ridge parameter minimises UEV' Else If (opt==3) Then Write (nout,*) 'Ridge parameter minimises FPE' Else If (opt==4) Then Write (nout,*) 'Ridge parameter minimises BIC' End If Write (nout,*) Write (nout,*) 'Estimated prediction errors:' Write (nout,99999) 'GCV =', perr(1) Write (nout,99999) 'UEV =', perr(2) Write (nout,99999) 'FPE =', perr(3) Write (nout,99999) 'BIC =', perr(4) If (optloo==2) Then Write (nout,99999) 'LOO CV =', perr(5) End If Write (nout,*) Write (nout,*) 'Residuals' Write (nout,99995)(i,res(i),i=1,n) Write (nout,*) Write (nout,*) 'Variance inflation factors' Write (nout,99995)(i,vif(i),i=1,ip) 100 Continue 99999 Format (1X,A,1X,F10.4) 99998 Format (1X,A,E11.4) 99997 Format (1X,A,1X,I5) 99996 Format (1X,A,I16) 99995 Format (1X,I4,1X,F11.4) End Program g02kafe