DISCR2 Subroutine

public subroutine DISCR2(X, N, Numcla, Y)

NAME

discr2(3f) - [M_datapac:STATISTICS] bin the elements of a vector
(output vector contains class midpoints)

SYNOPSIS

   SUBROUTINE DISCR2(X,N,Numcla,Y)

DESCRIPTION

discr2(3f) 'discretizes' the data of the REAL vector x
into numcla classes.

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

the sample minimum and sample maximum are automatically computed
internally and the class width (xdel) is computed as the (sample max -
sample min)/numcla.

the first class interval is from the sample min to the sample min +
xdel; the second class interval is from the sample min + xdel to the
sample min + 2*xdel;
...;

the last class interval is from the sample max - xdel to the sample
max. The use of discr2(3f) (and the discre 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_discr2
use M_datapac, only : discr2
implicit none
! call discr2(x,y)
end program demo_discr2

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
integer :: Numcla
real(kind=wp), dimension(:) :: Y

Source Code

SUBROUTINE DISCR2(X,N,Numcla,Y)
REAL(kind=wp) :: ai , anuml , classm , cmax , cmin , hold , p , X , xdel ,    &
     &     xmax , xmin , Y
INTEGER i , icount , ip , iupncl , 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.
!                     --NUMLEV = THE INTEGER NUMBER OF CLASSES
!                                DESIRED IN THE DISCRETIZATION.
!     OUTPUT ARGUMENTS--Y      = THE  VECTOR OF
!                                DISCRETIZED VALUES (= THE 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
!             (= THE CLASS MIDPOINTS)
!             CORRESPONDING TO THE N
!             CONTINUOUS VALUES IN THE
!             INPUT VECTOR X.
!             ALSO, (NUMCLA+5) 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.
!                 --NUMCLA SHOULD BE POSITIVE AND NOT EXCEED 1000
!     MODE OF INTERNAL OPERATIONS--.
!     COMMENT--THIS SUBROUTINE DIFFERS FROM THE DISCR3
!              SUBROUTINE INASMUCH AS THIS SUBROUTINE
!              PERFORMS ITS DISCRETIZATION BY OUTPUTING
!              CLASS MIDPOINTS, WHEREAS THE DISCR3
!              SUBROUTINE OUTPUTS CLASS NUMBERS
!              (1, 2, ... , NUMCLA).
!     COMMENT--THE INPUT VECTOR X REMAINS UNALTERED.
!     COMMENT--IN THE MAIN (CALLING) ROUTINE, IT IS
!              PERMISSABLE (IF THE ANALYST SO DESIRES)
!              TO USE THE SAME VARIABLE NAME
!              IN THE FOURTH ARGUMENT AS USED IN THE FIRST
!              ARGUMENT IN THE CALLING SEQUENCE TO THIS
!              DISCR2 SUBROUTINE--NO CONFLICT WILL RESULT
!              IN THE INTERNAL OPERATION OF THE     DISCR2
!              SUBROUTINE.  FOR EXAMPLE, IT IS PERMISSIBLE
!              TO HAVE        CALL DISCR2(X,N,10,X)
!              IN WHICH THE VARIABLE NAME      X    IS USED
!              AS BOTH THE FIRST AND FOURTH ARGUMENTS.
!     ORIGINAL VERSION--NOVEMBER  1974.
!     UPDATED         --APRIL     1975.
!     UPDATED         --NOVEMBER  1975.
!
!---------------------------------------------------------------------
!
      DIMENSION X(:) , Y(:)
      DIMENSION icount(1000)
      DIMENSION classm(1000)
!
      iupncl = 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 DISCR2 SUBROU&
     &TINE IS NON-POSITIVE *****')
         WRITE (G_IO,99015) N
         RETURN
      ELSEIF ( N==1 ) THEN
         WRITE (G_IO,99002)
99002    FORMAT (' ',                                                   &
     &'***** NON-FATAL DIAGNOSTIC--THE SECOND INPUT ARGUMENT TO THE DISC&
     &R2 SUBROUTINE HAS THE VALUE 1 *****')
         Y(1) = X(1)
         RETURN
      ELSEIF ( Numcla<1 .OR. Numcla>iupncl ) THEN
         WRITE (G_IO,99003) iupncl
99003    FORMAT (' ',                                                   &
     &'***** FATAL ERROR--THE THIRD  INPUT ARGUMENT TO THE DISCR2 SUBROU&
     &TINE IS OUTSIDE THE ALLOWABLE (1,',I0,') INTERVAL *****')
         WRITE (G_IO,99015) Numcla
         DO i = 1 , N
            Y(i) = 0.0_wp
         ENDDO
         RETURN
      ELSE
         IF ( Numcla==1 ) THEN
            WRITE (G_IO,99004)
99004       FORMAT (' ',                                                &
     &'***** NON-FATAL DIAGNOSTIC--THE THIRD  INPUT ARGUMENT TO THE DISC&
     &R2 SUBROUTINE HAS THE VALUE 1 *****')
         ELSE
            hold = X(1)
            DO i = 2 , N
               IF ( X(i)/=hold ) GOTO 50
            ENDDO
            WRITE (G_IO,99005) hold
99005       FORMAT (' ',                                                &
     &'***** NON-FATAL DIAGNOSTIC--THE FIRST  INPUT ARGUMENT (A VECTOR) &
     &TO THE DISCR2 SUBROUTINE HAS ALL ELEMENTS =',E15.8,' *****')
            DO i = 1 , N
               Y(i) = X(i)
            ENDDO
            RETURN
         ENDIF
!
!-----START POINT-----------------------------------------------------
!
 50      anuml = Numcla
!
!     ZERO OUT THE COUNT VECTOR (ICOUNT)
!
         DO i = 1 , Numcla
            icount(i) = 0
         ENDDO
!
!     COMPUTE THE SAMPLE MINIMUM AND MAXIMUM,
!     THEN COMPUTE THE CLASS WIDTH.
!
         xmin = X(1)
         xmax = X(1)
         DO i = 1 , N
            IF ( X(i)<xmin ) xmin = X(i)
            IF ( X(i)>xmax ) xmax = X(i)
         ENDDO
         xdel = (xmax-xmin)/anuml
!
!     COMPUTE THE CLASS MIDPOINT FOR EACH CLASS
!
         DO i = 1 , Numcla
            ai = i
            classm(i) = xmin + (ai-0.5_wp)*xdel
         ENDDO
!
!     PERFORM THE DISCRETIZING TRANSFORMATION.
!     ALSO, KEEP A FREQUENCY COUNT FOR EACH CLASS.
!
         DO i = 1 , N
            p = (X(i)-xmin)/(xmax-xmin)
            p = p*anuml + 1.0_wp
            ip = p
            IF ( ip<1 ) ip = 1
            IF ( ip>Numcla ) ip = Numcla
            Y(i) = classm(ip)
            icount(ip) = icount(ip) + 1
         ENDDO
!
!     COMPUTE CLASS LIMITS AND WRITE OUT SUMMARY INFORMATION.
!
         WRITE (G_IO,99016)
         WRITE (G_IO,99006)
!
99006    FORMAT (' ','OUTPUT FROM THE DISCR2 SUBROUTINE--')
         WRITE (G_IO,99016)
         WRITE (G_IO,99007) N
99007    FORMAT (' ',7X,'NUMBER OF OBSERVATIONS            = ',I0)
         WRITE (G_IO,99008) Numcla
99008    FORMAT (' ',7X,'SPECIFIED NUMBER OF LEVELS        = ',I0)
         WRITE (G_IO,99009) xmin
99009    FORMAT (' ',7X,'COMPUTED  LOWER BOUND OF INTERVAL = ',F15.7)
         WRITE (G_IO,99010) xdel
99010    FORMAT (' ',7X,'COMPUTED  CLASS WIDTH             = ',F15.7)
         WRITE (G_IO,99011) xmax
99011    FORMAT (' ',7X,'COMPUTED  UPPER BOUND OF INTERVAL = ',F15.7)
         WRITE (G_IO,99016)
         WRITE (G_IO,99012)
99012    FORMAT (' ',                                                   &
     &           '       CLASS     MINIMUM       MIDPOINT      MAXIMUM',&
     &           '      COUNT')
         WRITE (G_IO,99013)
99013    FORMAT (' ',                                                   &
     &           '       -------------------------------------------',  &
     &           '-------------')
         DO i = 1 , Numcla
            ai = i
            cmin = xmin + (ai-1.0_wp)*xdel
            cmax = xmin + ai*xdel
            WRITE (G_IO,99014) i , cmin , classm(i) , cmax , icount(i)
99014       FORMAT (' ',4X,I6,2X,3F14.7,I8)
         ENDDO
      ENDIF
99015 FORMAT (' ','***** THE VALUE OF THE ARGUMENT IS ',I0,' *****')
99016 FORMAT (' ')
!
END SUBROUTINE DISCR2