Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50145/regre.smp
There are 2 other files named regre.smp in the archive. Click here to see a list.
C                                                                       REGR  10
C     ..................................................................REGR  20
C                                                                       REGR  30
C        SAMPLE MAIN PROGRAM FOR MULTIPLE REGRESSION - REGRE            REGR  40
C                                                                       REGR  50
C        PURPOSE                                                        REGR  60
C           (1) READ THE PROBLEM PARAMETER CARD FOR A MULTIPLE REGRES-  REGR  70
C           SION, (2) READ SUBSET SELECTION CARDS, (3) CALL THE SUB-    REGR  80
C           ROUTINES TO CALCULATE MEANS, STANDARD DEVIATIONS, SIMPLE    REGR  90
C           AND MULTIPLE CORRELATION COEFFICIENTS, REGRESSION COEFFI-   REGR 100
C           CIENTS, T-VALUES, AND ANALYSIS OF VARIANCE FOR MULTIPLE     REGR 110
C           REGRESSION, AND (4) PRINT THE RESULTS.                      REGR 120
C                                                                       REGR 130
C        REMARKS                                                        REGR 140
C           THE NUMBER OF OBSERVATIONS, N, MUST BE GREATER THAN M+1,    REGR 150
C           WHERE M IS THE NUMBER OF VARIABLES.  IF SUBSET SELECTION    REGR 160
C           CARDS ARE NOT PRESENT, THE PROGRAM CAN NOT PERFORM MULTIPLE REGR 170
C           REGRESSION.                                                 REGR 180
C           AFTER RETURNING FROM SUBROUTINE MINV, THE VALUE OF DETER-   REGR 190
C           MINANT (DET) IS TESTED TO CHECK WHETHER THE CORRELATION     REGR 200
C           MATRIX IS SINGULAR.  IF DET IS COMPARED AGAINST A SMALL     REGR 210
C           CONSTANT, THIS TEST MAY ALSO BE USED TO CHECK NEAR-         REGR 220
C           SINGULARITY.                                                REGR 230
C                                                                       REGR 240
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                  REGR 250
C           CORRE  (WHICH, IN TURN, CALLS THE SUBROUTINE NAMED DATA)    REGR 260
C           ORDER                                                       REGR 270
C           MINV                                                        REGR 280
C           MULTR                                                       REGR 290
C                                                                       REGR 300
C        METHOD                                                         REGR 310
C           REFER TO B. OSTLE, 'STATISTICS IN RESEARCH', THE IOWA STATE REGR 320
C           COLLEGE PRESS', 1954, CHAPTER 8.                            REGR 330
C                                                                       REGR 340
C     ..................................................................REGR 350
C                                                                       REGR 360
C     THE FOLLOWING  DIMENSIONS MUST BE GREATER THAN OR EQUAL TO THE    REGR 370
C     NUMBER OF VARIABLES, M..                                          REGR 380
C                                                                       REGR 390
         DIMENSION XBAR(40),STD(40),D(40),RY(40),ISAVE(40),B(40),       REGR 400
     1             SB(40),T(40),W(40)                                   REGR 410
C                                                                       REGR 420
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE      REGR 430
C     PRODUCT OF M*M..                                                  REGR 440
C                                                                       REGR 450
         DIMENSION RX(1600)                                             REGR 460
C                                                                       REGR 470
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO          REGR 480
C     (M+1)*M/2..                                                       REGR 490
C                                                                       REGR 500
         DIMENSION R(820)                                               REGR 510
C                                                                       REGR 520
C     THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO 10..     REGR 530
C                                                                       REGR 540
         DIMENSION ANS(10)                                              REGR 550
C                                                                       REGR 560
C     ..................................................................REGR 570
C                                                                       REGR 580
C        IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE  REGR 590
C        C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION      REGR 600
C        STATEMENT WHICH FOLLOWS.                                       REGR 610
C                                                                       REGR 620
C     DOUBLE PRECISION XBAR,STD,RX,R,D,B,T,RY,DET,SB,ANS,SUM            REGR 630
C                                                                       REGR 640
C        THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS    REGR 650
C        APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS      REGR 660
C        ROUTINE.                                                       REGR 670
C                                                                       REGR 680
C        ...............................................................REGR 690
C                                                                       REGR 700
    1 FORMAT(A4,A2,I5,2I2)                                              REGR 710
    2 FORMAT(25H1MULTIPLE REGRESSION.....A4,A2//6X,14HSELECTION.....I2//REGR 720
     1)                                                                 REGR 730
    3 FORMAT(9H0VARIABLE,5X,4HMEAN,6X,8HSTANDARD,6X,11HCORRELATION,4X,  REGR 740
     110HREGRESSION,4X,10HSTD. ERROR,5X,8HCOMPUTED/6H   NO.,18X,9HDEVIATREGR 750
     2ION,7X,6HX VS Y,7X,11HCOEFFICIENT,3X,12HOF REG.COEF.,3X,7HT VALUE)REGR 760
    4 FORMAT(1H ,I4,6F14.5)                                             REGR 770
    5 FORMAT(10H DEPENDENT)                                             REGR 780
    6 FORMAT(1H0/10H INTERCEPT,10X,F16.5//23H MULTIPLE CORRELATION  ,F13REGR 790
     1.5//23H STD. ERROR OF ESTIMATE,F13.5//)                           REGR 800
    7 FORMAT(1H0,21X,39HANALYSIS OF VARIANCE FOR THE REGRESSION//5X,19HSREGR 810
     1OURCE OF VARIATION,7X,7HDEGREES,7X,6HSUM OF,10X,4HMEAN,12X,7HF VALREGR 820
     2UE/30X,10HOF FREEDOM,4X,7HSQUARES,9X,7HSQUARES)                   REGR 830
    8 FORMAT(30H ATTRIBUTABLE TO REGRESSION   ,I6,3F16.5/30H DEVIATION FREGR 840
     1ROM REGRESSION    ,I6,2F16.5)                                     REGR 850
    9 FORMAT(1H ,5X,5HTOTAL,19X,I6,F16.5)                               REGR 860
   10 FORMAT(36I2)                                                      REGR 870
   11 FORMAT(1H ,15X,18HTABLE OF RESIDUALS//9H CASE NO.,5X,7HY VALUE,5X,REGR 880
     110HY ESTIMATE,6X,8HRESIDUAL)                                      REGR 890
   12 FORMAT(1H ,I6,F15.5,2F14.5)                                       REGR 900
   13 FORMAT(53H1NUMBER OF SELECTIONS NOT SPECIFIED.  JOB TERMINATED.)  REGR 910
   14 FORMAT(52H0THE MATRIX IS SINGULAR.  THIS SELECTION IS SKIPPED.)   REGR 920
C                                                                       REGR 930
C     ..................................................................REGR 940
C                                                                       REGR 950
C     READ PROBLEM PARAMETER CARD                                       REGR 960
C                                                                       REGR 970
  100 READ (5,1,END=999) PR,PR1,N,M,NS                                  REGR 980
C        PR........PROBLEM NUMBER (MAY BE ALPHAMERIC)                   REGR 990
C        PR1.......PROBLEM NUMBER (CONTINUED)                           REGR1000
C        N.........NUMBER OF OBSERVATIONS                               REGR1010
C        M.........NUMBER OF VARIABLES                                  REGR1020
C        NS........NUMBER OF SELECTIONS                                 REGR1030
C                                                                       REGR1040
C     LOGICAL TAPE 13 IS USED AS INTERMEDIATE STORAGE TO HOLD INPUT     REGR1050
C     DATA.  THE INPUT DATA ARE WRITTEN ON LOGICAL TAPE 13 BY THE       REGR1060
C     SPECIAL INPUT SUBROUTINE NAMED DATA.  THE STORED DATA MAY BE USED REGR1070
C     FOR RESIDUAL ANALYSIS.                                            REGR1080
C                                                                       REGR1090
      REWIND 13                                                         REGR1100
C                                                                       REGR1110
      IO=0                                                              REGR1120
      X=0.0                                                             REGR1130
C                                                                       REGR1140
      CALL CORRE (N,M,IO,X,XBAR,STD,RX,R,D,B,T)                         REGR1150
C                                                                       REGR1160
      REWIND 13                                                         REGR1170
C                                                                       REGR1180
C     TEST NUMBER OF SELECTIONS                                         REGR1190
C                                                                       REGR1200
      IF(NS) 108, 108, 109                                              REGR1210
  108 WRITE (6,13)                                                      REGR1220
      GO TO 300                                                         REGR1230
C                                                                       REGR1240
  109 DO 200 I=1,NS                                                     REGR1250
      WRITE (6,2) PR,PR1,I                                              REGR1260
C                                                                       REGR1270
C     READ SUBSET SELECTION CARD                                        REGR1280
C                                                                       REGR1290
      READ (5,10) NRESI,NDEP,K,(ISAVE(J),J=1,K)                         REGR1300
C        NRESI.....OPTION CODE FOR TABLE OF RESIDUALS                   REGR1310
C                    0  IF IT IS NOT DESIRED.                           REGR1320
C                    1  IF IT IS DESIRED.                               REGR1330
C        NDEP......DEPENDENT VARIABLE                                   REGR1340
C        K.........NUMBER OF INDEPENDENT VARIABLES INCLUDED             REGR1350
C        ISAVE.....A VECTOR CONTAINING THE INDEPENDENT VARIABLES        REGR1360
C                       INCLUDED                                        REGR1370
C                                                                       REGR1380
      CALL ORDER (M,R,NDEP,K,ISAVE,RX,RY)                               REGR1390
C                                                                       REGR1400
      CALL MINV (RX,K,DET,B,T)                                          REGR1410
C                                                                       REGR1420
C     TEST SINGULARITY OF THE MATRIX INVERTED                           REGR1430
C                                                                       REGR1440
      IF(DET) 112, 110, 112                                             REGR1450
  110 WRITE (6,14)                                                      REGR1460
      GO TO 200                                                         REGR1470
C                                                                       REGR1480
  112 CALL MULTR (N,K,XBAR,STD,D,RX,RY,ISAVE,B,SB,T,ANS)                REGR1490
C                                                                       REGR1500
C     PRINT MEANS, STANDARD DEVIATIONS, INTERCORRELATIONS BETWEEN       REGR1510
C     X AND Y, REGRESSION COEFFICIENTS, STANDARD DEVIATIONS OF          REGR1520
C     REGRESSION COEFFICIENTS, AND COMPUTED T-VALUES                    REGR1530
C                                                                       REGR1540
      MM=K+1                                                            REGR1550
      WRITE (6,3)                                                       REGR1560
      DO 115 J=1,K                                                      REGR1570
      L=ISAVE(J)                                                        REGR1580
  115 WRITE (6,4) L,XBAR(L),STD(L),RY(J),B(J),SB(J),T(J)                REGR1590
      WRITE (6,5)                                                       REGR1600
      L=ISAVE(MM)                                                       REGR1610
      WRITE (6,4) L,XBAR(L),STD(L)                                      REGR1620
C                                                                       REGR1630
C     PRINT INTERCEPT, MULTIPLE CORRELATION COEFFICIENT, AND STANDARD   REGR1640
C     ERROR OF ESTIMATE                                                 REGR1650
C                                                                       REGR1660
      WRITE (6,6) ANS(1),ANS(2),ANS(3)                                  REGR1670
C                                                                       REGR1680
C     PRINT ANALYSIS OF VARIANCE FOR THE REGRESSION                     REGR1690
C                                                                       REGR1700
      WRITE (6,7)                                                       REGR1710
      L=ANS(8)                                                          REGR1720
      WRITE (6,8) K,ANS(4),ANS(6),ANS(10),L,ANS(7),ANS(9)               REGR1730
      L=N-1                                                             REGR1740
      SUM=ANS(4)+ANS(7)                                                 REGR1750
      WRITE (6,9) L,SUM                                                 REGR1760
      IF(NRESI) 200, 200, 120                                           REGR1770
C                                                                       REGR1780
C     PRINT TABLE OF RESIDUALS                                          REGR1790
C                                                                       REGR1800
  120 WRITE (6,2) PR,PR1,I                                              REGR1810
      WRITE (6,11)                                                      REGR1820
      MM=ISAVE(K+1)                                                     REGR1830
      DO 140 II=1,N                                                     REGR1840
      READ (13) (W(J),J=1,M)                                            REGR1850
      SUM=ANS(1)                                                        REGR1860
      DO 130 J=1,K                                                      REGR1870
      L=ISAVE(J)                                                        REGR1880
  130 SUM=SUM+W(L)*B(J)                                                 REGR1890
      RESI=W(MM)-SUM                                                    REGR1900
  140 WRITE (6,12) II,W(MM),SUM,RESI                                    REGR1910
      REWIND 13                                                         REGR1920
  200 CONTINUE                                                          REGR1930
      GO TO 100                                                         REGR1940
  300 CONTINUE                                                          REGR1950
999	STOP
      END                                                               REGR1960