home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l360 / 3.ddi / DIOPHANT.@BL / DIOPHANT.CBL
Encoding:
Text File  |  1991-04-08  |  4.7 KB  |  144 lines

  1.       $set ans85 noosvs mf
  2.  
  3.         PROGRAM-ID. DIOPHANT.
  4.       ******************************************************************
  5.       *
  6.       *              (C) Micro Focus Ltd. 1989
  7.       *
  8.       *                     DIOPHANT.CBL
  9.       *
  10.       * DIOPHANTINE - solve linear equation Ax + By = C
  11.       *                 for integers x and y.
  12.       *
  13.       * Method:
  14.       *         if A > B
  15.       *             swap A and B
  16.       *         fi
  17.       *
  18.       *         when A = 0
  19.       *             set x = 0, y = C/B as solution, and fail if non-integer
  20.       *         when A = 1
  21.       *             set x = C, y = 0 as solution
  22.       *         otherwise
  23.       *             let D = largest integer < (B/A)
  24.       *             let E = largets integer < (C/A)
  25.       *             let F = B - A*D
  26.       *             let G = C - A*E
  27.       *             then Ax + By = C becomes
  28.       *                 Ax + (F + A*D)y = (G + A*E)
  29.       *             so   x + (F/A + D)y = (G/A + E)
  30.       *             and (F/A)y + v = G/A   (since everything else is integral)
  31.       *             so solve
  32.       *                 Fy + Av = G for integers y and v
  33.       *
  34.       *             in COBOL terms:
  35.       *
  36.       *             divide B by A giving D remainder F
  37.       *             divide C by A giving E remainder G
  38.       *             solve Av + Fw = G for integers v and w
  39.       *             set x = E - Dw + v, y = w as solution
  40.       *
  41.       *         if swapped
  42.       *             swap x and y
  43.       *         fi
  44.       *
  45.       *
  46.       ******************************************************************
  47.         WORKING-STORAGE SECTION.
  48.         01  InitA   PIC s9(9) comp-5.
  49.         01  InitB   PIC s9(9) comp-5.
  50.         01  InitC   PIC s9(9) comp-5.
  51.         01  SolvX   PIC s9(9) comp-5.
  52.         01  SolvY   PIC s9(9) comp-5.
  53.         01  FailFg  PIC X.
  54.             88      OK  VALUE 'Y'.
  55.             88      BAD VALUE 'N'.
  56.             88      TRY VALUE '?'.
  57.         LOCAL-STORAGE SECTION.
  58.         01  D       PIC s9(9) comp-5.
  59.         01  E       PIC s9(9) comp-5.
  60.         01  F       PIC s9(9) comp-5.
  61.         01  G       PIC s9(9) comp-5.
  62.         01  V       PIC s9(9) comp-5.
  63.         01  TEMP    PIC s9(9) comp-5.
  64.         LINKAGE SECTION.
  65.         01  A       PIC s9(9) comp-5.
  66.         01  B       PIC s9(9) comp-5.
  67.         01  C       PIC s9(9) comp-5.
  68.         01  X       PIC s9(9) comp-5.
  69.         01  Y       PIC s9(9) comp-5.
  70.         PROCEDURE DIVISION.
  71.         MAIN SECTION.
  72.             DISPLAY "Solve Ax + By = C for integers x and y"
  73.             DISPLAY "Enter value for A: " with no advancing
  74.             ACCEPT InitA
  75.             DISPLAY "Enter value for B: " with no advancing
  76.             ACCEPT InitB
  77.             DISPLAY "Enter value for C: " with no advancing
  78.             ACCEPT InitC
  79.             SET TRY TO TRUE
  80.             CALL 'SOLVE' USING BY VALUE InitA InitB InitC
  81.                                BY REFERENCE SolvX SolvY
  82.  
  83.             IF OK
  84.                 DISPLAY "Solution is: x = " SolvX ", y = " SolvY
  85.             ELSE
  86.                 DISPLAY "No Solution exists."
  87.             END-IF
  88.             STOP RUN.
  89.  
  90.         SOLVE-DIOPHANTINE SECTION.
  91.         ENTRY 'SOLVE' USING BY VALUE A B C BY REFERENCE X Y.
  92.  
  93.             IF A > B
  94.       *     Use TEMP as a flag to indicate swapped or not.
  95.                 MOVE 1 TO TEMP
  96.                 CALL 'SWAP2' USING A B
  97.             ELSE
  98.                 MOVE 0 TO TEMP
  99.             END-IF
  100.  
  101.             EVALUATE A
  102.                 WHEN 0
  103.                     DIVIDE C BY B GIVING D REMAINDER E
  104.                     IF E = 0
  105.                         MOVE 0 TO X
  106.                         MOVE D TO Y
  107.                         SET OK TO TRUE
  108.                     ELSE
  109.       *     No solution exists.
  110.                         SET BAD TO TRUE
  111.                         MOVE 0 TO X, Y
  112.                     END-IF
  113.  
  114.                 WHEN 1
  115.                     MOVE C TO X
  116.                     MOVE 0 TO Y
  117.                     SET OK TO TRUE
  118.  
  119.                 WHEN OTHER
  120.       *     We must delve deeper to find a solution.
  121.                     DIVIDE B BY A GIVING D REMAINDER F
  122.                     DIVIDE C BY A GIVING E REMAINDER G
  123.  
  124.                     CALL 'SOLVE' USING BY VALUE A F G BY REFERENCE v Y
  125.  
  126.                     COMPUTE X = E - ( D * Y ) + v
  127.  
  128.             END-EVALUATE
  129.  
  130.             IF TEMP = 1
  131.                 CALL 'SWAP2' USING X Y
  132.             END-IF
  133.  
  134.             EXIT PROGRAM.
  135.  
  136.  
  137.       * Second level program to swap 2 variables using local temp variable.
  138.         SWAPPER SECTION.
  139.         ENTRY 'SWAP2' USING X Y.
  140.             MOVE X    TO TEMP
  141.             MOVE Y    TO X
  142.             MOVE TEMP TO Y
  143.             EXIT PROGRAM.
  144.