Question

我想知道它是否是Perl中的Don-care照片符号（X）。

我有一个50位二进制输入（实际上，我使用BigInt）。如果输入与数据库中的数据匹配，我将返回一个预定义的值。

让我们说数据库中的数据是11001100100010110111110110101001000010110101111101。

如果输入是X1001100100010110111110110101001000010110101111101，我想认为它是一个匹配的情况，因为X可以是1或0.我知道一种方法在50个1位中分割50位并作出例外，但我更愿意一起处理50位。

test.pl（主要代码，看起来很乱，但操作很简单，读取数据库和输入文件，并返回一个输出文件，其中包含匹配案例的预定义值。由test.pl运行）：

#!/usr/bin/perl 

use strict;
#use warnings;
use Math::BigInt;
#use Math::Gauss ':all';
#use Math::Gauss;
use 5.010;
use List::Util qw(sum);

my $Astrip="cmp_top.iop.sparc0.exu.rml.";
my $Aj=0;
my @Aoutput;
my $At=0;
my $Agen;
my @Aitems; my @Aweights;
my @Aitems_p; my @Aweights_p;
my $Ap=0;
my $Aselected_p = 0;
my $Atotal_p; my $Arand_p; my $Alimit_p;
my $Ai=0; my $Am=0; my $Ak=0;
my $Atotal; my $Arand; my $Alimit;
my $Aselected =0; my $Attemp=0; my $Ane=0; my $Asum=0;
my $Al=0; my $Attest=0;

#### change edb workload - matmul
open(CSV,'database.db')||die("Cannot open edb file $!");
my @Aedb;

while(<CSV>){
    my @Arow=split(/\t/,$_);
    push(@Aedb,\@Arow);
}
close CSV || die $!;
#       if ($At == 0) { goto ASTART;        }
my @Ainput=do{
    open my $Afh,"<","test.input" or die("Cannot open an input file $!");
    <$Afh>;
};
for (my $An=0; $An < (scalar @Ainput); $An +=3) {
### First loop
$Attest = 0;
for ($Ai=0; $Ai < (scalar @Aedb); $Ai +=2) {
    $a = Math::BigInt->new("$Aedb[$Ai][1]");
    $b = Math::BigInt->new("$Ainput[$An]"); 
    if ( $a == $b ) {

    $a = Math::BigInt->new("$Aedb[$Ai+1][1]");
    $b = Math::BigInt->new("$Ainput[$An+1]");
    if ( $a == $b ) {       $Attemp=0;
        $Attest++; 
        $Agen=$Ainput[$An+2];
        if (not defined $Agen) { $Arand_p = rand();}
        else { $Arand_p =  $Agen;   }
        #$Attemp=0;
        for ($Aj=2; $Aj < scalar @{ $Aedb[$Ai+1] }; $Aj++) {
            if ( $Aedb[$Ai+1][$Aj]/$Aedb[$Ai+1][2] > $Arand_p ) {
                $At++;
                    $Aedb[$Ai][$Aj] =~ s/\n//g;
                $Aoutput[$At+$An/3]= $Astrip.$Aedb[$Ai][$Aj];
                $Attemp++;
            }
        }
    #$Aoutput[$An/3+$At-$Attemp]= $Attemp;
    }
    }
}

}
open(my $Afh2, '>', 'test.output');
print $Afh2 join("\n", @Aoutput);
close $Afh2;

database.db（数据库文件）：

0.1 11001100100010110111110110101001000010110101111101  rml_irf_old_e_cwp_e[1]  rml_irf_new_e_cwp_e[1]  rml_irf_swap_even_e rml_irf_old_e_cwp_e[0]  rml_irf_new_e_cwp_e[0]  rml_irf_swap_odd_e
0.1 11101100110010011011001101100111001001100000010011  3.923510310023e-06  3.19470818154393e-08    7.05437377900141e-10    7.05437377900141e-10    4.89200539851702e-17    5.01433479478681e-19
0.1 10000110001111010010111101110011001001011110000100  rml_irf_new_e_cwp_e[1]  rml_irf_new_e_cwp_e[0]
0.1 01110111010010000000101001000001100011011100011111  0.052908822741908   2.7185508579738e-05
0.1 01001100100100001011101000011111100101111011000111  rml_irf_new_e_cwp_e[1]
0.1 00111101000100001101010111010100000111100100100101  1.09213787524617e-25
0.1 00001000011110000101010110111000000111011110011001  rml_irf_new_e_cwp_e[1]  rml_irf_new_lo_cwp_e[1] rml_irf_new_lo_cwp_e[2]
0.1 01101001011110101011111011011011101100110100000101  2.28019753307221e-06    2.89026436307201e-14    2.89026436307201e-14

test.input：

11001100100010110111110110101001000010110101111101
11101100110010011011001101100111001001100000010011

test.output（输入的预定义值，对于不匹配的大小写没有任何内容。我希望与X10011具有相同的输出...）：

cmp_top.iop.sparc0.exu.rml.rml_irf_old_e_cwp_e[1]

感谢任何帮助。

Answer 1

使用Math::BigInt :(附带Perl）

use Math::BigInt qw( );

my $pattern = 'X1001100100010110111110110101001000010110101111101';
my $mask = Math::BigInt->from_bin( $pattern =~ tr/X01/011/r );
my $targ = Math::BigInt->from_bin( $pattern =~ tr/X/0/r );

for my $num_bin (qw(
   11001100100010110111110110101001000010110101111101
   11101100110010011011001101100111001001100000010011
)) {
   my $num = Math::BigInt->from_bin($num);
   if (($num & $mask) == $targ) {
      say "$num_bin matches";
   } else {
      say "$num_bin doesn't match";
   }
}

使用Math::UInt64 :(比BigInt快）

use Math::UInt64 qw( net_to_uint64 );

sub bin_to_uint64 { net_to_uint64 pack 'B*', substr( ( "0" x 64 ) . $_[0], -64 ) }

my $pattern = 'X1001100100010110111110110101001000010110101111101';
my $mask = bin_to_uint64( $pattern =~ tr/X01/011/r );
my $targ = bin_to_uint64( $pattern =~ tr/X/0/r );

for my $num_bin (qw(
   11001100100010110111110110101001000010110101111101
   11101100110010011011001101100111001001100000010011
)) {
   my $num = bin_to_uint64($num);
   if (($num & $mask) == $targ) {
      say "$num_bin matches";
   } else {
      say "$num_bin doesn't match";
   }
}

使用原生整数:(如果支持则最快）

use Config qw( %Config );

sub bin_to_uint64 { unpack 'Q>', pack 'B*', substr( ( '0' x 64 ) . $_[0], -64 ) }

die("64-ints required\n") if $Config{ivsize} < 8;

my $pattern = 'X1001100100010110111110110101001000010110101111101';
my $mask = bin_to_uint64( $pattern =~ tr/X01/011/r );
my $targ = bin_to_uint64( $pattern =~ tr/X/0/r );

for my $num_bin (qw(
   11001100100010110111110110101001000010110101111101
   11101100110010011011001101100111001001100000010011
)) {
   my $num = bin_to_uint64($num);
   if (($num & $mask) == $targ) {
      say "$num_bin matches";
   } else {
      say "$num_bin doesn't match";
   }
}

使用压缩的int :(最快的。如上所述，假设pattern和num_bin的长度相同。）

sub bin_to_packed { pack 'B*', $_[0] }

my $pattern = 'X1001100100010110111110110101001000010110101111101';
my $mask = bin_to_packed( $pattern =~ tr/X01/011/r );
my $targ = bin_to_packed( $pattern =~ tr/X/0/r );

for my $num_bin (qw(
   11001100100010110111110110101001000010110101111101
   11101100110010011011001101100111001001100000010011
)) {
   my $num = bin_to_packed($num);
   if (($num & $mask) eq $targ) {
      say "$num_bin matches";
   } else {
      say "$num_bin doesn't match";
   }
}

使用字符串:(最快，因为在循环中不需要进行任何操作但实际检查。假设pattern和num_bin的长度相同。）

my $pattern = 'X1001100100010110111110110101001000010110101111101';
my $mask = $pattern =~ tr/X01/\x00\xFF\xFF/r;
my $targ = $pattern =~ tr/X/\x00/r;

for my $num_bin (qw(
   11001100100010110111110110101001000010110101111101
   11101100110010011011001101100111001001100000010011
)) {
   if (($num_bin & $mask) eq $targ) {
      say "$num_bin matches";
   } else {
      say "$num_bin doesn't match";
   }
}

与上述相同，但不使用5.14 +

my $pattern = 'X1001100100010110111110110101001000010110101111101';
( my $mask = $pattern ) =~ tr/X01/\x00\xFF\xFF/;
( my $targ = $pattern ) =~ tr/X/\x00/;

for my $num_bin (qw(
   11001100100010110111110110101001000010110101111101
   11101100110010011011001101100111001001100000010011
)) {
   if (($num_bin & $mask) eq $targ) {
      say "$num_bin matches";
   } else {
      say "$num_bin doesn't match";
   }
}

输出：

11001100100010110111110110101001000010110101111101 matches
11101100110010011011001101100111001001100000010011 doesn't match

Answer 2

#!/usr/bin/env perl

use strict;
use warnings;

my $search_for = 'X1001100100010110111110110101001000010110101111101';
(my $pat = $search_for) =~ s/X/./g;

while (my $line = <DATA>) {
    next unless $line =~ /\S/;
    my $key = (split ' ', $line, 3)[1];
    if ($key =~ /^$pat\z/) {
        print $line;
    }
}

__DATA__
0.1 11001100100010110111110110101001000010110101111101  rml_irf_old_e_cwp_e[1]  rml_irf_new_e_cwp_e[1]  rml_irf_swap_even_e rml_irf_old_e_cwp_e[0]  rml_irf_new_e_cwp_e[0]  rml_irf_swap_odd_e
0.1 11101100110010011011001101100111001001100000010011  3.923510310023e-06  3.19470818154393e-08    7.05437377900141e-10    7.05437377900141e-10    4.89200539851702e-17    5.01433479478681e-19
0.1 10000110001111010010111101110011001001011110000100  rml_irf_new_e_cwp_e[1]  rml_irf_new_e_cwp_e[0]
0.1 01110111010010000000101001000001100011011100011111  0.052908822741908   2.7185508579738e-05
0.1 01001100100100001011101000011111100101111011000111  rml_irf_new_e_cwp_e[1]
0.1 00111101000100001101010111010100000111100100100101  1.09213787524617e-25
0.1 00001000011110000101010110111000000111011110011001  rml_irf_new_e_cwp_e[1]  rml_irf_new_lo_cwp_e[1] rml_irf_new_lo_cwp_e[2]
0.1 01101001011110101011111011011011101100110100000101  2.28019753307221e-06    2.89026436307201e-

另外，你真的应该仔细研究你的变量。你有太多这些，并没有有用的名字。此外，如果它们都以A开头，则A不会传达任何信息。

Answer 3

如果我理解正确，你需要第一个（最不重要的）49位是相同的。

例如，为两者设置位50然后比较

if ( ($v1 | (1<<49)) == ($v2 | (1<<49)) ) { say "Match" }

其中$v1和$v2是整数，可能只在第50位有所不同，以使测试返回true。

其余的是选择如何从二进制字符串中形成这些整数。

在问题中使用Math::BigInt（使用ikegami的比较数字）

use warnings;
use strict;
use Math::BigInt;

my $input_bin = '01001100100010110111110110101001000010110101111101';
my $input  = Math::BigInt->from_bin($input_bin);    
print "$input_bin  input\n";

# First number in @nums differs from input only in the left-most bit
my @nums = (
   '11001100100010110111110110101001000010110101111101',
   '11101100110010011011001101100111001001100000010011'
);

my $bits = 49;
foreach my $num_bin (@nums) 
{
   my $num = Math::BigInt->from_bin($num_bin);

   if ( ($input | (1<<$bits)) == ($num | (1<<$bits)) ) 
   { 
       print "$num_bin  matches\n"; 
   } 
   else { 
       print "$num_bin  does not match\n" 
   }
}

打印

01001100100010110111110110101001000010110101111101  input
11001100100010110111110110101001000010110101111101  matches
11101100110010011011001101100111001001100000010011  does not match

还有其他模块，首先是Math::Int64。

如果您没有使用Math::BigInt，则可以通过其他方式获取整数，前提是您的系统具有64位支持且Perl已使用它进行编译。

使用pack，首先需要将字符串填充到64

my $input = unpack("Q>", pack("B*", substr("0" x 64 . $input_bin, -64)));

其中Q是

q  A signed quad (64-bit) value.
    Q  An unsigned quad value.
     (Quads are available only if your system supports 64-bit
      integer values _and_ if Perl has been compiled to support
      those.  Raises an exception otherwise.)

和>是big-endian修饰符，需要与B中的pack模板达成协议。

如果您不介意关闭'portable'警告，使用oct要简单得多

no warnings 'portable';

my $input = oct '0b' . $input_bin;

my $bits = 49;
foreach my $num_bin (@nums) 
{
   my $num = oct '0b' . $num_bin;

   if ( ($input | (1<<$bits)) == ($num | (1<<$bits)) ) { 
       print "$num_bin  matches\n"; 
   } else { 
       print "$num_bin  does not match\n" 
   }
}

警告将是关于此代码无法在32位和64位Perls之间移植。这应该比pack快得多。

Answer 4

感谢您的所有答案。我将非常感谢所有的帮助。我想我想知道的是Shinan的回答。我认为Don的关怀标志是＆＃34;。＆＃34;所以我会使用＆＃34;。＆＃34;而不是使用＆＃34; X＆＃34;。

另外，我认为我的第一个解释是不够的，所以我会解释细节。

1）即使我仅将其用于我的示例中的第一位，任何输入都可能不在乎。

2）BigInt - 即使示例是50位，我稍后会使用更多位，因此原生整数是不够的。但是，如果ikegami建议，Math :: Uint64要快得多，我将使用它。

我今晚将测试你的所有建议并尽快发布我的答案。再次感谢你。

不要关心Perl中的符号

4 个答案: