DISCRE Subroutine

public subroutine DISCRE(X, N, Xmin, Xdel, Xmax, Y)

NAME

discre(3f) - [M_datapac:STATISTICS] bin the elements of a vector
(like DISCR2, but allows specification of min and max class limits)

SYNOPSIS

   SUBROUTINE DISCRE(X,N,Xmin,Xdel,Xmax,Y)

DESCRIPTION

discre(3f) 'discretizes' the data of the REAL vector x.
the first class interval is from xmin to xmin + xdel; the second
class interval is from xmin+ xdel to xmin + 2*xdel; etc.

all values in the vector x within a given class will be mapped into
the midpoint of that class.

all values in the vector x smaller than xmin will be mapped into xmin -
(xdel/2.0).

all values in the vector x larger than xmax will be mapped into xmax +
(xdel/2.0).

the use of discre(3f) (and the discr2 and discr3 subroutines) gives
the data analyst the capability of constructing a discrete variate
from a continuous one.

the resulting discrete variate might then (for example) be analyzed
in itself for gross structure, or for adherence to some theoretical
discrete probability model, or the discrete variate might be used as
a subset definition vector for some other variate.

OPTIONS

 X   description of parameter
 Y   description of parameter

EXAMPLES

Sample program:

program demo_discre
use M_datapac, only : discre
implicit none
! call discre(x,y)
end program demo_discre

Results:

AUTHOR

The original DATAPAC library was written by James Filliben of the Statistical
Engineering Division, National Institute of Standards and Technology.

MAINTAINER

John Urban, 2022.05.31

LICENSE

CC0-1.0

Arguments

Type IntentOptional Attributes Name
real(kind=wp), dimension(:) :: X
integer :: N
real(kind=wp) :: Xmin
real(kind=wp) :: Xdel
real(kind=wp) :: Xmax
real(kind=wp), dimension(:) :: Y

Source Code

SUBROUTINE DISCRE(X,N,Xmin,Xdel,Xmax,Y)
REAL(kind=wp) :: ai , clasml , clasmu , classm , cmax , cmin , hold , pointl ,&
     &     pointu , totdel , X , Xdel , Xmax , Xmin , Y
INTEGER :: i , icounl , icount , icounu , ip , N , numcla
!
!     INPUT ARGUMENTS--X      = THE  VECTOR OF
!                                (UNSORTED OR SORTED) OBSERVATIONS.
!                                TO BE DISCRETIZED.
!                     --N      = THE INTEGER NUMBER OF OBSERVATIONS
!                                IN THE VECTOR X.
!                     --XMIN   = THE  VALUE
!                                WHICH DEFINES THE LOWER BOUNDARY
!                                (INCLUSIVELY) OF THE LOWERMOST
!                                CLASS.
!                     --XDEL   = THE  VALUE
!                                OF THE CLASS WIDTH.
!                     --XMAX   = THE  VALUE
!                                WHICH DEFINES THE UPPER BOUNDARY
!                                (INCLUSIVELY) OF THE UPPERMOST
!                                CLASS.
!     OUTPUT ARGUMENTS--Y      = THE  VECTOR OF
!                                DISCRETIZED VALUES (= CLASS
!                                MIDPOINTS) CORRESPONDING TO
!                                THE CONTINUOUS VALUES IN THE VECTOR X.
!                                THERE WILL RESULT N SUCH DISCRETIZED
!                                VALUES.
!     OUTPUT--THE  VECTOR Y
!             WHICH CONTAINS N DISCRETIZED VALUES
!             (= CLASS MIDPOINTS)
!             CORRESPONDING TO THE N
!             CONTINUOUS VALUES IN THE
!             INPUT VECTOR X.
!             ALSO, A FEW LINES LINES OF SUMMARY INFORMATION
!             WILL BE GENERATED INDICATING
!             1) WHAT THE SAMPLE SIZE IS (N);
!             2) WHAT THE NUMBER OF CLASSES IS (NUMCLA).
!             3) WHAT THE CLASS BOUNDARIES AND
!                THE NUMBER OF OBSERVATIONS
!                FALLING IN EACH CLASS ARE.
!     PRINTING--YES.
!     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
!                   OF N FOR THIS SUBROUTINE.
!                 --XDEL SHOULD BE POSITIVE.
!                 --(XMAX-XMIN)/XDEL SHOULD NOT EXCEED 999.
!     MODE OF INTERNAL OPERATIONS--.
!     COMMENT--IT IS SUGGESTED THAT XMIN, XDEL,
!              AND XMAX HAVE AT LEAST 1 MORE
!              DECIMAL PLACE THAN THE DATA VALUES
!              IN THE VECTOR X SO AS TO HELP ASSURE
!              A UNIQUE DISCRETIZATION MAPPING;
!              THAT IS, TO HELP ASSURE THAT
!              NO DATA VALUE WILL FALL
!              EXACTLY ON THE BOUNDARY POINT
!              BETWEEN 2 ADJACENT CLASSES.
!     COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS
!              PERMISSABLE (IF THE ANALYST SO DESIRES)
!              TO USE THE SAME VARIABLE NAME
!              IN THE SIXTH ARGUMENT AS USED IN THE FIRST
!              ARGUMENT IN THE CALLING SEQUENCE TO THIS
!              DISCRE SUBROUTINE--NO CONFLICT WILL RESULT
!              IN THE INTERNAL OPERATION OF THE     DISCRE
!              SUBROUTINE.  FOR EXAMPLE, IT IS PERMISSIBLE
!              TO HAVE     CALL DISCRE(X,N,0.5,1.0,20.5,X)
!              IN WHICH THE VARIABLE NAME      X    IS USED
!              AS BOTH THE FIRST AND SIXTH ARGUMENTS.
!     ORIGINAL VERSION--NOVEMBER  1974.
!     UPDATED         --NOVEMBER  1975.
!
!---------------------------------------------------------------------
!
      DIMENSION X(:) , Y(:)
      DIMENSION icount(1000)
      DIMENSION classm(1000)
!
!     CHECK THE INPUT ARGUMENTS FOR ERRORS
!
      IF ( N<1 ) THEN
         WRITE (G_IO,99001)
99001    FORMAT (' ',                                                   &
     &'***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE DISCRE SUBROU&
     &TINE IS NON-POSITIVE *****')
         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 DISC&
     &RE SUBROUTINE HAS THE VALUE 1 *****')
         Y(1) = X(1)
         RETURN
      ELSEIF ( Xdel<=0.0_wp ) THEN
         WRITE (G_IO,99004)
99004    FORMAT (' ',                                                   &
     &'***** FATAL ERROR--THE FOURTH INPUT ARGUMENT TO THE DISCRE SUBROU&
     &TINE IS NON-POSITIVE *****')
         WRITE (G_IO,99005) Xdel
99005    FORMAT (' ','***** THE VALUE OF THE ARGUMENT IS ',E15.7,       &
     &           ' *****')
         DO i = 1 , N
            Y(i) = 0.0_wp
         ENDDO
         RETURN
      ELSE
         IF ( Xmin==Xmax ) THEN
            WRITE (G_IO,99006)
99006       FORMAT (' ','***** FATAL ERROR--THE THIRD AND FIFTH INPUT ',&
     &              'ARGUMENTS TO THE DISCRE SUBROUTINE ARE IDENTICAL')
            WRITE (G_IO,99007) Xmin
99007       FORMAT (' ','***** THE VALUE OF THE ARGUMENTS ARE ',E15.7,  &
     &              ' *****')
            DO i = 1 , N
               Y(i) = 0.0_wp
            ENDDO
            RETURN
         ELSE
            hold = X(1)
            DO i = 2 , N
               IF ( X(i)/=hold ) GOTO 50
            ENDDO
            WRITE (G_IO,99008) hold
99008       FORMAT (' ',                                                &
     &'***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUMENT (A VECTOR) &
     &TO THE DISCRE SUBROUTINE HAS ALL ELEMENTS =',E15.8,' *****')
            DO i = 1 , N
               Y(i) = X(i)
            ENDDO
            RETURN
         ENDIF
!
!-----START POINT-----------------------------------------------------
!
!     DETERMINE THE TRUE INTERVAL MIN AND MAX;
!     THEN DETERMINE THE NUMBER OF CLASSES
!     WITHIN THE SPECIFIED MIN AND MAX.
!
 50      pointl = Xmin
         pointu = Xmax
         IF ( Xmin>Xmax ) pointl = Xmax
         IF ( Xmin>Xmax ) pointu = Xmin
         totdel = pointu - pointl
         numcla = (totdel/Xdel) + 0.999_wp
!
!     ZERO OUT THE COUNT VECTOR (ICOUNT)
!     AND THE LOWER AND UPPER COUNT VARIABLES.
!
         DO i = 1 , numcla
            icount(i) = 0
         ENDDO
         icounl = 0
         icounu = 0
!
!     COMPUTE THE CLASS MIDPOINT FOR EACH CLASS.
!
         DO i = 1 , numcla
            ai = i
            cmin = Xmin + (ai-1.0)*Xdel
            cmax = Xmin + ai*Xdel
            classm(i) = (cmin+cmax)/2.0_wp
         ENDDO
         cmax = pointu
         classm(numcla) = (cmin+cmax)/2.0_wp
!
!     PERFORM THE DISCRETIZING TRANSFORMATION.
!
         DO i = 1 , N
            IF ( X(i)>=pointl .AND. X(i)<=pointu ) THEN
               ip = (X(i)-pointl)/Xdel
               ip = ip + 1
               IF ( ip>numcla ) ip = numcla
               Y(i) = classm(ip)
               icount(ip) = icount(ip) + 1
            ELSEIF ( X(i)<pointl ) THEN
               clasml = pointl - (Xdel/2.0_wp)
               Y(i) = clasml
               icounl = icounl + 1
            ELSEIF ( X(i)>pointu ) THEN
               clasmu = pointu + (Xdel/2.0_wp)
               Y(i) = clasmu
               icounu = icounu + 1
            ENDIF
         ENDDO
!
!     COMPUTE CLASS LIMITS AND WRITE OUT SUMMARY INFORMATION.
!
         WRITE (G_IO,99020)
         WRITE (G_IO,99009)
!
99009    FORMAT (' ','OUTPUT FROM THE DISCRE SUBROUTINE--')
         WRITE (G_IO,99020)
         WRITE (G_IO,99010) N
99010    FORMAT (' ',7X,'NUMBER OF OBSERVATIONS            = ',I0)
         WRITE (G_IO,99011) Xmin
99011    FORMAT (' ',7X,'SPECIFIED LOWER BOUND OF INTERVAL = ',F15.7)
         WRITE (G_IO,99012) Xdel
99012    FORMAT (' ',7X,'SPECIFIED CLASS WIDTH             = ',F15.7)
         WRITE (G_IO,99013) Xmax
99013    FORMAT (' ',7X,'SPECIFIED UPPER BOUND OF INTERVAL = ',F15.7)
         WRITE (G_IO,99014) numcla
99014    FORMAT (' ',7X,'COMPUTED  NUMBER OF LEVELS        = ',I0)
         WRITE (G_IO,99020)
         WRITE (G_IO,99015)
99015    FORMAT (' ',                                                   &
     &           '       CLASS     MINIMUM       MIDPOINT      MAXIMUM',&
     &           '      COUNT')
         WRITE (G_IO,99016)
99016    FORMAT (' ',                                                   &
     &           '       -------------------------------------------',  &
     &           '-------------')
         IF ( icounl>=1 ) WRITE (G_IO,99017) clasml , pointl , icounl
99017    FORMAT (' ',4X,'   BELOW     -INFINITY',2F14.7,I8)
         DO i = 1 , numcla
            ai = i
            cmin = pointl + (ai-1.0_wp)*Xdel
            cmax = pointl + ai*Xdel
            IF ( cmax>pointu ) cmax = pointu
            WRITE (G_IO,99018) i , cmin , classm(i) , cmax , icount(i)
99018       FORMAT (' ',4X,I6,2X,3F14.7,I8)
         ENDDO
         IF ( icounu>=1 ) WRITE (G_IO,99019) pointu , clasmu , icounu
99019    FORMAT (' ',4X,'   ABOVE',2F14.7,'     +INFINITY',I0)
      ENDIF
99020 FORMAT (' ')
!
END SUBROUTINE DISCRE