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.
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
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.
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.
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 -৯০,১২০
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);
1 liner: Use a little loop whith 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 group2 on the beginning of $number
-> Followed is ignored
Substitution
$1,$2
-> Put a seperator sign (,) between group 1 and 2
-> The rest remains unchanged
So if you have 12345.67 the numers 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.
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).
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) );
}
}
Did somebody say Perl?
perl -pe '1while s/(\d+)(\d{3})/$1,$2/'
This works for any integer.
# 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))));
}
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.
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;
}
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)
I need this script to split on capital letters and numbers. I've got the split on capital letters part working but I can't seem to figure out the number side of it.
Needed result: Hvac System 8000 Series :: Heating System 8000 Series :: Boilers
#!/usr/bin/perl
print "Content-type: text/html\n\n";
use CGI qw(:standard);
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
use strict;
my $Last_URL = "HvacSystem8000Series/HeatingSystem8000Series/Boilers";
my ($Cat,$Sub1,$Sub2) = split(/\//, $Last_URL, 3);
if ($Sub2) {
$Last_URL = "<b>$Cat :: $Sub1 :: $Sub2</b>";
}
else {
$Last_URL = "<b>$Cat :: $Sub1</b>";
}
my #Last_URL = $Last_URL =~ s/(.)([A-Z][^A-Z][^0-9])/$1 $2/g;
print "$Last_URL";
A few s/// transformations will give you what you need:
for ($Last_URL) {
s/ ([a-z]) ([A-Z0-9]) / "$1 $2" /egx; # Foo123 -> Foo 123
s/ ([0-9]) ([A-Z]) / "$1 $2" /egx; # 123Bar -> 123 Bar
s! / ! " :: " !egx; # / -> " :: "
}
print $Last_URL, "\n";
I suggest you just use a regular expression match to find all the required "words" within the string and then join them with spaces. This program demonstrates. It counts / as a word, so these can just be substituted for double colons to complete the process
use strict;
use warnings;
my $Last_URL = "HvacSystem8000Series/HeatingSystem8000Series/Boilers";
(my $string = join ' ', $Last_URL =~ m<[A-Z][a-z]*|\d+|/>g) =~ s|/|::|g;
print $string;
output
Hvac System 8000 Series :: Heating System 8000 Series :: Boilers
Like pilcrow's answer but, you know, different
#!/usr/bin/env perl
use strict;
use warnings;
my $string = "HvacSystem8000Series/HeatingSystem8000Series/Boilers";
$string =~ s/(?<=\p{Ll})(?=\p{Lu}|\pN)/ /g;
$string =~ s/(?<=\pN)(?=\p{Lu})/ /g;
$string =~ s'/' :: 'g;
print "$string\n";
use strict;
use warnings;
my $newPasswd = 'abc123';
my #lines = ( "pwd = abc", "pwd=abc", "password=def", "name= Mike" );
my %passwordMap = (
'pwd(\\s*)=.*' => 'pwd\\1= $newPasswd',
'password(\\s*)=.*' => 'password\\1= $newPasswd',
);
print "#lines\n";
foreach my $line (#lines) {
while ( my ( $key, $value ) = each(%passwordMap) ) {
if ( $line =~ /$key/ ) {
my $cmdStr = "\$line =~ s/$key/$value/";
print "$cmdStr\n";
eval($cmdStr);
last;
}
}
}
print "#lines";
run it will give me the correct results:
pwd = abc pwd=abc password=def name= Mike
$line =~ s/pwd(\s*)=.*/pwd\1= $newPasswd/
\1 better written as $1 at (eval 2) line 1 (#1)
$line =~ s/password(\s*)=.*/password\1= $newPasswd/
\1 better written as $1 at (eval 3) line 1 (#1)
pwd = abc123 pwd=abc password= abc123 name= Mike
I don't want to see the warnings, tried to use $1 instead of \1, but it does not work. What should I do? Thanks a lot.
\1 is a regex pattern that means "match what was captured by the first set of capturing parens." It makes absolutely no sense to use that in a replacement expression. To get the string captured by the first set of capturing parens, use $1.
$line =~ s/pwd(\s*)=.*/pwd\1= $newPasswd/
should be
$line =~ s/pwd(\s*)=.*/pwd$1= $newPasswd/
so
'pwd(\\s*)=.*' => 'pwd\\1= $newPasswd',
'password(\\s*)=.*' => 'password\\1= $newPasswd',
should be
'pwd(\\s*)=.*' => 'pwd$1= $newPasswd',
'password(\\s*)=.*' => 'password$1= $newPasswd',
or better yet
qr/((?:pwd|password)\s*=).*/ => '$1= $newPasswd',
I see a lot of repetition in your code.
Assuming you're using Perl 5.10 or later, this is how I would have written your code.
use strict;
use warnings;
use 5.010;
my $new_pass = 'abc123';
my #lines = ( "pwd = abc", "pwd=abc", "password=def", "name= Mike" );
my #match = qw'pwd password';
my $match = '(?:'.join( '|', #match ).')';
say for #lines;
say '';
s/$match \s* = \K .* /$new_pass/x for #lines;
# which is essentially the same as:
# s/($match \s* =) .* /$1$new_pass/x for #lines;
say for #lines;
Assuming that the pattern of your pattern matching map stays the same, why not get rid of it and say simply:
$line =~ s/\s*=.*/=$newPassword/
Could anyone tel me what is the mistake? As the program is for finding the substrings in a given string and count there number of occurrences for those substrings. but the substring must check the occurrences for every three alphabets.
for eg: String: AGAUUUAGA (i.e. for AGA, UUU, AGA)
output: AGA-2
UUU-1
print"Enter the mRNA Sequence\n";
$count=0;
$count1=0;
$seq=<>;
chomp($seq);
$p='';
$ln=length($seq);
$j=$ln/3;
for($i=0,$k=0;$i<$ln,$k<$j;$k++) {
$fra[$k]=substr($seq,$i,3);
$i=$i+3;
if({$fra[$k]} eq AGA) {
$count++;
print"The number of AGA is $count";
} elseif({$fra[$k]} eq UUU) {
$count1++;
print" The number of UUU is $count1";
}
}
This is a Perl FAQ:
perldoc -q count
This code will count the occurrences of your 2 strings:
use warnings;
use strict;
my $seq = 'AGAUUUAGA';
my $aga_cnt = () = $seq =~ /AGA/g;
my $uuu_cnt = () = $seq =~ /UUU/g;
print "The number of AGA is $aga_cnt\n";
print "The number of UUU is $uuu_cnt\n";
__END__
The number of AGA is 2
The number of UUU is 1
If you use strict and warnings, you will get many messages pointing out errors in your code.
Here is another approach which is more scalable:
use warnings;
use strict;
use Data::Dumper;
my $seq = 'AGAUUUAGA';
my %counts;
for my $key (qw(AGA UUU)) {
$counts{$key} = () = $seq =~ /$key/g;
}
print Dumper(\%counts);
__END__
$VAR1 = {
'AGA' => 2,
'UUU' => 1
};
Have a try with this, that avoids overlaps:
#!/usr/bin/perl
use strict;
use warnings;
use 5.10.1;
use Data::Dumper;
my $str = q!AGAUUUAGAGAAGAG!;
my #list = $str =~ /(...)/g;
my ($AGA, $UUU);
foreach(#list) {
$AGA++ if $_ eq 'AGA';
$UUU++ if $_ eq 'UUU';
}
say "number of AGA is $AGA and number of UUU is $UUU";
output:
number of AGA is 2 and number of UUU is 1
This is an example of how quickly you can get things done in Perl. Grouping the strands together as a alternation is one way to make sure there is no overlap. Also a hash is a great way to count occurrences of they key.
$values{$_}++ foreach $seq =~ /(AGA|UUU)/g;
print "AGA-$values{AGA} UUU-$values{UUU}\n";
However, I generally want to generalize it to something like this, thinking that this might not be the only time you have to do something like this.
use strict;
use warnings;
use English qw<$LIST_SEPARATOR>;
my %values;
my #spans = qw<AGA UUU>;
my $split_regex
= do { local $LIST_SEPARATOR = '|';
qr/(#spans)/
}
;
$values{$_}++ foreach $seq =~ /$split_regex/g;
print join( ' ', map { "$_-$values{$_}" } #spans ), "\n";
Your not clear on how many "AGA" the string "AGAGAGA" contains.
If 2,
my $aga = () = $seq =~ /AGA/g;
my $uuu = () = $seq =~ /UUU/g;
If 3,
my $aga = () = $seq =~ /A(?=GA)/g;
my $uuu = () = $seq =~ /U(?=UU)/g;
If I understand you correctly (and certainly that is questionable; almost every answer so far is interpreting your question differently than every other answer):
my %substring;
$substring{$1}++ while $seq =~ /(...)/;
print "There are $substring{UUU} UUU's and $substring{AGA} AGA's\n";
Are there any functions are available for converting all newlines in a string to spaces?
For example:
$a = "dflsdgjsdg
dsfsd
gf
sgd
g
sdg
sdf
gsd";
The result is am looking for is:
$a = "dflsdgjsdg dsfsd gf sgd g sdg sdf gsd"
I would recommend restricting the use of $a and $b to sort routines only.
For your question, tr/// is more appropriate than s///:
#!/usr/bin/perl
use strict;
use warnings;
my $x = q{dflsdgjsdg
dsfsd
gf
sgd
g
sdg
sdf
gsd};
$x =~ tr{\n}{ };
print $x, "\n";
__END__
Output:
C:\Temp> ttt
dflsdgjsdg dsfsd gf sgd g sdg sdf gsd
Update: I do not think TMTOWTDI justifies using anything other than tr/// here. First, semantically, what the OP is asking for is transliteration and therefore it makes sense to use transliteration. Second, at least on my Windows XP laptop with 5.10, the benchmark module provides a clear contrast:
#!/usr/bin/perl
use strict;
use warnings;
use Benchmark qw( cmpthese );
use constant LONG_STRING => "\n" x 1_000_000;
cmpthese -10, {
subst => sub {
my $x = LONG_STRING;
$x =~ s{\n}{ }g;
return;
},
split_join => sub {
my $x = LONG_STRING;
$x = join ' ', split /\n/, $x;
return;
},
tr => sub {
my $x = LONG_STRING;
$x =~ tr{\n}{ };
return;
},
nop => sub {
my $x = LONG_STRING;
return;
}
};
__END__
Results:
Rate split_join subst tr nop
split_join 0.354/s -- -85% -100% -100%
subst 2.40/s 578% -- -99% -100%
tr 250/s 70514% 10320% -- -92%
nop 3025/s 854076% 125942% 1110% --
One more update: I should point out that the relative performance of tr/// to s/// depends on the size and composition of the source string. The case I chose for illustration here is definitely extreme. Using less extreme input strings, the performance ratio seems to be closer to 15:1 rather than 100:1 ;-)
Try the following program:
#!/usr/bin/perl
use strict;
use warnings;
my $a = 'dflsdgjsdg
dsfsd
gf
sgd
g
sdg
sdf
gsd';
$a =~ s{\n}{ }g;
print $a;
The program simply uses a regular expression to search for newlines and replace them with spaces globally.
how about substitition
$a = "dflsdgjsdg
dsfsd
gf
sgd
g
sdg
sdf
gsd";
$a =~ s/\n/ /g;
print $a;
or using split and join
#s =split /\n/,$a;
print join(" ",#s);
This is a nice question because it embodies Perl's TMTOWTDI.
The answers above give 3 options, all of which are valid. I'll summarize them here.
The string is:
$a = "dflsdgjsdg
dsfsd
gf
sgd
g
sdg
sdf
gsd";
substitution
$a =~ s/\n/ /g;
transliteration
$a =~ tr/\n/ /;
split/join
$a = join " ", split "\n", $a;