213 lines
7.5 KiB
COBOL
213 lines
7.5 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. FAREY-SEQUENCE.
|
|
|
|
ENVIRONMENT DIVISION.
|
|
|
|
DATA DIVISION.
|
|
WORKING-STORAGE SECTION.
|
|
|
|
*> Fraction storage
|
|
01 WS-MAX-FRACS PIC 9(6) VALUE 600000.
|
|
01 WS-FRAC-TABLE.
|
|
05 WS-FRAC OCCURS 600000 TIMES.
|
|
10 WS-NUM PIC 9(6).
|
|
10 WS-DEN PIC 9(6).
|
|
10 WS-VAL PIC S9(6)V9(9) COMP-3.
|
|
|
|
*> Dedup value table (parallel arrays for map simulation)
|
|
01 WS-SEEN-TABLE.
|
|
05 WS-SEEN OCCURS 600000 TIMES.
|
|
10 WS-SEEN-VAL PIC S9(6)V9(9) COMP-3.
|
|
10 WS-SEEN-USED PIC X VALUE 'N'.
|
|
|
|
01 WS-FRAC-COUNT PIC 9(6) VALUE 0.
|
|
01 WS-SEEN-COUNT PIC 9(6) VALUE 0.
|
|
|
|
*> Loop counters (renamed to avoid ambiguity with table fields)
|
|
01 WS-I PIC 9(4).
|
|
01 WS-LOOP-DEN PIC 9(4).
|
|
01 WS-LOOP-NUM PIC 9(4).
|
|
01 WS-K PIC 9(6).
|
|
01 WS-J PIC 9(6).
|
|
|
|
*> Computed value
|
|
01 WS-CURR-VAL PIC S9(6)V9(9) COMP-3.
|
|
01 WS-FOUND PIC X VALUE 'N'.
|
|
|
|
*> Sorting temporaries
|
|
01 WS-TEMP-NUM PIC 9(6).
|
|
01 WS-TEMP-DEN PIC 9(6).
|
|
01 WS-TEMP-VAL PIC S9(6)V9(9) COMP-3.
|
|
|
|
*> Output
|
|
01 WS-OUT-LINE PIC X(2000).
|
|
01 WS-FRAC-STR PIC X(20).
|
|
|
|
*> Numeric editing
|
|
01 WS-EDIT-NUM PIC Z(5)9.
|
|
01 WS-EDIT-I PIC Z(3)9.
|
|
01 WS-EDIT-CNT PIC Z(5)9.
|
|
|
|
*> Pointer for STRING
|
|
01 WS-POS PIC 9(4).
|
|
|
|
PROCEDURE DIVISION.
|
|
|
|
MAIN-PARA.
|
|
*> Print F1 through F11
|
|
PERFORM VARYING WS-I FROM 1 BY 1
|
|
UNTIL WS-I > 11
|
|
PERFORM GEN-FAREY
|
|
PERFORM PRINT-FAREY-LIST
|
|
END-PERFORM
|
|
|
|
*> Print counts for F100 to F1000 by 100
|
|
PERFORM VARYING WS-I FROM 100 BY 100
|
|
UNTIL WS-I > 1000
|
|
PERFORM GEN-FAREY
|
|
PERFORM PRINT-FAREY-COUNT
|
|
END-PERFORM
|
|
|
|
STOP RUN.
|
|
|
|
*>- -----------------------------------------------------------
|
|
*> GEN-FAREY: builds sorted unique fraction list for order WS-I
|
|
*>- -----------------------------------------------------------
|
|
GEN-FAREY.
|
|
MOVE 0 TO WS-FRAC-COUNT
|
|
MOVE 0 TO WS-SEEN-COUNT
|
|
|
|
*> Clear seen flags
|
|
PERFORM VARYING WS-K FROM 1 BY 1
|
|
UNTIL WS-K > 600000
|
|
MOVE 'N' TO WS-SEEN-USED(WS-K)
|
|
END-PERFORM
|
|
|
|
*> Generate fractions
|
|
PERFORM VARYING WS-LOOP-DEN FROM 1 BY 1
|
|
UNTIL WS-LOOP-DEN > WS-I
|
|
PERFORM VARYING WS-LOOP-NUM FROM 0 BY 1
|
|
UNTIL WS-LOOP-NUM > WS-LOOP-DEN
|
|
|
|
COMPUTE WS-CURR-VAL =
|
|
WS-LOOP-NUM / WS-LOOP-DEN
|
|
|
|
PERFORM CHECK-SEEN
|
|
IF WS-FOUND = 'N'
|
|
ADD 1 TO WS-FRAC-COUNT
|
|
MOVE WS-LOOP-NUM TO WS-NUM(WS-FRAC-COUNT)
|
|
MOVE WS-LOOP-DEN TO WS-DEN(WS-FRAC-COUNT)
|
|
MOVE WS-CURR-VAL TO WS-VAL(WS-FRAC-COUNT)
|
|
ADD 1 TO WS-SEEN-COUNT
|
|
MOVE WS-CURR-VAL
|
|
TO WS-SEEN-VAL(WS-SEEN-COUNT)
|
|
MOVE 'Y'
|
|
TO WS-SEEN-USED(WS-SEEN-COUNT)
|
|
END-IF
|
|
|
|
END-PERFORM
|
|
END-PERFORM
|
|
|
|
*> Bubble sort by value
|
|
PERFORM VARYING WS-K FROM 1 BY 1
|
|
UNTIL WS-K >= WS-FRAC-COUNT
|
|
PERFORM VARYING WS-J FROM 1 BY 1
|
|
UNTIL WS-J >= WS-FRAC-COUNT - WS-K + 1
|
|
IF WS-VAL(WS-J) > WS-VAL(WS-J + 1)
|
|
MOVE WS-NUM(WS-J) TO WS-TEMP-NUM
|
|
MOVE WS-DEN(WS-J) TO WS-TEMP-DEN
|
|
MOVE WS-VAL(WS-J) TO WS-TEMP-VAL
|
|
MOVE WS-NUM(WS-J + 1) TO WS-NUM(WS-J)
|
|
MOVE WS-DEN(WS-J + 1) TO WS-DEN(WS-J)
|
|
MOVE WS-VAL(WS-J + 1) TO WS-VAL(WS-J)
|
|
MOVE WS-TEMP-NUM TO WS-NUM(WS-J + 1)
|
|
MOVE WS-TEMP-DEN TO WS-DEN(WS-J + 1)
|
|
MOVE WS-TEMP-VAL TO WS-VAL(WS-J + 1)
|
|
END-IF
|
|
END-PERFORM
|
|
END-PERFORM.
|
|
|
|
*>- -----------------------------------------------------------
|
|
*> CHECK-SEEN: sets WS-FOUND = 'Y' if WS-CURR-VAL already seen
|
|
*>- -----------------------------------------------------------
|
|
CHECK-SEEN.
|
|
MOVE 'N' TO WS-FOUND
|
|
PERFORM VARYING WS-K FROM 1 BY 1
|
|
UNTIL WS-K > WS-SEEN-COUNT
|
|
IF WS-SEEN-USED(WS-K) = 'Y' AND
|
|
WS-SEEN-VAL(WS-K) = WS-CURR-VAL
|
|
MOVE 'Y' TO WS-FOUND
|
|
MOVE WS-SEEN-COUNT TO WS-K
|
|
END-IF
|
|
END-PERFORM.
|
|
|
|
*>- -----------------------------------------------------------
|
|
*> PRINT-FAREY-LIST: outputs "Fi: [a/b, c/d, ...]"
|
|
*>- -----------------------------------------------------------
|
|
PRINT-FAREY-LIST.
|
|
MOVE SPACES TO WS-OUT-LINE
|
|
MOVE 1 TO WS-POS
|
|
|
|
MOVE WS-I TO WS-EDIT-I
|
|
STRING 'F' DELIMITED SIZE
|
|
FUNCTION TRIM(WS-EDIT-I LEADING) DELIMITED SIZE
|
|
': [' DELIMITED SIZE
|
|
INTO WS-OUT-LINE
|
|
WITH POINTER WS-POS
|
|
END-STRING
|
|
|
|
PERFORM VARYING WS-K FROM 1 BY 1
|
|
UNTIL WS-K > WS-FRAC-COUNT
|
|
|
|
MOVE SPACES TO WS-FRAC-STR
|
|
MOVE WS-NUM(WS-K) TO WS-EDIT-NUM
|
|
STRING
|
|
FUNCTION TRIM(WS-EDIT-NUM LEADING) DELIMITED SIZE
|
|
'/' DELIMITED SIZE
|
|
INTO WS-FRAC-STR
|
|
END-STRING
|
|
MOVE WS-DEN(WS-K) TO WS-EDIT-NUM
|
|
STRING
|
|
FUNCTION TRIM(WS-FRAC-STR TRAILING) DELIMITED SIZE
|
|
FUNCTION TRIM(WS-EDIT-NUM LEADING) DELIMITED SIZE
|
|
INTO WS-FRAC-STR
|
|
END-STRING
|
|
|
|
IF WS-K < WS-FRAC-COUNT
|
|
STRING
|
|
FUNCTION TRIM(WS-FRAC-STR TRAILING) DELIMITED
|
|
SIZE
|
|
', ' DELIMITED
|
|
SIZE
|
|
INTO WS-OUT-LINE
|
|
WITH POINTER WS-POS
|
|
END-STRING
|
|
ELSE
|
|
STRING
|
|
FUNCTION TRIM(WS-FRAC-STR TRAILING) DELIMITED
|
|
SIZE
|
|
INTO WS-OUT-LINE
|
|
WITH POINTER WS-POS
|
|
END-STRING
|
|
END-IF
|
|
|
|
END-PERFORM
|
|
|
|
STRING ']' DELIMITED SIZE
|
|
INTO WS-OUT-LINE
|
|
WITH POINTER WS-POS
|
|
END-STRING
|
|
|
|
DISPLAY FUNCTION TRIM(WS-OUT-LINE TRAILING).
|
|
|
|
*>- -----------------------------------------------------------
|
|
*> PRINT-FAREY-COUNT: outputs "Fi: N members"
|
|
*>- -----------------------------------------------------------
|
|
PRINT-FAREY-COUNT.
|
|
MOVE WS-I TO WS-EDIT-I
|
|
MOVE WS-FRAC-COUNT TO WS-EDIT-CNT
|
|
DISPLAY 'F'
|
|
FUNCTION TRIM(WS-EDIT-I LEADING)
|
|
': '
|
|
FUNCTION TRIM(WS-EDIT-CNT LEADING)
|
|
' members'.
|