Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid

(Golf) Kaprekar's Process

by srawls (Friar)
on Jun 16, 2001 at 21:48 UTC ( #89075=perlmeditation: print w/ replies, xml ) Need Help??

We haven't had a golf in a while, so here it goes:

The problem is to write a perl golf (a solution in the fewest characters) to solve Kaprekar's Process. Kaprekar's Process basically states: "Take any number and arrange its digits in descending order and in ascending order and subtract. Repeat with the result. Ad Infinitum." Eventually, all 3 digit numbers (except when all digits are the same, like 333) will end up as 495. This is called Kaprekar's Constant. The program will return the number of steps it takes to get to 495.

Here is an example series:

Input: 213
1: 321 - 123 = 198
2: 981 - 189 = 792
3: 972 - 279 = 693
4: 963 - 369 = 594
5: 954 - 459 = 495


Your subrutine will recieve a 3 digit number; you may assume it is positive and that all the digits are not the same (i.e. you do not have to worry about error handling).


The return value will merely be the number of steps it took to reach 495; in the example above, it was 5. Here are a few sample calls: (assume sub name is a, it really doesn't matter what you name yours though)

print a(213) #prints 5
print a(258) #prints 2

Here is my attempt, weighing in at a bloated 60 chars:

sub a { return$i if$_[0]==495; $a=join'',sort{$a<=>$b}split//,pop; $i++; a((reverse$a)-$a) }

P.S. If it is still unclear to you, visit this website and look for Kaprekar's Process on it.

The 15 year old, freshman programmer,
Stephen Rawls

Comment on (Golf) Kaprekar's Process
Download Code
Re: (Golf) Kaprekar's Process
by larryk (Friar) on Jun 16, 2001 at 22:03 UTC

    I make your original 79 chars.

    sub a { return$i if$_[0]==495;$a=join'',sort{$a<=>$b}split//,pop;$i++;a((rever +se$a)-$a) #23456789_123456789_123456789_123456789_123456789_123456789_123456789_ +123456789 }

    if you are sorting single digits then perl's default alphanumeric sort will give the same result as explicitly defining a numeric sort. #71

    update: just realised you can use $_ instead of $a. #69

    "Argument is futile - you will be ignorralated!"

      Humm, I just counted manually and you're right, it is 79. I wonder why this prints 60:
      print length("return$i if$_[0]==495;$a=join'',sort{$a<=>$b}" ."split//,pop;$i++;a((reverse$a)-$a)");
      Anyway, nice improvements, I should've caught that sort one : )

      Update:Ooops, thanks MeowChow.

      The 15 year old, freshman programmer,
      Stephen Rawls

        You're double-quoting the code, which means that the variables are getting interpolated into undef 0-length strings.
                       s aamecha.s a..a\u$&owag.print
        And I can take it down a litter further massaging your code into this:
        sub g{ # 1 2 3 4 5 6 + 7 # 12345678901234567890123456789012345678901234567890123456789012345678 +9012 return$,if($_=pop)==495;$_=join'',sort split//,$_;$,++;g((reverse)-$ +_) }
        But I can't do one on my own... my own solution came in at 83 :(

        mr.nick ...

Re: (Golf) Kaprekar's Process
by MeowChow (Vicar) on Jun 16, 2001 at 23:00 UTC
    The answers given thus far all fail on numbers (such as 100 and 211) which generate two-digit numbers in their intermediate results. Here's a good test for this particular golf:
    $| = 1; for (100..999) { next if /(.)\1\1/; print "$_ : ", k($_), $/; }
    And here's a correct solution at 74 68 63 chars:
    sub k { $_=sprintf"%03d",pop;/495/?0:1+k(-($_=join'',sort/./g)+reverse) }
                   s aamecha.s a..a\u$&owag.print

                       s aamecha.s a..a\u$&owag.print
Re: (Golf) Kaprekar's Process
by ZZamboni (Curate) on Jun 16, 2001 at 23:08 UTC
    Here's my take, a non-recursive version, at 66 characters:
    sub a { $_=shift;do{$_=join'',sort/./g;$i++}while($_=(reverse)-$_)!=495;$i #23456789012345678901234567890123456789012345678901234567890123456 }
    Update #1: Ah, by borrowing an idea from MeowChow's solution, I can shave off one character :-)
    sub a { $_=shift;do{$_=join'',sort/./g;$_=(reverse)-$_;$i++}until/495/;$i #2345678901234567890123456789012345678901234567890123456789012345 }
    Update #2: Changed shift to pop, another 2 characters off. Thanks srawls!
    sub a { $_=pop;do{$_=join'',sort/./g;$_=(reverse)-$_;$i++}until/495/;$i #23456789012345678901234567890123456789012345678901234567890123 }


      ZZamboni: pop is shorter than shift; you can take two chars off of that.

      The 15 year old, freshman programmer,
      Stephen Rawls

Re: (Golf) Kaprekar's Process
by srawls (Friar) on Jun 16, 2001 at 23:19 UTC
    I've taken all the advice and improved my old one to this, 61 char solution (I counted manually this time : ). Oh, and it handles 0s in numbers correctly (well, I don't know if it's correct, but it doesn't freeze up like before). Here it is:
    sub a { $_=pop;/495/&&$i||do{$_=join'',sort/./g;$i++;a(reverse()-$_)} #234567890123456789012345678901234567890123456789012345678901 }

    Update:Changed code from 65 chars to 61.

    The 15 year old, freshman programmer,
    Stephen Rawls

      ... it handles 0s in numbers correctly
      There are many such cases, though I misstated the problem somewhat. It isn't so much zeroed digits, as intermediate two-digit results. So far, all the solutions in this thread (except my own :) fail on many three-digit numbers.

      Also, in Golf, it may be ok to violate strict, but your subroutine should be re-runnable (ie. $i should be reset somewhere).

                     s aamecha.s a..a\u$&owag.print
        Oh, I see: 100 - 001 is 99; 99 - 99 is zero. Now we've got an infinite loop. Just out of curiosity, how would you solve that? Your solution gives 6 (which is most likely right), I just don't see how.

        The 15 year old, freshman programmer,
        Stephen Rawls

Re: (Golf) Kaprekar's Process
by mr.nick (Chaplain) on Jun 17, 2001 at 04:33 UTC



    mr.nick ...

      That's odd...I tried running this on my system. First I just did the map statement, and assigned 123 to x. This worked perfectly. So, I got a little confused as to why it worked for me, and not for you, so I tried to run the whole script. However--and this is quite a big however--it resulted in an infinite loop, printing out large, negative numbers on my machine. Is this the exact code?
        Oh, it loops indefinately, all right. I ran it | head. And yes, that is the exact code.

        If you grab the top of the output, do the see the odd value of @_ = 312321,123312? I would think that @_ would contain the same value as the output from c() since it uses the same map statement (- the pop). But I can't shake the feeling I'm missing something simple here (as I often do) :)

        Btw, I split the subroutine up into individual statements for debugging. It used many fewer temporary variables at first.

        mr.nick ...

      Your map statement is working fine. The problem is that you have assigned a value to "$,", which is the output field separator variable. Its value is printed when you use a comma in a print statement.
      $,="bar"; print "foo","baz";
      will output:
Re: (Golf) Kaprekar's Process
by tachyon (Chancellor) on Jun 17, 2001 at 10:54 UTC

    Here's mine at 55.




    Shave 1 for 54, and I'm out


      The 15 year old, freshman programmer,
      Stephen Rawls

      For example, 247:

      1: 742-247 = 495
      the answer is 1.

      your code produces 2.





Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://89075]
Approved by root
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (3)
As of 2014-12-28 18:19 GMT
Find Nodes?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?

    Results (182 votes), past polls