Split one sentence with ｢ and square brackets into multiple

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.

An interesting problem. Here is one solution.

For now replace the open paren ｢ by < and adjust the sentence.^† Take an example string:

<!-- language: lang-none -->

word <a A1[b b1] and more <a A2[b b2] but <a A3[b b3] end

1. 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')
   

2. Identify indices of alternatives (1,3,5 here)

3. 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)

4. 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 '';
}

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 "", @_; } );