Here's a simple recursive solution (read the comments for explanation):
#!/usr/bin/perl
use warnings;
use strict;
sub alternate {
my ($id, $string, @changes) = @_;
unless (@changes) {
print "$id $string\n";
return
}
# The variant with the original character.
my ($bracket, $char) = @{ shift @changes };
alternate($id, $string, @changes);
# The variant with the alternative character.
$string =~ /\(/g for 1 .. $bracket; # Find the bracket.
substr $string, pos $string, 1, $char;
alternate($id, $string, @changes);
}
open my $STRINGS, '<', 'File1' or die $!;
open my $ALTS, '<', 'File2' or die $!;
while (my $string_line = <$STRINGS>) {
my ($string_id, $string) = split ' ', $string_line;
# Count the bracketed parts.
my $count = ((my $bare_string = $string) =~ s/[()]//g) / 2;
my @changes;
for my $bracket (1 .. $count) {
my $alt_line = <$ALTS>;
my ($alt_id, $pos, $orig, $alt) = split ' ', $alt_line;
die "Out of sync: $string_id != $alt_id\n" if $string_id ne $a
+lt_id;
my $char = substr $bare_string, $pos - 1, 1;
die "Invalid char at pos $pos in $string_id: $orig != $char\n"
if $orig ne $char;
push @changes, [ $bracket, $alt ];
}
alternate($string_id, $string, @changes);
}
It might be a bit too complex for a newbie, but the task is not really simple, either.
