in reply to Formatting a number

I've run some benchmarks against some of the solutions given and it turns out that the one I gave here using split/reverse/map/reverse performs like a dog. However, I found another way with substr that does much better. Here are the benchmarks

         Rate  Split   Molt    FAQ Cdarke PrefUN Substr
Split  8.00/s     --   -15%   -31%   -39%   -53%   -74%
Molt   9.36/s    17%     --   -19%   -29%   -45%   -70%
FAQ    11.5/s    44%    23%     --   -12%   -32%   -63%
Cdarke 13.2/s    64%    41%    14%     --   -22%   -58%
PrefUN 16.9/s   111%    80%    47%    28%     --   -46%
Substr 31.3/s   291%   234%   171%   138%    85%     --

[download]

and here is the benchmark code

use strict;
use warnings;

use Benchmark qw(cmpthese);

my @numbers;
push @numbers, int rand 1e9 for 1 .. 1000;

my $rcUseCdarke = sub
   {
       my $res = useCdarke($_) for @numbers;
   };

my $rcUseFAQ = sub
   {
       my $res = useFAQ($_) for @numbers;
   };

my $rcUseMolt = sub
   {
       my $res = useMolt($_) for @numbers;
   };

my $rcUsePrefUN = sub
   {
       my $res = usePrefUN($_) for @numbers;
   };

my $rcUseJwkrahn = sub
   {
       my $res = useJwkrahn($_) for @numbers;
   };

my $rcUseSplit = sub
   {
       my $res = useSplit($_) for @numbers;
   };

my $rcUseSubstr = sub
   {
       my $res = useSubstr($_) for @numbers;
   };

cmpthese (50,
   {
      Cdarke => $rcUseCdarke,
      FAQ => $rcUseFAQ,
      Jwkrahn => $rcUseJwkrahn,
      Molt => $rcUseMolt,
      PrefUN => $rcUsePrefUN,
      Split => $rcUseSplit,
      Substr => $rcUseSubstr
   });

sub useCdarke
{
    my $number = reverse shift;
    $number =~ s/(\d{3})/$1,/g;
    $number = reverse $number;
    return $number;
}

sub useFAQ
{
    my $number = reverse shift;
    $number =~
       s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;
    return $number;
}

sub useJwkrahn
{
    return scalar reverse join ',', unpack '(a3)*', reverse shift;
}

sub useMolt
{
    my $number = shift;
    while ($number =~ s/(\d)(\d\d\d)(?!\d)/$1,$2/) {};
    return $number;
}

sub usePrefUN
{
    my $num = reverse shift;
    my @threes = $num =~ /(.{1,3})/g;
    return scalar reverse join ',', @threes;
}

sub useSplit
{
    my $ct = 0;
    my $len = length $_[0];
    return join q{},
       reverse map
       {
           ++ $ct % 3
              ? $_
              : $ct == $len
                 ? $_
                 : ($_, q{,})
       }
       reverse split m{}, $_[0];
}

sub useSubstr
{
    my $number = shift;
    my $offset = -3;
    while (abs $offset < length $number)
    {
        substr $number, $offset , 0, q{,};
        $offset -= 4;
    }
    return $number;
}

[download]

I hope this is of interest.

Cheers,

JohnGG

Update: New benchmarks incorporating corrected split/reverse/map/reverse routine, thanks jwkrahn, and also jwkrahn's improvement to PreferredUserName's solution.

          Rate   Split    Molt     FAQ  Cdarke  PrefUN Jwkrahn  Substr
Split   7.85/s      --    -16%    -31%    -41%    -54%    -70%    -75%
Molt    9.31/s     19%      --    -19%    -31%    -45%    -64%    -70%
FAQ     11.4/s     46%     23%      --    -15%    -32%    -56%    -63%
Cdarke  13.4/s     71%     44%     17%      --    -21%    -48%    -57%
PrefUN  16.9/s    115%     81%     48%     26%      --    -35%    -45%
Jwkrahn 25.9/s    230%    178%    126%     93%     53%      --    -16%
Substr  30.9/s    293%    231%    170%    130%     83%     19%      --

[download]

Code in readmore tags revised,

Replies are listed 'Best First'.
Re^2: Formatting a number
by jwkrahn (Abbot) on Oct 17, 2006 at 01:14 UTC
    You can shave a few points off of your substr sub by taking the abs and length functions out of the loop: 
    sub useSubstr
{
    my $number = shift;
    my $length = -( 1 + length $number );
    my $offset = -3;
    while ( $offset > $length )
    {
        substr $number, $offset, 0, q{,};
        $offset -= 4;
    }
    return $number;
}

    [download]
[reply]
[d/l]
      Problem with that is the length is increasing as you insert commas from the right so it needs to be tested dynamically. Unfortunately, your modification breaks the routine.

      use strict;
use warnings;

my @nos = qw{
   1
   12
   123
   1234
   12345
   123456
   1234567
   12345678
   123456789
   1234567890
   12345678901
   123456789012
   1234567890123
   12345678901234};

printf qq{%20s\n}, useSubstr($_) for @nos;

sub useSubstr
{
    my $number = shift;
    my $length = -( 1 + length $number );
    my $offset = -3;
    while ( $offset > $length )
    {
        substr $number, $offset, 0, q{,};
        $offset -= 4;
    }
    return $number;
}

      [download]

      produces

                         1
                  12
                ,123
               1,234
              12,345
             123,456
           1,234,567
          12,345,678
         123,456,789
        1234,567,890
      12,345,678,901
     123,456,789,012
    1234,567,890,123
   12345,678,901,234

      [download]

      As you can see, it breaks out of the while too soon as it has not kept up with the increasing length of the number as the commas go in. I agree that it would be nice to factor abs and length out of the loop but can't quite see how to achieve it.

      Cheers,

      JohnGG

[reply]
[d/l]
[select]
        Right, I didn't test very much.   :-) This works correctly and appears to be about 10% faster: 
        
sub useSubstr { 
    my $number = shift;
    my $len = length $number;
    my $offset = 3;
    while ( $offset < $len ) {
        substr $number, -$offset , 0, q{,};
        $offset += 4;
        $len = length $number;
        }
    return $number;
    }

        [download]
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom