http://www.perlmonks.org?node_id=39508

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

Greetings,

I've got what may amount to a simple question, but I cannot recall seeing anything like this before around here. (And I will admit that I'm not quite sure what other words to send into the search box to fully find anything even mildly related.)

So, here's my current code:

$byte = ''; if ($obj->{organization} =~ /^\s*$/) { $byte .= '0'; } else { $byte .= '1'; } ... if ($obj->{report} =~ /^\s*$/) { $byte .= '0'; } else { $byte .= '1'; }
Extra details, the ... represents 6 more statements like the ones I have entered. All 8 checks are done to build a byte to check against a truth table as such:
if ($byte =~ /1(0|1){3}0{3}(0|1)/) { do more checks against database } elsif ($byte =~ /0{4}1(0|1)0{2}/) { do other checks against database } else { produce error message }
What I want to do, is (unless I'm doing it the most efficient way, which I don't think I am) find a better way to build that byte. Nonetheless, I figured it would be nice to see a real world application of discrete mathematics.

ALL HAIL BRAK!!!

Replies are listed 'Best First'.
Re: Building a byte to test truth table
by chromatic (Archbishop) on Nov 02, 2000 at 01:52 UTC
    Perl supports something called bit vectors. Essentially, it's just a way to treat a string of bits as an arbitrary length byte.

    You'd use something like $bv = pack('B*', $byte); to turn your string into a bit vector. You can use vec to access individual elements.

    If you were to do that, it might simplify your code somewhat. The first regex could be replaced with:

    if ((vec($bv, 0, 1) == 1) and (vec($bv, 4, 1) == 0)) { # do something }
    That's untested, as I've not found a good use for this yet.

    I'd probably turn your string into an integer and use bitwise operations to work on it.

    Update: After studying this a bit more, it'll take more work to use vec to replace the regex. Use logical and, not, or, and xor as tye suggests. The bit-shifting operands will also come in handy.

(tye)Re: Building a byte to test truth table
by tye (Sage) on Nov 02, 2000 at 01:52 UTC

    Here is one method:

    my %bits; my @fields= qw( organization report poise hair swimsuit question bribe connections ); @bits{@fields}= map { 1<<$_ } 0..7; sub mask { my $mask= 0; $mask |= $bits{$_} for @_; return $mask; } my $byte= 0; foreach my $field ( keys %bits ) { $byte |= $bits{$field} if $obj->{$field} =~ /\S/; } # ... if( $byte & mask(qw( organization swimsuit question bribe )) == mask("organization") ) { # ... } elsif( $byte & ~mask("question") == mask("swimsuit") ) { # ... } else { die "Contestant cheated!\n"; }

            - tye (but my friends call me "Tye")
(jcwren) RE: Building a byte to test truth table
by jcwren (Prior) on Nov 02, 2000 at 01:53 UTC
    There's always the TMTOWTDI principle, but allow me to point out a potential problem here:

    Your checks are now position dependent. If you move a block of code around in the section that builds the byte string, causing the byte position to change, you'll be spending the next few days debugging.

    A more managable way to do this is with a bit field. By having each check toggle a bit on or off, you can now compare against a full value:
    # # $word is 0, the default setting for bits being 0FF # $word = 0; $word |= 0x01 if ($obj->{organization} !~ /^\s*$/); ... $word |= 0x40 if ($obj->{report} !~ /^\s*$/); print "All fields supplied" if ($word == 0x00); print "Missing Organization" if ($word & 0x01 == 0);
    Now, as long as you don't duplicate bit positions, you run into far less chances of fubar'ing the code should you insert tests, etc.

    But this really isn't the best way either, since the code that sets the bit position and the code that tests for it are separated, and use magic numbers. You should use constants, to make sure you mean the same thing in both places.

    There are a couple of good books that talk about how to prevent problems like this from creeping up on you. There is 'The Pragmatic Programmer', 'Code Complete', another good one whose name escapes me at the moment (it's on my bookshelf at home, and I'm not awake).

    --Chris

    e-mail jcwren
      Since you're using a hash to hold the object, reusing the keys to map to bit positions might help. For example:
      @fields = qw(organization report foo bar baz);
      $bit = 1;
      foreach $field ( @fields ) {
          $bitmask{$field} = $bit;
          $bit <<= 1;
      }
      

      This reduces the code that build $mask to

      foreach $field ( @fields ) {
          $mask |= $bit{$field} if $obj{$field} !~ /^\s*$/;
      }
      

      The challenging part is converting the static regular expressions to something dynamic. Here's one (untested) thought:

      sub testMask {
          my($bits, $on, $off) = @_;
          my($onmask, $testmask) = 0;
      
          foreach $field ( @$on ) {
              $onmask |= $bit{$field};
              $testmask |= $bit{$field};
          }
          foreach $ field ( @$off ) {
              $testmask |= $bit{$field};
          }
          return ($bits & $testmask) == $onmask;
      }
      

      This lets you rewrite the tests as:

      moreDatabaseProcessing() unless testMask($mask, \qw(organization), \qw(foo bar));
      

      The up side of this approach is that it's completely position independent. The downside is that it's not resilient against field name typos, though that can be mitigated with some extra tests.

        After looking at the code samples above and below, dws is the big winner! Thanks to all who gave useful samples, and of course, I took all suggestions and modified to my own look and feel. But the end result is closest to the code above.

        I just wanted to give a final thank you, now that it's all working, and since it seems appropriate to give thanks on big posts like 1000 or 500 or in my case 50.

        ALL HAIL BRAK!!!

      Thanks, jcwren. In fact, your mention of "The Pragmatic Programmer" in a previous post, was the impetus for my recent visit to fatbrain.com. I have only digested a small portion of it, so I'd have eventually seen that sort of hint.

      And also thanks to Tye for his response too, but I figured that I'd cover it in one reply.

      /me buries his nose in the Camel to digest meaning. :) ALL HAIL BRAK!!!

Re: Building a byte to test truth table
by AgentM (Curate) on Nov 02, 2000 at 01:41 UTC
RE: Building a byte to test truth table
by dchetlin (Friar) on Nov 02, 2000 at 02:23 UTC
    Why not do real bitwise math?

    $byte = 0; $byte |= 1 if $obj->{organization} =~ /\S/; $byte |= 1<<1 if $obj->{foo} =~ /\S/; $byte |= 1<<2 if $obj->{bar} =~ /\S/; ... $byte |= 1<<7 if $obj->{report} =~ /\S/; # Here are your checks, rewritten as bitmasks if ($byte & 1<<7 and not $byte & 7<<1) { # do more checks against database } elsif (not $byte & 15<<4 and $byte & 1<<3 and not $byte & 3) { # do other checks against database } else { # produce error message }

    Update: while I was checking my solutions, several people already gave the right answers. Specifically, tye's looks nice to me. I'm leaving this here only for completeness' sake.

    -dlc