Discussion on: Challenge: find 'Kaprekar numbers'

View post

OK - this was way more of a rabbit hole than I thought... :) Here's two, new (F#) and old (COBOL). Both of these work within the constraints of the initial challenge, but will fail outside of that; had I not spent the amount of time I already spent on these, I might have at least made the F# version be able to handle others.

p.s. 0 also fits the description from the tweet! (0² = 0; 00 = 0 + 0 = 0; 0 = 0)

F#

[<EntryPoint>]
let main _ =
  Seq.initInfinite (fun nbr ->
    let square = nbr * nbr
    let split =
      match square with
      | _ when square >= 10000 -> 1000
      | _ when square >= 100 -> 100
      | _ -> 10
    let topHalf = square / split
    let bottomHalf = square % split
    topHalf + bottomHalf = nbr, nbr)
  |> Seq.filter fst
  |> Seq.skip 1
  |> Seq.take 8
  |> Seq.map (fun pair -> (snd >> string) pair)
  |> Seq.reduce (fun acc nbr -> sprintf "%s, %s" acc nbr)
  |> System.Console.WriteLine
  0

COBOL

(Free format, "*>" denotes a comment)

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.

Daniel J. Summers • Nov 18 '17

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.

Daniel J. Summers • Nov 18 '17

Holy cow - the formatter knows COBOL! If I'd used fixed format, it wouldn't even look weird.