1 #!/usr/bin/perl
  2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-209/#TASK2
  3 #
  4 # Task 2: Merge Account
  5 # =====================
  6 #
  7 # You are given an array of accounts i.e. name with list of email addresses.
  8 #
  9 # Write a script to merge the accounts where possible. The accounts can only be merged if they have at least one email address in common.
 10 #
 11 # Example 1:
 12 #
 13 # Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
 14 #                      ["B", "b1@b.com"],
 15 #                      ["A", "a3@a.com", "a1@a.com"] ]
 16 #
 17 # Output: [ ["A", "a1@a.com", "a2@a.com", "a3@a.com"],
 18 #           ["B", "b1@b.com"] ]
 19 #
 20 # Example 2:
 21 #
 22 # Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
 23 #                      ["B", "b1@b.com"],
 24 #                      ["A", "a3@a.com"],
 25 #                      ["B", "b2@b.com", "b1@b.com"] ]
 26 #
 27 # Output: [ ["A", "a1@a.com", "a2@a.com"],
 28 #           ["A", "a3@a.com"],
 29 #           ["B", "b1@b.com", "b2@b.com"] ]
 30 #
 31 ############################################################
 32 ##
 33 ## discussion
 34 ##
 35 ############################################################
 36 #
 37 # This is a bit a tricky one. When we walk through the input,
 38 # we can either merge directly to a previous element in the
 39 # output, or we have to append a new element to the output.
 40 # Since corner cases are not considered, there are a few funny
 41 # ones. What do we do if there is no common email address for
 42 # two elements with the same name, but a third element in the
 43 # list has an email address in common with both previous elements?
 44 # We can then either merge with the first, or we could merge all
 45 # three elements - since the task is unclear here, let's implement
 46 # both solutions as alternatives
 47 
 48 use strict;
 49 use warnings;
 50 use Data::Dumper;
 51 
 52 my @accounts = (
 53    ["A", "a1\@a.com", "a2\@a.com"],
 54    ["B", "b1\@b.com"],
 55    ["A", "a3\@a.com", "a1\@a.com"]
 56 );
 57 merge_accounts(@accounts);
 58 merge_accounts_full(@accounts);
 59 
 60 @accounts = (
 61    ["A", "a1\@a.com", "a2\@a.com"],
 62    ["B", "b1\@b.com"],
 63    ["A", "a3\@a.com"],
 64    ["B", "b2\@b.com", "b1\@b.com"]
 65 );
 66 merge_accounts(@accounts);
 67 merge_accounts_full(@accounts);
 68 
 69 @accounts = (
 70    ["A", "a1\@a.com", "a2\@a.com"],
 71    ["B", "b1\@b.com"],
 72    ["A", "a3\@a.com"],
 73    ["B", "b2\@b.com", "b1\@b.com"],
 74    ["A", "a3\@a.com", "a2\@a.com"],
 75 );
 76 merge_accounts(@accounts);
 77 merge_accounts_full(@accounts);
 78 
 79 # helper function: merge the accounts in the given array
 80 # this doesn't merge fully, only if an element already
 81 # has a matching email address in a previous element
 82 # returns the merged array
 83 # This function only does the actual merging, nothing else
 84 sub merge_accounts_ {
 85    my $accounts = shift;
 86    my $result = [];
 87    foreach my $elem (@$accounts) {
 88       my $did_merge = 0;
 89       # if there is an element in the current result set
 90       # that we can merge to, we do that, otherwise we'll
 91       # just add a new element to the result
 92       foreach my $i (0..$#$result) {
 93          if (can_merge_to($elem, $result->[$i])) {
 94             $result->[$i] = merge($result->[$i], $elem);
 95             $did_merge = 1;
 96             last;
 97          }
 98       }
 99       push @$result, $elem unless $did_merge;
100    }
101    return $result;
102 }
103 
104 # helper function to do the actual merging
105 # Just add each email address to the first
106 # element unless it's there
107 # The name will also not be added because it's
108 # already there, no need for special treatment here
109 sub merge {
110    my ($elem1, $elem2) = @_;
111    my $seen;
112    map { $seen->{$_} = 1 } @$elem1;
113    foreach my $part (@$elem2) {
114       next if $seen->{$part};
115       push @$elem1, $part;
116    }
117    return $elem1;
118 }
119 
120 # check whether we can merge two elements
121 # first, we need to check that name is the same
122 # then we need to find at least one matching email address
123 sub can_merge_to {
124    my ($elem1, $elem2) = @_;
125    my $seen;
126    map { $seen->{$_} = 1 } @$elem1;
127    my $name = $elem2->[0];
128    return 0 unless $name eq $elem1->[0];
129    foreach my $part (@$elem2) {
130       next if $part eq $name;
131       return 1 if $seen->{$part};
132    }
133    return 0;
134 }
135 
136 # merge accounts from list when possible, not doing the deep
137 # re-merge if possible. This function does some output and
138 # otherwise calls merge_accounts_ for the actual work
139 sub merge_accounts {
140    my $accounts = [ @_ ];
141    print "Input: [";
142    foreach my $elem (@$accounts) {
143       print " [" . join(", ", @$elem) . "]\n";
144    }
145    print "]\n";
146 
147    my $merged = merge_accounts_($accounts);
148 
149    print "Output: [";
150    foreach my $elem (@$merged) {
151       print " [" . join(", ", @$elem) . "]\n";
152    }
153    print "]\n";
154 }
155 
156 # this is the "full merge" option. We simply merge as before,
157 # but this time, as long as input and output of the actual
158 # merge step differ, we will start over with the current output
159 # as the new input. So we merge unless there is no more possibilty
160 # to merge anything
161 sub merge_accounts_full {
162    my $accounts = [ @_ ];
163    print "Input: [";
164    foreach my $elem (@$accounts) {
165       print " [" . join(", ", @$elem) . "]\n";
166    }
167    print "]\n";
168 
169    my $merged = merge_accounts_($accounts);
170 
171    while(is_same_deeply($accounts, $merged) == 0) {
172       $accounts = $merged;
173       $merged = merge_accounts_($accounts);
174    }
175 
176    print "Output: [";
177    foreach my $elem (@$merged) {
178       print " [" . join(", ", @$elem) . "]\n";
179    }
180    print "]\n";
181 }
182 
183 # helper function
184 # check if two nested arrays have the same elements at the bottom
185 sub is_same_deeply {
186    my ($list1, $list2) = @_;
187    if(scalar(@$list1) != scalar(@$list2)) {
188       return 0;
189    }
190    # two empty lists are the same
191    return 1 unless @$list1;
192    foreach my $i (0..$#$list1) {
193       if(ref($list1->[$i]) ne ref($list2->[$i])) {
194          return 0;
195       }
196       if(ref($list1->[$i]) eq "ARRAY") {
197          return 0 unless is_same_deeply($list1->[$i], $list2->[$i]);
198       }
199    }
200    return 1;
201 }
202