aboutsummaryrefslogtreecommitdiff
path: root/challenge-209/dave-jacoby/perl/ch-2.pl
blob: 5516082ae50c6ed927b847c4cc3a4a27f996bb26 (plain)
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
#!/usr/bin/env perl

use strict;
use warnings;
use experimental qw{ say postderef signatures state };

use List::Compare;
use JSON;
my $json = JSON->new->pretty;

my @examples = (

    [
        [ 'A', 'a1@a.com', 'a2@a.com' ],
        [ 'B', 'b1@b.com' ],
        [ 'A', 'a3@a.com', 'a1@a.com' ]
    ],
    [
        [ 'A', 'a1@a.com', 'a2@a.com' ],
        [ 'B', 'b1@b.com' ],
        [ 'A', 'a3@a.com' ],
        [ 'B', 'b2@b.com', 'b1@b.com' ]
    ],
);

for my $e (@examples) {
    my $i = format_mailbox( $e->@* );
    my @o = merge_mailbox( $e->@* );
    my $o = format_mailbox(@o);
    say <<"END";
    Input:  \@accounts = 
      $i
    Output: 
      $o
END
    say '';
}

# yes, a more complex version of JSON->encode
sub format_mailbox (@accounts) {
    @accounts = sort { $a->[0] cmp $b->[0] } @accounts;
    my $output = join ",\n\t", map { qq{[$_]} }
        map {
        join ',',
            map { qq{"$_"} }
            $_->@*
        } @accounts;
    $output = join ' ', '[', $output, ']';
    return $output;
}

sub merge_mailbox (@input) {
    my @accounts = @input;
    for my $i ( 0 .. -2 + scalar @accounts ) {
        my $ai = $accounts[$i];
        my @ii = $ai->@*;
        shift @ii;
        for my $j ( $i + 1 .. -1 + scalar @accounts ) {
            my $aj = $accounts[$j];
            next unless defined $aj;
            my @jj = $aj->@*;
            shift @jj;
            my $lc    = List::Compare->new( \@ii, \@jj );
            my @inter = $lc->get_intersection;
            if ( scalar @inter ) {
                my @union = $lc->get_union;
                my $ni    = $ai->[0];
                $ai->@* = ( $ni, @union );
                $aj->@* = ();
            }
        }
    }
    @accounts = sort { $a->[0] cmp $b->[0] } grep { scalar $_->@* } @accounts;
    return @accounts;
}