Menambahkan kata 'pengecualian' ke aturan skrip judul pencocokan perl

Saya telah menggunakan skrip perl ini (terima kasih kepada Jeff Schaller) untuk mencocokkan 3 atau lebih kata dalam bidang judul dari dua file csv terpisah seperti yang dijawab di sini:

Mencocokkan 3 atau lebih kata dari bidang dalam file csv terpisah

Scriptnya adalah:

#!/usr/bin/env perl

my @csv2 = ();
open CSV2, "<csv2" or die;
@csv2=<CSV2>;
close CSV2;

my %csv2hash = ();
for (@csv2) {
  chomp;
  my ($title) = $_ =~ /^.+?,\s*([^,]+?),/; #/ match the title 
  $csv2hash{$_} = $title;
}

open CSV1, "<csv1" or die;
while (<CSV1>) {
  chomp;
  my ($title) = $_ =~ /^.+?,\s*([^,]+?),/; #/ match the title 
  my @titlewords = split /\s+/, $title;    #/ get words
  my $desired = 3;
  my $matched = 0;
  foreach my $csv2 (keys %csv2hash) {
    my $count = 0;
    my $value = $csv2hash{$csv2};
    foreach my $word (@titlewords) {
      ++$count if $value =~ /\b$word\b/i;
      last if $count >= $desired;
    }
    if ($count >= $desired) {
      print "$csv2\n";
      ++$matched;
    }
  }
  print "$_\n" if $matched;
}
close CSV1;

Sejak itu saya menyadari bahwa saya ingin mengabaikan kata-kata tertentu di antara judul-judul dan tidak mengklasifikasikannya sebagai kata-kata yang cocok. Saya telah menggunakan sed untuk menghapusnya sebelum file csv dibandingkan tetapi ini tidak ideal karena saya kehilangan data dalam proses. Bagaimana saya bisa menambahkan kata-kata yang akan dianggap sebagai pengecualian untuk skrip perl ini? Sebagai contoh, katakanlah jika saya ingin skrip mengabaikan tiga kata yang terpisah and ifdan theketika mencocokkan judul sehingga mereka akan menjadi pengecualian dari aturan.

Setelah garis

my @titlewords = split /\s+/, $title;    #/ get words

tambahkan kode untuk menghapus kata-kata dari array:

my @new;
foreach my $t (@titlewords){
    push(@new, $t) if $t !~ /^(and|if|the)$/i;
}
@titlewords = @new;

Hal ini sangat mirip dengan jawaban @ meuh ini, tapi bukannya menambahkan foreachlingkaran setelah splitline, Anda hanya perlu menambahkan satu baris ada, baik menggunakan perl's grepfungsi atau nya mapfungsi:

@titlewords = grep (!/^(and|if|the)$/i, @titlewords);

atau

@titlewords = map { /^(and|if|the)$/i ? () : $_ } @titlewords;

Lihat perldoc -f grepdan perldoc -f mapuntuk detail lebih lanjut tentang fungsi-fungsi ini dan perbedaan di antara mereka. Mereka biasanya digunakan (terutama map) dalam banyak perlskrip, jadi ada baiknya meluangkan waktu untuk memahami apa yang mereka lakukan dan mempelajari cara kerjanya.

BTW, JANGAN gunakan #!/usr/bin/env perl. Menggunakan envseperti itu cukup dengan buruk pythondan rubyskrip (di mana itu, sayangnya, konvensi), tapi itu benar-benar rusak untuk perlscript dan pasti tidak dengan cara konvensional untuk menjalankannya.

perlmemiliki banyak opsi baris perintah yang mengubah perilakunya dalam cara yang signifikan, tergantung pada jenis program yang Anda coba tulis. Menggunakan envuntuk menjalankan juru bahasa seperti perlbenar - benar menghancurkan kemampuan untuk meneruskan opsi baris perintah ke juru bahasa (karena envtidak mendukungnya. envBahkan tidak dirancang untuk digunakan untuk tujuan ini, melakukannya hanya peretasan jelek yang mengambil keuntungan dari efek samping dari envtujuan aktual - yaitu mengatur variabel lingkungan sebelum menjalankan program).

Gunakan #!/usr/bin/perlsebaliknya (atau apa pun jalan menuju perlpenerjemah Anda ).

Berikut skrip perl lain yang melakukan apa yang Anda inginkan - tetapi ini menggunakan skrip Class::CSVdan List::Comparemodul, serta dua Hash-of-Array untuk membandingkan file CSV:

#! /usr/bin/perl

use strict;
use warnings;

use Class::CSV;
use List::Compare;

sub parse_csv($%) {
  my($filename,$tw) = @_;

  # exclude the following word list and the "empty word"
  my @exceptions = qw(and if the);
  my $exceptions = '^(\s*|' . join('|',@exceptions) . ')$';


  my $csv = Class::CSV->parse(
      filename => $filename,
      fields   => [qw/id title num1 num2/]
  );

  # build a hash-of-arrays (HoA), keyed by the CSV line. Each array
  # contains the individual words from each title for that line (except
  # for those matching $exceptions).  The words are all converted to
  # lowercase to enable case-insensitive matches.
  foreach my $line (@{$csv->lines()}) {

    # The following three lines are required because the input file has
    # fields separated by ', ' rather than just ',' which makes
    # Class::CSV interpret the numeric fields as strings.
    # It's easier/quicker to do this than to rewrite using Text::CSV.
    #
    # The final output will be properly-formed CSV, with only a comma as
    # field separator and quotes around the title string.
    my $key = join(',',$line->id,'"'.$line->title.'"',$line->num1,$line->num2);
    $key =~ s/([",])\s+/$1/g;   # trim whitespace immediately following " or ,
    $key =~ s/\s+([",])/$1/g;   # trim whitespace immediately preceding " or ,

    # If it wasn't for the not-quite-right CSV format, we could just use:
    #my $key = $line->string;

    push @{ $tw->{$key} }, grep (!/$exceptions/oi, split(/\s+/,$line->title));
  };
};

# two hashes to hold the titlewords HoAs
my %tw1=();
my %tw2=();

parse_csv('csv1',\%tw1);
parse_csv('csv2',\%tw2);

# now compare the HoAs
foreach my $k2 (sort keys %tw2) {
  my @matches = ();
  foreach my $k1 (sort keys %tw1) {
    my $lc = List::Compare->new('-u', \@{ $tw2{$k2} }, \@{ $tw1{$k1} });
    push @matches, $k1 if ($lc->get_intersection ge 3);
  };
  print join("\n",sort(@matches,$k2)),"\n\n" if (@matches);
};

Keluaran:

11,"The Sun Still Shines in Reading",64312,464566
97,"Reading Still Shines",545464,16748967

Setiap kelompok kecocokan diurutkan dan, meskipun output sampel tidak menunjukkannya (karena hanya ada satu kelompok kecocokan), masing-masing kelompok dicetak sebagai paragraf terpisah (yaitu dipisahkan oleh baris kosong)

BTW, jika Anda tidak ingin tanda kutip ganda di sekitar bidang judul, edit my $key=join(...)baris yang menambahkannya sehingga tidak.