StatLib applied statistics algorithms

StatLib -Applied Statistics algorithms StatLib -Applied Statistics algorithms The Royal Statistical Society has been publishing algorithms in its journal Applied Statistics since 1968 As of 1989, there are over 250 of them Most are in Fortran, though a few were in Algol, and some recent ones have been in Pascal The book - Applied Statistics Algorithms by Griffiths, P and Hill, I.D., Ellis Horwood: Chichester (1985) contains translations of several algorithms from Algol to Fortran A few of the other algorithms have been supplied in Fortran translations, though a few are in Algol or Pascal The index which follows indicates which algorithms are not in Fortran The full source code is published in the journal Those available here have been transcribed manually, mainly within CSIRO Division of Mathematics & Statistics, or have been supplied directly by the authors or by the RSS Algorithms Editor In some cases, later corrections or improvements published in Applied Statistics, have been incorporated It is the policy of the editors of the algorithms section of Applied Statistics that algorithms not use double precision Many of the algorithms here have been converted to double precision, though users should be careful to check what precision is used Many of the algorithms require the use of other algorithms, particularly functions for the gamma function and the normal distribution function Where such functions or subroutines are required, an appropriate comment has been added to the algorithm In a few cases, alternative algorithms from other sources have been added For instance, three algorithms are included in the file for as66 for calculating the area under the normal curve, and an alternative random number generator is provided in the file for as183 The Applied Statistics algorithm for Nelder-Mead simplex minimization (AS 47) does not include the fitting of a quadratic surface; the CSIRO/ Rothamsted implementation which does this is included with AS 47 Users must consult the original journal articles for details of the calling arguments; they are not included with these algorithms *** Warning In some cases, there are different arguments (usually more) in the Griffiths & Hill versions of these algorithms Users should check this It has been assumed that the user will be using a Fortran-77 compiler, so functions such as alog and amin1 have been converted to their generic forms (log and min) This simplifies conversion of code between single and double precision Also all constants in the code, such as 1.0, 0.d0, etc., have been replaced with one, zero, etc., and these are defined in either data or parameter statements Many of the algorithms have been entered in lower case, which is not acceptable in Fortran, though most compilers accept it Some of the algorithms need machine-dependant constants The user should check this In most cases, these have been set for compilers which allow a range of floating-point numbers from about 10**(-37) to 10**(+37), though most modern compilers allow a much wider range http://lib.stat.cmu.edu/apstat/ (1 of 18) [3/3/2002 9:48:19 PM] StatLib -Applied Statistics algorithms in double precision No guarantee is given that the algorithms have been entered correctly, or that they perform as claimed in the journal To obtain an algorithm, send an E-mail request of the form: send index from apstat send 207 from apstat to statlib@lib.stat.cmu.edu The Royal Statistical Society holds the copyright to these routines, but has given its permission for their distribution provided that no fee is charged The full collection of Applied Statistics algorithms is very large Please only request those algorithms which you need Requesting large numbers of algorithms places a great strain on the StatLib system and the underlying mail networks As of the end of 1997 the Applied Statistics journal does NOT accept algorithms Listing of available Applied Statistics algorithms No Brief description (volume number/year in brackets) Student's t-distribution (17/1968) See also AS 27 The non-central t-distribution (17/1968) See also AS 243 Cholesky decomposition of a symmetric +ve definite matrix (17/1968) Inversion of a symmetric matrix stored in triangular form (17/1968) 13 Minimum spanning tree (18/1969) See also AS 40 14 Printing the minimum spanning tree (18/1969) 15 Single-linkage cluster analysis (18/1969) 22 Calculate treatment effects in a complete factorial experiment for any numbers of levels of factors using the extended Yate's method (19/1970) http://lib.stat.cmu.edu/apstat/ (2 of 18) [3/3/2002 9:48:19 PM] StatLib -Applied Statistics algorithms 27 Upper tail area under Student's t-distribution (19/1970) See also AS 30 Half-normal plotting (19/1970) 32 The incomplete gamma integral (19/1970) See also AS 239 34 Update inverse of symmetric banded matrix (19/1970) 38 Calculate R-squared for all possible regression subsets using the Gauss-Jordan method (20/1971) See also AS 268 40 Update a minimum spanning tree (20/1971) 41 Updates corrected sums of squares and products matrices (20/1971) See also AS 240 45 Histogram plotting (20/1971) 46 Gram-Schmidt orthogonalization (20/1971) 47 Nelder & Mead simplex method of unconstrained minimization without requiring derivatives Does not include the quadratic surface fitting part of the algorithm A CSIRO/Rothamsted version of the algorithm, which does include fitting a quadratic surface, is also included (20/1971) (Updated, 20/Dec/93) 51 Log-linear fit for contingency tables (21/1972) See also AS 160 52 Calculation of sums of powers (up to 4) of deviations from the mean (21/1972) 53 Wishart variate generator (21/1972) 57 Printing multi-dimensional tables (22/1973) 58 Allocates observations to clusters to minimize within-cluster sum of squares (22/1973) See also AS 136 60 http://lib.stat.cmu.edu/apstat/ (3 of 18) [3/3/2002 9:48:19 PM] StatLib -Applied Statistics algorithms Eigenvalues/vectors of a symmetric matrix (22/1973) 62 Distribution of the Mann-Whitney U statistic (22/1973) 63 Incomplete beta function (22/1973) See also TOMS algorithm 708 TOMS algorithms are available from netlib 64 Inverse of the incomplete beta function ratio (22/1973) The file here is actually the Griffiths & Hill version of AS 109 65 Expands structure formula to a list of binary integers This is actually remark R82 which replaces the original AS65 (39/1990) 66 The normal distribution function Two other algorithms (not from Applied Statistics) have also been included (22/1973) 75 Algorithms for least-squares calculation using square-root free planar rotations (Morven Gentleman's package) (23/1974) 76 An integral useful in calculating noncentral t and bivariate normal probabilities (23/1974) 77 Calculate exact null distribution of the largest root of a beta matrix (23/1974) 78 The mediancentre (i.e the median in a multi-dimensional space) (23/1974) See also AS 143 83 Complex discrete fast Fourier transform (24/1975) 84 Measures of multivariate skewness and kurtosis (24/1975) 88 Generate all nCr combinations by simulating nested Fortran DO-loops (Jane Gentleman's routines) (24/1975) See also AS 172 89 Tail probabilities for Spearman's rho (24/1975) 91 Percentage points of the chi-squared distribution (24/1975) http://lib.stat.cmu.edu/apstat/ (4 of 18) [3/3/2002 9:48:19 PM] StatLib -Applied Statistics algorithms 93 Calculates frequency distribution for the Ansari-Bradley test statistic (25/1976) A routine has been added to return the distribution function 95 Maximum likelihood estimation of scale and location parameters from grouped data User's distribution function (25/1976) 96 Finding `nice' scales for graphs (25/1976) 97 Real discrete fast Fourier transform Series length must be a power of (25/1976) See also AS 117 and AS 176 99 Fitting Johnson curves by moments (25/1976) 100 Normal-Johnson and Johnson-Normal transformations (25/1976) 103 Psi or digamma function (25/1976) 107 Calculate operating characteristics and average sampling number for a general class of sequential sampling plans (26/1977) 108 Multiple linear regression minimizing the sum of absolute errors (26/1977) See also AS 238 (in Pascal) 109 Inverse of the incomplete beta function (26/1977) 110 LP-Norm fit of straight line by extension of Schlossmacher (26/1977) 111 Percentage points of the normal distribution (26/1977) See also AS 241 114 Compute the numerator of certain ordinal measures of association (Kendall's tau, Somer's d, Goodman and Kruskal's gamma) when the data are ordered categories (26/1977) 116 Calculate the tetrachoric correlation and its standard errors (26/1977) 117 http://lib.stat.cmu.edu/apstat/ (5 of 18) [3/3/2002 9:48:19 PM] StatLib -Applied Statistics algorithms Fast Fourier transform for series of any length using the CHIRP algorithm (26/1977) 121 Trigamma function (27/1978) 123 Distribution function of mixtures of beta distributions (27/1978) 125 Maximum likelihood estimation for censored exponential survival data with covariates (27/1978) 126 Distribution function of the range for the normal distribution (27/1978) 127 Generation of random orthogonal matrices (27/1978) 128 Computes approximate covariance matrix for normal order statistics (27/1978) 132 Simple regression minimizing the sum of absolute deviations (27/1978) 133 Finding the global maximum or minimum of a function of variable (27/1978) 134 Generate random beta variates for alpha < and beta > (28/1979) 135 Min-Max (L-infinity) estimates for linear multiple regression (28/1979) 136 A K-means clustering algorithm (28/1979) 138 Maximum likelihood estimates of the mean and standard deviation of the normal distribution with censored or confined observations (28/1979) 139 Maximum likelihood estimation in a linear model from confined and censored normal data (28/1979) 140 Clustering the nodes of a directed graph (28/1979) 141 Inversion of a symmetric matrix ignoring a specified row/column (28/1979) 142 Exact tests of significance in binary regression (28/1979) http://lib.stat.cmu.edu/apstat/ (6 of 18) [3/3/2002 9:48:19 PM] StatLib -Applied Statistics algorithms 143 Calculates the median centre (28/1979) 145 Exact distribution of the largest multinomial frequency (28/1979) 147 Incomplete gamma function (29/1980) See also AS 239 148 Removal of bias in the jackknife procedure (This is actually ASR 62) (29/1980) 149 Amalgamation of means in the case of simple ordering ('Up-and-Down Blocks' algorithm for isotonic regression) (29/1980) 150 Computes estimate of spectrum of a point process using a centered moving average of the periodogram of the counting process (29/1980) 151 Smoothed spectral estimate for bivariate point processes (29/1980) 152 Cumulative hypergeometric probabilities (This is actually AS R77) (29/1980, revised in 38/1989) 153 Distribution of weighted sum of squares of normal variables (29/1980) Pan's procedure for the tail probabilities of the Durbin-Watson statistic 154 Exact maximum likelihood estimation of autoregressive-moving average models by Kalman filtering (29/1980) See also AS 182 155 Distribution function of a linear combination of non-central chi- squared random variables (29/1980) See also AS 204 This is a Fortran translation supplied by the author 157 The runs-up and runs-down tests (30/1981) 158 Calculation of probabilities for inferences under simple order restrictions (30/1981) See also AS 198 159 Generate random 2-way table with given marginal totals (30/1981) 160 http://lib.stat.cmu.edu/apstat/ (7 of 18) [3/3/2002 9:48:19 PM] StatLib -Applied Statistics algorithms Partial and marginal association in multi-dimensional contingency tables (30/1981) 161 Critical regions of an unconditional non-randomized test of homogeneity in x contingency tables (30/1981) 162 Multivariate Conditional Logistic Analysis of Stratum-matched Case-control Studies (30/1981) Includes a Fortran version of CACM algorithm 382 for generating all combinations of M out of N items 163 A Givens Algorithm for Moving from one Linear Model to another without Going back to the Data (30/1981) 164 Least squares subject to linear constraints (30/1981) 165 Discriminant analysis of categorical data (30/1981) 166 Calculates the entanglement matrix for a specified design (30/1981) 167 Calculates efficiencies of estimation and their generalized inverse (30/1981) 168 Calculates 'neat' values for plotting scales (30/1981) 169 Produces scatter plots (30/1981) 170 Computation of probability and non-centrality parameter of a non- central chi-square distribution (30/1981) 171 Fisher's exact variance test for the Poisson distribution (31/1982) 172 Generates indices for simulated nested DO-loops Actually converts (either way) between a single index and a vector of subscripts (31/1982) 173 Generates design matrix for balanced factorial experiments (31/1982) 174 Multivariate rank sum test and median test (31/1982) 175 http://lib.stat.cmu.edu/apstat/ (8 of 18) [3/3/2002 9:48:19 PM] StatLib -Applied Statistics algorithms Cramer-Wold factorization of self-reciprocal polynomials as the product of two polynomials (31/1982) 176 Kernel density estimation using the fast Fourier transform (31/1982) Also contains an alternative set of routines for density estimation 177 Expected values of normal order statistics (31/1982) 178 Gauss-Jordan sweep operator with multi-collinearity detection (31/1982) 179 Enumeration of all permutations of multi-sets with fixed repetition numbers (31/1982) 180 Linear rank estimate of the standard deviation after symmetric trimming (31/1982) 181 Withdrawn See R94 below 182 Finite-sample prediction from ARIMA processes (31/1982) Uses AS 154 183 The Wichmann & Hill random number generator An alternative is also provided (31/1982) 184 Non-central studentized maximum and related multiple-t probabilities (31/1982) 185 Backward elimination procedure to find best-fitting log-linear models for contingency tables (31/1982) Uses AS 51 186 Discrete Fast Fourier Transform with data permutation Series length must be a power of (31/1982) 187 Derivatives of the incomplete gamma integral (31/1982) 188 Estimation of the order of dependence in sequences (32/1983) 189 Maximum likelihood estimation for the beta binomial distribution (32/1983) 190 Distribution function & its inverse, for the studentized range (32/1983) http://lib.stat.cmu.edu/apstat/ (9 of 18) [3/3/2002 9:48:19 PM] StatLib -Applied Statistics algorithms 191 Approximate likelihood calculation for ARMA and seasonal ARMA models Includes a routine for the Banachiewicz (or modified Cholesky) factorization A = LDL' (32/1983) 192 Calculate approximate percentage points using Pearson curves and the first three or four moments (32/1983) 193 The Knuth spectral test for congruential random number generators (32/1983) 194 Test of goodness of fit of ARMA models (32/1983) 195 Multivariate normal probabilities for a rectangular region in N- dimensional space A version which calls IMSL routines is also included (33/1984) See AS 251 for a special case 196 Conditional multivariate logistic analysis of stratified case-control studies (33/1984) 197 Likelihood function for an ARMA process (33/1984) 198 Calculation of level probabilities for order-restricted inference (33/1984) 199 Branch and bound algorithm to find the subset which maximizes a quadratic form (33/1984) 200 Approximate the sum of squares of normal score (33/1984) 201 Combine predictions about a statistic based on the orderings of a set of means with an F-test of differences between the means (33/1984) 202 Data-based nonparametric hazard estimation (33/1984) 203 Maximum likelihood estimation of mixtures of distributions (normal, exponential, Poisson and binomial) (33/1984) See also AS221 This is a translation from Algol into Fortran 204 Distribution of a sum of non-central chi-squared variables (33/1984) Translation from Algol into Pascal http://lib.stat.cmu.edu/apstat/ (10 of 18) [3/3/2002 9:48:19 PM] http://lib.stat.cmu.edu/apstat/319 Below are versions of this algorithm, the first as submitted to the RSS in Fortran 77; the second is my Fortran 90 version The author has given permission for his version to be submitted to the apstat collection As a `title' in the index I suggest: Unconstrained variable metric function minimization without derivatives The two versions are separated by a line of !!!!!!!!'s Alan P.S I have tested the F90 version version, that should work too! As it was derived from the F77 C Algorithm AS 319 and test program C -PROGRAM VAR C -C A PROGRAM TO IMPLEMENT A QUASI-NEWTON METHOD C USING NEW ALGORITHM VARMET JULY 1994 C -C COMMON /FUNERR/LER COMMON /TEST/IG,IFN EXTERNAL FUN LOGICAL LER C INTEGER N, NMAX PARAMETER (N=2, NMAX=50) INTEGER IG,IFN,GRADTL,MESS,MAXFN,IER PARAMETER (GRADTL = 12, MAXFN = 1000, MESS = 6) DOUBLE PRECISION X,XTMP,W,FP DIMENSION X(N),XTMP(N),W(225) C WRITE(*,*)' ' WRITE(*,*) 'INPUT YOUR STARTING GUESS' DO 12 I=1,N READ(*,*) XTMP(I) 12 CONTINUE WRITE(*,*)' ' WRITE(*,*)'INITIALIZATION COMPLETE.' WRITE(*,*)'***************************************' C DO 24 J=1,N 24 X(J)=XTMP(J) IFN = CALL VARME(FUN,N,X,FP,W,GRADTL,MAXFN,MESS,IER) C WRITE(*,*)' ' WRITE(*,*)' THE NUMBER OF FUNCTION EVALUATIONS IS ',IFN WRITE(*,*)' ' WRITE(*,*)'THE MINIMUM FOUND IS',(X(I),I=1,N) WRITE(*,*)' ' CALL FUN(N,X,FP) WRITE(*,*)'THE FUNCTION VALUE IS: ',FP STOP END C http://lib.stat.cmu.edu/apstat/319 (1 of 14) [3/3/2002 9:57:57 PM] http://lib.stat.cmu.edu/apstat/319 SUBROUTINE FUN(NORD,BP,Q) C -COMMON /FUNERR/LER COMMON /TEST/IG,IFN DIMENSION BP(*) LOGICAL LER DOUBLE PRECISION BP,Q Q=100.*(BP(2)-BP(1)**2)**2+(BP(1)-1.)**2 IFN = IFN + LER = FALSE RETURN END C SUBROUTINE VARME(FUN,NPAR,B,F0,W,NSIG,MAXFN,IOUT,IER) C C C CALLING SUBROUTINE FOR SUBROUTINE VARMET C C ALLOWS FOR SETUP OF DEFAULT PARAMETERS C AND EFFICIENT USE OF STORAGE C AS WELL AS WRITING OF ERROR MESSAGES C C VERSION 0.1 C CODED BY JOHN J KOVAL C MARCH 1986 C C VERSION 0.2 C CODED BY JOHN J KOVAL C JULY 1988 C C VERSION 0.26 C CODED BY MURRAY ALEXANDER FOR JOHN J KOVAL C JULY 1989 C C VERSION 0.27 C MODIFIED BY NAZIH HASSAN, JULY 1993 C C VERSION 0.28 C MODIFIED BY JOHN KOVAL, JUNE 1996 C BECAUSE OF COMMENTS FROM REVIEWER FOR APPLIED STATISTICS C CHANGES TO ORDER OF PARAMETERS IN GRAD C C PARAMETERS MEANING DEFAULT C -C C FUN NAME OF FUNCTION TO BE MINIMIZED C C NPAR ORDER OF PARAMETER VECTOR C (NUMBER OF UNKNOWNS) C C B ARRAY CONTAINING INITIAL ESTIMATES C ON OUTPUT CONTAINING FINAL ESTIMATES C C F0 VALUE OF FUNCTION AT MINIMUM C C W WORK ARRAY OF LENGTH FO (NPAR+5)*NPAR C C NSIG MACHINE ACCURACY AS NEGATIVE POWER 10 OR C OF TEN C C MAXFN MAXIMUM NUMBER OF FUNCTION EVALUATIONS 1000 http://lib.stat.cmu.edu/apstat/319 (2 of 14) [3/3/2002 9:57:57 PM] http://lib.stat.cmu.edu/apstat/319 C (DOES INCLUDE EVALUATIONS BY SUBROUTINE C GRAD WHICH CALCULATES APPROXIMATE GRADIENT) C C IOUT OUTPUT CHANNEL FOR ERROR MESSAGES C (IF 0, THEN MESSAGES NOT WRITTEN) C C IER ERROR INDICATOR C INTEGER C C DOUBLE PRECISION W,B,F0,EPD,GRADTL EXTERNAL FUN DIMENSION B(*),W(*) PARAMETER (MAXF = 1000, EPD = 1.0D-05, MSIG = 10) C C INITIALIZE C IER=0 C IF(NSIG.EQ.0) NSIG = MSIG GRADTL = 1.0/(10.0**(NSIG)) C IF(GRADTL.LT.0.0) THEN IF(IOUT.GT.0) WRITE(IOUT,300) NSIG, GRADTL 300 FORMAT(' NSIG VALUE OF ',I3,' CREATES NEGATIVE VALUE OF', 1' GRADTL, NAMELY, ',G12.5) GRADTL = 1.0/(10**(MSIG)) IF(IOUT.GT.0) WRITE(IOUT,310) MSIG, GRADTL 310 FORMAT(' PROGRAM SUBSTITUTES NSIG VALUE OF ',I3,' WHICH', 1' GIVES GRADTL VALUE OF ',G12.5) ENDIF C IF(MAXFN.EQ.0) MAXFN = MAXF C C NOW WE ARE READY TO CALL THE MINIMIZATION SUBROUTINE C I1 = NPAR*NPAR + I2 = I1 + NPAR I3 = I2 + NPAR I4 = I3 + NPAR C CALL VARMET(FUN,NPAR,B,F0,W(I3),W,W(I1),W(I2),W(I4), GRADTL,MAXFN,IER) C IF(IER.GT.0.AND.IOUT.GT.0)THEN WRITE(IOUT,30) IER 30 FORMAT(/' SUBROUTINE VARMET ERROR NUMBER ',I3) IF(IER.EQ.1) THEN WRITE(IOUT,40) ELSE IF(IER.EQ.2) THEN WRITE(IOUT,60) ELSE IF(IER.EQ.3) THEN WRITE(IOUT,70) ELSE IF(IER.EQ.4) THEN WRITE(IOUT,80) ENDIF 40 FORMAT(' FUNCTION UNDEFINED AT INITIAL VALUE ') 60 FORMAT(' GRADIENT UNDEFINED IN TOO MANY DIMENSIONS ') 70 FORMAT(' FUNCTON NOT MINIMIZED BUT' /' UNABLE TO FIND MINIMUM IN DIRECTION OF SEARCH') 80 FORMAT(' TOO MANY FUNCTION EVALUATIONS REQUIRED ') http://lib.stat.cmu.edu/apstat/319 (3 of 14) [3/3/2002 9:57:57 PM] http://lib.stat.cmu.edu/apstat/319 C ENDIF C 200 RETURN END C -SUBROUTINE VARMET(FUN,NPAR,B,F0,G,H,C,D,T,GRADTL,MAXFN,IFAULT) C C ALGORITHM AS 319 APPL.STATIST (1997), VOL.46, NO.4 C C VARIABLE METRIC FUNCTION MINIMISATION C EXTERNAL FUN COMMON/FUNERR/LER DIMENSION B(NPAR),G(NPAR),H(NPAR,NPAR),C(NPAR),D(NPAR),T(2*NPAR) DOUBLE PRECISION B,F0,G,H,C,D,T,GRADTL,W,TOLER,D1,S,CK,F1,D2 INTEGER IFN,IG LOGICAL LER PARAMETER (ICMAX=20, TOLER=0.00001, W=0.2) C IG = IFN = LER = FALSE IFAULT = NP = NPAR + C IF (MAXFN.EQ.0) MAXFN = 1000 IF (GRADTL.EQ.0.0) GRADTL = 1.0D-10 C CALL FUN(NPAR,B,F0) IF(LER) THEN IFAULT = RETURN ENDIF IFN = IFN + C CALL GRAD(FUN,NPAR,B,F0,G,T(NP),GRADTL,IFAULT) IF(IFAULT.GT.0) RETURN C IG = IG + IFN = IFN + NPAR IF(IFN.GT.MAXFN) THEN IFAULT = RETURN ENDIF C 10 DO 30 K = 1,NPAR DO 20 L = 1,NPAR H(K,L) = 0.0 20 CONTINUE H(K,K) = 1.00 30 CONTINUE ILAST = IG C 40 DO 50 I = 1,NPAR D(I) = B(I) C(I) = G(I) 50 CONTINUE C D1 = 0.0 http://lib.stat.cmu.edu/apstat/319 (4 of 14) [3/3/2002 9:57:57 PM] http://lib.stat.cmu.edu/apstat/319 DO 70 I = 1,NPAR S = 0.0 DO 60 J = 1,NPAR S = S - H(I,J)*G(J) 60 CONTINUE T(I) = S D1 = D1 - S*G(I) 70 CONTINUE C IF(D1.LE.0.0) THEN IF(ILAST.EQ.IG) THEN RETURN ENDIF GO TO 10 ELSE CK = 1.0 IC = 90 ICOUNT = DO 100 I = 1,NPAR B(I) = D(I) + CK*T(I) IF(B(I).EQ.D(I)) THEN ICOUNT = ICOUNT + ENDIF 100 CONTINUE C IF(ICOUNT.GE.NPAR) THEN IF(ILAST.EQ.IG) THEN RETURN ENDIF GO TO 10 ELSE CALL FUN(NPAR,B,F1) C IFN = IFN + IF(IFN.GT.MAXFN) THEN IFAULT = RETURN ELSE IF(LER) THEN CK = W * CK IC = IC+1 IF(IC.GT.ICMAX) THEN IFAULT = RETURN ENDIF GO TO 90 C ELSE IF(F1.GE.F0 - D1*CK*TOLER) THEN CK = W * CK GO TO 90 ELSE F0 = F1 CALL GRAD(FUN,NPAR,B,F0,G,T(NP),GRADTL,IFAULT) IF(IFAULT.GT.0) THEN RETURN ENDIF IG = IG + IFN = IFN + NPAR IF(IFN.GT.MAXFN) THEN IFAULT = RETURN ENDIF http://lib.stat.cmu.edu/apstat/319 (5 of 14) [3/3/2002 9:57:57 PM] http://lib.stat.cmu.edu/apstat/319 C 130 D1 = 0.0 DO 130 I = 1,NPAR T(I) = CK*T(I) C(I) = G(I) - C(I) D1 = D1 + T(I)*C(I) CONTINUE C IF(D1.LE.0.0) THEN GOTO 10 ENDIF C 140 150 D2 = 0.0 DO 150 I = 1,NPAR S = 0.0 DO 140 J = 1,NPAR S = S + H(I,J)*C(J) CONTINUE D(I) = S D2 = D2 + S*C(I) CONTINUE D2 = 1.0 + D2/D1 C DO 170 I = 1,NPAR DO 170 J = 1,NPAR H(I,J) = H(I,J) - (T(I)*D(J) + D(I)*T(J) D2*T(I)*T(J))/D1 170 CONTINUE ENDIF ENDIF ENDIF GO TO 40 END SUBROUTINE GRAD(F,NPAR,B,F0,G,SA,ER,IFAULT) C C C CALCULATE APPROXIMATE GRADIENT DIMENSION B(NPAR),G(NPAR),SA(NPAR) DOUBLE PRECISION B,F0,G,SA,ER,H,F1 COMMON/FUNERR/LER LOGICAL LER C JCMAX=NPAR-2 JC = C DO 20 I = 1,NPAR H =(DABS(B(I)) +DSQRT(ER)) *DSQRT(ER) SA(I) = B(I) B(I) = B(I) + H CALL F(NPAR,B,F1) B(I) = SA(I) C IF(LER) THEN F1 = F0 + H JC = JC + ENDIF C G(I) = (F1 -F0)/H 20 CONTINUE C http://lib.stat.cmu.edu/apstat/319 (6 of 14) [3/3/2002 9:57:57 PM] http://lib.stat.cmu.edu/apstat/319 IF(JC.GT.JCMAX) IFAULT = RETURN END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! ! ! Algorithm AS 319 and test program Converted to Fortran 90 free-format style by Alan Miller e-mail: Alan.Miller @ vic.cmis.csiro.au URL: www.ozemail.com.au/~milleraj MODULE as319 IMPLICIT NONE ! COMMON ! COMMON LOGICAL, INTEGER, /funerr/ler /test/ig,ifn SAVE :: ler SAVE :: ig, ifn INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(14, 50) END MODULE as319 ! SUBROUTINE varme(fun, npar, b, f0, nsig, maxfn, iout, ier) ! ! CALLING SUBROUTINE FOR SUBROUTINE VARMET ! ! ! ALLOWS FOR SETUP OF DEFAULT PARAMETERS AND EFFICIENT USE OF STORAGE AS WELL AS WRITING OF ERROR MESSAGES ! ! ! VERSION 0.1 CODED BY JOHN J KOVAL MARCH 1986 ! ! ! VERSION 0.2 CODED BY JOHN J KOVAL JULY 1988 ! ! ! VERSION 0.26 CODED BY MURRAY ALEXANDER FOR JOHN J KOVAL JULY 1989 ! ! VERSION 0.27 MODIFIED BY NAZIH HASSAN, JULY 1993 ! ! ! ! VERSION 0.28 MODIFIED BY JOHN KOVAL, JUNE 1996 BECAUSE OF COMMENTS FROM REVIEWER FOR APPLIED STATISTICS CHANGES TO ORDER OF PARAMETERS IN GRAD ! ! PARAMETERS ! FUN MEANING NAME OF FUNCTION TO BE MINIMIZED http://lib.stat.cmu.edu/apstat/319 (7 of 14) [3/3/2002 9:57:57 PM] DEFAULT - http://lib.stat.cmu.edu/apstat/319 ! ! NPAR ORDER OF PARAMETER VECTOR (NUMBER OF UNKNOWNS) ! ! B ARRAY CONTAINING INITIAL ESTIMATES ON OUTPUT CONTAINING FINAL ESTIMATES ! F0 VALUE OF FUNCTION AT MINIMUM ! ! NSIG MACHINE ACCURACY AS NEGATIVE POWER OF TEN ! ! ! MAXFN MAXIMUM NUMBER OF FUNCTION EVALUATIONS 1000 (DOES INCLUDE EVALUATIONS BY SUBROUTINE GRAD WHICH CALCULATES APPROXIMATE GRADIENT) ! ! IOUT OUTPUT CHANNEL FOR ERROR MESSAGES (IF 0, THEN MESSAGES NOT WRITTEN) ! ! IER ERROR INDICATOR INTEGER 10 OR ! USE as319 IMPLICIT NONE INTEGER, INTENT(IN) REAL (dp), INTENT(IN OUT) REAL (dp), INTENT(IN OUT) INTEGER, INTENT(IN OUT) INTEGER, INTENT(IN OUT) INTEGER, INTENT(IN OUT) INTEGER, INTENT(OUT) INTERFACE SUBROUTINE fun(nord, bp, q) USE as319 IMPLICIT NONE INTEGER, INTENT(IN) REAL (dp), INTENT(IN) REAL (dp), INTENT(OUT) END SUBROUTINE fun END INTERFACE :: :: :: :: :: :: :: npar b(:) f0 nsig maxfn iout ier :: nord :: bp(:) :: q REAL (dp) :: gradtl INTEGER, PARAMETER :: maxf = 1000, msig = 10 ! INITIALIZE ier=0 IF(nsig == 0) nsig = msig gradtl = 1.0 / (10.0**(nsig)) IF(gradtl < 0.0) THEN IF(iout > 0) WRITE(iout, 300) nsig, gradtl 300 FORMAT(' NSIG VALUE OF ', i3, ' CREATES NEGATIVE VALUE OF', ' GRADTL, NAMELY, ', g12.5) gradtl = 1.0/(10**(msig)) IF(iout > 0) WRITE(iout, 310) msig, gradtl 310 FORMAT(' PROGRAM SUBSTITUTES NSIG VALUE OF ', i3, ' WHICH', http://lib.stat.cmu.edu/apstat/319 (8 of 14) [3/3/2002 9:57:57 PM] & & http://lib.stat.cmu.edu/apstat/319 ' GIVES GRADTL VALUE OF ', g12.5) END IF IF(maxfn == 0) maxfn = maxf ! NOW WE ARE READY TO CALL THE MINIMIZATION SUBROUTINE CALL varmet(fun, npar, b, f0, gradtl, maxfn, ier) IF(ier > 0.AND.iout > 0)THEN WRITE(iout, 30) ier 30 FORMAT(/' SUBROUTINE VARMET ERROR NUMBER ', i3) IF(ier == 1) THEN WRITE(iout, 40) ELSE IF(ier == 2) THEN WRITE(iout, 60) ELSE IF(ier == 3) THEN WRITE(iout, 70) ELSE IF(ier == 4) THEN WRITE(iout, 80) END IF 40 FORMAT(' FUNCTION UNDEFINED AT INITIAL VALUE 60 FORMAT(' GRADIENT UNDEFINED IN TOO MANY DIMENSIONS 70 FORMAT(' FUNCTON NOT MINIMIZED BUT' & /' UNABLE TO FIND MINIMUM IN DIRECTION OF SEARCH') 80 FORMAT(' TOO MANY FUNCTION EVALUATIONS REQUIRED ') ') ') END IF RETURN CONTAINS ! -SUBROUTINE varmet(fun, npar, b, f0, gradtl, maxfn, ifault) ! ALGORITHM AS 319 APPL.STATIST (1997), VOL.46, NO.4 ! VARIABLE METRIC FUNCTION MINIMISATION INTEGER, INTENT(IN) REAL (dp), INTENT(IN OUT) REAL (dp), INTENT(OUT) REAL (dp), INTENT(OUT) INTEGER, INTENT(OUT) INTEGER, INTENT(OUT) INTERFACE SUBROUTINE fun(nord, bp, q) USE as319 IMPLICIT NONE INTEGER, INTENT(IN) REAL (dp), INTENT(IN) REAL (dp), INTENT(OUT) END SUBROUTINE fun END INTERFACE REAL (dp) INTEGER :: :: :: :: :: :: npar b(:) f0 gradtl maxfn ifault :: nord :: bp(:) :: q :: d1, s, ck, f1, d2 :: i, ic, icount, ifn, ig, ilast, j, k, np http://lib.stat.cmu.edu/apstat/319 (9 of 14) [3/3/2002 9:57:57 PM] http://lib.stat.cmu.edu/apstat/319 INTEGER, PARAMETER :: icmax=20 REAL (dp), PARAMETER :: toler=0.00001, w=0.2 REAL (dp) :: g(npar), h(npar,npar), c(npar), d(npar), t(2*npar) ig = ifn = ler = false ifault = np = npar + IF (maxfn == 0) maxfn = 1000 IF (gradtl == 0.0) gradtl = 1.0D-10 CALL fun(npar, b, f0) IF(ler) THEN ifault = RETURN END IF ifn = ifn + CALL grad(fun, npar, b, f0, g, t(np:), gradtl, ifault) IF(ifault > 0) RETURN ig = ig + ifn = ifn + npar IF(ifn > maxfn) THEN ifault = RETURN END IF 10 DO k = 1, npar h(k,1:npar) = 0.0 h(k,k) = 1.00 END DO ilast = ig 40 DO i = 1, npar d(i) = b(i) c(i) = g(i) END DO d1 = 0.0 DO i = 1, npar s = - DOT_PRODUCT( h(i,1:npar), g(1:npar) ) t(i) = s d1 = d1 - s*g(i) END DO IF(d1 = npar) THEN IF(ilast == ig) THEN RETURN END IF GO TO 10 ELSE CALL fun(npar, b, f1) ifn = ifn + IF(ifn > maxfn) THEN ifault = RETURN ELSE IF(ler) THEN ck = w * ck ic = ic+1 IF(ic > icmax) THEN ifault = RETURN END IF GO TO 90 ELSE IF(f1 >= f0 - d1*ck*toler) THEN ck = w * ck GO TO 90 ELSE f0 = f1 CALL grad(fun, npar, b, f0, g, t(np:), gradtl, ifault) IF(ifault > 0) THEN RETURN END IF ig = ig + ifn = ifn + npar IF(ifn > maxfn) THEN ifault = RETURN END IF d1 = 0.0 DO i = 1, npar t(i) = ck*t(i) c(i) = g(i) - c(i) d1 = d1 + t(i)*c(i) END DO IF(d1 jcmax) ifault = RETURN END SUBROUTINE grad END SUBROUTINE varme http://lib.stat.cmu.edu/apstat/319 (12 of 14) [3/3/2002 9:57:57 PM] http://lib.stat.cmu.edu/apstat/319 ! -PROGRAM var ! -! A PROGRAM TO IMPLEMENT A QUASI-NEWTON METHOD ! USING NEW ALGORITHM VARMET JULY 1994 ! -USE as319 IMPLICIT NONE INTEGER, PARAMETER INTEGER INTEGER, SAVE REAL (dp) :: :: :: :: n=2 ier gradtl = 12, maxfn = 1000, mess = x(n), xtmp(n), fp INTERFACE SUBROUTINE fun(nord, bp, q) USE as319 IMPLICIT NONE INTEGER, INTENT(IN) REAL (dp), INTENT(IN) REAL (dp), INTENT(OUT) END SUBROUTINE fun :: nord :: bp(:) :: q SUBROUTINE varme(fun, npar, b, f0, nsig, maxfn, iout, ier) USE as319 IMPLICIT NONE INTEGER, INTENT(IN) :: npar REAL (dp), INTENT(IN OUT) :: b(:) REAL (dp), INTENT(IN OUT) :: f0 INTEGER, INTENT(IN OUT) :: nsig INTEGER, INTENT(IN OUT) :: maxfn INTEGER, INTENT(IN OUT) :: iout INTEGER, INTENT(OUT) :: ier INTERFACE SUBROUTINE fun(nord, bp, q) USE as319 IMPLICIT NONE INTEGER, INTENT(IN) :: nord REAL (dp), INTENT(IN) :: bp(:) REAL (dp), INTENT(OUT) :: q END SUBROUTINE fun END INTERFACE END SUBROUTINE varme END INTERFACE WRITE(*,*)' ' WRITE(*,*) 'INPUT YOUR STARTING GUESS: ' READ(*,*) xtmp(1:n) WRITE(*,*)' ' WRITE(*,*)'INITIALIZATION COMPLETE.' WRITE(*,*)'***************************************' x(1:n)=xtmp(1:n) ifn = CALL varme(fun, n, x, fp, gradtl, maxfn, mess, ier) WRITE(*,*)' ' IF (ier /= 0) WRITE(*, *) '** IER =', ier, ' **' http://lib.stat.cmu.edu/apstat/319 (13 of 14) [3/3/2002 9:57:57 PM] http://lib.stat.cmu.edu/apstat/319 WRITE(*,*)' THE NUMBER OF FUNCTION EVALUATIONS IS ', ifn WRITE(*,*)' ' WRITE(*,*)'THE MINIMUM FOUND IS ', x(1:n) WRITE(*,*)' ' CALL fun(n, x, fp) WRITE(*, *)'THE FUNCTION VALUE IS: ', fp STOP END PROGRAM var ! -SUBROUTINE fun(nord, bp, q) ! -USE as319 IMPLICIT NONE INTEGER, INTENT(IN) REAL (dp), INTENT(IN) REAL (dp), INTENT(OUT) :: nord :: bp(:) :: q q=100.*(bp(2) - bp(1)**2)**2 + (bp(1) - 1.)**2 ifn = ifn + ler = false IF (nord < 1) WRITE(*, *)'** NORD must be > 0, actual value =', nord RETURN END SUBROUTINE fun http://lib.stat.cmu.edu/apstat/319 (14 of 14) [3/3/2002 9:57:57 PM] Pantelis Vlachos Pantelis Vlachos Pantelis Vlachos (vlachos@stat.cmu.edu) is a Research Scientist, in the Department of Statistics, at Carnegie Mellon University He took over the StatLib service in June of 1998 from Mike Meyer Mike started the StatLib, service in April of 1989 By 1995 StatLib had grown to a collection of about 150 Mbytes and the StatLib server was servicing about 60,000 transactions per month The people who really make StatLib a success are those who contribute software, datasets, and other information Thanks to those who have already contributed, and keep those contributions coming Back to http://lib.stat.cmu.edu/master/vlachos.html [3/3/2002 9:58:03 PM] ... underlying mail networks As of the end of 1997 the Applied Statistics journal does NOT accept algorithms Listing of available Applied Statistics algorithms No Brief description (volume number/year... is charged The full collection of Applied Statistics algorithms is very large Please only request those algorithms which you need Requesting large numbers of algorithms places a great strain on...StatLib -Applied Statistics algorithms in double precision No guarantee is given that the algorithms have been entered correctly, or that they perform