Helmut Mucker

Folge zwei aus der Reihe "Dichten mit Perl": Diesmal geht es um das Reimen. Wir definieren dazu ganz grob:

Reimen: Zwei Worte W1 und W2 sollen sich reimen, wenn vom Ende der Wörter beginnend mindestens zwei aufeinanderfolgende Zeichen übereinstimmem.

Die Anzahl der so übereinstimmenden Zeichen nennen wir den "Reimungsgrad" unserer Wörter. Also: "Perl" und "Kerl" reimen sich mit dem Reimungsgrad 3. Der "Wert" und das "Schwert" reimen sich mit dem Reimungsgrad 4. Das folgende kleine Script erledigt die Berechnung des Grades der Reimung (das klingt furchtbar!) für uns: Es liest einen Eingabetext als Vorlage. Dieser wird zunächst von unerwünschten Zeichen wie zum Beispiel Zahlen befreit (Was reimt sich denn zum Beispiel auf 1957? Etwa 241957?). Anschließend vergleicht es jedes Wort des Textes mit einem als Parameter übergebenen Wort, und zählt dabei , wie viele Zeichen, beginnend von den Wortenden, übereinstimmem.

#!/usr/bin/perl

use strict; use warnings;

$|=1;

my ($INFILE,$inword) = @ARGV;
open (IN,$INFILE) || die "cant open file";
my $text = join "", ;

$text =~ s/[0123456789"'!.,;:-]//g;
$text = lc($text);

my @words = split /\W/, $text;
my %words;

foreach my $word (@words) {

  my $long;
  my $small;

  if (length $word < length $inword) {
    $long = $inword;
    $small = $word;
  } else {
    $long = $word;
    $small = $inword;
  }

  my $ilong = length $long;
  my $ismall = length $small;
  my $count = -1;

  LOOP:
  while ($ismall >= 0) {
    if (substr($small,$ismall,1) eq substr($long,$ilong,1)) {
      $count++;  
    } else {
      last LOOP;
    }
    $ismall--;
    $ilong--;
  }

  if ($count > 0) {
    print "$count $word $inword\n";
  }

}