我想知道它是否是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]
感谢任何帮助。
答案 0 :(得分：6)
使用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
答案 1 :(得分：3)
#!/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不会传达任何信息。
答案 2 :(得分：1)
如果我理解正确，你需要第一个（最不重要的）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快得多。
答案 3 :(得分：0)
感谢您的所有答案。我将非常感谢所有的帮助。我想我想知道的是Shinan的回答。我认为Don的关怀标志是＆＃34;。＆＃34;所以我会使用＆＃34;。＆＃34;而不是使用＆＃34; X＆＃34;。
另外，我认为我的第一个解释是不够的，所以我会解释细节。
1）即使我仅将其用于我的示例中的第一位，任何输入都可能不在乎。
2）BigInt - 即使示例是50位，我稍后会使用更多位，因此原生整数是不够的。但是，如果ikegami建议，Math :: Uint64要快得多，我将使用它。
我今晚将测试你的所有建议并尽快发布我的答案。再次感谢你。