1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
#!/usr/bin/env perl
# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
#=============================================================================
# ch-2.pl Perl Weekly Challenge 209 Task 2 Merge Account
#=============================================================================
# Copyright (c) 2023, Bob Lied
#=============================================================================
# You are given an array of accounts i.e. name with list of email addresses.
# 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.
# Example 1:
# Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
# ["B", "b1@b.com"],
# ["A", "a3@a.com", "a1@a.com"] ]
# Output: [ ["A", "a1@a.com", "a2@a.com", "a3@a.com"], ["B", "b1@b.com"] ]
#
# Example 2: Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
# ["B", "b1@b.com"],
# ["A", "a3@a.com"],
# ["B", "b2@b.com", "b1@b.com"] ]
# Output: [ ["A", "a1@a.com", "a2@a.com"],
# ["A", "a3@a.com"],
# ["B", "b1@b.com", "b2@b.com"] ]
#
#=============================================================================
use v5.36;
use List::Util qw/uniq first/;
use Getopt::Long;
my $Verbose = 0;
my $DoTest = 0;
GetOptions("test" => \$DoTest, "verbose" => \$Verbose);
exit(!runTest()) if $DoTest;
# Merge two lists if they have an element in common. If they can be
# merged, then the first list will be modified.
sub merge($one, $two)
{
# For each email in the first list (first element is account name)
for my $email ( $one->@[1 .. $#{$one}] )
{
# If it exists in the second list, then they have something
# in common and should be merged.
if ( first { $_ eq $email } $two->@[1 .. $#{$two}] )
{
# Make a combined list, but with unique elements
return [ sort { $a cmp $b } uniq @$one, @$two ];
}
}
return undef;
}
sub mergeAccount($accounts)
{
my @merged;
# Collect all the account names, first element in each array
my @acctName = sort { $a cmp $b } uniq map { $_->[0] } @$accounts;
for my $n ( @acctName )
{
my @list = ( grep { $_->[0] eq $n } @$accounts );
for ( my $i = 0 ; $i < $#list ; $i++ )
{
for ( my $j = 0; $j <= $#list ; $j++ )
{
next if $j == $i;
next unless defined $list[$j];
if ( my $m = merge($list[$i], $list[$j]) )
{
$list[$i] = $m;
$list[$j] = undef;
$j = 0; # Rescan
}
}
}
push @merged, grep { defined $_ } @list;
}
return \@merged;
}
sub runTest
{
use Test2::V0;
my @accounts = ( ["A", 'a1@a.com', 'a2@a.com'],
["B", 'b1@b.com'],
["A", 'a3@a.com', 'a1@a.com'] );
is( mergeAccount(\@accounts),
[ [ qw(A a1@a.com a2@a.com a3@a.com) ], [ qw(B b1@b.com) ] ],
, "Example 1");
@accounts = ( ['A', 'a1@a.com', 'a2@a.com'],
['B', 'b1@b.com'],
['A', 'a3@a.com'],
['B', 'b2@b.com', 'b1@b.com'] );
is( mergeAccount(\@accounts),
[ [ qw(A a1@a.com a2@a.com) ],
[ qw(A a3@a.com) ],
[ qw(B b1@b.com b2@b.com) ] ],
, "Example 2");
@accounts = ( ['A', 'a1@a.com', 'a2@a.com'],
['B', 'b1@b.com'],
['A', 'a3@a.com'],
['B', 'b2@b.com', 'b1@b.com'],
['A', 'a3@a.com', 'a4@a.com' ],
['A', 'a1@a.com', 'a4@a.com' ],
['B', 'b3@b.com'] );
my $expected = [ [ qw(A a1@a.com a2@a.com a3@a.com a4@a.com) ],
[ qw(B b1@b.com b2@b.com) ],
[ qw(B b3@b.com) ] ];
my $actual = mergeAccount(\@accounts);
is( $actual, $expected, "Transitive merge all A");
done_testing;
}
|
