One better way would be to first match all patterns multiple times and then filter the list using a hash:

use strict;
use warnings;

my $word = "zezl";
my $dictword = "zezezl";

my @pairs = $word =~ /(?=(..))/g;

my $matcher = qr/(?=(@{[join "|", @pairs]}))/;


my %seen;
my $matches = 0;
my @matches;
foreach my $match ($dictword =~ /$matcher/g) {
    if (not exists $seen{$match}) {
        $matches ++;
        push @matches, $match;
    }
    $seen{$match} = 1;
}

print "Matches: @matches\n";
print "$matches $dictword \n";
[download]

The main idea is to get every pair to get matched only once BUT if there are two pairs identical in the keyword and in the dictionary there are 2 identical keywords too, then every keyword will get matched once..

I will try to elaborate:
keyword:zezlze --> ze ez zl lz ze
dicWord:zezezd --> ze ez ze ez zd

so the score of this part should be 3 as the ze appears twice and each one is matched with the corresponding and the ez is matched once ONLY as second ez the dictionary word hasn't found another match in the keyword

I hope that I explained well, if not, Please let me know.

Thank you very much for your help

Based on my last code, you could add a hash with the number of occurrence of every pair and then check if this pair was already matched this often:

use strict;
use warnings;

my $word = "zezlze";
my $dictword = "zezezd";

my @pairs = $word =~ /(?=(..))/g;
my %count;

$count{$_}++ foreach (@pairs);

my $matcher = qr/(?=(@{[join "|", @pairs]}))/;


my %seen;
my $matches = 0;
my @matches;
foreach my $match ($dictword =~ /$matcher/g) {
    if ($seen{$match}++ < $count{$match}) {
        $matches ++;
        push @matches, $match;
    }
}

print "Matches: @matches\n";
print "$matches $dictword \n";
[download]

results in

Matches: ze ez ze
3 zezezd
[download]

I'm not exactly sure what you want to achieve, but from what I read I would think you want matching pairs in $matcher instead of zero-length assertions, as in:

my $matcher = qr/(?:(@{[join "|", @pairs]}))/;
[download]

Which gives 3 matches instead of 5 (likewise for $dictword = "zeezze";.)

If I' completely wrong, please clean the syntax/stricture errors in your OP first.

I've updated the code and the current one is compiling right, sorry but didn't have much sleep. The problem still exist actually as I want it when it when one pair get matched once, it can't get matched again so for the current one, it should give only score 2 (ze and ez gets matched once each) and not 4 where it match each pair twice.

The example here has the same fault, it supported me but this problem still exist..

Hope you could help ....

my $matcher = do
   {
       local $" = q{|};
       qr{(?=(@pairs))};
   };
[download]

Also, you can avoid having to escape the double quotes in your print statements when you want to interpolate by using quoting constructs (qq{...} for double quotes).

$ perl -e '
> @arr = qw{a b c};
> print qq{"@arr"\n};'
"a b c"
$
[download]

I hope these points are useful.

Cheers,

JohnGG

will try to elaborate:
keyword:zezlze --> ze ez zl lz ze
dicWord:zezezd --> ze ez ze ez zd
so the score of this part should be 3 as the ze appears twice and each one is matched with the corresponding and the ez is matched once ONLY as second ez the dictionary word hasn't found another match in the keyword

Here are two ways:

my @kw = sort qw( ze ez zl lz ze );
my @dw = sort qw( ze ez ze ez zd );

my $c = 0;
my $kw_i = 0;
my $dw_i = 0;
while ($kw_i < @kw && $dw_i < @dw) {
   if ($kw[$kw_i] lt $dw[$dw_i]) { ++$kw_i; next; }
   if ($dw[$dw_i] lt $kw[$kw_i]) { ++$dw_i; next; }
   ++$c;
   ++$kw_i;
   ++$dw_i;
}
[download]

my $dw = ' ' . join(' ', qw( ze ez ze ez zd ));
my @kw = qw( ze ez zl lz ze );

my $c = 0;
my $dw_ = $dw;
for my $kw_part (@kw) {
   my $pos = index($dw_, " $kw_part");
   next if $pos < 0;
   substr($dw_, $pos+1, 2, '');
   ++c;
}
[download]

Untested.
I made them non-destructive.

It may be a small modification to the code I provided for dice's coefficient is what you are after. Consider: (note the two lines with the trailing ##)

use strict;
use warnings;
use List::Compare;

my @words = qw(dictate world mamal zezl);
my %dict;

# Build a lookup for the dictionary words
while (defined (my $word = <DATA>)) {
    chomp $word;
    next unless length $word;
    
    my %dup;
    my @bigrams = grep {! $dup{$_}++} $word =~ /(..)/g; ##
   
    next unless @bigrams;
    $dict{$word} = \@bigrams;
}

# Process the given words
for my $word (@words) {
    my %dup;
    my @bigrams = grep {! $dup{$_}++} $word =~ /(..)/g; ##

    next unless @bigrams;

    for my $dictWord (keys %dict) {
        my $lc = List::Compare->new($dict{$dictWord}, \@bigrams);
        my @common = $lc->get_intersection ();
        my $diceCoef = 2 * @common / (@bigrams + @{$dict{$dictWord}});
       
        next unless $diceCoef;
        print "Dice coefficient for '$word' and '$dictWord' is $diceCo
+ef\n";
    }
}


__DATA__
words
zezezl
[download]

Prints:

Dice coefficient for 'world' and 'words' is 0.5
Dice coefficient for 'zezl' and 'zezezl' is 1
[download]