C PROGRAM BNDCSTAT.FT C ---------------- C C SUBROUTINE BNDCSTAT(KX,KY,T1A,T2A,AN,ICORN,JPCNT,ICNT,AP,IOPR) C C PETER LEMKIN C IMAGE PROCESSING UNIT, DCBD C NATIONAL CANCER INSTITUTE C NATIONAL INSTITUTES OF HEALTH C 9000 ROCKVILLE PIKE C BETHESDA, MD. 20014 C C NOV 21, 1977 / REMOVED C@ ON H(I,J) THR TEST C NOV 18, 1977 C JULY 26, 1977 C JULY 25, 1977 C JULY 21, 1977 C JULY 20, 1977 C JULY 19, 1977 C JULY 18, 1977 C JULY 16, 1977 C JULY 15, 1977 C JULY 14, 1977 C C INTRODUCTION C ------------ C BNDCSTAT PUSHES THE CORNER INFORMATION AND ALSO C COMPUTES THE STATISTICS AND A HEURISTIC MEASURE OF C PAIRING BETWEEN CORNER POINTS (HEURISTIC). THE C HEURISTIC THRESHOLD IHEURISTIC IS USED TO PICK C SELECTED PAIRS > IHEURISTIC. C IF /L IS SPECIFIED, THEN THOSE PAIRS ARE LABLED C IN THE IBUF8 ARRAY (FROM THE IBUF4(179) ON UP AS 9-TUPLES C WITH THE NUMBER OF ENTRIES IN IBUF4(178)). C ENTRY i: [CC#,I,J,HEURISTIC,IX,IY,JX,JY,NORM] IN IBUF4[K:K+8]. C WHERE I AND J ARE BOUNDARY POINT INDICES. C C IOPR FUNCTION C ---- -------- C 1 RESET STACK POINTER C ARGS: C KX - /L SWITCH C KY - MEM C TIA(INTEGER) - IBYTE C C C 2 PUSH DATA (ALL ARGS USED) C C 3 COMPUTE STATISTICS. C ARGS C ---- C KX - IHEURISTIC C KY - CC# C AP - FLOATING NUMBER OF BOUNDARY POINTS C IF /L THEN LABEL 9-TUPLE ELSE PRINT. C OPDEFS C ------ S OPDEF TADI 1400 S OPDEF ISZI 2400 S OPDEF DCAI 3400 C C S OPDEF MQA 7501 S OPDEF MQL 7421 S OPDEF KRS 6034 S OPDEF BSW 7002 C C S OPDEF LDXP 6443 S OPDEF LDYP 6444 C S OPDEF DISP1 6435 S OPDEF DISP2 6436 C C C C NOTE: USE COMMON IBUF1:3 FOR SAVING HEURISTIC VALUES C NOTE: ONLY NEED PART OF THE ARRAY BUT IT IS USED TO FORCE C IBUF4 TO BE IN THE CURRECT PLACE (3*256) C NOTE: PART OF IBUF4 IS USED AS BNDPRINT HIST SCRATCH ARRAY C NOTE: SETUP COMMON STACK IN IBUF4[178:256] C COMMON IH1STK,IH2STK,IXSTK,IYSTK,JXSTK,JYSTK,NRMSTK COMMON IROWZERO,ICOLZERO,ITMP COMMON I1,I2,I3,I4,I5,I6,I7,I8,I9 COMMON IRSTIBUF3,JUNK,LABPTR,LABEL C DIMENSION IH1STK(96),IH2STK(96) DIMENSION IXSTK(96),IYSTK(96),JXSTK(96),JYSTK(96) DIMENSION NRMSTK(96) DIMENSION IROWZERO(16),ICOLZERO(16) DIMENSION ITMP(23),I1(1) C DIMENSION IRSTIBUF3(32) C DIMENSION JUNK(177),LABEL(78) C DIMENSION LXZ(14),LYZ(14),LCORNZ(14),LPCNTZ(14),LCNT(14) DIMENSION ZT1A(14),ZT2A(14),ZANORMAL(14),ZAPW(14) C [0] DISPATCH GOTO(100,200,300),IOPR C C [1] RESET STACK POINTER C SET MAXIMUM NUMBER OF EXTREMA TO ANALYZE! 100 MAXEXT=14 IPTR=0 C ILSW=KX MEM=KY S TAD I \T1A /GET IBYTE INTEGER S DCA \IBYTE C C ZERO THE CRITICAL POINT PAIR ANALYSIS POINTERS IRZ=0 ICZ=0 2047 RETURN C C C [2] GO PUSH C PUSH STACK DATA IF LEQ MAXEXT 200 IPTR=IPTR+1 IF(IPTR-MAXEXT)202,202,203 203 WRITE(3,201) 201 FORMAT(' BNDCSTAT OVF!') IPTR=MAXEXT GOTO 2047 C C 202 LXZ(IPTR)=KX LYZ(IPTR)=KY ZT1A(IPTR)=T1A ZT2A(IPTR)=T2A ZANORMAL(IPTR)=AN LCORNZ(IPTR)=ICORNERITY LPCNTZ(IPTR)=JPCNT LCNT(IPTR)=ICNT ZAPW(IPTR)=AP C GOTO 2047 C [3] PRINT STATISTICS C NOTE: AP IS THE NUMBER OF BOUNDARY POINTS 300 BP=AP C NOTE: COMES OVER INTEGER IHEURISTIC HURTHR=KX NC=KY C C ZERO THE ACCEPTED (I,J) PAIR STACK POINTER IH=0 C IPTRM1=IPTR-1 S TAD (6000 /"0@" TO PRINT SPACE! S DCA \IPHEADER C DO 399 I=1,IPTRM1 C GET THE I'TH ARGS IX=LXZ(I) IY=LYZ(I) PT1A=ZT1A(I) PT2A=ZT2A(I) PANORMAL=ZANORMAL(I) ICRN=LCORNZ(I) IPC=LPCNTZ(I) ICT=LCNT(I) PAPW=ZAPW(I) C LBOUND=I+1 DO 399 J=LBOUND,IPTR JX=LXZ(J) JY=LYZ(J) QT1A=ZT1A(J) QT2A=ZT2A(J) QANORMAL=ZANORMAL(J) JCRN=LCORNZ(J) JPC=LPCNTZ(J) JCT=LCNT(J) QAPW=ZAPW(J) C C NOTE: BP IS THE NUMBER OF BOUNDARY POINTS SUPPLIED BY CALLING C PROGRAM. C COMPUTE: RELATIVE DELTA X X=FLOAT(IX-JX)/BP C COMPUTE: RELATIVE DELTA Y Y=FLOAT(IY-JY)/BP C C RSQ IS THE FRACTION EUCLIDIAN DISTANCE RSQ=((1.0/BP)+X*X+Y*Y)*100.0 C C BALANCE IS THE BALANCE BETWEEN THE TWO SEGMENT HALVES KD1=IABS(ICT-JCT) KD2=IFIX(BP)-KD1 BALANCE=FLOAT(MAX(1,MIN(KD1,KD2)))/BP OPTSIZE=200.0/(200.0+BP) D1=BALANCE/(BALANCE+OPTSIZE) OPTBALSQ=D1*D1 C APWSQ=PAPW*QAPW+0.001 C CALL BNDHEM(QANORMAL,PANORMAL,DNORM) DNORM=ABS(4.0-DNORM) C C WEIGHT NORM BY APPERATURE DNRMPRIME=0.5+DNORM/(1.0+APWSQ) C C COMPUTE THE CORRELATION FUNCTIONS FOR CORNERITY AND % CURVE CORN=(FLOAT(ICRN)*FLOAT(JCRN))/FLOAT(ICRN+JCRN+1) C C NICK_(IF IPC=99 OR JPC=99 C THEN 1 ELSE 0) NICK=1 S TAD \IPC S TAD (-D99 S SNA CLA S DCA \NICK C S TAD \JPC S TAD (-D99 S SNA CLA S DCA \NICK NICK=1-NICK C PCNT=FLOAT(IPC)*FLOAT(JPC)/FLOAT(IPC+JPC+1) C C COMPUTE THE RELATIVE APERATURE CORRELATION. CALL BNDHEM(PT1A,QT2A,D1) CALL BNDHEM(QT1A,PT2A,D2) CAPW=ABS(D1*D2/APWSQ) C C COMPUTE PAIRING CORRELATION SUMMARY FUNCTION HEURISTIC=FLOAT(1-NICK)*(CORN*(PCNT+CAPW)*OPTBALANCE)/ 1(RSQ*DNRMPRIME*10.0) C C IF HEURISTIC GEQ HURTHR C THEN ACCEPT IT IF(HURTHR-HEURISTIC)311,311,399 C C IF (IH_IH+1) > 96 C THEN OVF 311 IH=IH+1 IF(IH-96)312,312,399 C GO PUSH HEURISTIC AND [I&J]; S\312, JMS PUSHPAIR C C C IF /L C THEN DO NOT WRITE ON LPT: S TAD \ILSW S SNA CLA S JMP \313 /PRINT C C WRITE SQUARES AROUND THE TWO POINTS CALL SQUARE(MEM,IBYTE,IX,IY) CALL SQUARE(MEM,IBYTE,JX,JY) GOTO 399 C 313 WRITE(3,302)IPHEADER,I,J,RSQ,BALANCE,DNORM 1,CORN,PCNT,CAPW,NICK 302 FORMAT(A1,'[',I2,',',I2,'] RSQ=',F4.2,', BAL=',F5.3, 1', DNRM=',F3.1,', CCRN=',F3.0,', C%CV=',F3.0,', CAPW=',F5.1, 2,' NICK=',I1) WRITE(3,303)OPTBALANCE,DNRMPRIME,HEURISTIC 303 FORMAT(6X,'OPTBALANCE=',F5.3,', DNRMPRIME=',F5.2 1,', HEURISTIC=',F10.3) C C SETUP CARRIAGE CONTROL FOR THE REST OF THE PAIRS S TAD (4040 /" " S DCA \IPHEADER 399 CONTINUE C C C C [3.1] IF IH > 0 THEN PUSH CRITICAL POINTS INTO LABEL STACK S TAD \IH S SNA CLA S JMP \2047 /NO C IH=MIN(IH,96) C C C [3.1.1] SORT IH1STK AND IH2STK BY THE MAXIMUM VALUES C IN IH1STK (HEURISTIC) WITH THE MAX ON THE TOP. S JMS SORT C C C [3.1.2] RUN THROUGH THE STACK FOR THE MAX DO 370 L=1,IH C COMPUTE: I1=IH2STK(L) S CLA CMA S TAD \L S TAD PIH2STK S DCA 7 S CPAGE 4 S DCA \I1 /FORCE COMMON S TADI 7 S DCA \I1 C C COMPUTE: I_(I1 LSH 6) LAND '77; S TAD \I1 S AND (77 S DCA \J C C COMPUTE: J_I1 LAND '77 S TAD \I1 S BSW S AND (77 S DCA \I C C C IF NOT (I IN ROWZERO[1:IRZ] OR J IN COLZERO[1:ICZ]) S JMS TESTIJ S TAD \K S SZA CLA S JMP \370 /YES EITHER I OR J WAS USED BEFORE. C C THEN C BEGIN "PUSH ENTRY" C PUSH (NC,I,J,HEURISTIC,IX,IY,JX,JY)==>LABEL; S JMS PUSHLABEL C C PUSH J==>ROWZERO(IRZ_IRZ+1); S JMS PUSHROWZERO C C PUSH I==>COLZERO(ICZ_ICZ+1); S JMS PUSHCOLZERO C END "PUSH ENTRY" 370 CONTINUE C GOTO 2047 C C ******************************************************* C *SUBROUTINE P U S H L A B E L C ******************************************************* C C PUSH (NC,I,J,IHEURISTIC,IX,IY,JX,JY,HEURISTIC) C INTO LABEL STACK IN COMMON C S CPAGE 3 S RPUSHLABEL, JMP I PUSHLABEL S PUSHLABEL, 0 C C NOTE: LABPTR IS ZEROED INITIALLY BY BNDPRINT C IF LABPTR_LABPTR+1 LEQ 8 C THEN PUSH 9-TUPLE (NC,I,J)==>LABEL[..] STACK LABPTR=LABPTR+1 IF(LABPTR-8)380,380,382 C C C OVERFLOW - PRINT MSG AND CONTINUE 382 WRITE(3,383) 383 FORMAT(' PUSHED > 8 LABEL PAIRS. IGNORE REST, CONTINUING!') GOTO 2047 C SETUP AUTOINDEX REGISTER PUSH C 380 I1=NC I2=I I3=J I4=IH1STK(L) I5=IXSTK(L) I6=IYSTK(L) I7=JXSTK(L) I8=JYSTK(L) I9=NRMSTK(L) D1=FLOAT(I9)/100.0 C IPHEADER=LABPTR-1 S TAD \IPHEADER /INDEX S CLL RAL /X2 S CLL RAL /X2 S CLL RAL /X2 S TAD \IPHEADER S TAD PLABEL S TAD (-1 /FOR AUTOINDEX S DCA 11 C C PRINT MESSAGE OF SPLIT. WRITE(3,381)(I1(M),M=1,8),D1 381 FORMAT(' SPLIT AT CC#',I3,', [',I2,',',I2,'], HEUR=',I5 1,', [',I3,':',I3,'] TO [',I3,':',I3,'], NORMAL=',F5.2) C S CPAGE 4 S TAD \I1 S DCAI 11 C S CPAGE 4 S TAD \I2 S DCAI 11 C S CPAGE 4 S TAD \I3 S DCAI 11 C S CPAGE 4 S TAD \I4 S DCAI 11 C S CPAGE 4 S TAD \I5 S DCAI 11 C S CPAGE 4 S TAD \I6 S DCAI 11 C S CPAGE 4 S TAD \I7 S DCAI 11 C S CPAGE 4 S TAD \I8 S DCAI 11 C S CPAGE 4 S TAD \I9 S DCAI 11 S JMP RPUSHLABEL C C ******************************************************* C *SUBROUTINE P U S H R O W Z E R O C ******************************************************* C C PUSH ROW J INTO ROWZERO STACK; C S CPAGE 3 S RPUSHROWZERO, JMP I PUSHROWZERO S PUSHROWZERO, 0 IRZ=IRZ+1 C IROWZERO(IRZ)=J C S JMP RPUSHROWZERO C C ******************************************************* C *SUBROUTINE P U S H C O L Z E R O C ******************************************************* C C PUSHCOL I INTO COLZERO STACK; C S CPAGE 3 S RPUSHCOLZERO, JMP I PUSHCOLZERO S PUSHCOLZERO, 0 ICZ=ICZ+1 ICOLZERO(ICZ)=I C S JMP RPUSHCOLZERO C C ******************************************************* C *SUBROUTINE P U S H P A I R C ******************************************************* C C PUSH (I&J==IH2STK, HEURISTIC==>IH1STK, IX/IY/JX/JY/NORM==>*STK) C AT IH. C S CPAGE 3 S RPUSHPAIR, JMP I PUSHPAIR S PUSHPAIR, 0 C IH1STK(IH)=HEURISTIC S TAD \I S BSW S TAD \J S DCA \K IH2STK(IH)=K C IXSTK(IH)=IX IYSTK(IH)=IY JXSTK(IH)=JX JYSTK(IH)=JY C C C COMPUTE THE AVERAGE NORMAL D1=QANORMAL+4.0 IF(8.0-D1)392,393,393 392 D1=D1-8.0 393 NORMAL=50.0*(PANORMAL+D1) NRMSTK(IH)=NORMAL C S JMP RPUSHPAIR C C ******************************************************* C *SUBROUTINE S O R T C ******************************************************* C C BUBBLE SORT STACKS BY IHEURISTIC VALUE (OF IH1STK) (MAX ON TOP) C STACKS: IH2STK,IXSTK,IYSTK,JXSTK,JYSTK C S CPAGE 3 S RSORT, JMP I SORT S SORT, 0 C C DO BUBBLE SORT OF IH1STK M=2 C C IF M GEQ IH C THEN DONE; 361 IF(M-IH)362,362,369 C C C NOT DONE, COMPARE NEXT ENTRY 362 CONTINUE C COMPUTE: I2=IH1STK(M) S CLA CMA S TAD \M S TAD PIH1STK S DCA 7 S CPAGE 4 S DCA \I2 /FORCE COMMON S TADI 7 S DCA \I2 C C COMPUTE: I1=IH1STK(M-1) S CLA CMA /PTR-1 S TAD 7 S DCA 25 S CPAGE 4 S DCA \I1 /FORCE COMMON S TADI 25 S DCA \I1 C C IF I1 < I2 IF(I1-I2)333,334,334 C C THEN SWAP M/M-1 ENTRIES AND BEGIN AGAIN; 333 CONTINUE C COMPUTE: IH1STK(M-1)=I2 S CPAGE 4 S TAD \I2 S DCAI 25 C C COMPUTE: IH1STK(M)=I1 S CPAGE 4 S TAD \I1 S DCAI 7 C C COMPUTE: I2=IH2STK(M) S CLA CMA S TAD \M S TAD PIH2STK S DCA 7 S CPAGE 4 S DCA \I2 /FORCE COMMON S TADI 7 S DCA \I2 C C COMPUTE: I1=IH2STK(M-1) S CLA CMA /PTR-1 S TAD 7 S DCA 25 S CPAGE 4 S DCA \I1 /FORCE COMMON S TADI 25 S DCA \I1 C C COMPUTE: IH2STK(M)=I1 S CPAGE 4 S TAD \I1 S DCAI 7 C C COMPUTE: IH2STK(M-1)=I2 S CPAGE 4 S TAD \I2 S DCAI 25 C C COMPUTE: I2=IXSTK(M) S CLA CMA S TAD \M S TAD PIXSTK S DCA 7 S CPAGE 4 S DCA \I2 /FORCE COMMON S TADI 7 S DCA \I2 C C COMPUTE: I1=IXSTK(M-1) S CLA CMA /PTR-1 S TAD 7 S DCA 25 S CPAGE 4 S DCA \I1 /FORCE COMMON S TADI 25 S DCA \I1 C C COMPUTE: IXSTK(M)=I1 S CPAGE 4 S TAD \I1 S DCAI 7 C C COMPUTE: IXSTK(M-1)=I2 S CPAGE 4 S TAD \I2 S DCAI 25 C C COMPUTE: I2=IYSTK(M) S CLA CMA S TAD \M S TAD PIYSTK S DCA 7 S CPAGE 4 S DCA \I2 /FORCE COMMON S TADI 7 S DCA \I2 C C COMPUTE: I1=IYSTK(M-1) S CLA CMA /PTR-1 S TAD 7 S DCA 25 S CPAGE 4 S DCA \I1 /FORCE COMMON S TADI 25 S DCA \I1 C C COMPUTE: IYSTK(M)=I1 S CPAGE 4 S TAD \I1 S DCAI 7 C C COMPUTE: IYSTK(M-1)=I2 S CPAGE 4 S TAD \I2 S DCAI 25 C C COMPUTE: I2=JXSTK(M) S CLA CMA S TAD \M S TAD PJXSTK S DCA 7 S CPAGE 4 S DCA \I2 /FORCE COMMON S TADI 7 S DCA \I2 C C COMPUTE: I1=JXSTK(M-1) S CLA CMA /PTR-1 S TAD 7 S DCA 25 S CPAGE 4 S DCA \I1 /FORCE COMMON S TADI 25 S DCA \I1 C C COMPUTE: JXSTK(M)=I1 S CPAGE 4 S TAD \I1 S DCAI 7 C C COMPUTE: JXSTK(M-1)=I2 S CPAGE 4 S TAD \I2 S DCAI 25 C C COMPUTE: I2=JYSTK(M) S CLA CMA S TAD \M S TAD PJYSTK S DCA 7 S CPAGE 4 S DCA \I2 /FORCE COMMON S TADI 7 S DCA \I2 C C COMPUTE: I1=JYSTK(M-1) S CLA CMA /PTR-1 S TAD 7 S DCA 25 S CPAGE 4 S DCA \I1 /FORCE COMMON S TADI 25 S DCA \I1 C C COMPUTE: JYSTK(M)=I1 S CPAGE 4 S TAD \I1 S DCAI 7 C C COMPUTE: JYSTK(M-1)=I2 S CPAGE 4 S TAD \I2 S DCAI 25 C C C C COMPUTE: I2=NRMSTK(M) S CLA CMA S TAD \M S TAD PNRMSTK S DCA 7 S CPAGE 4 S DCA \I2 /FORCE COMMON S TADI 7 S DCA \I2 C C COMPUTE: I1=NRMSTK(M-1) S CLA CMA /PTR-1 S TAD 7 S DCA 25 S CPAGE 4 S DCA \I1 /FORCE COMMON S TADI 25 S DCA \I1 C C COMPUTE: NRMSTK(M)=I1 S CPAGE 4 S TAD \I1 S DCAI 7 C C COMPUTE: NRMSTK(M-1)=I2 S CPAGE 4 S TAD \I2 S DCAI 25 C M=2 GOTO 361 C C C INCREMENT TO NEXT PAIR 334 M=M+1 GOTO 361 C 369 CONTINUE C DONE! S JMP RSORT C C ******************************************************* C *SUBROUTINE T E S T I J C ******************************************************* C C TEST WHETHER I OR J IS IN A ZERO STACK C IN WHICH CASE RETURN 1==>K ELSE 0==>K C S CPAGE 3 S RTESTIJ, JMP I TESTIJ S TESTIJ, 0 C C C CHECK STACKS DO 410 M=1,IRZ I2=IROWZERO(M) IF(I2-J)411,415,411 411 IF(I2-I)410,415,410 410 CONTINUE C DO 414 M=1,ICZ I2=ICOLZERO(M) IF(I2-J)412,415,412 412 IF(I2-I)414,415,414 414 CONTINUE K=0 S JMP RTESTIJ C C I OR J IN STACK 415 K=1 S JMP RTESTIJ C ****PARAMETERS**** S PNRMSTK, \NRMSTK S PIXSTK, \IXSTK S PIYSTK, \IYSTK S PJXSTK, \JXSTK S PJYSTK, \JYSTK C S PICOLZERO, \ICOLZERO S PIROWZERO, \IROWZERO S PIH1STACK, \IH1STACK S PIH2STACK, \IH2STACK S PLABEL, \LABEL END