Learning_Perl_2017 has asked for the wisdom of the Perl Monks concerning the following question:

Hi there friends,

We have complicated expressions like this, which may also contain deep nesting:

  ((A & B)' | (A & C & (A & B & D)'));

[download]

Every time we see sub expressions like:
(1)  (A & B)\' and
(2)  (A & C & (A & B & D)')
we have to substitute them with the following:
 !(A & B) for (1) above
and  (A & C & !(A & B & D)) for (2) above.

I wrote the following but it obviously requires some more improvements. Can you help me know what I am doing wrong? 

#!/usr/bin/perl
use strict;
use warnings;

my $x = '((A & B)\' | (A & C & (A & B & D)\'))'; 

print "Given: $x\n"; 

$x =~ s/(\(.*?\))\'/\!$1/g; 

print "Calculated: ",$x,"\n";

[download]

That prints: 

Given: ((A & B)' | (A & C & (A & B & D)')) 
Calculated: (!(A & B) | !(A & C & (A & B & D)))

[download]

The second part of the sub expression is incorrect as my regex match did not do what is intended, which is: substitute  (A & B & D)' with  !(A & C & (A & B & D))
Thank you friends.
Bill Murphy.

Replies are listed 'Best First'.
Re: Regex matching and substitution
by choroba (Cardinal) on Jan 29, 2016 at 08:08 UTC
    Are you trying to find the corresponding left parenthesis? You don't need a regex, just use a stack of the positions of the left parentheses: 
    #!/usr/bin/perl
use warnings;
use strict;

for my $given ( "(A & B)'",
                "((A & B)' | (A & C & (A & B & D)'))",
                "((A | B)' & (C | (D & (E & F)))')'",
              ) {
    my @left;
    my $calc = $given;
    my $last;
    for my $pos (0 .. length($given) - 1) {
        my $current = substr $given, $pos, 1;
        push @left, $pos if '(' eq $current;
        $last = pop @left if ')' eq $current;
        if ("'" eq $current) {
            substr $calc, $pos, 1, q();
            substr $calc, $last, 0, '!';
        }
    }
    print "Given: $given\n";
    print "Calculated: $calc\n";
}

    [download]

    Update: Or, if you really need to use a regex, use a recursive subpattern (see perlre): 

    #!/usr/bin/perl
use warnings;
use strict;

my $re = qr/(\(((?:(?>[^()]+)|(?1))*)\))'/;

for my $given ( "(A & B)'",
                "((A & B)' | (A & C & (A & B & D)'))",
                "((A | B)' & (C | (D & (E & F)))')'",
              ) {
    my $calc = $given;
    $calc =~ s/$re/!($2)/g while $calc =~ /'/;
    print "Given: $given\n";
    print "Calculated: $calc\n";
}

    [download]

    Update 2: You can also write a full parser for the expressions: 

    #!/usr/bin/perl
use warnings;
use strict;

use Marpa::R2;

my $dsl = << '__DSL__';

:default ::= action => concat
lexeme default = latm => 1

Expression ::= '(' Expression ')'             assoc  => group
             | literal
             | Expression quote               action => negation
            || Expression sp operator sp Expression

quote    ~ [']                                                   # '
operator ~ [&|]
literal  ~ [A-Z]
sp       ~ [\s]+

__DSL__

my $i = 0;
sub concat { $i++; join q(), @_[ 1 .. $#_ ] }
sub negation { $i++; "!$_[1]" }

my $grammar = 'Marpa::R2::Scanless::G'->new({ source => \$dsl });

for my $given ( "(A & B)'",
                "((A & B)' | (A & C & (A & B & D)'))",
                "((A | B)' & (C | (D & (E & F)))')'",
              ) {
    my $calc = $grammar->parse(\$given, { semantics_package => 'main' 
+});
    print "Given: $given\n";
    print "Calculated: $$calc\n";
}

    [download]
    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,

    [download]
[reply]
[d/l]
[select]
[reply]
Re: Regex matching and substitution
by kcott (Archbishop) on Jan 29, 2016 at 07:14 UTC

    G'day Bill,

    Welcome to the Monastery.

    You're almost there. Just change the '.' in your regex to '[^(]'. Here's your code with that change (plus a small modification to the shebang line for my purposes): 

    #!/usr/bin/env perl
use strict;
use warnings;

my $x = '((A & B)\' | (A & C & (A & B & D)\'))'; 

print "Given: $x\n"; 

#$x =~ s/(\(.*?\))\'/\!$1/g; 
$x =~ s/(\([^(]*?\))\'/\!$1/g;

print "Calculated: ",$x,"\n";

    [download]

    Output:

    Given: ((A & B)' | (A & C & (A & B & D)'))
Calculated: (!(A & B) | (A & C & !(A & B & D)))

    [download]

    — Ken

[reply]
[d/l]
[select]
Re: Regex matching and substitution
by NetWallah (Canon) on Jan 29, 2016 at 06:35 UTC
    Try this: 
    #!/usr/bin/perl
use strict;
use warnings;

my $x = '((A & B)\' | (A & C & (A & B & D)\'))'; 

print "Given: $x\n"; 
my ($find)= $x=~/([^()]+?)\)/;
print "FInd:$find\n";
$x =~ s/$find/!$find/g; 

print "Calculated: ",$x,"\n";

    [download]
    Prints:
    Given: ((A & B)' | (A & C & (A & B & D)'))
FInd:A & B
Calculated: ((!A & B)' | (A & C & (!A & B & D)'))

    [download]
    I could not understand the logic of your substitution requirement.

            "I can cast out either one of your demons, but not both of them." -- the XORcist

[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom