Как сравнить 2 строки по каждому символу в Perl - PullRequest
Новая
       5

Как сравнить 2 строки по каждому символу в Perl

3 голосов
/ 19 декабря 2011

В основном я хочу сравнить 

$a = "ABCDE";
$b = "--(-)-";

и получить вывод CE.

, т. Е. Где бы ни возникали скобки, должны быть взяты символы $ a.

Ответы [ 6 ]

4 голосов
/ 19 декабря 2011

Одно из редких применений побитового оператора or. 

# magic happens here  ↓
perl -E'say (("ABCDE" | "--(-)-" =~ tr/-()/\377\000/r) =~ tr/\377//dr)'

печать CE.

Используйте это только для целей игры в гольф, решение AHA гораздо более удобен в обслуживании.

3 голосов
/ 19 декабря 2011

Простое регулярное выражение и pos решение: 

my $str = "ABCDE";
my $pat = "--(-)-";

my @list;
while ($pat =~ /(?=[()])/g) {
    last if pos($pat) > length($str);  # Required to prevent matching outside $x
    my $char = substr($str, pos($y), 1); 
    push @list, $char;
}
print @list;

Обратите внимание на использование Lookahead для получения позиции перед соответствующим символом.

В сочетании с использованием Аксеманом переменной @- мы можем получить альтернативный цикл: 

while ($pat =~ /[()]/g) {
    last if $-[0] > length($str);
    my $char = substr($str, $-[0], 1);
    push @list, $char;
}

Это в значительной степени упоминается в документации по@-: 

After a match against some variable $var :
....
$& is the same as substr($var, $-[0], $+[0] - $-[0])

Другими словами, соответствующая строка $& равна этому выражению подстроки.Если вы замените $var другой строкой, вы получите символы, совпадающие с теми же позициями.

В моем примере выражение $+[0] - $-[0] (смещение конца совпадения минус смещение начала совпадения) будет1, поскольку это максимальная длина соответствующего регулярного выражения.

КЭД.

2 голосов
/ 20 декабря 2011

Значительно быстрее, чем все решения, кроме daxim, и почти так же быстро, как и daxim, не предотвращая использование символов 255 и выше: 

my $pat = $b =~ s/[^()]/.?/gr =~ s/[()]/(.?)/gr
my $c = join '', $a =~ /^$pat/s;

Изменяется 

---(-)-

на 

.?.?.?(.?).?(.?).?

Затем использует результат в качестве шаблона регулярного выражения для извлечения нужных символов.

2 голосов
/ 19 декабря 2011

При этом используется идея, что вы можете отсканировать одну строку на предмет позиций и просто взять значения других строк.@s - это продукт многократного использования. 

use strict;
use warnings;

sub chars {
    my $source = shift;
    return unless @_;
    my @chars  = map { substr( $source, $_, 1 ) } @_;
    return wantarray ? @chars, join( '', @chars );
}

my $a = "ABCDE";
my $b = "--(-)-";

my @s;
push @s, @- while $b =~ m/[()]/g;
my $res = chars( $a, @s );
2 голосов
/ 19 декабря 2011

Это легко сделать, используя each_array, each_arrayref или pairwise из List::MoreUtils: 

#!/usr/bin/env perl

use strict;
use warnings;

use List::Util      qw( min );
use List::MoreUtils qw( each_array );

my $string        = 'ABCDE';
my $pattern       = '--(-)-';
my @string_chars  = split //, $string;
my @pattern_chars = split //, $pattern;

# Equalise length
my $min_length = min $#string_chars, $#pattern_chars;
$#string_chars = $#pattern_chars = $min_length;

my $ea = each_array @string_chars, @pattern_chars;
while ( my ( $string_char, $pattern_char ) = $ea->() ) {
    print $string_char if $pattern_char =~ /[()]/;
}

Использование pairwise: 

{
    no warnings qw( once );
    print pairwise {
        $a if $b =~ /[()]/;
    } @string_chars, @pattern_chars;
}

Без использования List::MoreUtils: 

for ( 0 .. $#string_chars ) {
    print $string_chars[$_] if $pattern_chars[$_] =~ /[()]/;
}

Спасибо TLP за открытие техники set $#, без которой это решение было бы длиннее и сложнее.: -)

1 голос
/ 19 декабря 2011 
#!/usr/bin/perl
use strict;
use warnings;

my $a = "ABCDE";
my $b = "--(-)-";
my ($i, $c, $x, $y) = 0;

$c .= $y =~ /\(|\)/ ? $x : "" while ($x = substr $a, $i, 1) && ($y = substr $b, $i++, 1);

print "$c\n";
...