How to search for a pair of words taken from two lists

Question

I need to write a Perl script to find time and location entities in a French text at the beginning of sentences which XML tags. For instance <temps> En été </temps> ( "in summer" ).

I have a list of location names in a CSV file and a list of moments (winter, summer, Monday, Tuesday etc.) in a text file. I read the lists in two arrays @topo and @tabplace with one cell per line of the original file.

I want to detect entities by searching the sentences beginning with En, à, le etc. (in, at etc.) with the results stored in @entites. Then I need to separate time entities and place entities : places entities will be stored in @places and time entities will be stored in @times.

My problem is about how to find any entry of @entites followed by any entry of @topowith all the results stocked in @times

I was thinking of something like this but I'm missing some steps:

foreach my $celtime ( @entite ) {
    @times = ( grep(/\b@entites.@tabtime/)
}

For your information this is the full project code:

my @phrases  = ();
my @topo     = ();
my @entite   = ();
my @tabplace = ();
my @tabtime  = ();
my $fichiertexte;
my $celplace;
my $fichiertemps = 'entitemps.txt';
my $fichiertopo  = 'toponymes.csv';
my $lignedic;
my $lignetemps;

print "Quel fichier voulez-vous segmentez ?\n";
$fichierstexte = <STDIN>;
chomp( $fichiertexte );

open( TEXT, ">>:encoding(utf8)", $fichiertexte )
        or die( "Impossible d'ouvrir le fichier : ", $!, "\n" );
my @phrases = split( /\./, $lignetexte );  # Chaque phrase sur une ligne
while ( $lignetexte = <FICH> ) {
    chomp( $lignetexte );
    push( @phrases, $lignetexte );
}
close( TEXT );

open( TEMPS, ">>:encoding(utf8)", $fichiertemps )
        or die( "Impossible d'ouvrir le fichier : ", $!, "\n" );
while ( $lignetemps = <FICH> ) {
    chomp( $lignetemps );
    push( @tabtime, $lignetemps );  # @tabtime = tableau des noms de temps
}
close( TEMPS );

open( DICO, "<:encoding(utf8)", $fichiertopo )
        or die( "Impossible d'ouvrir le fichier : ", $!, "\n" );
while ( $lignedic = <FICH> ) {
    chomp( $lignedic );
    push( @topo, $lignedic );  # @topo = tableau des noms de lieu
}
close( DICO );

foreach my $cellule ( @phrases ) {
    if ( grep( /\b(En|En|A|À|Au|Le|Ce|Du|Au).+/, $cellule ) ) { # Si la cellule commence par l'expression régulière
        push( @entite, $cellule );
    }
}

foreach my $celplace ( @entite ) {

    #$cellieu = $cellieu.@dico
    @places = ( grep( /\b$cellieu/ . @topo );    #places = tableau des entités de lieu
}

foreach my $celtime ( @entite ) {
    @times = ( grep( /\b@entite.@tabtime/ ) );     #times = tableau des entité de temps
}

foreach my $entitetemps ( @times ) {
    $entitelieu = "<temps>.$entitetemps.</temps>";
}

foreach my $entitelieu ( @places ) {
    $entitelieu = "<lieu>.$entitetemps.</lieu>";

close( TEXT );

Answer 1

I have my doubts that just finding anything in one array followed by anything in another is sufficient. Language isn't generally that well behaved, and usually requires a lot more work to match real phrases

However, I can easily answer your question directly. It is simply a matter of building a regex pattern as a string and then compiling it

I've used locations A, B and C, and moments X, Y and Z. With sprintf and join I've built a regex which represents a word boundary, then any of any of the first array, then some whitespace, then any of the second array, and another word boundary

I hope this helps

use strict;
use warnings 'all';
use feature 'say';

chomp( my @data = <DATA> );

my @topo  = qw/ A B C /;
my @times = qw/ X Y Z /;

my $re = sprintf '\b(%s)\s+(%s)\b',
    join( '|', @topo ),
    join( '|', @times );

say "Regex: $re\n";  # Display the regex we've built

$re = qr/$re/i;      # Compile the regex with case-independence

say 'All Data';
say for @data;

say '---';

say 'Matching Data';
say for grep /$re/, @data;

__DATA__
R P G X
E U Q B
K B V X
R J Q X
B Y H V
R L E D
A C Y T
G B Z O
P B Z X
R C X J
Y P N I
U L E O
M C Z V
I R T X

output

Regex: \b(A|B|C)\s+(X|Y|Z)\b

All Data
R P G X
E U Q B
K B V X
R J Q X
B Y H V
R L E D
A C Y T
G B Z O
P B Z X
R C X J
Y P N I
U L E O
M C Z V
I R T X
---
Matching Data
B Y H V
A C Y T
G B Z O
P B Z X
R C X J
M C Z V