geoplt(3f) - [M_datapac:LINE_PLOT] generate a geometric probability
plot
SUBROUTINE GEOPLT(X,N,P)
geoplt(3f) generates a geometric probability plot (with 'bernoulli
probability' parameter value = p).
the geometric distribution used herein has mean = (1-p)/p and standard
deviation = sqrt((1-p)/(p*p))). this distribution is defined for
all non-negative integer x--x = 0, 1, 2, ... . this distribution
has the probability function
f(x) = p * (1-p)**x.
the geometric distribution is the distribution of the number of
failures before obtaining 1 success in an indefinite sequence of
bernoulli (0,1) trials where the probability of success in a precision
trial = p.
as used herein, a probability plot for a distribution is a plot
of the ordered observations versus the order statistic medians for
that distribution.
the geometric probability plot is useful in graphically testing
the composite (that is, location and scale parameters need not be
specified) hypothesis that the underlying distribution from which
the data have been randomly drawn is the geometric distribution with
probability parameter value = p.
if the hypothesis is true, the probability plot should be near-linear.
a measure of such linearity is given by the calculated probability
plot correlation coefficient.
X description of parameter
Y description of parameter
Sample program:
program demo_geoplt
use M_datapac, only : geoplt
implicit none
! call geoplt(x,y)
end program demo_geoplt
Results:
The original DATAPAC library was written by James Filliben of the Statistical
Engineering Division, National Institute of Standards and Technology.
John Urban, 2022.05.31
CC0-1.0
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=wp), | dimension(:) | :: | X | |||
| integer | :: | N | ||||
| real(kind=wp) | :: | P |
| Type | Attributes | Name | Initial | |||
|---|---|---|---|---|---|---|
| real | :: | WS(15000) |
SUBROUTINE GEOPLT(X,N,P) REAL(kind=wp) :: an , cc , hold , P , pp0025 , pp025 , pp975 , pp9975 , q , & & sum1 , sum2 , sum3 , tau , W , wbar , WS , X , Y , ybar , & & yint REAL(kind=wp) :: yslope INTEGER i , iupper , N ! ! INPUT ARGUMENTS--X = THE VECTOR OF ! (UNSORTED OR SORTED) OBSERVATIONS. ! --N = THE INTEGER NUMBER OF OBSERVATIONS ! IN THE VECTOR X. ! --P = THE VALUE ! OF THE 'BERNOULLI PROBABILITY' ! PARAMETER FOR THE GEOMETRIC ! DISTRIBUTION. ! P SHOULD BE BETWEEN ! 0.0 (EXCLUSIVELY) AND ! 1.0 (EXCLUSIVELY). ! OUTPUT--A ONE-page GEOMETRIC PROBABILITY PLOT. ! PRINTING--YES. ! RESTRICTIONS--THE MAXIMUM ALLOWABLE VALUE OF N ! FOR THIS SUBROUTINE IS 7500. ! --P SHOULD BE BETWEEN 0.0 (EXCLUSIVELY) ! AND 1.0 (EXCLUSIVELY). ! OTHER DATAPAC SUBROUTINES NEEDED--SORT, UNIMED, PLOT, GEOPPF. ! FORTRAN LIBRARY SUBROUTINES NEEDED--SQRT. ! MODE OF INTERNAL OPERATIONS--. ! ORIGINAL VERSION--NOVEMBER 1975. ! UPDATED --FEBRUARY 1976. ! UPDATED --FEBRUARY 1976. ! UPDATED --MARCH 1987. ! !--------------------------------------------------------------------- ! DIMENSION X(:) DIMENSION Y(7500) , W(7500) COMMON /BLOCK2_real32/ WS(15000) EQUIVALENCE (Y(1),WS(1)) EQUIVALENCE (W(1),WS(7501)) ! iupper = 7500 ! ! CHECK THE INPUT ARGUMENTS FOR ERRORS ! IF ( N<1 .OR. N>iupper ) THEN WRITE (G_IO,99001) iupper 99001 FORMAT (' ', & &'***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE GEOPLT SUBROU& &TINE IS OUTSIDE THE ALLOWABLE (1,',I0,') INTERVAL *****') WRITE (G_IO,99002) N 99002 FORMAT (' ','***** THE VALUE OF THE ARGUMENT IS ',I0,' *****') RETURN ELSEIF ( N==1 ) THEN WRITE (G_IO,99003) 99003 FORMAT (' ', & &'***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUMENT TO THE GEOP& < SUBROUTINE HAS THE VALUE 1 *****') RETURN ELSE IF ( P<=0.0_wp .OR. P>=1.0_wp ) THEN WRITE (G_IO,99004) 99004 FORMAT (' ', & &'***** FATAL ERROR--THE THIRD INPUT ARGUMENT TO THE GEOPLT SUBROU& &TINE IS OUTSIDE THE ALLOWABLE (0,1) INTERVAL *****') WRITE (G_IO,99005) P 99005 FORMAT (' ','***** THE VALUE OF THE ARGUMENT IS ',E15.8, & & ' *****') RETURN ELSE hold = X(1) DO i = 2 , N IF ( X(i)/=hold ) GOTO 50 ENDDO WRITE (G_IO,99006) hold 99006 FORMAT (' ', & &'***** NON-FATAL DIAGNOSTIC--THE FIRST INPUT ARGUMENT (A VECTOR) & &TO THE GEOPLT SUBROUTINE HAS ALL ELEMENTS = ',E15.8,' *****') RETURN ENDIF ! !-----START POINT----------------------------------------------------- ! 50 an = N ! ! SORT THE DATA ! CALL SORT(X,N,Y) ! ! GENERATE UNIFORM ORDER STATISTIC MEDIANS ! CALL UNIMED(N,W) ! ! COMPUTE GEOMETRIC DISTRIBUTION ORDER STATISTIC MEDIANS ! DO i = 1 , N CALL GEOPPF(W(i),P,W(i)) ENDDO ! ! PLOT THE ORDERED OBSERVATIONS VERSUS ORDER STATISTICS MEDIANS. ! COMPUTE THE TAIL LENGTH MEASURE OF THE DISTRIBUTION. ! WRITE OUT THE TAIL LENGTH MEASURE OF THE DISTRIBUTION ! AND THE SAMPLE SIZE. ! CALL PLOT(Y,W,N) q = 0.9975_wp CALL GEOPPF(q,P,pp9975) q = 0.0025_wp CALL GEOPPF(q,P,pp0025) q = 0.975_wp CALL GEOPPF(q,P,pp975) q = 0.025_wp CALL GEOPPF(q,P,pp025) tau = (pp9975-pp0025)/(pp975-pp025) WRITE (G_IO,99007) P , tau , N ! 99007 FORMAT (' ','GEOMETRIC PROBABILITY PLOT WITH PROBABILITY ', & & 'PARAMETER = ',E17.10,1X,'(TAU = ',E15.8,')',11X, & & 'THE SAMPLE ','SIZE N = ',I0) ! ! COMPUTE THE PROBABILITY PLOT CORRELATION COEFFICIENT. ! COMPUTE LOCATION AND SCALE ESTIMATES ! FROM THE INTERCEPT AND SLOPE OF THE PROBABILITY PLOT. ! THEN WRITE THEM OUT. ! sum1 = 0.0_wp sum2 = 0.0_wp DO i = 1 , N sum1 = sum1 + Y(i) sum2 = sum2 + W(i) ENDDO ybar = sum1/an wbar = sum2/an sum1 = 0.0_wp sum2 = 0.0_wp sum3 = 0.0_wp DO i = 1 , N sum1 = sum1 + (Y(i)-ybar)*(Y(i)-ybar) sum2 = sum2 + (Y(i)-ybar)*(W(i)-wbar) sum3 = sum3 + (W(i)-wbar)*(W(i)-wbar) ENDDO cc = sum2/SQRT(sum3*sum1) yslope = sum2/sum3 yint = ybar - yslope*wbar WRITE (G_IO,99008) cc , yint , yslope 99008 FORMAT (' ','PROBABILITY PLOT CORRELATION COEFFICIENT = ',F8.5,& & 5X,'ESTIMATED INTERCEPT = ',E15.8,3X, & & 'ESTIMATED SLOPE = ',E15.8) ENDIF ! END SUBROUTINE GEOPLT