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

Replies are listed 'Best First'.
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
      sub k { $_="000"|"@{[pop]}";/495/?0:1+k(-($_=join('',sort/./g)+reverse) }

        Verrrry cool idea... this can actually come down to 56:
        sub k { $_="000"|"@_";/495/?0:1+k(-($_=join'',sort/./g)+reverse) }
        The interesting thing about this is that it's not the same as right-formatting the number via sprintf, since the 0 goes to the back, but it doesn't matter because the digits are reordered anyway.
                       s aamecha.s a..a\u$&owag.print
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 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 mr.nick (Chaplain) on Jun 17, 2001 at 04:33 UTC
    Aarrrgghhhh!!! I'm going crazy here. I can't seem to figure out why something is working the way it is; could any of you help me? I left all my debugging print statements there so that you can run it yourself and see the same results.
    sub b { print 'args=',join(",",@_),"\n"; $,=pop()-pop(); print ", = $,\n"; $x=join'',sort split//,$,; print "x = '$x'\n"; ## the line below doesn't seem to work!! @_=map{scalar reverse($_),$_ } $x; print "\@_ = ",join(",",@_),"\n"; print "\n"; $,==495?0:1+b(@_); } sub c { @a=map{ scalar reverse($_),$_ } pop; print join(",",@a),"\n"; } c(312); b(312); ==== Results when run< ==== 213,312 ## this is c() args=312 ## this is b() , = 312 x = '123' @_ = 312321,123312
    For some reason, the map statement in b() is resulting in that strange "312321,123312" results ... which for the life of me, I can't figure out why.

    I have a feeling it's something stupid, but I can't see it. Can anyone else?

    Update: God, I love this place. You write a technical, perl question, one that contains a user-error (such as I did, using $, as a temporary variable (golf, you know)), and you get down voted as much as upvoted. This node of mine has bounced from -1 to 1 so many times my head is spinning. So at what point is a question stupid enough that you shouldn't ask? I seem to remember quite a few people having on their tag lines, and on their tongues, the phrase of "Ask a silly question, be a fool for a minute, don't ask a silly question and be a fool forever.". I guess that doesn't always apply, huh?</rant>

    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:
      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 ...

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 tachyon (Chancellor) on Jun 17, 2001 at 10:54 UTC

    Here's mine at 55.



    sub a { ++$a;$_=join"",sort pop=~/./g;$_!=459?a(-$_+reverse):$a }

    Shave 1 for 54, and I'm out

    sub a { ++$a;($_=join"",sort pop=~/./g)!=459?a(-$_+reverse):$a }
      This doesn't work for a lot of numbers, because you're checking AFTER the sort, for 459, which could've been 459,495,954,945,549, or 594 before the sort. your code gets the right answer when it was anything EXCEPT 495 before the sort.
      For example, 247:

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

      your code produces 2.

        Good point, what can I say, seemed like a good idea at the time. The thinking was that any combination of 4,5,9 will sort to 954 and reverse to 459 so the timing of the sort was not important. As you note this breaks down in some cases. The QA was a bit suboptimal - I just bunged in the two examples and when they worked...

        Drat! I knew sneaking in a solution shorter than MeowChow was to good to be true :-)



      Nice... I can shave off four chars by taking off that $a variable. It still doesn't handle numbers like 100 correctly though; but so far only MeowChow's and mine, where I merely saved a few chars from MeowChow's solution, do. Here is your improved code, weighing in at a respectable 50 chars:
      sub a { ($_=join"",sort pop=~/./g)!=459?1+a(-$_+reverse):1 #2345678901234567890123456789012345678901234567890 }

      The 15 year old, freshman programmer,
      Stephen Rawls