The thought was suggested to try to approach this with the concepts of a binary search to perhaps make it more efficient.
What would be the merits of each of the methods that have come out?
1) This one I presented seems great, since we have at most 4 or 5 compares AFTER the proper quadrant is found. But hard telling about the table accesses. At most, though, 7-8 compares for the whole string.
2) inspect function reverse tallying I would think be a performance issue, simply for the reverse function call.
3) simple loop from sizeof(string) down to the last non-space character...potentially the easiest and definitely most efficient, but what if we have to do this for a large number of records?
Might be worth trying to find the merits of each and develop them out.
Anyway, here's the thought. 1000 was coded so it could be dropped into a sub-program easily.
What would be the merits of each of the methods that have come out?
1) This one I presented seems great, since we have at most 4 or 5 compares AFTER the proper quadrant is found. But hard telling about the table accesses. At most, though, 7-8 compares for the whole string.
2) inspect function reverse tallying I would think be a performance issue, simply for the reverse function call.
3) simple loop from sizeof(string) down to the last non-space character...potentially the easiest and definitely most efficient, but what if we have to do this for a large number of records?
Might be worth trying to find the merits of each and develop them out.
Anyway, here's the thought. 1000 was coded so it could be dropped into a sub-program easily.
Code:
00010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. CONCAT1.
000030* CONCATENATE FIELDS USING A BINARY SEARCH METHOD TO DISCOVER THE
000040* LAST NON-SPACE CHARACTER IN THE FIELD.
000050 ENVIRONMENT DIVISION.
000060 DATA DIVISION.
000070 WORKING-STORAGE SECTION.
000080 01 input-fields.
000090 04 infield-city pic x(30) value 'Atlanta'.
000100 04 infield-state pic x(30) value 'Georgia'.
000110 04 infield-zipcode pic x(30) value '12345'.
000120 01 work-vars.
000130* HARD CODED VALUES BASED ON INPUT-WORK
000140 04 quad-items.
000150 08 filler pic 9(2) value 23.
000160 08 filler pic 9(2) value 15.
000170 08 filler pic 9(2) value 7.
000180 04 quad-table redefines quad-items pic 9(2) occurs 3
000190 INDEXED BY QUAD-NDX.
000200 04 input-work pic x(30).
000210 04 OUTPUT-DATA PIC 9(2).
000220 04 DONE-FLAG PIC 9 VALUE 0.
000230 04 ITEM-NDX PIC S9(5) COMP-5.
000231 04 DUMMY-VAR PIC 9.
000232
000240 04 OUT-CITY PIC 9(2).
000250 04 OUT-STATE PIC 9(2).
000260 04 OUT-ZIP PIC 9(2).
000270 04 FINAL-OUTPUT PIC X(100).
000280
000290 PROCEDURE DIVISION.
000300 0000-start section.
000310 MOVE INFIELD-CITY TO INPUT-WORK.
000320 PERFORM 1000-FIND-END.
000330 MOVE OUTPUT-DATA TO OUT-CITY.
000340 MOVE INFIELD-STATE TO INPUT-WORK.
000350 PERFORM 1000-FIND-END.
000360 MOVE OUTPUT-DATA TO OUT-STATE.
000370 MOVE INFIELD-ZIPCODE TO INPUT-WORK.
000380 PERFORM 1000-FIND-END.
000390 MOVE OUTPUT-DATA TO OUT-ZIP.
000400
000410 STRING INFIELD-CITY (1:OUT-CITY) DELIMITED BY SIZE
000420 ', ' DELIMITED BY SIZE
000430 INFIELD-STATE (1:OUT-STATE) DELIMITED BY SIZE
000440 ', ' DELIMITED BY SIZE
000450 INFIELD-ZIPCODE (1:OUT-ZIP) DELIMITED BY SIZE
000451 ',' DELIMITED BY SIZE
000460 INTO FINAL-OUTPUT.
000470 DISPLAY "FINAL OUTPUT IS: ", FINAL-OUTPUT.
000480 GOBACK.
000490
000500 1000-FIND-END SECTION.
000510 SET QUAD-NDX TO 1.
000520 MOVE 0 TO DONE-FLAG.
000530 PERFORM UNTIL (QUAD-NDX > 3) OR (DONE-FLAG = 1)
000540* LOOKING FOR THREE SPACES IN CASE WE HIT A SPACE IN THE FILE
000550 IF INPUT-WORK (QUAD-TABLE (QUAD-NDX): 3) NOT = SPACES
000560 MOVE 1 TO DONE-FLAG
000570 ELSE
000580 SET QUAD-NDX UP BY 1
000590 END-IF
000600 END-PERFORM.
000610* WE FOUND THE RIGHT QUADRANT, NOW ITERATE TO FIND THE RIGHT SPOT
000620 SET QUAD-NDX DOWN BY 1.
000630 PERFORM VARYING ITEM-NDX FROM QUAD-TABLE (QUAD-NDX) BY -1
000640 UNTIL INPUT-WORK (ITEM-NDX:1) NOT = SPACES
000641 MOVE 1 TO DUMMY-VAR
000642 END-PERFORM.
000650 MOVE ITEM-NDX TO OUTPUT-DATA.