Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Working with Binary Numbers

by shoness (Friar)
on Sep 24, 2007 at 20:36 UTC ( #640813=perlquestion: print w/replies, xml ) Need Help??

shoness has asked for the wisdom of the Perl Monks concerning the following question:

The novice monk asked his teachers this kōan...

I've a set of binary (base 2) numbers, where the '-' means BOTH 0 and 1 are to be substituted:

my @data = qw( 000- 0101 011- 1-0- );
Hence the above array reads:
my @data = qw( 0 1 5 6 7 8 9 12 13 );
Now the last part of my problem is easy, since I can change binary to decimal like this:
sub to_binary { my $str = shift; my $value = 0; for (my $ii=0; $ii<length($str); $ii++) { $value = 2 * $value + substr($str, $ii, 1); } return $value; }
The middle part, expanding the array members that contain '-' should probably be done using a recursive subroutine call since there can be multiple dashes. This is where I'm working now:
for (my $ii=0; $ii<@data; $ii++) { if (@data[$ii] =~ /-/) { splice(@data, $ii, 1, bits(@data[$ii])); } } sub bits { my $str = shift; if ($str =~ /-/) { if (substr($str, $ii, 1) eq '-') { bits( substr($str, $ii, 1, '0' ); bits( substr($str, $ii, 1, '1' ); # somehow don't return anything... ???? } } else { return $str; } }
My approach to the binary conversion is brute-force. My approach to solve the "-" expansion is going to have to get more brute-force. I'm sure that I'm missing something on both accounts....

I looked into it, but I don't think Set::Scalar is useful here. I also don't see any proper binary number modules to start with up on CPAN either.

Your help is appreciated.

As always,
Thanks!

Replies are listed 'Best First'.
Re: Working with Binary Numbers
by blokhead (Monsignor) on Sep 24, 2007 at 21:09 UTC
    Perl already has a nice built-in way to expand wildcards, it's called glob. It's just a simple matter of converting your wildcard syntax into one that glob recognizes.
    my @data = qw( 000- 0101 011- 1-0- ); my @expanded = map { (my $s = $_) =~ s/-/{0,1}/g; glob($s) } @data;
    Update: There is also an easier built-in way to convert them to integers from binary:
    my @integers = map { oct "0b$_" } @expanded;

    blokhead

      I believe glob returns a list of filenames, not all possible combinations (which would be useless with * wildcards).

      Why does this work?

        This is the glob function. If you don't supply an EXPR to glob EXPR then it uses $_.
        His map makes @data become $_ in the glob scope.
        I think.

        Thanks Again!

        Update: removed my garbage...

        Read CountZero's much better/accurate explanation

      It seems to me that you are abusing a bug in glob

      After expanding the pattern it should check that the entries actually exist on the file system and return only those that do.

        This rule does not apply to {x,y,z} alternations in the glob pattern. The documentation I could find isn't great on this point, and its language is generally in terms of filenames. But I'm 99% sure it's not a bug. I've seen tons of uses of glob in this way on PM!

        BTW, the same behavior should happen in your shell (though it may be a different glob under the hood).

        $ ls {x,y,z} ls: x: No such file or directory ls: y: No such file or directory ls: z: No such file or directory
        First, glob expands {...} and then it checks the filesystem to expand * and ? and the resulting pattern(s).
        $ ls *{p,q,r} ls: *p: No such file or directory ls: *q: No such file or directory ls: *r: No such file or directory

        blokhead

Re: Working with Binary Numbers
by kyle (Abbot) on Sep 24, 2007 at 20:58 UTC

    Converting your list just screams "map" to me, so that's the kind of solution I was shooting for.

    use Data::Dumper; my @data = qw( 000- 0101 011- 1-0- ); print Dumper(\@data); @data = map { bits($_) } @data; print Dumper(\@data); sub bits { my $str = shift; if ($str =~ /-/) { my ($zero, $one) = ( $str, $str ); $zero =~ s/-/0/; $one =~ s/-/1/; return ( bits( $zero ), bits( $one ) ); } else { return $str; } } __END__ $VAR1 = [ '000-', '0101', '011-', '1-0-' ]; $VAR1 = [ '0000', '0001', '0101', '0110', '0111', '1000', '1001', '1100', '1101' ];
Re: Working with Binary Numbers
by Anno (Deacon) on Sep 24, 2007 at 22:17 UTC
    I like blokhead's glob()-based solution. Here is one that is based on binary arithmetic (aka bit fiddling).

    Essentially, filling in the dashes in a template amounts to counting upwards the bits indicated by dashes while keeping the other bits unchanged. For n dashes, this results in 2**n values. The subroutine increment_masked() below does one counting step arithmetically, given a value and a mask indicating the original position of dashes.

    To expand a template of zeroes, ones, and dashes, extract from the template a mask (a number with 1-bits where dashes were, 0-bits otherwise), and a starting value (a number with zeroes where dashes were, other bits unchanged from the template). Apply increment_masked() appropriately to the starting value and collect the results. This is what the sub expand() does.

    The final result is achieved by mapping expand() over the given templates.

    my @data = qw( 000- 0101 011- 1-0- ); my @res = map expand( $_), @data; print "@res\n"; sub expand { my $template = shift; my $n_dashes = $template =~ tr/-//; my $mask; # ones where - was, else 0 ( $mask = $template) =~ tr/01-/001/; my $val; # zeroes where - was, else unchanged ( $val = $template) =~ tr/01-/010/; $_ = oct "0b$_" for $mask, $val; # transform to numeric my @coll = $val; push @coll, $val = increment_masked( $val, $mask) for 1 .. 2**$n_dashes - 1; @coll; } # Increment the combined unmasked bits as a single binary number, # leaving masked bits alone. Masked bits are indicated by a 0-bit in # the mask, unmasked bits by 1 sub increment_masked { my ( $x, $mask) = @_; ( ( ($x | ~$mask) # fill masked bits with 1 + 1 # increment (carry will jump over... # masked stretches) ) & $mask) # clear masked bits, leaving... # incremented bits alone | ($x & ~$mask); # restore masked bits from $x }
    Anno

    Update: Typos corrected
    Much later update: Added comments to sub increment_masked()

Re: Working with Binary Numbers
by jdporter (Canon) on Sep 24, 2007 at 20:52 UTC

    This is rather brute-force (exponential in the length of the pattern), but at least it's (somewhat) succinct.

    sub expand_binary_patterns { map { my $l = length($_); my $q = $_; $q =~ y/-/./; grep { sprintf('%0'.$l.'b',$_) =~ /$q/ } 0 .. (2**$l)-1; } @_ } my @data = qw( 000- 0101 011- 1-0- ); @data = expand_binary_patterns( @data );

    Update: blokhead++ :-)

Re: Working with Binary Numbers
by FunkyMonk (Chancellor) on Sep 24, 2007 at 21:51 UTC
    If you want to stick with a recursive solution:
    use Test::More tests => 1; my @data = qw( 000- 0101 011- 1-0- ); my @expected = qw( 0000 0001 0101 0110 0111 1000 1001 1100 1101 ); my @got = map { expand_binary( $_ ) } @data; is_deeply \@got, \@expected; sub expand_binary { my $bin = shift; if ( $bin =~ /-/ ) { ( my $zero = $bin ) =~ s/-/0/; ( my $one = $bin ) =~ s/-/1/; return ( expand_binary( $zero ), expand_binary( $one ) ); } return $bin; }

Re: Working with Binary Numbers
by shoness (Friar) on Sep 24, 2007 at 22:24 UTC
    Really outstanding! Thanks!

    Almost everyone suggested "map" which seems obvious to me now. "map" creates a list by operating on each element of another list. In this case, the "operation" is to expand the wildcards and/or convert the binary-to-decimal.

    Using "glob" to convert the wildcards was really clever. I didn't know about using "oct" for binary either! These are bit-vectors, so Bit::Vector is useful in other ways.

    Thanks Again!

Re: Working with Binary Numbers
by stark (Pilgrim) on Sep 24, 2007 at 20:59 UTC
    One proper binary number module is Bit::Vector.
Re: Working with Binary Numbers
by salva (Abbot) on Sep 25, 2007 at 11:16 UTC
    brute force but non-recursive:
    my @data = qw( 000- 0101 011- 1-0-); my @bin; while (@data) { my $data = shift @data; if ($data =~ tr/-//) { my ($zero, $one) = ($data, $data); $zero =~ s/-/0/; $one =~ s/-/1/; unshift @data, $zero, $one; } else { push @bin, $data; } } print "@bin\n";
    and anyway, what is your real problem? for a big subset of the ones I can imagine, maintaining your data as a list of numbers and masks can be a better solution than actually expanding the data set.
      No worries, you're right. Most of the time I keep data in the more compact form, but sometimes I've got to expand it to actually work on the real bit vectors.

      I understand your example right away as well. map-a-glob is elegant but people know I didn't write it and can't maintain it. :-)

Re: Working with Binary Numbers (nail)
by tye (Sage) on Sep 25, 2007 at 18:20 UTC
    use Algorithm::Loops qw( NestedLoops ); my @patterns= qw( 000- 0101 011- 1-0- ); my @bits; for( @patterns ) { my $pattern= $_; # Copy; don't modify @patterns my $count= $pattern =~ s/-/%d/g; push @bits, NestedLoops( [ ([0,1])x$count ], sub { sprintf $pattern, @_ }, ); } print "@bits\n" # prints 0000 0001 0110 0111 1000 1001 1100 1101

    If you've got my Hammer.

    - tye        

Re: Working with Binary Numbers
by catellus (Initiate) on Sep 25, 2007 at 17:25 UTC
    For a regex solution, which functions a bit recursively even though it's just repetitive:
    C:\>perl -p -e"1 while s/^([01 ]*?)([01]*)-([-01]*)([-01 ]*)$/$1${2}0$ +3 ${2}1$3$4/" 000- 0101 011- 1-0- 0000 0001 0101 0110 0111 1000 1001 1100 1101
Re: Working with Binary Numbers
by ikegami (Pope) on Sep 27, 2007 at 05:26 UTC
    Build your own "glob"... using the regex engine!
    use strict; use warnings; my @data = qw( 000- 0101 011- 1-0- ); my ($re) = map "(?{''})(?:$_)(?{push \@results, oct \"0b\$^R\"})(?!)", join '|', map { local $_ = $_; s/([01]+)/(?{\$^R.'$1'})/g; s/-/(?:(?{\$^R.0})|(?{\$^R.1}))/g; $_ } @data; local our @results; { use re 'eval'; '' =~ /$re/ } local $, = ", "; local $\ = "\n"; print @results;

    In this case, the generated regex is:

    / (?{''}) (?: (?{$^R.'000'}) (?:(?{$^R.0})|(?{$^R.1})) | (?{$^R.'0101'}) | (?{$^R.'011'}) (?:(?{$^R.0})|(?{$^R.1})) | (?{$^R.'1'}) (?:(?{$^R.0})|(?{$^R.1})) (?{$^R.'0'}) (?:(?{$^R.0})|(?{$^R.1})) ) (?{ $push @results, oct "0b$^R" }) (?!) /x
Re: Working with Binary Numbers
by hobbs (Monk) on Sep 27, 2007 at 04:39 UTC
    Just for fun, the first solution that came into my head. It's not the most efficient (I agree with the use of glob as a practical solution) but I think it's reasonably simple to understand. No recursion, only iteration.
    use strict; my @data = qw( 00- 0101 011- 1-0- ); while (grep /-/, @data) { @data = map do { unless (/-/) { $_; } else { my ($zero, $one); ($zero = $_) =~ s/-/0/; ($one = $_) =~ s/-/1/; ($zero, $one); } }, @data; } print join(" ", map oct "0b$_", @data), "\n";
    Note that the grep can actually be removed if you don't mind having a 'map' with side-effects; you can keep track of whether you did any replacements as you go along, and stop after the first time that there weren't any.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://640813]
Approved by Corion
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (4)
As of 2020-10-28 03:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favourite web site is:












    Results (259 votes). Check out past polls.

    Notices?