Task — Count common

You are given two array of strings, @str1 and @str2. Write a script to return the count of common strings in both arrays.

Examples

Example 1
Input: @str1 = ('perl', 'weekly', 'challenge')
       @str2 = ('raku', 'weekly', 'challenge')
Output: 2

Example 2
Input: @str1 = ('perl', 'raku', 'python')
       @str2 = ('python', 'java')
Output: 1

Example 3
Input: @str1 = ('guest', 'contribution')
       @str2 = ('fun', 'weekly', 'challenge')
Output: 0

Analysis

Well, this looked easy until I wondered about repeated strings. For example:

@str1 = ('fred', 'fred', 'fred');
@str2 = ('fred', 'fred');

Do we report 1, because 'fred' is the only string that appears in both arrays, or 2 because there are only 2 pairs of 'fred', or 3 because each of the three 'fred' strings in @str1 matches a string in @str2.

I decided to go with 2. if you rephrase the challenge as follows, then my solution gives the answer: 'How many times can you delete a string from @str1 and delete the same string from @str2'.

Deleting something from the middle of an array is messy, so I started by creating $one, which is a concatenation of the strings in @str1 using a '~' character as separator, and as the first and last character. Then I count the number of times I can do $one =~ s|~$s~|~| while iterating $s along @str2.

That algorithm also works for edge cases such as either of both arrays being empty.

Try it 

#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use v5.26;    # The Weekly Challenge - 2025-02-10
use utf8;     # Week 308 - task 1 - Count common
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';

count_common(['fred', 'jim', 'max', 'john'], ['john', 'bill', 'fred', 'alex']);
count_common(['fred', 'fred', 'fred'], ['joe', 'joe']);
count_common(['fred', 'fred', 'fred'], ['fred', 'fred', 'alice']);
count_common(['fred', 'fred', 'fred'], []);
count_common([], ['fred', 'fred', 'fred']);
count_common([], []);
count_common(['axe', 'bean', 'cabbage', 'dog', 'egg'], ['egg', 'axe', 'cabbage', 'bean', 'dog']);

sub count_common {
    
    my (@str1, @str2, $one, $count, $s);
    
    @str1 = @{$_[0]};
    @str2 = @{$_[1]};
    $count = 0;
    
    # join @str1 into a string separated by ~
    $one = '~' . join('~', @str1) . '~';
    
    # count times we can delete a member of @str2 from the string
    for $s (@str2) {
        $count ++ if $one =~ s|~$s~|~|;
    }
    
    say qq[\nInput:  \@str1 = ('] . join(q[', '], @str1) . qw[')];
    say qq[        \@str2 = ('] . join(q[', '], @str2) . qw[')];
    say qq[Output: $count];
}

Output

Input:  @str1 = ('fred', 'jim', 'max', 'john')
        @str2 = ('john', 'bill', 'fred', 'alex')
Output: 2

Input:  @str1 = ('fred', 'fred', 'fred')
        @str2 = ('joe', 'joe')
Output: 0

Input:  @str1 = ('fred', 'fred', 'fred')
        @str2 = ('fred', 'fred', 'alice')
Output: 2

Input:  @str1 = ('fred', 'fred', 'fred')
        @str2 = ('')
Output: 0

Input:  @str1 = ('')
        @str2 = ('fred', 'fred', 'fred')
Output: 0

Input:  @str1 = ('')
        @str2 = ('')
Output: 0

Input:  @str1 = ('axe', 'bean', 'cabbage', 'dog', 'egg')
        @str2 = ('egg', 'axe', 'cabbage', 'bean', 'dog')
Output: 5