Perl printf to use commas as thousands-separator

Question

Using awk, I can print a number with commas as thousands separators.
(with a export LC_ALL=en_US.UTF-8 beforehand).

awk 'BEGIN{printf("%\047d\n", 24500)}'

24,500

I expected the same format to work with Perl, but it does not:

perl -e 'printf("%\047d\n", 24500)'

%'d

The Perl Cookbook offers this solution:

sub commify {
    my $text = reverse $_[0];
    $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
    return scalar reverse $text;
}

However I am assuming that since the printf option works in awk, it should also work in Perl.

Answer 1

Most of these solutions fail with real numbers that have a decimal fraction or one that is longer than three decimal digits; or they are overly complex. Here are two solutions, both use the /e perl regular expression modifier in s/PATTERN/CODE/e syntax. The idea is to extract with grouping to $1 the integer component leaving the decimal fraction untouched, and then use either format_number() from Number::Format, or a regex in the CODE part of s///, to wit:

use v5.14;
use strict;
use Number::Format 'format_number';

my $nbr = 'This is a real number, 834569.334656';
(my $res = $nbr) =~ s{ (\d+) }{ format_number($1) }xe;
say $res;

or:

(my $res = $nbr) =~ s{ (\d+) }{
    $1 =~ s/ (?<=\d) (?= (?:\d{3} )+ (?!\d) ) /,/xrg; }ex;
say $res;

Running either of these fragments yields:

This is a real number, 834,569.334656

/xrg is: x = ignore white-space; r = return substitution and leave original string untouched, necessary because $1 is immutable; g = replace globally.

Answer 2

1 liner: Use a little loop with a regex:

while ($number =~ s/^(\d+)(\d{3})/$1,$2/) {}

---

Example:

use strict;
use warnings;

my @numbers = (
    12321,
    12.12,
    122222.3334,
    '1234abc',
    '1.1',
    '1222333444555,666.77',
);
for (@numbers) {
    my $number = $_;
    while ($number =~ s/^(\d+)(\d{3})/$1,$2/) {}
    print "$_  ->  $number\n";
}

Output:

12321  ->  12,321
12.12  ->  12.12
122222.3334  ->  122,222.3334
1234abc  ->  1,234abc
1.1  ->  1.1
1222333444555,666.77  ->  1,222,333,444,555,666.77

---

Pattern:

(\d+)(\d{3})
    -> Take all numbers but the last 3 in group 1
    -> Take the remaining 3 numbers in group 2 on the beginning of $number
    -> Followed is ignored

Substitution

$1,$2
    -> Put a separator sign (,) between group 1 and 2
    -> The rest remains unchanged

So if you have 12345.67 the numbers the regex uses are 12345. The '.' and all followed is ignored.

1. run (12345.67):
  -> matches: 12345
  -> group 1: 12,
     group 2: 345
  -> substitute 12,345
  -> result: 12,345.67
2. run (12,345.67):
  -> does not match!
  -> while breaks.

Answer 3

With modern Perls:

$commafied = scalar reverse (reverse($number) =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/gr);

s/.../.../r is "non destructive" substitution, returning the modified string as the result.

Answer 4

Here's an elegant Perl solution I've been using for over 20 years :)

1 while $text =~ s/(.*\d)(\d\d\d)/$1\.$2/g;

And if you then want two decimal places:

$text = sprintf("%0.2f", $text);

Answer 5

Did somebody say Perl?

perl -pe '1while s/(\d+)(\d{3})/$1,$2/'

This works for any integer.

Answer 6

Parting from @Laura's answer, I tweaked the pure perl, regex-only solution to work for numbers with decimals too:

while ($formatted_number =~ s/^(-?\d+)(\d{3}(?:,\d{3})*(?:\.\d+)*)$/$1,$2/) {};

Of course this assumes a "," as thousands separator and a "." as decimal separator, but it should be trivial to use variables to account for that for your given locale(s).

Answer 7

A more perl-ish solution:

$a = 12345678;                 # no comment
$b = reverse $a;               # $b = '87654321';
@c = unpack("(A3)*", $b);      # $c = ('876', '543', '21');
$d = join ',', @c;             # $d = '876,543,21';
$e = reverse $d;               # $e = '12,345,678';
print $e;

outputs 12,345,678.

Answer 8

Most of these answers assume that the format is universal. It isn't. CLDR uses Unicode information to figure it out. There's a long thread in How to properly localize numbers?.

CPAN has the CLDR::Number module:

#!perl
use v5.10;
use CLDR::Number;
use open qw(:std :utf8);

my $locale = $ARGV[0] // 'en';

my @numbers = qw(
    123
    12345
    1234.56
    -90120
    );

my $cldr = CLDR::Number->new( locale => $locale );

my $decf = $cldr->decimal_formatter;

foreach my $n ( @numbers ) {
    say $decf->format($n);
    }

Here are a few runs:

$ perl comma.pl
123
12,345
1,234.56
-90,120

$ perl comma.pl es
123
12.345
1234,56
-90.120

$ perl comma.pl bn
১২৩
১২,৩৪৫
১,২৩৪.৫৬
-৯০,১২০

It seems heavyweight, but the output is correct and you don't have to allow the user to change the locale you want to use. However, when it's time to change the locale, you are ready to go. I also prefer this to Number::Format because I can use a locale that's different from my local settings for my terminal or session, or even use multiple locales:

#!perl
use v5.10;
use CLDR::Number;
use open qw(:std :utf8);

my @locales = qw( en pt bn );

my @numbers = qw(
    123
    12345
    1234.56
    -90120
    );


my @formatters = map {
    my $cldr = CLDR::Number->new( locale => $_ );
    my $decf = $cldr->decimal_formatter;
    [ $_, $cldr, $decf ];
    } @locales;

printf "%10s %10s %10s\n" . '=' x 32 . "\n", @locales;

foreach my $n ( @numbers ) {
    printf "%10s %10s %10s\n",
        map { $_->[-1]->format($n) } @formatters;
    }

The output has three locales at once:

        en         pt         bn
================================
       123        123        ১২৩
    12,345     12.345     ১২,৩৪৫
  1,234.56   1.234,56   ১,২৩৪.৫৬
   -90,120    -90.120    -৯০,১২০

Answer 9

A solution that produces a localized output:

# First part - Localization
my ( $thousands_sep, $decimal_point, $negative_sign );
BEGIN {
        my ( $l );
        use POSIX qw(locale_h);
        $l = localeconv();

        $thousands_sep = $l->{ 'thousands_sep' };
        $decimal_point = $l->{ 'decimal_point' };
        $negative_sign = $l->{ 'negative_sign' };
}

# Second part - Number transformation
sub readable_number {
        my $val = shift;

        #my $thousands_sep = ".";
        #my $decimal_point = ",";
        #my $negative_sign = "-";

        sub _readable_int {
                my $val = shift;
                # a pinch of PERL magic
                return scalar reverse join $thousands_sep, unpack( "(A3)*", reverse $val );
        }

        my ( $i, $d, $r );
        $i = int( $val );
        if ( $val >= 0 ) {
                $r =  _readable_int( $i );
        } else {
                $r = $negative_sign . _readable_int( -$i );
        }
        # If there is decimal part append it to the integer result
        if ( $val != $i ) {
                ( undef, $d ) = ( $val =~ /(\d*)\.(\d*)/ );
                $r = $r . $decimal_point . $d;
        }

        return $r;
}

The first part gets the symbols used in the current locale to be used on the second part.
The BEGIN block is used to calculate the sysmbols only once at the beginning.
If for some reason there is need to not use POSIX locale, one can ommit the first part and uncomment the variables on the second part to hardcode the sysmbols to be used ($thousands_sep, $thousands_sep and $thousands_sep)

Answer 10

I used the following but it does not works as of perl v5.26.1

sub format_int
{
        my $num = shift;
        return reverse(join(",",unpack("(A3)*", reverse int($num))));
}

The form that worked for me was:

sub format_int
{
        my $num = shift;
        return scalar reverse(join(",",unpack("(A3)*", reverse int($num))));
}

But to use negative numbers the code must be:

sub format_int
{
    if ( $val >= 0 ) {
        return scalar reverse join ",", unpack( "(A3)*", reverse int($val) );
    } else {
        return "-" . scalar reverse join ",", unpack( "(A3)*", reverse int(-$val) );
    }

}

Answer 11

I realize this question was from almost 4 years ago, but since it comes up in searches, I'll add an elegant native Perl solution I came up with. I was originally searching for a way to do it with sprintf, but everything I've found indicates that it can't be done. Then since everyone is rolling their own, I thought I'd give it a go, and this is my solution.

$num = 12345678912345; # however many digits you want
while($num =~ s/(\d+)(\d\d\d)/$1\,$2/){};
print $num;

Results in:

12,345,678,912,345

Explanation: The Regex does a maximal digit search for all leading digits. The minimum number of digits in a row it'll act on is 4 (1 plus 3). Then it adds a comma between the two. Next loop if there are still 4 digits at the end (before the comma), it'll add another comma and so on until the pattern doesn't match.

If you need something safe for use with more than 3 digits after the decimal, use this modification: (Note: This won't work if your number has no decimal)

while($num =~ s/(\d+)(\d\d\d)([.,])/$1\,$2$3/){};

This will ensure that it will only look for digits that ends in a comma (added on a previous loop) or a decimal.

Answer 12

# turning above answer into a function

sub format_float
# returns number with commas..... and 2 digit decimal
# so format_float(12345.667) returns "12,345.67"
{
        my $num = shift;
        return reverse(join(",",unpack("(A3)*", reverse int($num)))) . sprintf(".%02d",int(100*(.005+($num - int($num)))));
}

sub format_int
# returns number with commas.....
# so format_int(12345.667) returns "12,345"
{
        my $num = shift;
        return reverse(join(",",unpack("(A3)*", reverse int($num))));
}

Answer 13

This is good for money, just keep adding lines if you handle hundreds of millions.

sub commify{
    my $var = $_[0];
    #print "COMMIFY got $var\n"; #DEBUG
    $var =~ s/(^\d{1,3})(\d{3})(\.\d\d)$/$1,$2$3/;
    $var =~ s/(^\d{1,3})(\d{3})(\d{3})(\.\d\d)$/$1,$2,$3$4/;
    $var =~ s/(^\d{1,3})(\d{3})(\d{3})(\d{3})(\.\d\d)$/$1,$2,$3,$4$5/;
    $var =~ s/(^\d{1,3})(\d{3})(\d{3})(\d{3})(\d{3})(\.\d\d)$/$1,$2,$3,$4,$5$6/;
    #print "COMMIFY made $var\n"; #DEBUG
    return $var;
}

Answer 14

I wanted to print numbers it in a currency format. If it turned out even, I still wanted a .00 at the end. I used the previous example (ty) and diddled with it a bit more to get this.

    sub format_number {
            my $num = shift;
            my $result;
            my $formatted_num = ""; 
            my @temp_array = (); 
            my $mantissa = ""; 
            if ( $num =~ /\./ ) { 
                    $num = sprintf("%0.02f",$num);
                    ($num,$mantissa) = split(/\./,$num);
                    $formatted_num = reverse $num;
                    @temp_array = unpack("(A3)*" , $formatted_num);
                    $formatted_num = reverse (join ',', @temp_array);
                    $result = $formatted_num . '.'. $mantissa;
            } else {
                    $formatted_num = reverse $num;
                    @temp_array = unpack("(A3)*" , $formatted_num);
                    $formatted_num = reverse (join ',', @temp_array);
                    $result = $formatted_num . '.00';
            }   
            return $result;
    }
    # Example call
    # ...
    printf("some amount = %s\n",format_number $some_amount);

I didn't have the Number library on my default mac OS X perl, and I didn't want to mess with that version or go off installing my own perl on this machine. I guess I would have used the formatter module otherwise.

I still don't actually like the solution all that much, but it does work.

Answer 15

The apostrophe format modifier is a non-standard POSIX extension. The documentation for Perl's printf has this to say about such extensions

Perl does its own "sprintf" formatting: it emulates the C function sprintf(3), but doesn't use it except for floating-point numbers, and even then only standard modifiers are allowed. Non-standard extensions in your local sprintf(3) are therefore unavailable from Perl.

The Number::Format module will do this for you, and it takes its default settings from the locale, so is as portable as it can be

use strict;
use warnings 'all';
use v5.10.1;

use Number::Format 'format_number';

say format_number(24500);

output

24,500