Discussion on: Challenge: find 'Kaprekar numbers'

[Daniel J. Summers]

OK - fixed format, just for grins...

(Fixed format: col 1-6 reserved, usually line numbers or blank; col 7 - "*" = comment, blank otherwise; col 8-11 - division/section identifiers, paragraph names, top-level data items; col 12-72 - executable code, data item sub-definitions; col 73+ - ignored)

       identification division.
         program-id. kaprekar.
       data division.
         working-storage section.
       77  current-nbr   pic 9(4)  value zeroes.
       77  square        pic 9(6)  value zeroes.
       77  split         pic 9(6)  value zeroes.
       77  top-half      pic 9(3)  value zeroes.
       77  bottom-half   pic 9(3)  value zeroes.
       77  sum-of-halves pic 9(6)  value zeroes.
       01  kap-numbers             value all zeroes.
           03  result    pic 9(3)  occurs 100 times
                                     indexed by accrue-idx,
                                                display-idx.
       77  results       pic x(80) value spaces.
       77  results-ptr   pic 9(2)  value 1.
       77  formatted-nbr pic x(3)  value spaces.
       procedure division
       . calculate-kaprekars.
           set accrue-idx to 1
           perform varying current-nbr from 1 by 1
             until current-nbr > 999
               multiply current-nbr by current-nbr giving square
      *>       Determine the split for the square
               evaluate true
                   when square >= 10000
                       move 1000 to split
                   when square >= 100
                       move 100 to split
                   when other
                       move 10 to split
               end-evaluate
      *>       Split, sum, and compare
               divide square by split giving top-half
                 remainder bottom-half
               add top-half bottom-half giving sum-of-halves
               if sum-of-halves = current-nbr
                   move current-nbr to result(accrue-idx)
                   set accrue-idx up by 1
               end-if
           end-perform
           set accrue-idx down by 1
           perform varying display-idx from 1 by 1
             until display-idx > accrue-idx
      *>       Left-justified numbers
               evaluate true
                   when result(display-idx) < 10
                       move result(display-idx)(3:1) to formatted-nbr
                   when result(display-idx) < 100
                       move result(display-idx)(2:2) to formatted-nbr
                   when other
                       move result(display-idx) to formatted-nbr
               end-evaluate
               string formatted-nbr delimited by space into results
                 with pointer results-ptr
               if display-idx not = accrue-idx
                   string ', ' into results with pointer results-ptr
               end-if
           end-perform
           display results
           goback
       .
       end program kaprekar.