Split one sentence with ｢ and square brackets into multiple - perl

Question

I have sentences of this pattern in the dictionary text data:
I have ｢an absolute [a deadly] abhorrence of ｢laziness [greasy food].
Is there a way that I can split it into 4 sentences as follows to make it more searchable in the dictionary (using Perl)?
I have an absolute abhorrence of laziness.
I have an absolute abhorrence of greasy food.
I have a deadly abhorrence of laziness.
I have a deadly abhorrence of greasy food.

Answer 1

An interesting problem. Here is one solution.
For now replace the open paren ｢ by < and adjust the sentence.† Take an example string:
word <a A1[b b1] and more <a A2[b b2] but <a A3[b b3] end
Split the string into tokens: substrings containing alternatives <...[...], and substrings with groups of words around them. Once we are here, break each alternatives-substring into the two alternatives and put that in an arrayref. So we'll have an array with:
('word', ['a A1', 'b b1'], 'and more', ['a A2', 'b b2'],
'but', ['a A3', 'b b3'], 'end')
Identify indices of alternatives (1,3,5 here)
Create all combinations of these indices (as a set, so find the set of all subsets, the power set). For the indices in a subset we take the first alternative when composing a sentence, for those not in the subset we take the second (or the other way round)
Go through the tokens array and print, selecting the alternatives as described above
I use Algorithm::Combinatorics for combinations but there are of course other libraries.
A program with a test sentence introduced above (and only ascii characters)
use warnings;
use strict;
use feature 'say';
use List::Util qw(any none);
use Algorithm::Combinatorics qw(subsets);
my $str = q(word <a A1[b b1] and more <a A2[b b2] but <a A3[b b3] end);
say $str;
my #tokens =
map { /^</ ? [ /<([^\[]+) \[([^\]]+)\]/x ] : $_ }
split /(<[^\[]+ \[[^\]]+\])/x, $str;
#say "#tokens";
my #idx = grep { ref $tokens[$_] eq 'ARRAY' } 0..$#tokens;
#say "#idx";
my #subsets = subsets( \#idx );
for my $ss (#subsets) {
my #take_0 = #$ss;
for my $iw (0..$#tok) {
if (none { $iw == $_ } #idx) { print " $tok[$iw] " }
elsif (any { $iw == $_ } #take_0) { print " $tok[$iw]->[0] " }
else { print " $tok[$iw]->[1] " }
}
say '';
}
There are great simplifications considering all kinds of sentence structure an details from natural languages. There is plenty of room for code improvement, and there's a bit of cleanup to do (extra spaces, for one), but it does print all combinations with alternative phrases.
The library can generate one item at a time: when invoked in scalar context its functions return an iterator, on which ->next gives the next item. This is important for very large sets of items.
Here is a program with the sentence given in the question. (The solution above has ascii (<) instead of the ｢ character, as some systems still have problems with Unicode. Other than that the program is the same.)
use warnings;
use strict;
use feature 'say';
use List::Util qw(any none);
use Algorithm::Combinatorics qw(subsets);
use utf8;
use open qw(:std :encoding(UTF-8));
my $str = q(I have ｢an absolute [a deadly] abhorrence of ｢laziness [greasy food].);
say $str;
my #tokens =
map { /^｢/ ? [ /｢([^\[]+) \[([^\]]+)\]/x ] : $_ }
split /(｢[^\[]+ \[[^\]]+\])/x, $str;
my #idx = grep { ref $tokens[$_] eq 'ARRAY' } 0..$#tokens;
my #subsets = subsets( \#idx );
for my $ss (#subsets) {
my #take_0 = #$ss;
for my $iw (0..$#tokens) {
if (none { $iw == $_ } #idx) { print " $tokens[$iw] " }
elsif (any { $iw == $_ } #take_0) { print " $tokens[$iw]->[0] " }
else { print " $tokens[$iw]->[1] " }
}
say '';
}

Answer 2

First, parse into
my #def = (
[ "I have " ],
[ "an absolute", "a deadly" ],
[ " abhorrence of " ],
[ "laziness", "greasy food" ],
[ "." ],
);
This can be achieved using the following, a validating parser:
my #def;
for ( $str ) {
/ \G ( [^｢]+ ) /xgc
and push #def, [ $1 ];
if ( / \G ｢ /xgc ) {
/ \G ( [^｢\[\]]+ ) [ ] \[ ( [^｢\[\]]+ ) \] /xgc
or die( "Bad sequence at offset ".( pos() - 1 )."\n" );
push #def, [ $1, $2 ];
redo;
}
/\G \z /xgc
and last;
die( "Should not happen" );
}
Then find the product. This can be achieved using the following:
use Algorithm::Loops qw( NestedLoops );
my $iter = NestedLoops( \#def );
while ( my #parts = $iter->() ) {
say join "", #parts;
}
or
use Algorithm::Loops qw( NestedLoops );
NestedLoops( \#def, sub { say join "", #_; } );