Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

bitstrings calculator

by chunlou (Curate)
on Aug 07, 2003 at 22:52 UTC ( #282051=CUFP: print w/ replies, xml ) Need Help??

After reading bitwise string operator question and Detecting transpositions, and since I'm not Abigail-II, thought I could use a primitive bitstrings calculator.

Do this

print bitstrings('rkt', '^', '%$#');

and get this

__________________ 'rkt' ^ '%$#' __________________ 'r' ^ '%' = 'W' 114 ^ 37 = 87 1110010 ^ 100101 = 1010111 'k' ^ '$' = 'O' 107 ^ 36 = 79 1101011 ^ 100100 = 1001111 't' ^ '#' = 'W' 116 ^ 35 = 87 1110100 ^ 100011 = 1010111 'rkt' ^ '%$#' = 'WOW'

Doesn't handle escape characters very well though.

use strict ; use warnings; use Carp; print bitstrings('*&TG', '^', 'bI##y'); print bitstrings('*&TG', '&', 'bI##y'); print bitstrings('*&TG', '|', 'bI##y'); sub bitstrings { my($lft,$op,$rgt) = @_; my $opn = "'$lft' $op '$rgt'"; my $str = "_" x (length($opn)+5) . "\n\n"; $str .= " $opn\n"; $str .= "_" x (length($opn)+5) . "\n\n\n"; $str .= iterbit($lft,$op,$rgt); $str .= "\n$opn = "; $str .= $str =~ / = 0$/m ? "0 bits returned!" : "'" . eval($opn) . + "'"; $str .= "\n\n"."- "x 20 ."\n\n\n"; return $str; } sub iterbit { my($lft,$op,$rgt) = @_; my @lft = split('',$lft); my @rgt = split('',$rgt); my $str = ""; my $idx = idx(\@lft,$op,\@rgt); for my $i (0..$idx) { $str .= chrop($lft[$i], $op, $rgt[$i])."\n"; $str .= decop($lft[$i], $op, $rgt[$i])."\n"; $str .= binop($lft[$i], $op, $rgt[$i])."\n\n"; } return $str; } sub idx { my($lft,$op,$rgt) = @_; if($op eq '&'){return $#{$lft} < $#{$rgt} ? $#{$lft} : $#{$rgt}} elsif($op eq '^' || $op eq '|'){return $#{$lft} > $#{$rgt} ? $#{$l +ft} : $#{$rgt}} else{croak "Invalid operator: $op $! "} } sub chrop { my $lft = shift || ''; my $op = shift; my $rgt = shift || ''; my $str = "'".$lft."' $op '".$rgt."' = "; $lft =~ s/\\/\\\\/; $rgt =~ s/\\/\\\\/; my $opn = "'".$lft."' $op '".$rgt."'"; my $rs = eval($opn); $str .= "'".($rs && ord($rs) ? $rs : '')."'"; return $str; } sub decop { my $lft = shift || 0; my $op = shift; my $rgt = shift || 0; my $str = ord($lft) . " $op " . ord($rgt) . " = "; $str .= eval eval'"'.ord($lft).$op.ord($rgt).'"'; return $str; } sub binop { my $str = decop(@_); $str =~ s/(\d+)/dec2bin($1)/mge; return $str; } sub dec2bin { my $bin = unpack("B32", pack("N", shift)); $bin =~ s/^0+(?=\d)//; return $bin; } # sub bin2dec {unpack("N", pack("B32", substr("0" x 32 . shift, -32))) +}

Comment on bitstrings calculator
Select or Download Code
Replies are listed 'Best First'.
Re: bitstrings calculator
by jmcnamara (Monsignor) on Aug 07, 2003 at 23:59 UTC

    With perl 5.6 and later you can also do this for dec2bin:
    sub dec2bin { return sprintf "%b", $_[0]; }

    --
    John.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://282051]
Approved by Aristotle
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (15)
As of 2015-07-07 17:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (93 votes), past polls