PERL Beginners - Perl - Joining of Binary values

Author

Perl - Joining of Binary values

Dharshana Eswaran

2006-11-16, 7:56 am

Hi all,

I am working on the code below:

use strict;
use warnings;

my %TypeofNumber = (
'00' => Integer,
'01' => Floating,
'10' => Char,
'11' => Double );

my @hex = ("14", "2a", "11", "83");
$hex_length = @hex;

for($i=0; $i<$hex_length; $i++) {

my $binary = unpack 'B*', pack 'H*', $hex[$i];

print "$binary\n\n";

my @fields = unpack 'A2A2A4', $binary;

my $i;
printf "%-4s => %s\n\n", $fields[0], 'Ext';

print "TypeofNumber\n";
printf "%-4s => %s\n\n", $fields[1], $TypeofNumber{$fields[1]};

printf "%-4s => %s\n\n", $fields[2], 'NumberingPlan';

}

Now i need to split the binary value of the first element into two halves
(A7A1), seecond element into A6A2, third element into A5A3 and so on...

Then i need to display the 7bits of the first element, then join 1bit of the
first element to the 6bits of the second element(that is join A1 of first
element and A6of the second element) and then display it, then join A2 of
the second element and A5 of the third element and then display it and so
on.

How to go bout this?

Thanks and Regards,
Dharshana

Rob Dixon

2006-11-16, 7:56 am

Dharshana Eswaran wrote:
> Hi all,
>
> I am working on the code below:
>
> use strict;
> use warnings;
>
> my %TypeofNumber = (
> '00' => Integer,
> '01' => Floating,
> '10' => Char,
> '11' => Double );
>
>
> my @hex = ("14", "2a", "11", "83");
> $hex_length = @hex;
>
> for($i=0; $i<$hex_length; $i++) {
>
> my $binary = unpack 'B*', pack 'H*', $hex[$i];
>
> print "$binary\n\n";
>
> my @fields = unpack 'A2A2A4', $binary;
>
> my $i;
> printf "%-4s => %s\n\n", $fields[0], 'Ext';
>
> print "TypeofNumber\n";
> printf "%-4s => %s\n\n", $fields[1], $TypeofNumber{$fields[1]};
>
> printf "%-4s => %s\n\n", $fields[2], 'NumberingPlan';
>
> }
>
> Now i need to split the binary value of the first element into two halves
> (A7A1), seecond element into A6A2, third element into A5A3 and so on...
>
> Then i need to display the 7bits of the first element, then join 1bit of
> the
> first element to the 6bits of the second element(that is join A1 of first
> element and A6of the second element) and then display it, then join A2 of
> the second element and A5 of the third element and then display it and so
> on.
>
> How to go bout this?

Does this help?

Rob

use strict;
use warnings;

my @hex = ("14", "2a", "11", "83");
my $hex = join '', @hex;
my $binary = unpack 'B*', pack 'H*', $hex;

my @fields = unpack '(A7)*', $binary;
print $_, "\n" foreach @fields;

**OUTPUT

0001010
0001010
1000010
0011000
0011

Dharshana Eswaran

2006-11-16, 9:56 pm

Rob,

my @fields = unpack '(A7)*', $binary;

When i tried compiling, it says that

"Invalid type in unpack: '(' at line 10."

It does not accept this, i tried other combinations too. But it does not
compile the program.

What should i do?

Thanks and Regards,
Dharshana

On 11/16/06, Rob Dixon <rob.dixon@350.com> wrote:
>
> Dharshana Eswaran wrote:
> halves
> first
> of
> so
>
> Does this help?
>
> Rob
>
>
> use strict;
> use warnings;
>
> my @hex = ("14", "2a", "11", "83");
> my $hex = join '', @hex;
> my $binary = unpack 'B*', pack 'H*', $hex;
>
> my @fields = unpack '(A7)*', $binary;
> print $_, "\n" foreach @fields;
>
> **OUTPUT
>
> 0001010
> 0001010
> 1000010
> 0011000
> 0011
>

Rob Dixon

2006-11-16, 9:56 pm

Dharshana Eswaran wrote:
>
> On 11/16/06, Rob Dixon <rob.dixon@350.com> wrote:
[snip irrelevancies][color=darkred]
[snip irrelevancies][color=darkred]
>
> my @fields = unpack '(A7)*', $binary;
>
> When i tried compiling, it says that
>
> "Invalid type in unpack: '(' at line 10."
>
> It does not accept this, i tried other combinations too. But it does not
> compile the program.
>
> What should i do?

(Please bottom-post your replies, as it makes long threads like this much easier
to understand. Thanks.)

Oh dear. It looks like you have an ealier version of Perl where unpack has no
sub-templates, altthough I thought it had always been like that. Find out what
version you are running (with perl -v) and consider upgrading. I am using v5.8.8
and bmost people use v5.8 or above.

In the meantime, replace

my @fields = unpack '(A7)*', $binary;

with

my @fields = $binary =~ /.{1,7}/g;

Rob

Dharshana Eswaran

2006-11-16, 9:56 pm

On 11/16/06, Rob Dixon <rob.dixon@350.com> wrote:
>
> Dharshana Eswaran wrote:
> [snip irrelevancies]
> [snip irrelevancies]
> halves
> on...
> of the
> first
> of
> so
>
> (Please bottom-post your replies, as it makes long threads like this much
> easier
> to understand. Thanks.)
>
> Oh dear. It looks like you have an ealier version of Perl where unpack has
> no
> sub-templates, altthough I thought it had always been like that. Find out
> what
> version you are running (with perl -v) and consider upgrading. I am using
> v5.8.8
> and bmost people use v5.8 or above.
>
> In the meantime, replace
>
> my @fields = unpack '(A7)*', $binary;
>
> with
>
> my @fields = $binary =~ /.{1,7}/g;
>
>
>
> Rob
>

Thanks Rob. I sincerely want to appreciate your immediate response. It has
been a great help for me.

Thanks and Regards,
Dharshana

Rob Dixon

2006-11-16, 9:56 pm

Dharshana Eswaran wrote:
>
> On 11/16/06, Rob Dixon <rob.dixon@350.com> wrote:
>
>
> my @fields = $binary =~ /.{7,1}/g; This works fine
>
> my @fields = $binary =~ /.{7,1}/g; Why does'nt this work?
>
> Coz i wanted the procedure to be reversed, that is if the input is
> "31","59", "4C","15","53"
>
> I wanted the output to be
>
> 0110001
> 0110010
> 0110001
> 0101010
> 1110001
> 01010

The 1 and the 7 in the regex can't be exchanged as they are a minimum and
maximum number of characters to match. The pattern matches between one and seven
of any character, and so splits the 40-character string into five blocks of
seven characters and one of five.

I don't understand what you mean about reversing the procedure I'm afraid.

"31","59","4C","15","53"

is

00110001 01011001 01001100 00010101 01010011

in binary, and I can't see how to get to the bit patterns you give from that,
although it starts off close enough. Your fourth pattern of seven bits, for
instance, has three consecutive 1s in it, and that doesn't appear anywhere in
the number sequence you gave.

Are you sure the data you've posted is right?

Rob

Dharshana Eswaran

2006-11-16, 9:56 pm

On 11/17/06, Rob Dixon <rob.dixon@350.com> wrote:
>
> Dharshana Eswaran wrote:
> has no
> out
> am
[color=darkred]
>

The input is "31","59", "4C","15","53","DD","54","31"

The above input is represented as shown below:
00110001 01011001 01001100 00010101 01010011 11011101 01010100 00110001

The correction in the desired output is

0110001
0110010
0110001
0101010
0110001
0101010
0110111

The output should have 7bits for each representation. That is 8th bit of the
1st byte is taken as the 0th bit of the next byte and 7th and 8th of the
second bytes becomes the 0th and 1st of the third byte, next 6th, 7th,8th of
the third becomes 0th,1st,2nd of the fourth....And so on....

The 1 and the 7 in the regex can't be exchanged as they are a minimum and[color=darkred]
> maximum number of characters to match. The pattern matches between one and
> seven
> of any character, and so splits the 40-character string into five blocks
> of
> seven characters and one of five.
>
> I don't understand what you mean about reversing the procedure I'm afraid.
>
> "31","59","4C","15","53"
>
> is
>
> 00110001 01011001 01001100 00010101 01010011
>
> in binary, and I can't see how to get to the bit patterns you give from
> that,
> although it starts off close enough. Your fourth pattern of seven bits,
> for
> instance, has three consecutive 1s in it, and that doesn't appear anywhere
> in
> the number sequence you gave.
>
> Are you sure the data you've posted is right?
>
> Rob

I hope the corrections would help you better.

Thanks and Regards,
Dharshana

--
> To unsubscribe, e-mail: beginners-unsubscribe@perl.org
> For additional commands, e-mail: beginners-help@perl.org
> <http://learn.perl.org/> <http://learn.perl.org/first-response>
>
>
>

Dharshana Eswaran

2006-11-16, 9:56 pm

On 11/17/06, Dharshana Eswaran <dharshana.ve@gmail.com> wrote:

>
>
> On 11/17/06, Rob Dixon <rob.dixon@350.com> wrote:
>
>
>
> The input is "31","59", "4C","15","53","DD","54","31"
>
> The above input is represented as shown below:
> 00110001 01011001 01001100 00010101 01010011 11011101 01010100 00110001
>
> The correction in the desired output is
>
> 0110001
> 0110010
> 0110001
> 0101010
> 0110001
> 0101010
> 0110111
>

0110001
0110010
0110001
0101010
0110001
0101010
0110111
0101010
0110001
0
This is the complete pattern output for the input array....

>
> The output should have 7bits for each representation. That is 8th bit of
> the 1st byte is taken as the 0th bit of the next byte and 7th and 8th of the
> second bytes becomes the 0th and 1st of the third byte, next 6th, 7th,8th of
> the third becomes 0th,1st,2nd of the fourth....And so on....
>
>
>
> The 1 and the 7 in the regex can't be exchanged as they are a minimum and
>
>
> I hope the corrections would help you better.
>
> Thanks and Regards,
> Dharshana
>
> --
>

Dr.Ruud

2006-11-16, 9:56 pm

"Dharshana Eswaran" schreef:

> The input is "31","59", "4C","15","53","DD","54","31"
>
> The above input is represented as shown below:
> 00110001 01011001 01001100 00010101 01010011 11011101 01010100
> 00110001
>
> The correction in the desired output is
>
> 0110001
> 0110010
> 0110001
> 0101010
> 0110001
> 0101010
> 0110111
>
> The output should have 7bits for each representation. That is 8th bit
> of the 1st byte is taken as the 0th bit of the next byte and 7th and
> 8th of the second bytes becomes the 0th and 1st of the third byte,
> next 6th, 7th,8th of the third becomes 0th,1st,2nd of the
> fourth....And so on....

#!/usr/bin/perl
use warnings ;
use strict ;

my $data = join("\n", map {sprintf "%08b", $_}
map hex, <DATA> =~ /[[:xdigit:]]+/g) . "\n" ;

1 while $data =~ s/(.+?)(.{7}\n.*)/$2$1/ ;

print "$data\n" ;

__DATA__
"31","59", "4C","15","53","DD","54","31"

--
Affijn, Ruud

"Gewoon is een tijger."

Dr.Ruud

2006-11-16, 9:56 pm

"Dr.Ruud" schreef:

> my $data = join("\n", map {sprintf "%08b", $_}
> map hex, <DATA> =~ /[[:xdigit:]]+/g) . "\n" ;
>
> 1 while $data =~ s/(.+?)(.{7}\n.*)/$2$1/ ;

Better:

my $data = join "\n", map {sprintf "%08b", $_}
map hex, <DATA> =~ /[[:xdigit:]]+/g ;

$data =~ s/(?<=.)\z/\n/
while $data =~ s/(.+?)(.{7}\n.*)/$2$1/ ;

Alternative for that last (folded) line:

for ($data) {s/(?<=.)\z/\n/ while s/(.+?)(.{7}\n.*)/$2$1/}

--
Affijn, Ruud

"Gewoon is een tijger."

DJ Stunks

2006-11-17, 3:56 am

Dharshana Eswaran wrote:
> The input is "31","59", "4C","15","53","DD","54","31"
>
> The above input is represented as shown below:
> 00110001 01011001 01001100 00010101 01010011 11011101 01010100 00110001
>
> The correction in the desired output is
>
> 0110001
> 0110010
> 0110001
> 0101010
> 0110001
> 0101010
> 0110111
>
> The output should have 7bits for each representation. That is 8th bit of the
> 1st byte is taken as the 0th bit of the next byte and 7th and 8th of the
> second bytes becomes the 0th and 1st of the third byte, next 6th, 7th,8th of
> the third becomes 0th,1st,2nd of the fourth....And so on....

how about :

#!/usr/bin/perl

use strict;
use warnings;

my $input = join '', map { sprintf '%08b', hex($_) }
reverse qw{31 59 4C 15 53 DD 54 31};

while ( my $output = substr $input, -7, 7, '' ) {
print "$output\n";
}

__END__

-jp

Dharshana Eswaran

2006-11-17, 3:56 am

On 11/17/06, Dr.Ruud <rvtol+news@isolution.nl> wrote:
>
> "Dr.Ruud" schreef:
>
>
> Better:
>
> my $data = join "\n", map {sprintf "%08b", $_}
> map hex, <DATA> =~ /[[:xdigit:]]+/g ;
>
> $data =~ s/(?<=.)\z/\n/
> while $data =~ s/(.+?)(.{7}\n.*)/$2$1/ ;
>
>
> Alternative for that last (folded) line:
>
> for ($data) {s/(?<=.)\z/\n/ while s/(.+?)(.{7}\n.*)/$2$1/}
>
> --
> Affijn, Ruud
>
> "Gewoon is een tijger."
>
> --
> To unsubscribe, e-mail: beginners-unsubscribe@perl.org
> For additional commands, e-mail: beginners-help@perl.org
> <http://learn.perl.org/> <http://learn.perl.org/first-response>
>
> Thanks Dr.Ruud. Since i am unable to understand the working of the code
> which you have written, I request you to explain the working for me.

Thanks and Regards,
Dharshana

Dr.Ruud

2006-11-17, 7:58 am

"Dr.Ruud" schreef:

Some explanation of the tight code follows.

> my $data = join "\n", map {sprintf "%08b", $_}
> map hex, <DATA> =~ /[[:xdigit:]]+/g ;

Let's start at the end:

@r1 = <DATA> =~ /[[:xdigit:]]+/g ;

That creates a list of the sequences of hexadecimal digit characters out
of the line read from <DATA>.
So it results in "qw(31 59 4C 15 53 DD 54 31)", which is a list of
strings.
Maybe "<DATA> =~ /([[:xdigit:]]+)/g" (with brackets) is more efficient
(like when $& and $1 are involved).

The following step:

@r2 = map hex, @r1 ;

transforms this list to "(0x31, 0x59, ... , 0x54, 0x31)", which is a
list of integers.

The next step:

@r3 = map {sprintf "%08b", $_} @r2 ;

transforms this list to "qw(00110001 01011001 ... 01010100 00110001)",
which is a list of strings.

The next step:

my $data = join "\n", @r3 ;

creates a single string from the list, with "\n" as glue. So $data is
"00110001\n01011001\n...\n01010100\n00110001".

> $data =~ s/(?<=.)\z/\n/
> while $data =~ s/(.+?)(.{7}\n.*)/$2$1/ ;

This appends a \n to $data if there is a non-\n character at the end of
$data, and shortens each embedded line to the trailing 7 characters,
moving the surplus from the current line to the end of the next line
(and that all as many times as possible).

To see what goes on, make it:

do{ $data =~ s/(?<=.)\z/\n/; print "$data\n\n" }
while $data =~ s/(.+?)(.{7}\n.*)/$2$1/ ;

--
Affijn, Ruud

"Gewoon is een tijger."

Rob Dixon

2006-11-17, 9:57 pm

Dharshana Eswaran wrote:[color=darkred]
>
> On 11/17/06, Dharshana Eswaran <dharshana.ve@gmail.com> wrote:
>
> 0110001
> 0110010
> 0110001
> 0101010
> 0110001
> 0101010
> 0110111
> 0101010
> 0110001
> 0
>
> This is the complete pattern output for the input array....
>

Ah, I see. The bits are in the opposite order to what I assumed. The code below
produces the correct result. All I've changed is to use an unpack format of 'b'
instead of 'B' which delivers the bits in the reverse order. Then we can just
take chunks of seven bits at a time from the string as before, but have to
reverse each chunk back again before it displayed.

I hope this helps.

Rob

use strict;
use warnings;

my @hex = ("31","59", "4C","15","53","DD","54","31");
my $hex = join '', @hex;
my $binary = unpack 'b*', pack 'H*', $hex;

my @fields = $binary =~ /.{1,7}/g;
$_ = reverse foreach @fields;

print "$_\n" foreach @fields;

**OUTPUT

0110001
0110010
0110001
0101010
0110001
0101010
0110111
0101010
0110001
0

Dr.Ruud

2006-11-17, 9:57 pm

Rob Dixon schreef:

> use strict;
> use warnings;
>
> my @hex = ("31","59", "4C","15","53","DD","54","31");
> my $hex = join '', @hex; # (1)
> my $binary = unpack 'b*', pack 'H*', $hex; # (2)
>
> my @fields = $binary =~ /.{1,7}/g;
> $_ = reverse foreach @fields;
>
> print "$_\n" foreach @fields;

Nice approach.

(1) This assumes that values < "10" have a 0-prefix, so like "0A" and
not just "A".
Alternatives:
my $hex = join '', map {sprintf "%02x", hex} @hex;
my $hex = join '', map substr("00$_", -2), @hex;
my $hex; $hex .= substr("00$_", -2) for @hex;

(2) A value like "XX" in @hex is silently accepted by pack().

<quote src="perldoc -f pack">
The "h" and "H" fields pack a string that many nybbles
(4-bit groups, representable as hexadecimal digits,
0-9a-f) long.
Each byte of the input field of pack() generates 4 bits
of the result. For non-alphabetical bytes the result
is based on the 4 least-significant bits of the input
byte, i.e., on "ord($byte)%16". In particular, bytes
"0" and "1" generate nybbles 0 and 1, as do bytes "\0"
and "\1". For bytes "a".."f" and "A".."F" the result
is compatible with the usual hexadecimal digits, so
that "a" and "A" both generate the nybble "0xa==10".
The result for bytes "g".."z" and "G".."Z" is not
well-defined.
</quote>

--
Affijn, Ruud

"Gewoon is een tijger."

Rob Dixon

2006-11-17, 9:57 pm

Dr.Ruud wrote:
> Rob Dixon schreef:
>
>
> Nice approach.
>
> (1) This assumes that values < "10" have a 0-prefix, so like "0A" and
> not just "A".
> Alternatives:
> my $hex = join '', map {sprintf "%02x", hex} @hex;
> my $hex = join '', map substr("00$_", -2), @hex;
> my $hex; $hex .= substr("00$_", -2) for @hex;

Or, since we don't really need the intermediate $hex, just

my $binary = unpack 'b*', join '', map chr hex, @hex;

But this is a beginners' group :)

Rob

DJ Stunks

2006-11-17, 9:57 pm

Rob Dixon wrote:
> my $binary = unpack 'b*', join '', map chr hex, @hex;

chr?? what for? in the immortal words of Tina Tunrer "What's [ASCII]
got to do with it?"

didn't my solution come through? I humbly submit that it was simpler
and more straight forward than the other solutions presented.

-jp

Dr.Ruud

2006-11-18, 7:56 am

Rob Dixon schreef:

> my $binary = unpack 'b*', join '', map chr hex, @hex;
>
> But this is a beginners' group :)

No problem if you explain some of the details:

(*1*) my @temp1 = map chr hex, @hex;

This achieves about the same:

my @temp1;

foreach my $elm (@hex)
{
push @temp1, chr( hex( $elm ) );
}

or more compact:

my @temp1; push @temp1, chr(hex($_)) for @hex;

or even more compact:

my @temp1; push @temp1, chr hex for @hex;

It creates and fills an array (intermediate in the original expression,
named @temp1 here for clarity), in which each element is a single
character (not necessarily limited to \x00-\xFF).
See `perldoc -f hex` and `perldoc -f chr` (and of course `perldoc -f
map`).

Test-1:
perl -wle "@data=qw(78 FF 7A); print chr(hex($_)) for @data"
(Windows)
perl -wle "@data=qw(78 FF 7A); print chr(hex(\$_)) for @data" (*ix)
perl -wle '@data=qw(78 FF 7A); print chr(hex($_)) for @data' (*ix)
perl -wle "@data=qw(78 FF 7A); print chr hex for @data" (both)

(*2*) my $temp2 = join '', @step1

This just concatenates all ellements of @step1 (which are all a single
character) into a string.

Test-2:
perl -wle "print join q//, (1, q/ZX/, 2)"

(I wrote the '' as q//, to make this work in most shells.)

(*3*) my $binary = unpack 'b*', $temp2 ;

This creates a binary representation of the string of characters, see
`perldoc -f pack` for details about the 'b' conversion.

Test-3:
perl -wle "print unpack q/b8/, chr(0x51)"

--
Affijn, Ruud

"Gewoon is een tijger."

Dharshana Eswaran

2006-11-20, 7:56 am

Thanks Rob and Dr.Ruuf.

Your discussion has shown different ways of approach which is very useful
for the beginners.
It was really helpful in understanding the concepts as well as the logic
approach.

Thanks and Regards,
Dharshana

On 11/18/06, Dr.Ruud <rvtol+news@isolution.nl> wrote:
>
> Rob Dixon schreef:
>
>
> No problem if you explain some of the details:
>
>
> (*1*) my @temp1 = map chr hex, @hex;
>
>
> This achieves about the same:
>
> my @temp1;
>
> foreach my $elm (@hex)
> {
> push @temp1, chr( hex( $elm ) );
> }
>
> or more compact:
>
> my @temp1; push @temp1, chr(hex($_)) for @hex;
>
> or even more compact:
>
> my @temp1; push @temp1, chr hex for @hex;
>
> It creates and fills an array (intermediate in the original expression,
> named @temp1 here for clarity), in which each element is a single
> character (not necessarily limited to \x00-\xFF).
> See `perldoc -f hex` and `perldoc -f chr` (and of course `perldoc -f
> map`).
>
> Test-1:
> perl -wle "@data=qw(78 FF 7A); print chr(hex($_)) for @data"
> (Windows)
> perl -wle "@data=qw(78 FF 7A); print chr(hex(\$_)) for @data" (*ix)
> perl -wle '@data=qw(78 FF 7A); print chr(hex($_)) for @data' (*ix)
> perl -wle "@data=qw(78 FF 7A); print chr hex for @data" (both)
>
>
> (*2*) my $temp2 = join '', @step1
>
> This just concatenates all ellements of @step1 (which are all a single
> character) into a string.
>
> Test-2:
> perl -wle "print join q//, (1, q/ZX/, 2)"
>
> (I wrote the '' as q//, to make this work in most shells.)
>
>
> (*3*) my $binary = unpack 'b*', $temp2 ;
>
> This creates a binary representation of the string of characters, see
> `perldoc -f pack` for details about the 'b' conversion.
>
> Test-3:
> perl -wle "print unpack q/b8/, chr(0x51)"
>
>
> --
> Affijn, Ruud
>
> "Gewoon is een tijger."
>
>
> --
> To unsubscribe, e-mail: beginners-unsubscribe@perl.org
> For additional commands, e-mail: beginners-help@perl.org
> <http://learn.perl.org/> <http://learn.perl.org/first-response>
>
>
>

Sponsored Links