Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0026/mdisc.smp
There are 2 other files named mdisc.smp in the archive. Click here to see a list.
C                                                                       MDIS  10
C     ..................................................................MDIS  20
C                                                                       MDIS  30
C        SAMPLE MAIN PROGRAM FOR DISCRIMINANT ANALYSIS - MDISC          MDIS  40
C                                                                       MDIS  50
C        PURPOSE                                                        MDIS  60
C           (1) READ THE PROBLEM PARAMETER CARD AND DATA FOR DISCRIMI-  MDIS  70
C           NANT ANALYSIS, (2) CALL THREE SUBROUTINES TO CALCULATE VARI-MDIS  80
C           ABLE MEANS IN EACH GROUP, POOLED DISPERSION MATRIX, COMMON  MDIS  90
C           MEANS OF VARIABLES, GENERALIZED MAHALANOBIS D SQUARE,       MDIS 100
C           COEFFICIENTS OF DISCRIMINANT FUNCTIONS, AND PROBABILITY     MDIS 110
C           ASSOCIATED WITH LARGEST DISCRIMINANT FUNCTION OF EACH       MDIS 120
C           CASE IN EACH GROUP, AND (3) PRINT THE RESULTS.              MDIS 130
C                                                                       MDIS 140
C        REMARKS                                                        MDIS 150
C           THE NUMBER OF VARIABLES MUST BE GREATER THAN OR EQUAL TO    MDIS 160
C           THE NUMBER OF GROUPS.                                       MDIS 170
C                                                                       MDIS 180
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                  MDIS 190
C           DMATX                                                       MDIS 200
C           MINV                                                        MDIS 210
C           DISCR                                                       MDIS 220
C                                                                       MDIS 230
C        METHOD                                                         MDIS 240
C           REFER TO 'BMD COMPUTER PROGRAMS MANUAL', EDITED BY W. J.    MDIS 250
C           DIXON, UCLA, 1964, AND T. W. ANDERSON, 'INTRODUCTION TO     MDIS 260
C           MULTIVARIATE STATISTICAL ANALYSIS', JOHN WILEY AND SONS,    MDIS 270
C           1958, SECTION 6.6-6.8.                                      MDIS 280
C                                                                       MDIS 290
C     ..................................................................MDIS 300
C                                                                       MDIS 310
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE      MDIS 320
C     NUMBER OF GROUPS, K..                                             MDIS 330
C                                                                       MDIS 340
         DIMENSION N(5)                                                 MDIS 350
C                                                                       MDIS 360
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE      MDIS 370
C     NUMBER OF VARIABLES, M..                                          MDIS 380
C                                                                       MDIS 390
         DIMENSION CMEAN(10)                                            MDIS 400
C                                                                       MDIS 410
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE      MDIS 420
C     PRODUCT OF M*K..                                                  MDIS 430
C                                                                       MDIS 440
         DIMENSION XBAR(50)                                             MDIS 450
C                                                                       MDIS 460
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE      MDIS 470
C     PRODUCT OF (M+1)*K..                                              MDIS 480
C                                                                       MDIS 490
         DIMENSION C(55)                                                MDIS 500
C                                                                       MDIS 510
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE      MDIS 520
C     PRODUCT OF M*M..                                                  MDIS 530
C                                                                       MDIS 540
         DIMENSION D(100)                                               MDIS 550
C                                                                       MDIS 560
C     THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO THE     MDIS 570
C     TOTAL OF SAMPLE SIZES OF K GROUPS COMBINED, T (T = N(1)+N(2)+...  MDIS 580
C     +N(K))..                                                          MDIS 590
C                                                                       MDIS 600
         DIMENSION P(250),LG(250)                                       MDIS 610
C                                                                       MDIS 620
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE      MDIS 630
C     TOTAL DATA POINTS WHICH IS EQUAL TO THE PRODUCT OF T*M..          MDIS 640
C                                                                       MDIS 650
         DIMENSION X(2500)                                              MDIS 660
C                                                                       MDIS 670
C     ..................................................................MDIS 680
C                                                                       MDIS 690
C        IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE  MDIS 700
C        C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION      MDIS 710
C        STATEMENT WHICH FOLLOWS.                                       MDIS 720
C                                                                       MDIS 730
C     DOUBLE PRECISION CMEAN,XBAR,D,DET,C,V,P                           MDIS 740
C                                                                       MDIS 750
C        THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS    MDIS 760
C        APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS      MDIS 770
C        ROUTINE.                                                       MDIS 780
C                                                                       MDIS 790
C        ...............................................................MDIS 800
C                                                                       MDIS 810
    1 FORMAT(A4,A2,2I2,12I5/(14I5))                                     MDIS 820
    2 FORMAT(27H1DISCRIMINANT ANALYSIS.....,A4,A2/19H0  NUMBER OF GROUPSMDIS 830
     1,7X,I3/22H   NUMBER OF VARIABLES,I7/17H   SAMPLE SIZES../12X,5HGROMDIS 840
     2UP)                                                               MDIS 850
    3 FORMAT(12X,I3,8X,I4)                                              MDIS 860
    4 FORMAT(1H0)                                                       MDIS 870
    5 FORMAT(12F6.0)                                                    MDIS 880
    6 FORMAT(6H0GROUP,I3,7H  MEANS/(8F15.5))                            MDIS 890
    7 FORMAT(1H0/25H POOLED DISPERSION MATRIX)                          MDIS 900
    8 FORMAT(4H0ROW,I3/(8F15.5))                                        MDIS 910
    9 FORMAT(1H0//13H COMMON MEANS/(8F15.5))                            MDIS 920
   10 FORMAT(1H///33H GENERALIZED MAHALANOBIS D-SQUARE,F15.5//)         MDIS 930
   11 FORMAT(22H0DISCRIMINANT FUNCTION,I3/1H ,6X,27HCONSTANT   *   COEFFMDIS 940
     1ICIENTS/1H F14.5,7H   *   ,7F14.5/(22X,7F14.5))                   MDIS 950
   12 FORMAT(1H0//60H EVALUATION OF CLASSIFICATION FUNCTIONS FOR EACH OBMDIS 960
     1SERVATION)                                                        MDIS 970
   13 FORMAT(6H0GROUP,I3/19X,27HPROBABILITY ASSOCIATED WITH,11X,7HLARGESMDIS 980
     1T/13H  OBSERVATION,5X,29HLARGEST DISCRIMINANT FUNCTION,8X,12HFUNCTMDIS 990
     2ION NO.)                                                          MDIS1000
   14 FORMAT(1H ,I7,20X,F8.5,20X,I6)                                    MDIS1010
C                                                                       MDIS1020
C     ..................................................................MDIS1030
C                                                                       MDIS1040
C     READ PROBLEM PARAMETER CARD                                       MDIS1050
C                                                                       MDIS1060
  100 READ (5,1,END=999) PR,PR1,K,M,(N(I),I=1,K)                        MDIS1070
C        PR.......PROBLEM NUMBER (MAY BE ALPHAMERIC)                    MDIS1080
C        PR1......PROBLEM NUMBER (CONTINUED)                            MDIS1090
C        K........NUMBER OF GROUPS                                      MDIS1100
C        M........NUMBER OF VARIABLES                                   MDIS1110
C        N........VECTOR OF LENGTH K CONTAINING SAMPLE SIZES            MDIS1120
C                                                                       MDIS1130
      WRITE (6,2) PR,PR1,K,M                                            MDIS1140
      DO 110 I=1,K                                                      MDIS1150
  110 WRITE (6,3) I,N(I)                                                MDIS1160
      WRITE (6,4)                                                       MDIS1170
C                                                                       MDIS1180
C     READ DATA                                                         MDIS1190
C                                                                       MDIS1200
      L=0                                                               MDIS1210
      DO 130 I=1,K                                                      MDIS1220
      N1=N(I)                                                           MDIS1230
      DO 120 J=1,N1                                                     MDIS1240
      READ (5,5) (CMEAN(IJ),IJ=1,M)                                     MDIS1250
      L=L+1                                                             MDIS1260
      N2=L-N1                                                           MDIS1270
      DO 120 IJ=1,M                                                     MDIS1280
      N2=N2+N1                                                          MDIS1290
  120 X(N2)=CMEAN(IJ)                                                   MDIS1300
  130 L=N2                                                              MDIS1310
C                                                                       MDIS1320
      CALL DMATX (K,M,N,X,XBAR,D,CMEAN)                                 MDIS1330
C                                                                       MDIS1340
C     PRINT MEANS AND POOLED DISPERSION MATRIX                          MDIS1350
C                                                                       MDIS1360
      L=0                                                               MDIS1370
      DO 150 I=1,K                                                      MDIS1380
      DO 140 J=1,M                                                      MDIS1390
      L=L+1                                                             MDIS1400
  140 CMEAN(J)=XBAR(L)                                                  MDIS1410
  150 WRITE (6,6) I,(CMEAN(J),J=1,M)                                    MDIS1420
      WRITE (6,7)                                                       MDIS1430
      DO 170 I=1,M                                                      MDIS1440
      L=I-M                                                             MDIS1450
      DO 160 J=1,M                                                      MDIS1460
      L=L+M                                                             MDIS1470
  160 CMEAN(J)=D(L)                                                     MDIS1480
  170 WRITE (6,8) I,(CMEAN(J),J=1,M)                                    MDIS1490
C                                                                       MDIS1500
      CALL MINV (D,M,DET,CMEAN,C)                                       MDIS1510
C                                                                       MDIS1520
      CALL DISCR (K,M,N,X,XBAR,D,CMEAN,V,C,P,LG)                        MDIS1530
C                                                                       MDIS1540
C     PRINT COMMON MEANS                                                MDIS1550
C                                                                       MDIS1560
      WRITE (6,9) (CMEAN(I),I=1,M)                                      MDIS1570
C                                                                       MDIS1580
C     PRINT GENERALIZED MAHALANOBIS D-SQUARE                            MDIS1590
C                                                                       MDIS1600
      WRITE (6,10) V                                                    MDIS1610
C                                                                       MDIS1620
C     PRINT CONSTANTS AND COEFFICIENTS OF DISCRIMINANT FUNCTIONS        MDIS1630
C                                                                       MDIS1640
      N1=1                                                              MDIS1650
      N2=M+1                                                            MDIS1660
      DO 180 I=1,K                                                      MDIS1670
      WRITE (6,11) I,(C(J),J=N1,N2)                                     MDIS1680
      N1=N1+(M+1)                                                       MDIS1690
  180 N2=N2+(M+1)                                                       MDIS1700
C                                                                       MDIS1710
C     PRINT EVALUATION OF CALSSIFICATION FUNCTIONS FOR EACH OBSERVATION MDIS1720
C                                                                       MDIS1730
      WRITE (6,12)                                                      MDIS1740
      N1=1                                                              MDIS1750
      N2=N(1)                                                           MDIS1760
      DO 210 I=1,K                                                      MDIS1770
      WRITE (6,13) I                                                    MDIS1780
      L=0                                                               MDIS1790
      DO 190 J=N1,N2                                                    MDIS1800
      L=L+1                                                             MDIS1810
  190 WRITE (6,14) L,P(J),LG(J)                                         MDIS1820
      IF(I-K) 200, 100, 100                                             MDIS1830
  200 N1=N1+N(I)                                                        MDIS1840
      N2=N2+N(I+1)                                                      MDIS1850
  210 CONTINUE                                                          MDIS1860
999	STOP
      END                                                               MDIS1870