CODEWITHSUNDEEP
stringperlstring-comparison
Kiran K Telukunta
Kiran K Telukunta

Reputation: 2234

how to compare 2 strings by each characters in perl

basically I want to compare 

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

and get output CE.

i.e where ever parentheses occur the characters of $a should be taken.

Upvotes: 4

Views: 3237

Answers (6)

Alan Haggai Alavi
Alan Haggai Alavi

Reputation: 74222

This is easy to accomplish using each_array, each_arrayref or pairwise from 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 =~ /[()]/;
}

Using pairwise:

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

Without using List::MoreUtils:

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

Thanks to TLP for discovering the set $# technique without which this solution will have been longer and complicated. :-)

Upvotes: 2

ikegami
ikegami

Reputation: 385657

Way faster than all the solutions except daxim's, and almost as fast as daxim's without preventing the use of characters 255 and above:

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

It changes

---(-)-

to

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

Then uses the result as regex pattern to extract the desired characters.

Upvotes: 2

TLP
TLP

Reputation: 67900

Simple regex and pos solution:

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;

Note the use of lookahead to get the position before the matching character.

Combined with Axeman's use of the @- variable we can get an alternative loop:

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

This is pretty much mentioned in the documentation for @-:

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

In other words, the matched string $& equals that substring expression. If you replace $var with another string, you would get the characters matching the same positions.

In my example, the expression $+[0] - $-[0] (offset of end of match minus offset of start of match) would be 1, since that is the max length of the matching regex.

QED.

Upvotes: 3

daxim
daxim

Reputation: 39158

One of the rare uses of the bitwise or-operator.

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

prints CE.

Use this for golfing purposes only, AHA’s solution is much more maintainable.

Upvotes: 4

Axeman
Axeman

Reputation: 29854

This uses the idea that you can scan one string for positions and just take the values of the other strings. @s is a reusable product.

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 );

Upvotes: 2

flesk
flesk

Reputation: 7579

#!/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";

Upvotes: 1

Related Questions