The Weekly Challenge - 277

TASK #1: Count Common
You are given two array of strings, @words1 and @words2.

Write a script to return the count of words that appears in both arrays exactly once.

#!/usr/bin/perl
use strict;
use warnings;

use List::Compare;

sub count_common {

    my ($words1, $words2) = @_;

    # Find common elements using List::Compare
    my $lc = List::Compare->new($words1, $words2);
    my @common_words = $lc->get_intersection;

    my %frequency;

    # Count frequencies of common words in both arrays
    foreach my $word (@common_words) {
        $frequency{$word}{words1} = scalar ( grep { $_ eq $word } @$words1 );
        $frequency{$word}{words2} = scalar ( grep { $_ eq $word } @$words2 );
    }

    # Filter words that appear exactly once in both arrays
    my @filtered_words = grep { $frequency{$_}{words1} == 1 && 
                                $frequency{$_}{words2} == 1 } @common_words;

    return(scalar @filtered_words);
}

# TESTS

my (@words1, @words2);

# Example 1
@words1 = ("Perl", "is", "my", "friend");
@words2 = ("Perl", "and", "Raku", "are", "friend");
print(count_common(\@words1, \@words2), "\n"); # Output: 2

# Example 2
@words1 = ("Perl", "and", "Python", "are", "very", "similar");
@words2 = ("Python", "is", "top", "in", "guest", "languages");
print(count_common(\@words1, \@words2), "\n"); # Output: 1

# Example 3
@words1 = ("Perl", "is", "imperative", "Lisp", "is", "functional");
@words2 = ("Crystal", "is", "similar", "to", "Ruby");
print(count_common(\@words1, \@words2), "\n"); # Output: 0

#!/usr/bin/perl
use strict;
use warnings;

use List::Uniq ':all';
use Math::Combinatorics;

sub strong_pair { 
	
    # Duplicate values are unnecessary and lead to duplicate pairs, 
    # so they should be removed: uniq(@_);

    my $c = Math::Combinatorics->new ( count => 2, data => [uniq(@_)], );

    my $count = 0; 
   
    while ( my @cmb = $c->next_combination ) {
		
        my $abs = abs($cmb[0] - $cmb[1]);
        # finding min(): ($x + $y + abs($x - $y)) / 2 
        # https://www.perlmonks.org/?node_id=406883
        $count++ if ( ($abs < ($cmb[0] + $cmb[1] - $abs) / 2) && ($abs > 0) );
        
    }
  
    return ($count);
}

# TESTS

my @ints;

# Example 1
@ints = (1, 2, 3, 4, 5);
print(strong_pair(@ints), "\n"); # Output: 4

# Example 2
@ints = (5, 7, 1, 7);
print(strong_pair(@ints), "\n"); # Output: 1