The weekly challenge 277 - Task 1: Count Common

 1 #!/usr/bin/env perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-277/#TASK1
 3 #
 4 # Task 1: Count Common
 5 # ====================
 6 #
 7 # You are given two array of strings, @words1 and @words2.
 8 #
 9 # Write a script to return the count of words that appears in both arrays
10 # exactly once.
11 #
12 ## Example 1
13 ##
14 ## Input: @words1 = ("Perl", "is", "my", "friend")
15 ##        @words2 = ("Perl", "and", "Raku", "are", "friend")
16 ## Output: 2
17 ##
18 ## The words "Perl" and "friend" appear once in each array.
19 #
20 ## Example 2
21 ##
22 ## Input: @words1 = ("Perl", "and", "Python", "are", "very", "similar")
23 ##        @words2 = ("Python", "is", "top", "in", "guest", "languages")
24 ## Output: 1
25 #
26 ## Example 3
27 ##
28 ## Input: @words1 = ("Perl", "is", "imperative", "Lisp", "is", "functional")
29 ##        @words2 = ("Crystal", "is", "similar", "to", "Ruby")
30 ## Output: 0
31 #
32 ############################################################
33 ##
34 ## discussion
35 ##
36 ############################################################
37 #
38 # For each word in both arrays, count their number of occurrences.
39 # In the end, for each word, add 1 to the output of it occurs in both
40 # arrays exactly once.
41 
42 use strict;
43 use warnings;
44 
45 count_common( ["Perl", "is", "my", "friend"], ["Perl", "and", "Raku", "are", "friend"] );
46 count_common( ["Perl", "and", "Python", "are", "very", "similar"], ["Python", "is", "top", "in", "guest", "languages"] );
47 count_common( ["Perl", "is", "imperative", "Lisp", "is", "functional"], ["Crystal", "is", "similar", "to", "Ruby"] );
48 
49 sub count_common {
50    my $words1 = shift;
51    my $words2 = shift;
52    my $all_words = {};
53    print "Input: (", join(", ", @$words1), "), (", join(", ", @$words2), ")\n";
54    # count words in first array
55    foreach my $word (@$words1) {
56       $all_words->{$word}->{"1"}++;
57    }
58    # count words in second array
59    foreach my $word (@$words2) {
60       $all_words->{$word}->{"2"}++;
61    }
62    my $output = 0;
63    foreach my $word (keys %$all_words) {
64       next unless $all_words->{$word}->{"1"};
65       next unless $all_words->{$word}->{"2"};
66       $output++ if $all_words->{$word}->{"1"} == 1 && $all_words->{$word}->{"2"} == 1;
67    }
68    print "Output: $output\n";
69 }