DISCR3 – M

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

NAME

discr3(3f) - [M_datapac:STATISTICS] bin the elements of a vector
(output vector contains 1's, 2's, 3's, and so on)

SYNOPSIS

   SUBROUTINE DISCR3(X,N,Numcla,Y)

DESCRIPTION

discr3(3f) 'discretizes' the data on the REAL vector x
into numcla classes.

all values in the vector x within a given class will be mapped into
the class number (1, 2, ... , numcla). thus all the elements in the
lowermost class will be mapped into the value 1.0; all the elements
of x in the next higher class will be mapped into 2.0; etc.

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 discr3(3f) (and the discre and discr2 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.

this discr3 subroutine is particularly suited to this last purpose
inasmuch as it output's 1's, 2's, etc. rather than midpoints.

OPTIONS

 X   description of parameter
 Y   description of parameter

EXAMPLES

Sample program:

program demo_discr3
use M_datapac, only : discr3
implicit none
! call discr3(x,y)
end program demo_discr3

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

Source Code

SUBROUTINE DISCR3(X,N,Numcla,Y)
REAL(kind=wp) :: ai , anuml , 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 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
!             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 DISCR2
!              SUBROUTINE INASMUCH AS THIS SUBROUTINE
!              PERFORMS ITS DISCRETIZATION BY OUTPUTING
!              CLASS NUMBERS (1, 2,, ..., NUMCLA);
!              WHEREAS THE DISCR2 SUBROUTINE
!              OUTPUTS CLASS MIDPOINTS.
!     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
!              DISCR3 SUBROUTINE--NO CONFLICT WILL RESULT
!              IN THE INTERNAL OPERATION OF THE     DISCR3
!              SUBROUTINE.  FOR EXAMPLE, IT IS PERMISSIBLE
!              TO HAVE        CALL DISCR3(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)
!
      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 DISCR3 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&
     &R3 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 DISCR3 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&
     &R3 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 DISCR3 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
!
!     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) = 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 DISCR3 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 (' ','       LEVEL     MINIMUM       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 , cmax , icount(i)
99014       FORMAT (' ',4X,I6,2X,2F14.7,I8)
         ENDDO
      ENDIF
99015 FORMAT (' ','***** THE VALUE OF THE ARGUMENT IS ',I0,' *****')
99016 FORMAT (' ')
!
END SUBROUTINE DISCR3

DISCR3 Subroutine

Contents

Source Code

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

NAME

SYNOPSIS

DESCRIPTION

OPTIONS

EXAMPLES

AUTHOR

MAINTAINER

LICENSE

Arguments

Source Code