i guess it's all related to the split or the join

I would guess so too. You split on /\s+/ but you join with " " so there's clearly going to be a change in the whitespace there if you have anything other than single whitespaces between the words in your input.

Since you check for \b anyway, why not split on that instead and then check each field for an alpha character before doing your comparison? You could then join on ''.

Alternatively look into using one of the many text parsing modules.

Thanks a lot, certainly seems like a better solution. Will for sure try it out.

I'm quite new to perl and certainly a novice regarding regex so I'm sure there is plenty mistakes on that front.

If you say that you “are new at this,” then you are certainly off to a good start.   :-)

hippo, are there any particular text-parsing modules that you might suggest, to do a thing like this?

Hello larsb, and welcome to the Monastery!

Another approach is to modify the text of the file by using s///g to replace each repeated word with its marked version. The following script shows one way to do this (but it doesn’t take into account the maximum number of words allowed between repeats):

#! perl
use strict;
use warnings;

my $file = do { local $/; <DATA>; };        # Slurp the whole file int
+o a string

# Make a hash that maps each word to its word count in the file
my %words;
 ++$words{lc $_} for split /\W+/, $file;

# Construct a regular expression to match each word which appears at l
+east twice
my $str = join '|', grep { $words{$_} > 1 } keys %words;
my $re  = qr{($str)}i;

$words{$_} = 0 for keys %words;             # Re-set the word counts t
+o zero

# Mark the second and subsequent occurrences of each word
$file =~ s{$re}{ $words{lc $1}++ ? "*$1*" : $1 }eg;

print $file;

__DATA__
To be or not to be; that is to be the question.
Is that the question? Yes!
[download]

Output:

 0:13 >perl 1369_SoPW.pl
To be or not *to* *be*; that is *to* *be* the question.
*Is* *that* *the* *question*? Yes!

 0:13 >
[download]

Hope that helps,

Oops!

Try replacing __DATA__ with:

To be or not to be?
Today Glastonbury tomorrow Brighton!
[download]

Output:

To be or not *to* *be*?
*To*day Glas*to*nbury *to*morrow Brigh*to*n!
[download]

:-)

Update: Worse (and incomprehensibly to me), replacing __DATA__ with:

To be or not?
Today Glastonbury tomorrow Brighton!
[download]

gives:

T**o** **b**e** **o**r** **n**o**t**?**
**T**o**d**a**y** **G**l**a**s**t**o**n**b**u**r**y** **t**o**m**o**r*
+*r**o**w**
 **B**r**i**g**h**t**o**n**!**
[download]

Hello Not_a_Number,

Two excellent catches!

The first problem occurs because the regex is matching parts (substrings) of words. It can be fixed by adding a test for word boundaries (\b) before and after each word in the regex. The second problem occurs when there are no repeated words at all, in which case the regex becmes (?^i:()), which matches the empty string. It can be fixed by an explicit test. Here is a revised script:

#! perl
use strict;
use warnings;
use List::Util qw(any);

my $file = do { local $/; <DATA>; };        # Slurp the whole file int
+o a string

# Make a hash that maps each word to its word count in the file
my %words;
 ++$words{lc $_} for split /\W+/, $file;

# Construct a regular expression to match each word which appears at l
+east twice
my $re;

if (any { $_ > 1 } values %words)
{
    my $str = '\\b' . join('\\b|\\b', grep { $words{$_} > 1 } keys %wo
+rds) . '\\b';
    $re = qr{($str)}i;
}

$words{$_} = 0 for keys %words;             # Re-set the word counts t
+o zero

# Mark the second and subsequent occurrences of each word
$file =~ s{$re}{ $words{lc $1}++ ? "*$1*" : $1 }eg if $re;

print $file;
[download]

Thanks!

Athanasius <°(((>< contra mundum

Iustus alius egestas vitae, eros Piratica,

Thanks for the welcome and the data.

I have to admit though that this is way above my head, maybe in a year or so i will understand. Very nice to see such short solutions compared to mine.

#!/usr/bin/perl

# http://perlmonks.org/?node_id=1141535

use strict;
use warnings;

my $numwords = 40;

$_ = "To be or not to be.\n"; # or read from file...

my @previous; # holds the $numwords previous words
s/(\w+)/
  my $match = grep lc $1 eq lc, @previous;
  push @previous, $1;
  @previous > $numwords and shift @previous;
  $match ? "*$1*" : $1 /ge;

print;
[download]

Thanks, that regex really opened up my eyes to what can be accomplished.

Aye ... and the Perl language will never cease in doing just-exactly that.   If you ever pondered, “so, what is all the Fuss about?,” well, “here it is.”