Merge pull request #9636 from GeekRuthie/challenge-257-cobol

Week 257 challenges, in COBOL

3 files changed, 261 insertions, 0 deletions

diff --git a/challenge-257/geekruthie/cobol/ch-1.cob b/challenge-257/geekruthie/cobol/ch-1.cob
new file mode 100644
index 0000000000..34b756b791
--- /dev/null
+++ b/challenge-257/geekruthie/cobol/ch-1.cob
@@ -0,0 +1,59 @@
+      * Perl/Raku Weekly Challenge Week 257, Challenge 1
+      *
+      * GnuCOBOL, v 3.2-rc2.0
+      *
+      * Compile and execute with: $ cobc -xj ch-1.cob
+      *
+      * This code has the following brewed-in limitations:
+      * - The system will randomly generate exactly five test arrays
+      *   of exactly five positive integers each, in the range
+      *   1-99.
+      *
+       IDENTIFICATION DIVISION.
+         PROGRAM-ID. PRC-257-1.
+
+       DATA DIVISION.
+         WORKING-STORAGE SECTION.
+         01 EXAMPLE-DATA.
+           03 EXAMPLE-ARR OCCURS 5 TIMES.
+             05 EXAMPLE-INT OCCURS 5 TIMES PIC 9(2) USAGE IS COMP.
+         01 IDX1 PIC 9(1) USAGE IS COMP.
+         01 IDX2 PIC 9(1) USAGE IS COMP.
+         01 IDX3 PIC 9(1) USAGE IS COMP.
+         01 COUNTER PIC 9(1) USAGE IS COMP.
+         01 HEADER-LINE PIC X(40) VALUE ALL '-'.
+
+       PROCEDURE DIVISION.
+           PERFORM INITIALIZE_ONE_ARRAY VARYING IDX1 FROM 1 BY 1
+             UNTIL IDX1 > 5.
+           PERFORM ANALYZE_ONE_ARRAY VARYING IDX1 FROM 1 BY 1
+             UNTIL IDX1 > 5.
+           STOP RUN.
+
+         ANALYZE_ONE_ARRAY.
+           PERFORM DISPLAY_THIS_ARRAY.
+           PERFORM VARYING IDX2 FROM 1 BY 1 UNTIL IDX2 > 5
+             MOVE ZERO TO COUNTER
+             PERFORM VARYING IDX3 FROM 1 BY 1 UNTIL IDX3 > 5
+               IF IDX2 IS NOT = IDX3
+                  AND EXAMPLE-INT(IDX1,IDX3) < EXAMPLE-INT(IDX1,IDX2)
+                 ADD 1 TO COUNTER
+               END-IF
+             END-PERFORM
+             DISPLAY EXAMPLE-INT(IDX1,IDX2) ': ' COUNTER
+           END-PERFORM.
+           EXIT.
+
+         DISPLAY_THIS_ARRAY.
+           DISPLAY HEADER-LINE.
+           DISPLAY 'ARRAY #' IDX1 ':'.
+           DISPLAY EXAMPLE-INT(IDX1, 1) ' ' EXAMPLE-INT(IDX1, 2)
+             ' ' EXAMPLE-INT(IDX1, 3) ' ' EXAMPLE-INT(IDX1, 4)
+             ' ' EXAMPLE-INT(IDX1, 5).
+           EXIT.
+
+         INITIALIZE_ONE_ARRAY.
+           PERFORM VARYING IDX2 FROM 1 BY 1 UNTIL IDX2 > 5
+             COMPUTE EXAMPLE-INT(IDX1,IDX2) = FUNCTION RANDOM * 99 + 1
+           END-PERFORM.
+           EXIT.
diff --git a/challenge-257/geekruthie/cobol/ch-2.cob b/challenge-257/geekruthie/cobol/ch-2.cob
new file mode 100644
index 0000000000..4207107b1a
--- /dev/null
+++ b/challenge-257/geekruthie/cobol/ch-2.cob
@@ -0,0 +1,176 @@
+      * Perl/Raku Weekly Challenge Week 257, Challenge 2
+      *
+      * GnuCOBOL, v 3.2-rc2.0
+      *
+      * Compile and execute with: $ cobc -xj ch-2.cob
+      *
+      * This code has the following brewed-in limitations:
+      *  - Exactly six matrices will be read in.
+      *  - The maximum matrix size is 5x5 signed integers.
+      *  - The data file must be organized properly, or
+      *    chaos and madness will result.
+
+       IDENTIFICATION DIVISION.
+         PROGRAM-ID. PRC-257-2.
+       ENVIRONMENT DIVISION.
+         INPUT-OUTPUT SECTION.
+         FILE-CONTROL.
+           SELECT TEST-DATA
+           ASSIGN TO 'ch-2.dat'
+           ORGANIZATION IS LINE SEQUENTIAL.
+
+       DATA DIVISION.
+         FILE SECTION.
+         FD TEST-DATA.
+         01 DATA-REC PIC X(80).
+         WORKING-STORAGE SECTION.
+         01 DIMENSION_DATA OCCURS 6 TIMES.
+           03 DIM-X PIC 9(2) USAGE IS COMP.
+           03 DIM-Y PIC 9(2) USAGE IS COMP.
+         01 EXAMPLE-DATA.
+           03 EXAMPLE-MATRIX OCCURS 6 TIMES.
+             05 ROW-DATA OCCURS 5 TIMES.
+               07 COLUMN-DATA OCCURS 5 TIMES.
+                 09 CELL PIC S9(2) USAGE IS COMP.
+         01 IDX1 PIC 9(1) USAGE IS COMP.
+         01 IDX2 PIC 9(1) USAGE IS COMP.
+         01 IDX3 PIC 9(1) USAGE IS COMP.
+         01 LEADING-1 PIC 9(1) OCCURS 5 TIMES.
+         01 FILLER PIC X(1) VALUE 'N'.
+           88 ZERO-ROW-NOT-FOUND VALUE 'N'.
+           88 ZERO-ROW-FOUND VALUE 'Y'.
+         01 FILLER PIC X(1) VALUE 'N'.
+           88 IS-NOT-RRE VALUE 'N'.
+           88 IS-RRE VALUE 'Y'.
+         01 FILLER PIC X(1) VALUE 'N'.
+           88 ROW-NOT-CHECKED VALUE 'N'.
+           88 ROW-CHECKED VALUE 'Y'.
+         01 HEADER-LINE PIC X(40) VALUE ALL '-'.
+
+       PROCEDURE DIVISION.
+           OPEN INPUT TEST-DATA.
+           PERFORM READ-MATRICES-FROM-FILE VARYING IDX1 FROM 1 BY 1
+             UNTIL IDX1 > 6.
+           CLOSE TEST-DATA.
+           PERFORM DISPLAY-MATRIX VARYING IDX1 FROM 1 BY 1
+             UNTIL IDX1 > 6.
+           STOP RUN.
+
+         ANALYZE-MATRIX.
+           SET IS-RRE TO TRUE;
+           PERFORM VARYING IDX2 FROM 1 BY 1 UNTIL IDX2 > 5
+             INITIALIZE LEADING-1(IDX2)
+           END-PERFORM.
+           PERFORM RULE-1 VARYING IDX2 FROM 1 BY 1
+             UNTIL IDX2 > DIM-Y(IDX1) OR IS-NOT-RRE.
+           SET ZERO-ROW-NOT-FOUND TO TRUE.
+           PERFORM RULE-2 VARYING IDX2 FROM 1 BY 1
+             UNTIL IDX2 > DIM-Y(IDX1) OR IS-NOT-RRE.
+           PERFORM RULE-3 VARYING IDX2 FROM 1 BY 1
+             UNTIL IDX2 > DIM-Y(IDX1) OR IS-NOT-RRE.
+           PERFORM RULE-4 VARYING IDX2 FROM 1 BY 1
+             UNTIL IDX2 > DIM-Y(IDX1) OR IS-NOT-RRE.
+           IF (IS-RRE)
+             DISPLAY "This matrix is RRE."
+           ELSE
+             DISPLAY "This matrix is NOT RRE."
+           EXIT.
+
+         DISPLAY-MATRIX.
+           DISPLAY HEADER-LINE.
+           DISPLAY 'MATRIX #' IDX1.
+           PERFORM VARYING IDX2 FROM 1 BY 1 UNTIL IDX2 > DIM-Y(IDX1)
+             PERFORM VARYING IDX3 FROM 1 BY 1 UNTIL IDX3 > DIM-X(IDX1)
+               DISPLAY CELL(IDX1,IDX2,IDX3) ' ' WITH NO ADVANCING
+             END-PERFORM
+             DISPLAY ' '
+           END-PERFORM.
+           PERFORM ANALYZE-MATRIX.
+           EXIT.
+
+         READ-MATRICES-FROM-FILE.
+           READ TEST-DATA.
+           UNSTRING DATA-REC
+             DELIMITED BY SPACES
+             INTO DIM-X(IDX1)
+                  DIM-Y(IDX1).
+             PERFORM READ-MATRIX-ROW VARYING IDX2 FROM 1 BY 1
+               UNTIL IDX2 > DIM-Y(IDX1).
+           EXIT.
+
+         READ-MATRIX-ROW.
+           READ TEST-DATA.
+           UNSTRING DATA-REC
+             DELIMITED BY SPACES
+             INTO CELL(IDX1, IDX2, 1)
+                  CELL(IDX1, IDX2, 2)
+                  CELL(IDX1, IDX2, 3)
+                  CELL(IDX1, IDX2, 4)
+                  CELL(IDX1, IDX2, 5).
+           EXIT.
+
+      * If a row does not consist entirely of zeros, then the first
+      * nonzero number in the row is a 1. We call this the leading 1.
+         RULE-1.
+           SET ROW-NOT-CHECKED TO TRUE.
+           PERFORM VARYING IDX3 FROM 1 BY 1
+              UNTIL IDX3 > DIM-X(IDX1) OR ROW-CHECKED OR IS-NOT-RRE
+              IF ( CELL(IDX1, IDX2, IDX3) IS NOT ZERO)
+                IF ( CELL(IDX1, IDX2, IDX3) = 1 )
+                  SET LEADING-1(IDX2) TO IDX3
+                  SET ROW-CHECKED TO TRUE
+                ELSE
+                  SET ROW-CHECKED TO TRUE
+                  SET IS-NOT-RRE TO TRUE
+                END-IF
+           END-PERFORM.
+           EXIT.
+
+      * 2. If there are any rows that consist entirely of zeros, then
+      * they are grouped together at the bottom of the matrix.
+         RULE-2.
+             SET ROW-NOT-CHECKED TO TRUE
+           PERFORM VARYING IDX3 FROM 1 BY 1
+              UNTIL IDX3 > DIM-X(IDX1) OR ROW-CHECKED OR IS-NOT-RRE
+             IF (CELL(IDX1,IDX2,IDX3) IS NOT ZERO)
+               IF (ZERO-ROW-FOUND)
+                 SET IS-NOT-RRE TO TRUE
+               ELSE
+                 SET ROW-CHECKED TO TRUE
+               END-IF
+             END-IF
+           END-PERFORM.
+           IF (ROW-NOT-CHECKED)
+             SET ZERO-ROW-FOUND TO TRUE
+           END-IF.
+           EXIT.
+
+      * 3. In any two successive rows that do not consist entirely of
+      * zeros, the leading 1 in the lower row occurs farther to the
+      * right than the leading 1 in the higher row.
+         RULE-3.
+           PERFORM VARYING IDX3 FROM IDX2 BY 1
+             UNTIL IDX3 > DIM-Y(IDX1) OR IS-NOT-RRE
+             IF (LEADING-1(IDX3) < LEADING-1(IDX2)
+                AND LEADING-1(IDX3) IS NOT ZERO)
+               SET IS-NOT-RRE TO TRUE
+             END-IF
+           END-PERFORM.
+           EXIT.
+
+      * 4. Each column that contains a leading 1 has zeros everywhere
+      * else in that column.
+         RULE-4.
+           PERFORM VARYING IDX2 FROM 1 BY 1 UNTIL IDX2 > DIM-Y(IDX1)
+              OR IS-NOT-RRE
+             IF (LEADING-1(IDX2) IS NOT ZERO)
+               PERFORM VARYING IDX3 FROM 1 BY 1 UNTIL IDX3 > DIM-Y(IDX1)
+                  OR IS-NOT-RRE
+                 IF (IDX2 IS NOT = IDX3
+                    AND CELL(IDX1, IDX3, LEADING-1(IDX2)) IS NOT ZERO)
+                   SET IS-NOT-RRE TO TRUE
+                 END-IF
+               END-PERFORM
+             END-IF
+           END-PERFORM.
+           EXIT.
diff --git a/challenge-257/geekruthie/cobol/ch-2.dat b/challenge-257/geekruthie/cobol/ch-2.dat
new file mode 100644
index 0000000000..69ab7443da
--- /dev/null
+++ b/challenge-257/geekruthie/cobol/ch-2.dat
@@ -0,0 +1,26 @@
+3 3
+1 1 0
+0 1 0
+0 0 0
+5 4
+0 1 -2 0 1
+0 0 0 1 3
+0 0 0 0 0
+0 0 0 0 0
+4 3
+1 0 0 4
+0 1 0 7
+0 0 1 -1
+5 4
+0 1 -2 0 1
+0 0 0 0 0
+0 0 0 1 3
+0 0 0 0 0 
+3 3
+0 1 0
+1 0 0
+0 0 0
+4 3
+4 0 0 0
+0 1 0 7
+0 0 1 -1