/*JOBPARM REGION=1024,LINES=19 // EXEC FORTGCLG //FORT.SYSIN DD * C C PROGRAM IMSG1A C VERSION 3.4 19-SEP-82 C C IMSG1CMA: C IMAGE SEGMENTATION, 1-CHANNEL DATA, COMMON VARIANCE, AUTOMATIC MODE C IM S G 1 C M A C C C PROG.IMSG1CMA WAS DEVELOPED FROM PROG.ISOLINE.TRANS C FOR SEGMENTING TIME SERIES. C C C PROGRAMMED BY C DR. STANLEY L. SCLOVE 312/996-2681 C DEPARTMENT OF QUANTITATIVE METHODS 312/996-2676 C COLLEGE OF BUSINESS ADMINISTRATION C UNIVERSITY OF ILLINOIS AT CHICAGO C BOX 4348, CHICAGO, IL 60680 C C C C RESEARCH SUPPORTED IN PART BY: C ONR CONTRACT N00014-80-C-0408, TASK NR042-443 C ARO CONTRACT DAAG29-82-K-0155 C C C RESTRICTIONS (CAN BE MODIFIED): C C NR, NUMBER OF ROWS OF ARRAY, AT MOST 256; C NC, NUMBER OF COLUMNS OF ARRAY, AT MOST 256; C K, NUMBER OF CLASSES OF SEGMENT, AT MOST 29; C ITER, MAXIMUM NUMBER OF ITERATIONS, 20. C C C INPUT "CARDS": C C DATASET NAME, IN FORMAT (18A4) C NUMBER OF ROWS, NR, IN FORMAT(3X,I3) C NUMBER OF COLUMNS, NC, IN FORMAT(3X,I3) C DATA FORMAT, FMT, FORMAT (18A4), E.G., (10X,F6.3) C NOTE THAT FMT IS ALSO USED FOR OUTPUT. C THE FIRST COLUMN MUST BE BLANK. C DATA, IN FORMAT SPECIFIED BY FMT, ROW-WISE C SMALLEST NUMBER OF CLASSES TO BE TRIED, KL, IN FORMAT 2X,I2 C LARGEST NUMBER OF CLASSES TO BE TRIED, KU, IN FORMAT 2X,I2 C (2 <= KL <= KU <= 29 ) C C DIMENSION X(256,256),DIST(29),ICLUS(256,256),IOTA(256),SUM(29) DIMENSION TITLE(18) DIMENSION NG(29),XMEAN(29) DIMENSION FMT(18) DIMENSION SS(29),SSD(29) DIMENSION SD(29),NT(29,29,29),IRSUM(29,29),TP(29,29,29) DIMENSION VAR(29) DIMENSION ICLSOL(256,256) DIMENSION P(29) DOUBLE PRECISION SSD,SS,SUM,WGSS C C C READ (5,36000) TITLE READ (5,10000) NR READ (5,10000) NC WRITE (6,22000) WRITE (6,56000) TITLE WRITE (6,38000) NR WRITE (6,40000) NC C READ (5,36000) FMT C C INITIALIZE VARIABLES; SET CONSTANTS. N = NR*NC XN = N DO 100 INTEG=1,N IOTA(INTEG) = INTEG 100 CONTINUE PI = 3.1415927 DO 400 I = 1,NR DO 400 J = 1,NC READ (5,FMT) X(I,J) IF (I .EQ. 1 .AND. J.EQ.1) GO TO 200 GO TO 300 200 XMAX = X(1,1) XMIN = X(1,1) 300 CONTINUE IF (X(I,J) .LT. XMIN) XMIN=X(I,J) IF (X(I,J).GT.XMAX) XMAX=X(I,J) 400 CONTINUE WRITE (6,66000) WRITE (6,FMT) XMIN WRITE (6,68000) WRITE (6,FMT) XMAX WRITE (6,16000) DO 500 I=1,NR WRITE (6,88000) (X(I,J), J=1,NC) 500 CONTINUE READ (5,64000) KL READ (5,64000) KU C DO 4600 K = KL,KU C COMPUTE INITIAL MEANS. DO 600 IG=1,K XMEAN(IG) = XMIN + IG*(XMAX-XMIN)/(K+1) 600 CONTINUE WRITE (6,24000) K WRITE (6,18000) WRITE (6,20000) ( XMEAN(IG), IG=1,K ) C C FOR FIRST ITERATION, MARGINAL DISTRIBUTION OF LABELS IS TAKEN C TO BE UNIFORM. C DO 700 I = 1,K P(I) = 1.0/K 700 CONTINUE C ITER = 1 C 800 CONTINUE IF (ITER .EQ. 1) GO TO 1000 DO 900 I = 1,NR DO 900 J = 1,NC ICLSOL(I,J) = ICLUS(I,J) 900 CONTINUE 1000 CONTINUE DO 1700 I = 1,NR DO 1700 J = 1,NC DO 1500 L = 1,K DIST(L) = ( XMEAN(L) - X(I,J) )**2 IF (ITER .EQ. 1) GO TO 1500 C FOR FIRST ITERATION, CLASSIFICATION IS SIMPLY BY MINIMUM C DISTANCE. TEST=-DIST(L)/(2.0*VARHAT) IF (TEST .LT. -180.2) GO TO 1100 GO TO 1200 1100 DIST(L) = 0.0 1200 CONTINUE C DIST(L) = EXP(-DIST(L)/(2.0*VARHAT)) 1300 CONTINUE IF (I .EQ. 1 .OR. J . EQ. 1) GO TO 1400 IG1 = ICLUS(I,J-1) IG2 = ICLUS(I-1,J) DIST(L) = -TP(IG1,IG2,L)*DIST(L) GO TO 1500 1400 CONTINUE C CLASSIFY BORDER OBSERVATIONS: DIST(L) = -DIST(L)*P(L) 1500 CONTINUE F = DIST(1) ICLUS(I,J) = 1 DO 1700 L = 2,K IF ( DIST(L).LT.F ) GO TO 1600 GO TO 1700 1600 F = DIST(L) ICLUS(I,J) = L 1700 CONTINUE C C DO 1800 IG = 1,K SUM(IG) = 0.0 SS(IG) = 0.0 NG(IG) = 0 1800 CONTINUE DO 1900 I = 1,NR DO 1900 J = 1,NC IGROUP = ICLUS(I,J) SUM(IGROUP) = SUM(IGROUP) + X(I,J) SS(IGROUP) = SS(IGROUP) + X(I,J)*X(I,J) NG(IGROUP) = NG(IGROUP) + 1 1900 CONTINUE WGSS = 0.0 DO 2400 IG = 1,K IF (NG(IG) .EQ. 0) GO TO 2000 GO TO 2100 2000 WRITE (6,62000) IG GO TO 4600 2100 CONTINUE XMEAN(IG) = SUM(IG)/NG(IG) NTEMP=NG(IG) IF (NTEMP .EQ. 1) GO TO 2200 SSD(IG) = SS(IG) - SUM(IG)**2/NG(IG) VAR(IG) = SSD(IG)/(NG(IG)-1) SD(IG) = SQRT(VAR(IG)) GO TO 2300 2200 SSD(IG)=0.0 SD(IG)=0.0 2300 CONTINUE WGSS = WGSS + SSD(IG) C 2400 CONTINUE C C WGMS = WGSS/(N-K) STDERR = SQRT(WGMS) C IF (ITER .EQ. 1) GO TO 2600 DO 2500 I = 1,NR DO 2500 J = 1,NC IF (ICLUS(I,J) .EQ. ICLSOL(I,J)) GO TO 2500 GO TO 2600 2500 CONTINUE GO TO 4500 2600 CONTINUE C C C C C DO 2700 I1 = 1,K DO 2700 I2 = 1,K DO 2700 J = 1,K NT(I1,I2,J) = 0 2700 CONTINUE DO 2800 I = 2,NR DO 2800 J = 2,NC IM1 = I-1 JM1 = J-1 INORTH = ICLUS(IM1,J) IWEST = ICLUS(I,JM1) IY = ICLUS(I,J) NT(IWEST,INORTH,IY) = NT(IWEST,INORTH,IY) + 1 2800 CONTINUE DO 2900 I1 = 1,K DO 2900 I2 = 1,K IRSUM(I1,I2) = 0 2900 CONTINUE DO 3000 I1 = 1,K DO 3000 I2 = 1,K DO 3000 J = 1,K IRSUM(I1,I2) = IRSUM(I1,I2) + NT(I1,I2,J) 3000 CONTINUE DO 3300 I1=1,K DO 3300 I2=1,K XDENOM=IRSUM(I1,I2) IF (XDENOM .EQ. 0.0) GO TO 3100 GO TO 3200 3100 XDENOM = K 3200 CONTINUE C DO 3300 J = 1,K XNUM=NT(I1,I2,J) C IF THERE ARE NO TRANSITIONS FROM (I1,I2), THEN TP(I1,I2,J) C IS SET EQUAL TO ZERO, FOR ALL J = 1,2,...,K. C TP(I1,I2,J) = XNUM/XDENOM 3300 CONTINUE 3400 CONTINUE C C COMPUTE MARGINAL DISTRIBUTION OF LABELS. DO 3500 IG = 1,K P(IG) = NG(IG) P(IG) = P(IG)/N 3500 CONTINUE C C TRANS=0.0 DO 3600 I1=1,K DO 3600 I2=1,K DO 3600 J=1,K ITEST = NT(I1,I2,J) IF (ITEST .EQ. 0) GO TO 3600 IF (TP(I1,I2,J) .EQ. 0.) GO TO 3600 TRANS = TRANS + NT(I1,I2,J)*ALOG(TP(I1,I2,J)) 3600 CONTINUE TRANS = -2.0*TRANS C C ACCOUNT FOR LABELS OF BORDER OBSERVATIONS: FIRST = 0.0 DO 3700 J = 1,NC LABEL1 = ICLUS(1,J) PROBAB = P(LABEL1) FIRST = FIRST + ALOG(PROBAB) 3700 CONTINUE DO 3800 I = 2,NR LABEL1 = ICLUS(I,1) PROBAB = P(LABEL1) FIRST = FIRST + ALOG(PROBAB) 3800 CONTINUE FIRST = -2.0*FIRST C C C COMPUTE MODEL SELECTION CRITERIA: C NUMBER OF PARAMETERS EQUALS (K MEANS) + (1 VARIANCE) + C ((K**2)*(K-1) TRANSITION PROBABILITIES) NOPARM = K + 1 + (K**2)*(K-1) WRITE (6,30000) ITER C EXCEPT FOR FIRST ITERATION, COMPUTE AIC BASED ON C NEW CLUSTERING AND OLD VARIANCE. IF (ITER .EQ. 1) GO TO 3900 XMN2LL = N + N*ALOG(2.0*PI*VARHAT) XMN2LL = XMN2LL + TRANS + FIRST AICOLD = XMN2LL + 2.0*NOPARM SCHOLD = XMN2LL + ALOG(XN)*NOPARM 3900 CONTINUE WRITE (6,12000) (IOTA(I), I=1,NC) DO 4000 I=1,NR WRITE (6,14000) I, (ICLUS(I,J), J=1,NC) 4000 CONTINUE IF (ITER .EQ. 1) GO TO 4100 WRITE (6,70000) AICOLD WRITE (6,72000) SCHOLD 4100 CONTINUE C VARHAT IS MLE OF VARIANCE. VARHAT = WGSS/N C COMPUTE AIC BASED ON NEW CLUSTERING AND NEW VARIANCE. XMN2LL = N + N*ALOG(2.0*PI*VARHAT) AIC = XMN2LL + 2.0*NOPARM SCH = XMN2LL + ALOG(XN)*NOPARM WRITE (6,28000) WGSS, XMN2LL, WGMS WRITE (6,54000) STDERR WRITE (6,26000) (XMEAN(IG),IG=1,K) WRITE (6,32000) (SUM(IG),IG=1,K) WRITE (6,34000) (NG(IG),IG=1,K) WRITE (6,52000) (VAR(IG),IG=1,K) WRITE (6,42000) (SD(IG), IG=1,K) WRITE (6,60000) VARHAT WRITE (6,46000) DO 4200 I1 = 1,K DO 4200 I2 = 1,K WRITE (6,44000) I1, I2, (NT(I1,I2,J),J=1,K) 4200 CONTINUE WRITE (6,48000) DO 4300 I1=1,K DO 4300 I2=1,K WRITE (6,50000) I1, I2, (TP(I1,I2,J),J=1,K) 4300 CONTINUE WRITE (6,86000) (P(I),I=1,K) WRITE (6,74000) TRANS WRITE (6,80000) NOPARM WRITE (6,76000) AIC WRITE (6,78000) SCH ITER = ITER + 1 IF (ITER.GE.21) GO TO 4400 GO TO 800 4400 WRITE (6,82000) GO TO 4600 C C 4500 CONTINUE WRITE (6,84000) ITER 4600 CONTINUE STOP 10000 FORMAT(3X,I3) 12000 FORMAT(1X,'ROW: COLUMN: '/, 4X, (40I3/) ) 14000 FORMAT(1X, I3, (40I3/) ) 16000 FORMAT(1X,'DATA'/) 18000 FORMAT(/1X,'INITIAL MEANS') 20000 FORMAT(1X, (9E13.4/)/) 22000 FORMAT('1',1X,'#################################################', X'###########################################################', X/,1X,'PROGRAM IMSG1CMA:'/,' IMAGE SEGMENTATION, ', X'1-CHANNEL DATA, COMMON VARIANCE, AUTOMATIC MODE '/ X/,1X,'DEVELOPED AND PROGRAMMED BY DR. STANLEY L. SCLOVE' X/,1X,'VERSION 3.4 19-SEP-82'//) 24000 FORMAT('1',1X,'K = ',I1,' CLASSES OF SEGMENT'/) 26000 FORMAT(1X,'MEANS: ',(9E13.4/)) 28000 FORMAT(/1X,'WGSS = ',E15.7,' MINUS 2 LOG LIKELIHOOD = ', XE15.7, ' WGMS = ',E15.7/) 30000 FORMAT(//,1X,'ITERATION ', I2) 32000 FORMAT(1X,'SUMS:',6X,(9E13.4/)) 34000 FORMAT(1X,'NUMBERS:',3X,9(I10,3X)) 36000 FORMAT(18A4) 38000 FORMAT(/,1X,'NUMBER OF ROWS = ',I3/) 40000 FORMAT(1X,'NUMBER OF COLUMNS = ',I3/) 42000 FORMAT(1X,'STD.DEVS.: ',(9E13.4/)) 44000 FORMAT(1X,2I4,9I7) 46000 FORMAT(/1X,'TRANSITIONS'/) 48000 FORMAT(/1X,'TRANSITION PROBABILITIES'/) 50000 FORMAT(1X,2I4,9F7.4) 52000 FORMAT(1X,'VARIANCES: ',(9E13.4/)) 54000 FORMAT(1X,'STD.ERROR=SQRT(WGMS) = ',E14.5/) 56000 FORMAT(1X,18A4) 58000 FORMAT(1X,I3) 60000 FORMAT(/,1X, 'M.L. ESTIMATE OF COMMON VARIANCE = ',F14.5/) 62000 FORMAT(/,1X,'PROGRAM STOPPED BECAUSE OF NO OBSERVATIONS', X' IN CLASS ',I2/) 64000 FORMAT(2X,I2) 66000 FORMAT(/,1X,'MIN:') 68000 FORMAT(/,1X,'MAX:') 70000 FORMAT(/,1X,'AIC = ', F14.4, X1X,'(FROM NEW CLUSTERING AND VARIANCE THAT PRODUCED IT)') 72000 FORMAT(/,1X,'SCHWARZ CRITERION = ', E15.5, X1X,'(FROM NEW CLUSTERING AND VARIANCE THAT PRODUCED IT)') 74000 FORMAT(//,1X,'CONTRIBUTION OF TRANS. PROBS. TO ', X'LOG LIKELIHOOD = ',E15.5/) 76000 FORMAT(1X,'AIC = ', E15.5, X1X, '(FROM NEW CLUSTERING AND VARIANCE IT PRODUCED)'/) 78000 FORMAT(1X,'SCHWARZ CRITERION = ', E15.5, X1X, '(FROM NEW CLUSTERING AND VARIANCE IT PRODUCED)'/) 80000 FORMAT(/1X,'NUMBER OF PARAMETERS = ',I4/) 82000 FORMAT(1X,'STOPPED: ISOLINE.TRANS HAS NOT CONVERGED', X' IN 20 ITERATIONS.') 84000 FORMAT(1X,'RESULTS DID NOT CHANGE IN ITERATION NUMBER',I3,'.', X/,1X, 'PROGRAM ENDED SUCCESSFULLY.') 86000 FORMAT(/,1X,'MARGINAL PROB. VECTOR:',(9F11.4/)) 88000 FORMAT((1X,10F6.1/)) END //GO.SYSIN DD * FISHER IRISES NR=015 NC=010 (F4.1) 5.1 3.5 1.4 0.2 1 4.9 3.0 1.4 0.2 1 4.7 3.2 1.3 0.2 1 4.6 3.1 1.5 0.2 1 5.0 3.6 1.4 0.2 1 5.4 3.9 1.7 0.4 1 4.6 3.4 1.4 0.3 1 5.0 3.4 1.5 0.2 1 4.4 2.9 1.4 0.2 1 4.9 3.1 1.5 0.1 1 5.4 3.7 1.5 0.2 1 4.8 3.4 1.6 0.2 1 4.8 3.0 1.4 0.1 1 4.3 3.0 1.1 0.1 1 5.8 4.0 1.2 0.2 1 5.7 4.4 1.5 0.4 1 5.4 3.9 1.3 0.4 1 5.1 3.5 1.4 0.3 1 5.7 3.8 1.7 0.3 1 5.1 3.8 1.5 0.3 1 5.4 3.4 1.7 0.2 1 5.1 3.7 1.5 0.4 1 4.6 3.6 1.0 0.2 1 5.1 3.3 1.7 0.5 1 4.8 3.4 1.9 0.2 1 5.0 3.0 1.6 0.2 1 5.0 3.4 1.6 0.4 1 5.2 3.5 1.5 0.2 1 5.2 3.4 1.4 0.2 1 4.7 3.2 1.6 0.2 1 4.8 3.1 1.6 0.2 1 5.4 3.4 1.5 0.4 1 5.2 4.1 1.5 0.1 1 5.5 4.2 1.4 0.2 1 4.9 3.1 1.5 0.2 1 5.0 3.2 1.2 0.2 1 5.5 3.5 1.3 0.2 1 4.9 3.6 1.4 0.1 1 4.4 3.0 1.3 0.2 1 5.1 3.4 1.5 0.2 1 5.0 3.5 1.3 0.3 1 4.5 2.3 1.3 0.3 1 4.4 3.2 1.3 0.2 1 5.0 3.5 1.6 0.6 1 5.1 3.8 1.9 0.4 1 4.8 3.0 1.4 0.3 1 5.1 3.8 1.6 0.2 1 4.6 3.2 1.4 0.2 1 5.3 3.7 1.5 0.2 1 5.0 3.3 1.4 0.2 1 7.0 3.2 4.7 1.4 2 6.4 3.2 4.5 1.5 2 6.9 3.1 4.9 1.5 2 5.5 2.3 4.0 1.3 2 6.5 2.8 4.6 1.5 2 5.7 2.8 4.5 1.3 2 6.3 3.3 4.7 1.6 2 4.9 2.4 3.3 1.0 2 6.6 2.9 4.6 1.3 2 5.2 2.7 3.9 1.4 2 5.0 2.0 3.5 1.0 2 5.9 3.0 4.2 1.5 2 6.0 2.2 4.0 1.0 2 6.1 2.9 4.7 1.4 2 5.6 2.9 3.6 1.3 2 6.7 3.1 4.4 1.4 2 5.6 3.0 4.5 1.5 2 5.8 2.7 4.1 1.0 2 6.2 2.2 4.5 1.5 2 5.6 2.5 3.9 1.1 2 5.9 3.2 4.8 1.8 2 6.1 2.8 4.0 1.3 2 6.3 2.5 4.9 1.5 2 6.1 2.8 4.7 1.2 2 6.4 2.9 4.3 1.3 2 6.6 3.0 4.4 1.4 2 6.8 2.8 4.8 1.4 2 6.7 3.0 5.0 1.7 2 6.0 2.9 4.5 1.5 2 5.7 2.6 3.5 1.0 2 5.5 2.4 3.8 1.1 2 5.5 2.4 3.7 1.0 2 5.8 2.7 3.9 1.2 2 6.0 2.7 5.1 1.6 2 5.4 3.0 4.5 1.5 2 6.0 3.4 4.5 1.6 2 6.7 3.1 4.7 1.5 2 6.3 2.3 4.4 1.3 2 5.6 3.0 4.1 1.3 2 5.5 2.5 4.0 1.3 2 5.5 2.6 4.4 1.2 2 6.1 3.0 4.6 1.4 2 5.8 2.6 4.0 1.2 2 5.0 2.3 3.3 1.0 2 5.6 2.7 4.2 1.3 2 5.7 3.0 4.2 1.2 2 5.7 2.9 4.2 1.3 2 6.2 2.9 4.3 1.3 2 5.1 2.5 3.0 1.1 2 5.7 2.8 4.1 1.3 2 6.3 3.3 6.0 2.5 3 5.8 2.7 5.1 1.9 3 7.1 3.0 5.9 2.1 3 6.3 2.9 5.6 1.8 3 6.5 3.0 5.8 2.2 3 7.6 3.0 6.6 2.1 3 4.9 2.5 4.5 1.7 3 7.3 2.9 6.3 1.8 3 6.7 2.5 5.8 1.8 3 7.2 3.6 6.1 2.5 3 6.5 3.2 5.1 2.0 3 6.4 2.7 5.3 1.9 3 6.8 3.0 5.5 2.1 3 5.7 2.5 5.0 2.0 3 5.8 2.8 5.1 2.4 3 6.4 3.2 5.3 2.3 3 6.5 3.0 5.5 1.8 3 7.7 3.8 6.7 2.2 3 7.7 2.6 6.9 2.3 3 6.0 2.2 5.0 1.5 3 6.9 3.2 5.7 2.3 3 5.6 2.8 4.9 2.0 3 7.7 2.8 6.7 2.0 3 6.3 2.7 4.9 1.8 3 6.7 3.3 5.7 2.1 3 7.2 3.2 6.0 1.8 3 6.2 2.8 4.8 1.8 3 6.1 3.0 4.9 1.8 3 6.4 2.8 5.6 2.1 3 7.2 3.0 5.8 1.6 3 7.4 2.8 6.1 1.9 3 7.9 3.8 6.4 2.0 3 6.4 2.8 5.6 2.2 3 6.3 2.8 5.1 1.5 3 6.1 2.6 5.6 1.4 3 7.7 3.0 6.1 2.3 3 6.3 3.4 5.6 2.4 3 6.4 3.1 5.5 1.8 3 6.0 3.0 4.8 1.8 3 6.9 3.1 5.4 2.1 3 6.7 3.1 5.6 2.4 3 6.9 3.1 5.1 2.3 3 5.8 2.7 5.1 1.9 3 6.8 3.2 5.9 2.3 3 6.7 3.3 5.7 2.5 3 6.7 3.0 5.2 2.3 3 6.3 2.5 5.0 1.9 3 6.5 3.0 5.2 2.0 3 6.2 3.4 5.4 2.3 3 5.9 3.0 5.1 1.8 3 KL02 KU09 /*