Pad string with characters - perl

I have
$data_dec = 7;
$data_bin = sprintf("%08b",data_dec);
and $data_bin is
00000111
How do I pad with "X" instead of zeros while maintaining 8-bits? Expected data:
XXXXX111

substr( sprintf( "XXXXXXX%b", $n ), -8 )
sprintf( "%8b", $n ) =~ tr/ /X/r

Related

How to compare a couple binary bytes in code?

I read a binary file and want to make sure that some specific bytes have some specific value. What's the most perl way of doing this?
my $blob = File::Slurp::read_file( 'blob.bin', {binmode=>'raw'} );
substr( $blob, 4, 4 ) == #equals what?
I want to test if bytes 5-8 equal 0x32 0x32 0x00 0x04. What should I compare the substr to?
substr( $blob, 4, 4 ) eq "\x32\x32\x00\x04"
If it's a 32-bit unsigned number, you might prefer the following:
unpack( "N", substr( $blob, 4, 4 ) ) == 0x32320004 # Big endian
unpack( "L>", substr( $blob, 4, 4 ) ) == 0x32320004 # Big endian
unpack( "L<", substr( $blob, 4, 4 ) ) == 0x04003232 # Little endian
unpack( "L", substr( $blob, 4, 4 ) ) == ... # Native endian
(Use l instead oaf L for signed 32-bit ints.)
substr can even be avoided when using unpack.
unpack( "x4 N", $blob ) == 0x32320004
You could also use a regex match.
$blob =~ /^.{4}\x32\x32\x00\x04/s
$blob =~ /^ .{4} \x32\x32\x00\x04 /sx
my $packed = pack( "N", 0x32320004 );
$blob =~ /^ .{4} \Q$packed\E /sx

sprintf pad string on right with dash

I need to pad a string on the right with dashes ('-'). e.g. convert 'M' to 'M-----'.
sprintf "%-6s", "M"; gives me 'M '. I tried printf "%-6-s", "M";, and printf "%--6s", "M";, but neither of those work...
Can this be done with sprinf and if so, how?
It can't be done with sprintf alone. (sprintf will only pad with spaces or with zeroes.)
sprintf("%-6s", $s) =~ tr/ /-/r
or
substr($s.("-" x 6), 0, 6)
or
$s . ("-" x (6-length($s)))
sprintf only supports padding with 0 and , so no. You can pad with one of those then replace the padding, but the problem with that, is that you run the risk of replacing any padding characters in the original string. For example sprintf('%-6s', ' M') =~ s/ /-/gr produces --M---.
From the FAQ:
If you need to pad with a character other than blank or zero you can
use one of the following methods. They all generate a pad string with
the x operator and combine that with $text. These methods do not
truncate $text.
Left and right padding with any character, creating a new string:
my $padded = $pad_char x ( $pad_len - length( $text ) ) . $text;
my $padded = $text . $pad_char x ( $pad_len - length( $text ) );
Left and right padding with any character, modifying $text directly:
substr( $text, 0, 0 ) = $pad_char x ( $pad_len - length( $text ) );
$text .= $pad_char x ( $pad_len - length( $text ) );
If you do it often, you could wrap it in a subroutine.
sub pad {
my ($str, $padding, $length) = #_;
my $pad_length = $length - length $str;
$pad_length = 0 if $pad_length < 0;
$padding x= $pad_length;
$str.$padding;
}
say pad('M', '-', 6);
say pad('MMMMMM', '-', 6);
say pad('12345', '-', 6);
say pad('1234567', '-', 6);
say pad(' ', '-', 6);
Output:
M-----
MMMMMM
12345-
1234567
--

Using perl to find median, mode, Standard deviation?

I have an array of numbers. What is the easiest way to calculate the Median, Mode, and Std Dev for the data set?
Statistics::Basic::Mean
Statistics::Basic::Median
Statistics::Basic::Mode
Statistics::Basic::StdDev
#!/usr/bin/perl
#
# stdev - figure N, min, max, median, mode, mean, & std deviation
#
# pull out all the real numbers in the input
# stream and run standard calculations on them.
# they may be intermixed with other test, need
# not be on the same or different lines, and
# can be in scientific notion (avagadro=6.02e23).
# they also admit a leading + or -.
#
# Tom Christiansen
# tchrist#perl.com
use strict;
use warnings;
use List::Util qw< min max >;
sub by_number {
if ($a < $b){ -1 } elsif ($a > $b) { 1 } else { 0 }
}
#
my $number_rx = qr{
# leading sign, positive or negative
(?: [+-] ? )
# mantissa
(?= [0123456789.] )
(?:
# "N" or "N." or "N.N"
(?:
(?: [0123456789] + )
(?:
(?: [.] )
(?: [0123456789] * )
) ?
|
# ".N", no leading digits
(?:
(?: [.] )
(?: [0123456789] + )
)
)
)
# abscissa
(?:
(?: [Ee] )
(?:
(?: [+-] ? )
(?: [0123456789] + )
)
|
)
}x;
my $n = 0;
my $sum = 0;
my #values = ();
my %seen = ();
while (<>) {
while (/($number_rx)/g) {
$n++;
my $num = 0 + $1; # 0+ is so numbers in alternate form count as same
$sum += $num;
push #values, $num;
$seen{$num}++;
}
}
die "no values" if $n == 0;
my $mean = $sum / $n;
my $sqsum = 0;
for (#values) {
$sqsum += ( $_ ** 2 );
}
$sqsum /= $n;
$sqsum -= ( $mean ** 2 );
my $stdev = sqrt($sqsum);
my $max_seen_count = max values %seen;
my #modes = grep { $seen{$_} == $max_seen_count } keys %seen;
my $mode = #modes == 1
? $modes[0]
: "(" . join(", ", #modes) . ")";
$mode .= ' # ' . $max_seen_count;
my $median;
my $mid = int #values/2;
my #sorted_values = sort by_number #values;
if (#values % 2) {
$median = $sorted_values[ $mid ];
} else {
$median = ($sorted_values[$mid-1] + $sorted_values[$mid])/2;
}
my $min = min #values;
my $max = max #values;
printf "n is %d, min is %g, max is %g\n", $n, $min, $max;
printf "mode is %s, median is %g, mean is %g, stdev is %g\n",
$mode, $median, $mean, $stdev;
Depending on how in depth you need to go, erickb's answer may work. However for numerical functionality in Perl there is PDL. You would create a piddle (the object containing your data) using the pdl function. From there you can use the operations on this page to do the statistics you need.
Edit: Looking around I found two function calls that do EXACTLY what you need. statsover gives statistics on one dimension of a piddle, while stats does the same over the whole piddle.
my $piddle = pdl #data;
my ($mean,$prms,$median,$min,$max,$adev,$rms) = statsover $piddle;

Why doesn't Perl's for() go through all of the elements in my array?

Have a perl brain-teaser:
my #l = ('a', 'b', 'c');
for (#l) {
my $n = 1;
print shift #l while (#l and $n --> 0);
print "\n";
}
What's it print? Should be a, b, and c, right? But oh wait actually there's a bug somewhere, it only prints a and b. Probably just some stupid off-by-one, should be easy to solve, right?
Ok so make a small code change to test things out and change #l to
my #l = ('a', 'b', 'c', 'd');
What's it print? Probably a, b, and c because of that stupid off by one, right? ...Wait a second, actually it still prints only a and b. Okay, so the bug is that it only prints the first two characters.
Change #l again to
my #l = ('a', 'b', 'c', 'd', 'e');
Uhm, now it prints a, b, and c. But not d or e. In fact, every 2 letters we add from now on will make it print the next letter in the sequence. So if we add f it'll still just print a, b, and c, but if we add f and g it'll print a, b, c, and d.
This also happens with similar results for different values of $n.
So what's going on here?
Dave Webb beat me to the problem, but here's a quote from perldoc perlsyn saying not to do it:
If any part of LIST is an array, foreach will get very confused if you add or remove elements within the loop body, for example with splice. So don't do that.
Note that, earlier in the text, the syntax of foreach was described as foreach LIST, which is the LIST they refer to in the documentation. Note also that foreach and for are equivalent.
What's going on is that you're using for and shift at the same time. So you're looping through the list whilst modifying it, not a good idea.
I think this is somebody's gadget code. It doesn't look like the way you would want to write anything. But what it might illustrate best is that (in at least some versions) Perl is really running a more basic for loop, where:
for ( #l ) {
#...
}
Is replaced by:
for ( my $i = 0; $i < #l; $i++ ) {
local $_ = $l[$i];
#...
}
Thus, because #l is ( 'c' ) when we've gone through twice, our trips through is already greater than scalar( #l ), so we're out. I've tested it out in a number of cases, and they seem to be equivalent.
Below is the code I wrote to test cases. From it we can see that because of the shift, as soon as we're halfway through, the loop will exit.
use strict;
use warnings;
use English qw<$LIST_SEPARATOR>;
use Test::More 'no_plan';
sub test_loops_without_shifts {
my #l = #_;
my #tests;
for ( #l ) {
push #tests, $_;
}
my #l2 = #_;
my $n = #tests;
my $i = 0;
for ( $i = 0; $i < #l2; $i++ ) {
local $_ = $l2[$i];
my $x = shift #tests;
my $g = $_;
is( $g, $x, "expected: $x, got: $g" );
}
is( $n, $i );
is_deeply( \#l, \#l2, do { local $LIST_SEPARATOR = .', '; "leftover: ( #l ) = ( #l2 )" } );
return $i;
}
sub test_loops {
my #l = #_;
my #tests;
for ( #l ) {
push #tests, shift #l;
}
my #l2 = #_;
my $n = #tests;
my $i = 0;
for ( $i = 0; $i < #l2; $i++ ) {
local $_ = $l2[$i];
my $x = shift #tests;
my $g = shift #l2;
is( $g, $x, "expected: $x, got: $g" );
}
is( $n, $i );
is_deeply( \#l, \#l2, do { local $LIST_SEPARATOR = ', 'c; "leftover: ( #l ) = ( #l2 )" } );
return $i;
}
is( test_loops( 'a'..'c' ), 2 );
is( test_loops( 'a'..'d' ), 2 );
is( test_loops( 'a'..'e' ), 3 );
is( test_loops( 'a'..'f' ), 3 );
is( test_loops( 'a'..'g' ), 4 );
is( test_loops_without_shifts( 'a'..'c' ), 3 );
is( test_loops_without_shifts( 'a'..'d' ), 4 );
is( test_loops_without_shifts( 'a'..'e' ), 5 );
is( test_loops_without_shifts( 'a'..'f' ), 6 );
is( test_loops_without_shifts( 'a'..'g' ), 7 );

How do I do vertical alignment of lines of text in Perl?

Suppose two lines of text correspond to each other word by word except for the punctuation marks. How do I make vertical alignment of them?
For example:
$line1 = "I am English in fact";
$line2 = "Je suis anglais , en fait";
I want the output to be like this:
I am English in fact
Je suis anglais , en fait .
I've come up with the following code, based on what I've learnt from the answers to my previous questions posted on SO and the "Formatted Output with printf" section of Learning Perl.
use strict;
use warnings;
my $line1 = "I am English in fact";
my $line2 = "Je suis anglais , en fait.";
my #array1 = split " ", $line1;
my #array2= split " ", $line2;
printf "%-9s" x #array1, #array1;
print "\n";
printf "%-9s" x #array2, #array2;
print "\n";
It is not satisfying. The output is this:
I am English in fact
Je suis anglais , en fait.
Can someone kindly give me some hints and suggestions to solve this problem?
Thanks :)
Updated
#ysth sent me on the right track! Thanks again:) Since I know what my own date looks like,for this sample, all I have to do is add the following line of code:
for ( my $i = 0; $i < #Array1 && $i < #Array2; ++$i ) {
if ( $Array2[$i] =~ /,/ ) {
splice( #Array1, $i, 0, '');
}
}
Learning Perl briefly mentions that splice function can be used to remove or add items in the middle of array. Now thanks, I've enlarged my Perl knowledge stock again :)
From your sample output, it seems what you are trying to do is to add extra
empty string elements where there is just punctuation in one array but not in the other.
This is fairly straightforward to do:
for ( my $i = 0; $i < #array1 && $i < #array2; ++$i ) {
if ( $array1[$i] =~ /\w/ != $array2[$i] =~ /\w/ ) {
if ( $array1[$i] =~ /\w/ ) {
splice( #array1, $i, 0, '' );
}
else {
splice( #array2, $i, 0, '' );
}
}
}
Or, somewhat more fancy, using flag bits en passant:
given ( $array1[$i] =~ /\w/ + 2 * $array2[$i] =~ /\w/ ) {
when (1) { splice( #array1, $i, 0, '' ) }
when (2) { splice( #array2, $i, 0, '' ) }
}