|
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! |
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;
| [reply]
[d/l]
[select] |
|
|
I believe glob returns a list of filenames, not all possible combinations (which would be useless with * wildcards).
Why does this work?
| [reply]
[d/l] |
|
|
| [reply] |
|
|
| [reply]
[d/l] |
|
|
$ 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
| [reply]
[d/l]
[select] |
|
|
|
|
|
|
|
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'
];
| [reply]
[d/l] |
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() | [reply]
[d/l]
[select] |
Re: Working with Binary Numbers
by jdporter (Paladin) 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++ :-)
| [reply]
[d/l] |
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;
}
| [reply]
[d/l]
[select] |
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!
| [reply] |
Re: Working with Binary Numbers
by stark (Pilgrim) on Sep 24, 2007 at 20:59 UTC
|
One proper binary number module is Bit::Vector. | [reply] |
Re: Working with Binary Numbers
by salva (Canon) 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. | [reply]
[d/l] |
|
|
| [reply] |
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.
| [reply]
[d/l] |
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
| [reply]
[d/l] |
Re: Working with Binary Numbers
by ikegami (Patriarch) 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
| [reply]
[d/l]
[select] |
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. | [reply]
[d/l] |
|
|
