perl logo Perl logo (Thanks to Olaf Alders)

The weekly challenge 310 - Task 1: Arrays Intersection

 1 #!/usr/bin/env perl
 2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-310/#TASK1
 3 #
 4 # Task 1: Arrays Intersection
 5 # ===========================
 6 #
 7 # You are given a list of array of integers.
 8 #
 9 # Write a script to return the common elements in all the arrays.
10 #
11 ## Example 1
12 ##
13 ## Input: $list = ( [1, 2, 3, 4], [4, 5, 6, 1], [4, 2, 1, 3] )
14 ## Output: (1, 4)
15 #
16 ## Example 2
17 ##
18 ## Input: $list = ( [1, 0, 2, 3], [2, 4, 5] )
19 ## Output: (2)
20 #
21 ## Example 3
22 ##
23 ## Input: $list = ( [1, 2, 3], [4, 5], [6] )
24 ## Output: ()
25 #
26 ############################################################
27 ##
28 ## discussion
29 ##
30 ############################################################
31 #
32 # Let's create a result hash. For reach element of each list, we
33 # increase the corresponding hash element by 1. In the end, we
34 # delete all hash elements where the value is less than the number
35 # of arrays.
36 # I could have stopped there assuming there won't be any
37 # duplicates in any of the lists, but the task was not 100% clear
38 # whether or not duplicates could happen. So I corrected for
39 # duplicates by counting all elements in a temporary hash for each
40 # individual list and correct the count in the result hash in
41 # case a duplicate was found.
42 #
43 
44 use v5.36;
45 
46 array_intersection( [1, 2, 3, 4], [4, 5, 6, 1], [4, 2, 1, 3] );
47 array_intersection( [1, 0, 2, 3], [2, 4, 5] );
48 array_intersection( [1, 2, 3], [4, 5], [6] );
49 array_intersection( [1, 2, 3, 4], [4, 5, 6], [4, 2, 1, 3, 4, 1] );
50 
51 sub array_intersection( @list ) {
52    print "Input: (";
53    foreach my $l (@list) {
54       print "[" . join(", ", @$l) . "], ";
55    }
56    say ")";
57    my $result = {};
58    my $count = 0;
59    foreach my $l (@list) {
60       my $tmp = {};
61       $count++;
62       map { $result->{$_}++ } @$l;
63       map { $tmp->{$_}++ } @$l;
64       # correct for duplicates
65       foreach my $key (keys %$tmp) {
66          my $t = $tmp->{$key};
67          if($t > 1) {
68             $t--;
69             $result->{$key} -= $t;
70          }
71       }
72    }
73    foreach my $key (keys %$result ) {
74       delete $result->{$key} unless $result->{$key} == $count;
75    }
76    say "Output: (" . join(", ", sort {$a <=> $b} keys %$result) . ")";
77 }